c----------------------------------------------------------------------- c c Strip Daily Appointment subroutine c c part of GLENN EVERHART'S MODS TO DTC program c c Input: c line - 72 characters; 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 character line(1) c input line CHARACTER*2 TMP2 character temp(2) EQUIVALENCE(TMP2,TEMP(1)) c temporary string converting array character appoin(60) c appointment string 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 integer ctlfg c misc control flags here common/ctls/rdspfg,ctlfg character fname(60) CHARACTER*20 FNAM60 EQUIVALENCE (FNAME(1),FNAM60) integer fnsz common/fn/fnsz,fname c c Initialize: c iterm = 0 c Output terminal unit number esc = 27 c Escape character call idate(im,id,iye) c initialize to today's date c c Parse that line c 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) read(tmp2,2)im c decode ( 2 , 2 , temp ) im temp(1) = line(3) temp(2) = line(4) read(tmp2,2)id c decode ( 2 , 2 , temp ) id temp(1) = line(5) temp(2) = line(6) read(tmp2,2)iye c 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 (1, file=FNAM60,status='OLD',form='FORMATTED') close(2) OPEN(2,FILE=FNAM60,STATUS='NEW',FORM='FORMATTED') 100 continue c loop back up here to continue reading and c 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 c no more appointments left in file. close(1) CLOSE(2) return end