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
c	Modified 850314 to write day-of-week to daily-appointment screen,
c	   and note current time if current day displayed
c		CG
c
	SUBROUTINE day		! (line)
c
c	Declarations:
c
	include 'comdtc.inc/nolist'
	include 'escdtc.inc/nolist'
c
c	byte line(1)		!	input line
	byte temp(2)		!	temporary string converting array
	byte appoin(icmln)	!	appointment string
	byte work(icmln)	!  scratch array for handling scheduling
c	byte esc/"033/		!	escape character
c	integer iterm/6/	! 	Terminal unit #
	integer	id, idr		!	Julian Day
	integer im, imr		!	Julian Month
	integer iye, iyr	!	Julian Year
	integer idx, imx, iyx, isx	! copies for calling DANY
c
	real*8 daylist(7) / '   Sun', '   Mon', '  Tues',
	1 'Wednes', ' Thurs', '   Fri', ' Satur' /
c
c	Initialize:
c
c	iterm = 6		!	Output terminal unit number
c	esc = "033		!	Escape character
c
	call idate(imr,idr,iyr)	!	Get today's date
c
	IM=IDMO
	ID=IDDY
	IYE=IDYR
c
c		Parse that line!
c
c
c
c		Was there a D on the front?  If so, trim it off:
c
	IDMX=0
	If ( line(1) .eq. 'D') then
	    IENDER=1
	    DO 63 I=2,10
	    IF(LINE(I).NE.' '.AND.LINE(I).NE.'	')GO TO 64
	    IENDER=IENDER+1
 63	    CONTINUE
 64	    Do 1 i=1,icmln-iender	! shrink the line back
		line(i) = line(i+IENDER)
 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(3)		! (LINE)
c
	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:

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

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
	iyx = iye				! Can be modified
c
	if ((im .eq. imr) .and.
	1   (id .eq. idr) .and.
	2   (iye .eq. iyr)) then
c
	    scnds = secnds(0.)		!	Get current time
	    ihalf = imod(iifix(scnds/1800.), 48) ! current half-hour (orig 0)
	    ihour = ihalf/2		!	Current hour
	    ihalf = ihalf - (ihour*2)	!	0 or 1 for half-hour
c
	else
	    ihour = 0			!	Set non-match value
	endif
c
	call dany (isx, imx, im, iyx)		! Get day-of-week
c
	idx = imod (id + isx - 2, 7) + 1	! Calc current d/o/w
c
	write(iterm,4) esc,homescrn, esc,clrscrn
 4	format('+',4a, $)

	write(iterm,5) '+', esc,dhdw1, daylist(idx),im,id,iye
 5	format(3a,'   Appointments for ', a6,'day, ',
	1 i2,'/',i2.2,'/',i2.2)
	write(iterm,5) ' ', esc,dhdw2, daylist(idx),im,id,iye

	Do 8 i=8,16
	    If ( i .gt. 12 ) then
		j = i - 12
	    Else
		j = i
	    End If
c
	if (i .ne. ihour) then			! Check for high-lighting
	    write(iterm,6) j
 6	    format(x,i2,':00   -')
	    write(iterm,7) j
 7	    format(x,i2,':30   -')
	else					! must be current hour
	    if (ihalf .eq. 0) then		! Check which half
		write(iterm,96), esc,revattr, j, esc,resetvattr
		write(iterm,7) j
	    else
		write(iterm,6) j
		write(iterm,97), esc,revattr, j, esc,resetvattr
	    endif
c
 96	    format (x, 2a, i2,':00   -', 2a)
 97	    format (x, 2a, i2,':30   -', 2a)
c
	endif
 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).le.'9').and.(line(1).ge.'0')).OR.
	1    LINE(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	! Assume h:mm
		do 700 mtmp=83,1,-1
 700		line(mtmp+1)=line(mtmp)
		line(1)='0'		! so fix

	    end if

	    if(line(8).eq.':') then	! Assumes hh:mm>h:mm
		do 710 mtmp=83,7,-1
 710		line(mtmp+1)=line(mtmp)
		line(7)='0'		! fix again
	    end if
	    temp(1) = line(1)
	    temp(2) = line(2)
	    decode ( 2 , 2 , temp ) iht
	    if ( iht .lt. 8 .and. iht .gt. 5) iht = 8
	    If ( iht .lt. 5 ) iht = iht + 12
	    IHHR=IHT
	    iht = iht * 10
	    If ( line(4) .ge. '3' ) iht = iht + 3
c
	END IF
C HANDLE "EV" MODIFIER FOR EVENING APPOINTMENTS
c
	IF(LINE(1).EQ.'E')IHT=170
c
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
		if(ihmx.lt.ihhr) ihmx=17
		DECODE(2,2,LINE(10))IMMX
		IF(IMMX.lt.30) then
			IMMX=0
		   else
			immx=30
		end if
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
c ???????????????????
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 playing 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),comlen, line
 13		format(q,84a1)
 914		CONTINUE
	    End If
c copy appointment for use later...
	Do 1118 ivx=1,icmln
 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 ... 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.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 (imod(iht,10) .ge. 3) iy = iy + 1
	    ix = 10
	    call dtcat(ix,iy)
	    write(iterm,300) (line(k),k=1,60)
 300	    format('+',60a1)
	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
	go to 101			! Common exit code
 99	CONTINUE
	OPEN(UNIT=1,FILE=FNAME,STATUS='NEW',FORM='FORMATTED')
 101	CLOSE(1)
	call dtcat(1,22)
	return
	end