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

	SUBROUTINE day(line2)

c
c	Declarations:
c
	CHARACTER LINE2(80)
	character line(80)		
	CHARACTER*18 LINE16
	EQUIVALENCE(LINE(1),LINE16)
c 	input line
	CHARACTER*2 TEMP2
	character temp(2)		
	EQUIVALENCE(TEMP(1),TEMP2)
c 	temporary string converting array
	character appoin(60)		
c 	appointment string
	character work(60)           
c   scratch array for handling scheduling
	character esc		
c 	escape character
	integer	id		
c 	Julian Day
	integer im		
c 	Julian Month
	integer iye		
c 	Julian Year
	integer rdspfg          
c   flag to reverse sense of display of time
	character junk(130)
	integer ctlfg           
c   misc control flags here
	INTEGER IDYR,IDMO,IDDY
	COMMON/DEFDAT/IDYR,IDMO,IDDY
	common/ctls/rdspfg,ctlfg
	character fname(60)
	CHARACTER*18 FNAM60
	EQUIVALENCE(FNAME(1),FNAM60)
	integer fnsz
	common/fn/fnsz,fname

c
c	Initialize:
c
	DO 933 IV=1,80
933	LINE(IV)=LINE2(IV)
	iterm = 0		
c 	Output terminal unit number
	esc = 27		
c 	Escape character
C	call idate(im,id,iye)	
c 	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)
	read(temp2,2)im
c	    decode ( 2 , 2 , temp ) im
	    temp(1) = line(3)
	    temp(2) = line(4)
c	    decode ( 2 , 2 , temp ) id
	read(temp2,2)id
	    temp(1) = line(5)
	    temp(2) = line(6)
c	    decode ( 2 , 2 , temp ) iye
	read(temp2,2)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,'[','2','J',esc,'[','0','1',';','0',
     1  '1','H'
4	format(1X,79a1)

	write(iterm,5) im,id,iye
5	format(1X,10X,'Appointments For ',i2,'/',i2,'/',i2,/)

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

	write(iterm,9)
9	format(1x,'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
c
	  IF(LINE(1).NE.'E') THEN

	    If ( line(2) .eq. ':' ) then
		temp(1) = '0'
		temp(2) = line(1)
	READ(TEMP2,2)IHT
C		decode ( 2 , 2 , temp2 ) 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)
	  READ(TEMP2,2)IHT
C		decode ( 2 , 2 , temp2 ) 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
	temp(1)=line(7)
	temp(2)=line(8)
	READ(temp2,2)ihmx
c		DECODE(2,2,LINE(7))IHMX
		IF(IHMX.LT.5)IHMX=IHMX+12
c		DECODE(2,2,LINE(10))IMMX
	temp(1)=line(10)
	temp(2)=line(11)
	READ(temp2,2)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	
c  Found a space; exit loop
		Do 10 i=1,71
		    line(i) = line(i+1)
10		Continue
11	    Continue
12	    Continue				
c  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
	    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)
c		close(iterm)
C ... SLIGHTLY SCREWY CODE HERE...
	write(0,1955)
1955	format('+ Enter appt here:')
		read(0,913,END=914) (line(i),i=1,60)
913		format(1X,60a1)
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 ( 1,file=FNAM60,status='OLD',form='FORMATTED')
	do 8877 iv=1,9999
c simulate append access by reading to eof
	read(1,8879,end=8878,err=8878)junk
8879	format(130a1)
8877	continue
8878	continue
	backspace 1
	BACKSPACE 1
		IHTSV=IHT
		IF(IDMX.LT.1)IDMX=1
		DO 3005 IVX=1,IDMX
		write(1,614) iye,im,id,iht,(line(i),i=1,60)
		IF((IHT/10)*10.EQ.IHT)THEN
614		format(3i2,i3,60a1)
C THIS IS AN EVEN HOUR ... ADD 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,i3,60a1,\)
	write(1,1600)
1600	format(/)
		close(1)
	END IF
	    End If
	End If

	nunit=1
	Open (nunit,file=FNAM60,status='OLD' ,form='FORMATTED')

100	continue	
c 	loop back up here to continue reading and
			
c 	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(60)=32
	kkk=0
	do 1068 ii=1,59
	if(line(ii).le.31.or.line(ii).eq.'=')kkk=1
	if(kkk.gt.0)line(ii)=32
c	if(line(ii).eq.'=')line(ii)=32
1068	continue
C SKIP WRITING IN SUBSIDIARY FILES IF NOT APPORPRIATE FOR COMMAND...
	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 ( 2,file=line16,status='OLD',form='FORMATTED')
	do 8977 iv=1,9999
c simulate append access by reading to eof
	read(2,8979,end=8978,err=8978)junk
8979	format(130a1)
8977	continue
8978	continue
	backspace 2
	backspace 2
		IHTSV=IHT
		iht=iwht
		IF(IDMX.LT.1)IDMX=1
		DO 3007 IVX=1,IDMX
		write(2,614) iwy,iwm,iwd,iht,(work(i),i=1,60)
		IF((IHT/10)*10.EQ.IHT)THEN
C IF THIS IS AN EVEN HOUR ... ADD THE HALF HOUR
			IHT=IHT+3
		ELSE
C IF THIS IS A HALF HOUR ... MAKE UP TO NEXT HOUR
			IHT=IHT+7
		END IF
3007		CONTINUE
		IHT=IHTSV
	write(2,1600)
	   close(2)
c ****
1119	continue
	CLOSE(NUNIT)
c7663	continue
	DO 7660 II=1,40
7660	IF(LINE(II).LE.' ')LINE(II)=' '
	IF(LINE(1).EQ.' ')THEN
	 DO 7661 II=1,40
7661	 LINE(II)=LINE(II+1)
c	goto 7663
	END IF
	Open(nunit,file=line16,status='old',form='formatted')
	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(1X,60a1,\)
	    call dtcat(1,22)
	End If
	goto 100

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


