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