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, CG, to write day-of-week to daily-appointment screen,
c	   and note current time if current day displayed (reverse video)
c	Modified 19850802, CG, to write full date as well, and handle both new-
c	   and old-format appointment files.
c	Modified 851218, CG: change default range of appointment from whole day
c	   to 8:00 only!
c	Modified 860220, CG: Check for duplicate appointment times,
c	   move and flag them

	SUBROUTINE day		! (line)

c	Declarations:

	include 'comdtc.inc/nolist'
	include 'apptdtc.inc/nolist'
	include 'escdtc.inc/nolist'

	character*100 apstr
	byte appnt(icmln)	!	appointment string
	byte temp(2), ll, ln1,	!	temporary string converting array
	1 ap1

	byte blot/26/		!	^Z, for entry from display

	integer	id, idr		!	Julian Day
	integer im, imr		!	Julian Month
	integer iye, iyr	!	Julian Year
	integer idx, imx, iyx, isx	! copies for calling DANY

	integer eofflg

	real*8 daylist(7) / '   Sun', '   Mon', '  Tues', ! uses A6 fmt
	1 'Wednes', ' Thurs', '   Fri', ' Satur' /	! 'day' is in format
	character*9 mthlist(12)
	1 /'  January', ' February', '    March', '    April',
	2  '      May', '     June', '     July', '   August',
	3  'September', '  October', ' November', ' December'/

	character*22 dupl		! only 3:22 used
	byte dupb(22)

	equivalence (line, ln1), (apstr, appnt, ap1), (dupl, dupb)

	include 'stmtfunc.for/nolist'

c	Initialize:

	dupl = '##'			! Init for duplicate check

	if ((ln1 .and. ucmask) .eq. 'D')	! leave = or *
	1    call shrink(1, ifnb, lnb)

	call dtcdatcvt(3)		! Pick off a date value

	im=idmo
	id=iddy
	iye=ibigyr

	call dtcalcdow (isx, imx, im, iye)	! Get day-of-week for B/O/M

	idx = mod (id + isx - 2, 7) + 1		! Calc current d/o/w

	call dtcidate(imr, idr, iyr)		! Get today's date

	if ((im .eq. imr) .and.		! if current = today,
	1   (id .eq. idr) .and.		! flag current time
	2   (iye .eq. iyr)) then	! Displaying current day

	    scnds = amax1(secnds(0.), 28801.)	! Get current time (>8 AM)
	    ihalf = mod(ifix(scnds/1800.), 48) ! current half-hour (orig 0)
	    ihour = ihalf/2		!	Current hour
	    ihalf = ihalf - (ihour*2)	!	0 or 1 for half-hour

	else
	    ihour = 0			!	Set non-match value
	endif

c ************************** Move the cursor to top of screen and clear it,
c ************************** set up appointments display:

	write(iterm,4) esc,homescrn, esc,clrscrn
 4	format('+', 4a, $)

	write(iterm,5) '+', esc,dhdw1,
	1 daylist(idx), mthlist(im), id, ibigyr
 5	format(3a,'Schedule - ', a6,'day, ', a9, i3, ',', i5)
	write(iterm,5) ' ', esc,dhdw2,
	1 daylist(idx), mthlist(im), id, ibigyr

	Do i=8,16
	    If ( i .gt. 12 ) then
		j = i - 12
	    Else
		j = i
	    End If

	    if (i .ne. ihour) then			! Check for highlighting
		write(iterm,6) j
		write(iterm,7) j
	    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

	    endif
	end do

 6	format(x,i2,':00   -')
 7	format(x,i2,':30   -')
 96	format (x, 2a, i2,':00', 2a, '   -')
 97	format (x, 2a, i2,':30', 2a, '   -')

	if (ihour .ge. 17) then		! Highlight 'Evening' line
	    write(iterm,98), esc,revattr, esc,resetvattr
	else				! Includes display other than today
	    write(iterm,9)
	end if

 9	format(x, 'Evening -', /, x, 78('='))
 98	format(x, 2a, 'Evening', 2a, ' -', /, x, 78('='))

c ******************* Screen has now been displayed,
c ******************* now check rest of line for time and appointment

	if (ln1 .ne. 0) then		! More characters available?

	    iht = 80			! Default is 8:00
	    ihmx = iht			! (only 1 entry)
	    call dtctimcvt(iht, ihmx)	! Decode time value if present
	
	    ihh1 = (iht+2)/5			! Adds 1 if trailing 3
	    ihh2 = (ihmx+2)/5			! Result is 16 to 35
	    idmx = min0(max0(ihh2-ihh1, 1), 20)	! 8:00>6:00
	    iht = min0(iht,173)			! Limit entry time (DTCTIMCVT lim is 180)

c Note: range of h1:00>h1:30 is considered only one scheduling interval,
c similarly h(1)>h(2) is an even number, ending just before h(2),
c computation forces at least one for interval h1:00>h1:00

	    ifnb = 0
	    lnb = 0
	    ivx = 0
	    ap1 = 0				! Clear appointment string

	    do i = 1, icmln

		ll = line(i)
		appnt(i) = ll

		if (ll .eq. 0) go to 6789		! done

		ivx = i					! Save current length

	    end do

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.

 6789	    If (ap1 .eq. 0) then		! Empty appointment string

		iy = ihh1 - 13			! Vertical position for half hour
		ix = 11
		call dtcat(ix,iy)

		write(iterm, 987) blot, esc,'[D'	! write, backspace
 987		format ('+', 3a, $)

		read(5,13,END=914) lapp, workstr
 13		format(q,a)

c copy appointment for use later...

		ifnb = 0
		lnb = 0
		ivx = 0

		Do i = 1, lapp

		    ll = work(i)			! fetch character

		    if (ll .gt. ' ') then
			if (ifnb .eq. 0) ifnb = i	! Flag first non-blank
			lnb = i				! Flag last non-blank

		    end if

		    if (ifnb .ne. 0) then		! Copy after first n/b
			ivx = ivx + 1
			appnt(ivx) = ll
		    end if

		end do

		if (ifnb .eq. 0) go to 914		! Nothing on read either

	    End If

	    ivx = min0(ivx, iaptlim)	! ivx = length of string

C  If we are using the 'S' command, add meetings to the indirected files ONLY,
C  not to the current (control) file.

	    if (ctlfg .ne. 1) then	! Add appointment if D or G

		close (1)		! Insurance
		Open ( unit=1,file=FNAME,status='UNKNOWN',form='FORMATTED',
	1	carriagecontrol='LIST', access='APPEND',err=9876)

		ihtxx=iht
		do ixx = 1, idmx

		    write(1,14) iye,im,id,ihtxx,apstr(1:ivx)

		    if ((ihtxx/10)*10 .eq. ihtxx)
	1	      then

			ihtxx=ihtxx+3	! IHT is even hour, go to next half hour

		      else

			ihtxx=ihtxx+7	! IHT is a half hour ... make up to next hour

		    end if

		end do

 14		format(i4.4,2i2.2,i3.3,x,a)

 9876		close(1)

	    End If

	else				! Empty line (no appointment to add)
 914	    idmx = 0			! Use as flag for display only

	end if

	eofflg = -1			! Request OPEN
	prveof = 0			! Set for DO WHILE

	lookind = 0
	if (ctlfg .ne. 0) lookind = 1	! Set for looking at filenames

	irqhash(1) = ihymd(iye, im, id)		! Set match for file scan
	irqhash(2) = irqhash(1)			! One day only

	do while (prveof .ge. 0)

	    call dtcrdappt(eofflg, lookind)

	    if (eofflg .eq. 1)		! Returned with filename string
	1     then

c on scheduling multiple dates via S or G functions, use this occasion to
c add the record to everyone's calendar file.

		close(2)
		Open (unit=2, file=work(istart), status='UNKNOWN',
	1	    form='FORMATTED', carriagecontrol='LIST',
	2	    access='APPEND', err=1119)

		ihtxx=iht
		do ixx = 1, idmx
		    write(2,14) iye,im,id,ihtxx,apstr(1:ivx)
		    if ((ihtxx/10)*10 .eq. ihtxx) then
			ihtxx=ihtxx+3	! iht is an even hour ... add the half hour
		    else
			ihtxx=ihtxx+7	! iht is a half hour ... make up to next hour
		    end if

		end do

 1119		close(2)

c Display appointment if it matches current date

	    else If (eofflg .eq. 0)
	1     then

		iy = min0(max0((((iht+2) / 5) - 13), 3), 22) ! Compute vertical posn
		if (dupb(iy) .eq. ' ')		! Have we been here before
	1	  then				! No
		    dupb(iy) = '-'		! Flag it
		  else				! Duplicate time stamps, find substitute
		    do ix = iy-1, 3, -1		! Search backward first
			if (dupb(ix) .eq. ' ')
	1		  then
			    iy = ix		! Save replacement
			    dupb(iy) = 'v'	! Point to where it should go
			    go to 3141		! >>> BREAK <<<
			end if
		    end do
		    do ix = iy + 1, 22		! Search forward
			if (dupb(ix) .eq. ' ')
	1		  then
			    iy = ix		! Save replacement
			    dupb(iy) = '^'	! Point to where it should go
			    go to 3141		! >>> BREAK <<<
			end if
		    end do
		    dupb(iy) = blot		! Flag it
		end if

 3141		ix = 2				! first char to print
		if (appoin(1) .ne. ' ')
	1	  then
		    ix = 1			! '12:00   - Appointment'
		  else
		    if (iaptln .le. 1)
	1	     then
			appoin(2) = blot	! Display BLOT for empty entry
			iaptln = 2
		    end if
		end if

		kk = min0(iaptln, iaptlim)

		call dtcat(8,iy)		! Set cursor position

		write(iterm,300) dupb(iy), ' ', apptstr(ix:kk), ! flag + text
	1	    esc,'[K'			! Erase EOL
 300		format('+ ', 5a, $)

	    End If			! eofflg .ge. 0

	    prveof = eofflg		! Show what happened

	end do				! while (prveof)

	call dtcat(1,22)

	end
