c----------------------------------------------------------------------- c c Strip Daily Appointment subroutine c c part of GLENN EVERHART'S MODS TO DTC program c c Input: c line - 72 bytes; Format: P [mmddyy] c c Output: c Strips old appointments (before date) from dtc.dat c and builds new dtc.dat. c c----------------------------------------------------------------------- c SUBROUTINE strip(line) c c Declarations: c byte line(1) ! input line byte temp(2) ! temporary string converting array byte appoin(60) ! appointment string 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 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 call idate(im,id,iye) ! initialize to today's date c c Parse that line! c c c Was there a P on the front? If so, trim it off: c IDMX=0 If ( line(1) .eq. 'P' .or.line(1).eq.'p') 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 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 KHSH=ID+32*(IM+12*(IYE-81)) C ADD CLOSE TO GUARANTEE NO FAILURES... CLOSE(1) Open (unit=1, file=FNAME , status='OLD' , form='FORMATTED', 1 err=99) close(2) OPEN(UNIT=2,FILE=FNAME,STATUS='NEW',FORM='FORMATTED') 100 continue ! loop back up here to continue reading and ! processing input file: read(1,200,end=400) ihy,ihm,ihd,iht,(line(k),k=1,60) 200 format(3i2,i3,60a1) LHSH=IHD+32*(IHM+12*(IHY-81)) IF(LHSH.LT.KHSH)GOTO 100 WRITE(2,200)IHY,IHM,IHD,IHT,(LINE(K),K=1,60) goto 100 400 continue ! no more appointments left in file. close(1) CLOSE(2) return 99 CONTINUE OPEN(UNIT=1,FILE=FNAME,STATUS='NEW',FORM='FORMATTED') CLOSE(1) return end