c-----------------------------------------------------------------------
c
c	Daily Appointment subroutine
c
c	part of Mitch Wyle's DTC program
c
c	Input: 
c       line - 72 bytes;  Format: D [mmddyy [hh:mm>HH:MM [appointment]]]
c
c	Output:
c		display screen (see below)
c
c-----------------------------------------------------------------------
c

	SUBROUTINE day(line)

c
c	Declarations:
c

	byte line(1)		!	input line
	byte temp(2)		!	temporary string converting array
	byte appoin(60)		!	appointment string
	byte work(60)           !  scratch array for handling scheduling
	byte esc		!	escape character
	integer	id		!	Julian Day
	integer im		!	Julian Month
	integer iye		!	Julian Year
	integer rdspfg          !  flag to reverse sense of display of time
	integer ctlfg           !  misc control flags here
	INTEGER IDYR,IDMO,IDDY
	COMMON/DEFDAT/IDYR,IDMO,IDDY
	common/ctls/rdspfg,ctlfg
	byte fname(60)
	integer fnsz
	common/fn/fnsz,fname

c
c	Initialize:
c

	iterm = 6		!	Output terminal unit number
	esc = "033		!	Escape character
C	call idate(im,id,iye)	!	initialize to today's date
	IM=IDMO
	ID=IDDY
	IYE=IDYR

c
c		Parse that line!
c

c
c		Was there a D on the front?  If so, trim it off:
c

	IDMX=0
	If ( line(1) .eq. 'D' .or.line(1).eq.'d') then
	    Do 1 i=1,70
		line(i) = line(i+2)
1	    Continue

	End If


c
c		If the date was specified in command line then
c		set id, im and iye to the right values:
c

	CALL DATMUN(LINE)
	Do 22 i=1,6
	    IDL=I
	    If ( ( line(i) .gt. '9' ) .or. ( line(i) .lt. '0' ) ) goto 33
22	Continue

c	Six numbers in a row, so decode into numeric date:

	    temp(1) = line(1)
	    temp(2) = line(2)
	    decode ( 2 , 2 , temp ) im
	    temp(1) = line(3)
	    temp(2) = line(4)
	    decode ( 2 , 2 , temp ) id
	    temp(1) = line(5)
	    temp(2) = line(6)
	    decode ( 2 , 2 , temp ) iye
	IDDY=ID
	IDYR=IYE
	IDMO=IM
2	Format(i2)

c
c		Now discard the date part from line string:
c

	    Do 3 i=1,63
		line(i) = line(i+7)
3	    continue
	GOTO 3307
33	continue
C GOT A DELIMITER NOT A NUMERIC IN 1ST 6 COLS SO MAKE THAT THE START OF LINE
C BY CHOPPING OFF ALL THAT'S EARLIER
	IF(IDL.LE.0.OR.IDL.GT.6)GOTO 3307
	DO 3308 I=1,63
		LINE(I)=LINE(I+IDL)
3308	CONTINUE
3307	CONTINUE
c
c		Clear the screen, move the cursor to the top part,
c		set up appointments screen:
c

	write(iterm,4) esc,'<',esc,'[','2','J',esc,'[','0','1',';','0',
     1  '1','H'
4	format(x,79a1)

	write(iterm,5) esc,'#','3',im,id,iye
5	format(x,3a1,10X,'Appointments For ',i2.2,'/',i2.2,'/',i2.2)
	write(iterm,5) esc,'#','4',im,id,iye

	Do 8 i=8,16
	    If ( i .gt. 12 ) then
		j = i - 12
	    Else
		j = i
	    End If
	    write(iterm,6) j
6	    format(x,i2.2,':00   -')
	    write(iterm,7) j
7	    format(x,i2.2,':30   -')
8	Continue

	write(iterm,9)
9	format(x,'Evening:',/,79('='))

c
c	Was a time input?  Did it accompany an appointment string?
c	Why do fools fall in love?
c
	IDMX=0

	if(line(1).eq.'e')LINE(1)='E'
	If (((line(1).le.'9').and.(line(1).ge.'0')).OR.LINE(1)
     1   .EQ.'E') then

c
c		Parse the time string, rock the Casbah:
c
	  IF(LINE(1).NE.'E') THEN

	    If ( line(2) .eq. ':' ) then
		temp(1) = '0'
		temp(2) = line(1)
		decode ( 2 , 2 , temp ) iht
		if ( iht .lt. 5 ) iht = iht + 12
		IHHR=IHT
		iht = iht * 10
		If ( line(3) .eq. '3' ) iht = iht + 3
	    Else If ( line(3) .eq. ':' ) then
		temp(1) = line(1)
		temp(2) = line(2)
		decode ( 2 , 2 , temp ) iht
		If ( iht .lt. 5 ) iht = iht + 12
		IHHR=IHT
		iht = iht * 10
		If ( line(4) .eq. '3' ) iht = iht + 3
	    End If
	  END IF
C HANDLE "EV" MODIFIER FOR EVENING APPOINTMENTS
	IF(LINE(1).EQ.'E')IHT=170
C 170 IS SPECIAL EVENING CODE..... CORRESPONDS TO 5PM...
	IHMX=1
	IDHR=0
	IOMX=6
	IF (LINE(6).EQ.'>') THEN
C IF 2 RANGES EXIST DUPLICATE MESSAGE AFTER EXTRACTING 2ND RANGE
C OF HH:MM
		DECODE(2,2,LINE(7))IHMX
		IF(IHMX.LT.5)IHMX=IHMX+12
		DECODE(2,2,LINE(10))IMMX
		IF(IMMX.NE.30)IMMX=0
C COUNT HALF HOURS IN GIVEN INTERVAL ...
		IDHR=(IHMX-IHHR)*2
C FIND NUMBER ENTRIES TO SHOVE OUT...
		IF(IMMX.NE.0)IDHR=IDHR+1
		IF(IHT.NE.(10*IHHR))IDHR=IDHR-1
		IDHR=MAX0(1,IDHR)
		IDMX=IDHR
C ABOVE CLAMPS POSITIVE... NO INVALID ENTRIES PLEASE...
		IOMX=12
	END IF
c
c		Now look for space delimiter to trim off the time
c		of day part, and then extract the appointment:
c

C USE IOMX SO WE SCAN PAST 2ND RANGE IF ANY...
	    Do 11 io=1,IOMX
		If ( line(1) .eq. ' ') goto 12	! Found a space; exit loop
		Do 10 i=1,71
		    line(i) = line(i+1)
10		Continue
11	    Continue
12	    Continue				! Label to Exit loop

c
c		Was there an appointment string input?
c		If so, put it in file, and display it on screen.
c		If not, move cursor to correct time on screen,
c		then input the appointment, put in file and re-display it.
c		and when the band you're in starts playin different tunes,
c		I'll see you on the dark side of the moon.
c
	    If ( line(1) .lt. ' ' ) then
		itemp = iht / 10
		if ( itemp .gt. 7 ) itemp = itemp - 7
		iy = 2 * itemp + 1
		If ( ( ( iht/10 ) * 10 ) .ne. iht ) iy = iy + 1
		ix = 10
		call dtcat(ix,iy)
		close(iterm)
		read(5,13,END=914) (line(i),i=1,60)
13		format('+',60a1)
914		CONTINUE
	    End If
c copy appointment for use later...
	Do 1118 ivx=1,60
1118	work(ivx)=line(ivx)
	iwy=iye
	iwm=im
	iwd=id
	iwht=iht
	    If ( line(1) .ge. ' ' ) then
C ADD CLOSE TO GUARANTEE NO FAILURES...
                CLOSE(1)
C  If we are using the 'S' command, ONLY add meetings to the indirected
C  files, not to the current (control) file.
	IF(CTLFG.NE.1) THEN
		Open ( unit=1,file=FNAME,status='UNKNOWN',form='FORMATTED',
     1		ACCESS='APPEND')
		IHTSV=IHT
		IF(IDMX.LT.1)IDMX=1
		DO 3005 IVX=1,IDMX
		write(1,14) iye,im,id,iht,(line(i),i=1,60)
		IF((IHT/10)*10.EQ.IHT)THEN
C IHT IS AN EVEN HOUR ... AD THE HALF HOUR
			IHT=IHT+3
		ELSE
C IHT IS A HALF HOUR ... MAKE UP TO NEXT HOUR
			IHT=IHT+7
		END IF
3005		CONTINUE
		IHT=IHTSV
14		format(3i2.2,i3.3,60a1)
		close(1)
	END IF
	    End If
	End If

	nunit=1
	Open (unit=nunit,file=FNAME ,status='OLD' ,form='FORMATTED',
     1		err=99)

100	continue	!	loop back up here to continue reading and
			!	processing input file:


	read(nunit,200,end=400) ihy,ihm,ihd,iht,(line(k),k=1,60)
200	format(3i2,i3,60a1)
	if(ihy.eq.99.and.nunit.eq.1)then
	nunit=2
c null terminate the filename somewhere
c lines with 99 in 1st 2 cols are filenames only...
c use = as delimiter of filename
	line(59)=0
	do 1068 ii=1,59
	if(line(ii).eq.'=')line(ii)=0
1068	continue
	if(CTLFG.eq.0) goto 1119
c ****
c on scheduling multiple dates via the S function, use this occasion to
c add the record to everyone's calendar file.
                CLOSE(2)
		Open ( unit=2,file=line,status='OLD',form='FORMATTED',
     1		ACCESS='APPEND',err=1119)
		IHTSV=IHT
		iht=iwht
		IF(IDMX.LT.1)IDMX=1
		DO 3007 IVX=1,IDMX
		write(2,14) iwy,iwm,iwd,iht,(work(i),i=1,60)
		IF((IHT/10)*10.EQ.IHT)THEN
C IHT IS AN EVEN HOUR ... AD THE HALF HOUR
			IHT=IHT+3
		ELSE
C IHT IS A HALF HOUR ... MAKE UP TO NEXT HOUR
			IHT=IHT+7
		END IF
3007		CONTINUE
		IHT=IHTSV
	   close(2)
c ****
1119	continue
	Open(unit=nunit,file=line,status='old',form='formatted',
     1  err=1067)
	goto 100
	end if
	If ((iye .eq. ihy) .and. (im .eq. ihm) .and. (id .eq. ihd)) then
	    itemp = iht / 10
	    if ( itemp .gt. 7 ) itemp = itemp - 7
	    iy = 2 * itemp + 1
	    If (((iht/10)*10) .ne. iht)	iy = iy + 1
	    ix = 10
	    call dtcat(ix,iy)
	    write(iterm,300) (line(k),k=1,60)
300	    format('+',60a1)
	    call dtcat(1,22)
	End If
	goto 100

400	continue	! no more appointments left in file.
	if(nunit.ne.1)then
1067	continue
	close(2)
	nunit=1
	goto 100
	end if
	close(1)

	return
99	CONTINUE
	OPEN(UNIT=1,FILE=FNAME,STATUS='NEW',FORM='FORMATTED')
	CLOSE(1)
	return
	end