PROGRAM CHCKPM C C This program checks the data file LB:[1,5]PMTIME.DAT for the next C scheduled maintenance date and then creates a NOTICE file for C system logins if there is indeed a PM in a week. C CHARACTER*80 timfl, + notice, + pmtxt CHARACTER*80 line CHARACTER*80 cmdlin CHARACTER*9 dater CHARACTER*8 timer CHARACTER*4 nul, ones CHARACTER*3 months(12) C LOGICAL dispos C INTEGER*2 i INTEGER*2 luntim, lunnot, lunpm, lunnew INTEGER*2 lentim, lennot, lenpm INTEGER*2 status INTEGER*2 iday, imonth, iyear INTEGER*2 idaymn(12) INTEGER*2 linlen C DATA notice/'KMS_SYS_NOTICE'/ DATA pmtxt/'KMS_PM_NOTICE'/ DATA timfl/'KMS_PM_DATE'/ DATA cmdlin/'PURGE KMS_SYS_NOTICE'/ DATA months/'JAN','FEB','MAR','APR','MAY','JUN', + 'JUL','AUG','SEP','OCT','NOV','DEC'/ DATA nul(1:1)/0/, nul(2:2)/0/, nul(3:3)/0/, + nul(4:4)/0/ DATA ones(1:1)/0/, ones(2:2)/0/, ones(3:3)/0/, + ones(4:4)/0/ DATA luntim/1/, lunnot/2/, lunpm/3/, luntrm/4/, + lunnew/5/ DATA lentim/22/, lennot/22/, lenpm/18/ DATA idaymn/31,28,31,30,31,30,31,31, + 30,31,30,31/ DATA linlen/23/ C C Executable begins here. C CALL ERRSET ( 29, , , , .FALSE., ) status = 1 OPEN ( UNIT = luntrm, ! Open terminal for + FILE = 'TI:', ! output. + STATUS = 'unknown' ) ! OPEN ( UNIT = luntim, ! Open date-time file. + FILE = timfl(1:lentim), ! + STATUS = 'old', ! + ERR = 9100 ) ! CALL IDATE ( imonth, iday, iyear ) ! Get integer date. D WRITE ( luntrm, * ) iday, imonth, iyear 500 CONTINUE D WRITE ( luntrm, * ) 'Reading from date-time file' READ ( luntim, 110, END = 8000, ERR = 9200 ) line ! Get a line. 110 FORMAT ( A ) ! C dater = line(1:9) ! Pull of file date timer = line(11:18) ! and time. READ ( line(1:2), '(I2)' ) idaypm ! Integer day of PM. READ ( line(8:9), '(I2)' ) iyrpm ! Integer year of PM. DO 100 i = 1, 12 ! For each month do... IF ( months(i) .EQ. dater(4:6) ) THEN ! Get integer month. imonpm = i ! Save value. D WRITE ( luntrm, * ) 'Current month: ', imonpm GO TO 101 ! Exit loop. END IF ! 100 CONTINUE ! GO TO 9300 ! Error condition. 101 CONTINUE ! Successful loop term. icnt = 0 ! Initialize day count. D WRITE ( luntrm, *) 'IYRPM: ', iyrpm, ' IYEAR: ', iyear D WRITE ( luntrm, *) 'IMONPM: ', imonpm, ' IMONTH: ', imonth D WRITE ( luntrm, *) 'IDAYPM: ', idaypm, ' IDAY: ', iday IF ( iyrpm - 1 .GT. iyear ) THEN ! Too many years. icnt = 8 ! Failure. ELSE IF ( iyrpm .EQ. iyear ) THEN ! Same year. IF ( imonpm .EQ. imonth ) THEN ! Same month. icnt = idaypm - iday ELSE ! Differant months. IF ( IABS ( imonpm - imonth ) .GT. 1 ) THEN ! More than seven days. icnt = 8 ! Force too many days. ELSE icnt = idaypm + idaymn(imonth) - + iday ! Count days left in ! month plus days in ! new month. END IF END IF ELSE IF ( IABS ( imonpm - imonth ) .EQ. 1 ) THEN icnt = idaypm + idaymn(imonth) - + iday ! Count days left in ! month plus days in ! new month. ELSE icnt = 8 END IF D WRITE ( luntrm, *) 'ICNT: ', icnt IF ( icnt .LE. 7 .AND. + icnt .GE. 0 ) THEN ! Got one.... C C The code from here to 1300 assures that if there is a message already C in NOTICE.TXT, it is preserved. It also checks that the PM message C is not already in the file. C OPEN ( UNIT = lunnot, ! Check for PM NOTICE + FILE = notice, ! already in the + STATUS = 'old', ! notice file. + READONLY, SHARED, + ERR = 1100 ) 1050 CONTINUE READ ( lunnot, 1310, END = 1060 ) lenlin, + line(1:lenlin) loc1 = INDEX ( line(1:lenlin), nul ) ! Look for 4 0s. IF ( loc1 .GT. 0 ) THEN ! Already there. GO TO 9000 ! Close and exit. ELSE ! None yet. GO TO 1050 ! Read next record. END IF ! 1060 CONTINUE ! Get here only if ! the file NOTICE ! exists and doesn't ! contain PM NOTICE:. CLOSE ( UNIT = lunnot ) ! Shut file. OPEN ( UNIT = lunnot, ! Open it append so + FILE = notice, ! we can add message. + STATUS = 'old', + ACCESS = 'append', + ERR = 1100 ) GO TO 1200 ! Skip creation. 1100 CONTINUE ! Could not open file ! old, so try new. OPEN ( UNIT = lunnot, ! File did not exist. + FILE = notice, ! Make one. + STATUS = 'new', + FORM = 'formatted', + CARRIAGECONTROL = 'list', + ERR = 9400 ) 1200 CONTINUE ! Common continuation. OPEN ( UNIT = lunpm, ! Open the PM text file. + FILE = pmtxt, + STATUS = 'old', + ERR = 9500 ) 1300 CONTINUE ! Loop here for each ! record in PM text. READ ( lunpm, 1310, ERR = 9550, END = 1400 ) lenlin, line(1:lenlin) 1310 FORMAT ( Q, A ) IF ( lenlin .LE. 0 ) THEN lenlin = 1 line(1:1) = ' ' END IF loc1 = INDEX ( line(1:lenlin), '' ) loc2 = INDEX ( line(1:lenlin), '' ) IF ( loc1 .GT. 0 ) THEN line(loc1:loc1+8) = dater(1:9) END IF IF ( loc2 .GT. 0 ) THEN line(loc2:loc2+4) = timer(1:5) END IF D WRITE ( luntrm, 1311 ) line(1:lenlin) D1311 FORMAT ( ' ', A ) WRITE ( lunnot, 1320 ) line(1:lenlin) 1320 FORMAT ( A ) GO TO 1300 1400 CONTINUE CLOSE ( UNIT = lunnot ) CLOSE ( UNIT = lunpm ) D WRITE ( luntrm, * ) 'Got an inrange value' GO TO 9000 ELSE GO TO 500 END IF 8000 CONTINUE ! No in range values, ! so we hit EOF on the ! DATTIM file. Check ! the NOTICE file for ! any PM NOTICEs, and ! delete to end of file. CLOSE ( UNIT = luntim ) ! Close time file. CLOSE ( UNIT = lunnot ) ! Make sure its closed. C C The code from here to 1300 assures that if there is a message already C in NOTICE.TXT, it is preserved. It also checks that the PM message C is not already in the file. C D WRITE ( luntrm, * ) 'Trying to open old notice' OPEN ( UNIT = lunnot, ! Open the old notice file. + FILE = notice, ! + STATUS = 'old', ! + ERR = 9000 ) ! D WRITE ( luntrm, * ) 'Opening old notice file' OPEN ( UNIT = lunnew, ! Open new copy. + FILE = notice, ! + STATUS = 'new', ! + CARRIAGECONTROL = 'list', ! + ERR = 9400 ) ! D WRITE ( luntrm, * ) 'Opening new notice file' dispos = .TRUE. ! Init. dispose flag for new 1700 CONTINUE ! file to delete it. READ ( lunnot, 1310, ! Read each input record. + END = 1760 ) lenlin, ! + line(1:lenlin) ! D WRITE ( luntrm, 1701 ) line(1:lenlin) D1701 FORMAT ( 'line: ', A ) IF ( lenlin .LE. 0 ) THEN lenlin = 1 line(1:1) = ' ' ELSE IF ( INDEX ( line(1:lenlin), ! Test for 0s record. + nul ) .GT. ! Found the four 0s, so + 0 ) THEN ! don't write any more ! until four 1s. On ! EOF, save it. dispos = .FALSE. ! Don't dispose of it. 1710 CONTINUE ! Loop for each until 1s. READ ( lunnot, 1310, ! Read next record, but + END = 1760 ) lenlin, ! Don't write it out. + line(1: ! + lenlin) ! IF ( lenlin .LE. 0 ) GO TO 1710 ! No data on line. IF ( INDEX ( line(1:lenlin), ! Find ones yet? + ones ) .GT. 0 ) THEN ! GO TO 1700 ! Read and write again. ELSE ! No ones. GO TO 1710 ! Keep not printing. END IF ! End ones test. ELSE ! None yet. WRITE ( lunnew, 1310 ) line(1: ! Write out the record. + lenlin) ! GO TO 1700 ! Read next record. END IF ! 1760 CONTINUE ! Get here only if ! the file NOTICE ! exists and doesn't ! contain PM NOTICE:. IF ( dispos ) THEN ! Kill the new file. CLOSE ( UNIT = lunnew, DISPOSE = 'delete' ) ! Close new ! file. ELSE ! Keep the new file. CLOSE ( UNIT = lunnew, DISPOSE = 'save' ) ! Close new ! file. CALL MCRSPW ( luntrm, cmdlin, linlen, ids ) ! Spawn command ! to purge. D WRITE ( luntrm, 1892 ) cmdlin(1:linlen), ids D1892 FORMAT ( ' CMDLIN: ', A / D + ' IDS: ', I6 ) END IF ! End disposal test. 9000 CONTINUE ! CLOSE ( UNIT = lunnot ) ! Shut file. CLOSE ( UNIT = luntim ) ! Close date-time file. CALL EXST ( status ) ! Boogie. C 9100 CONTINUE ! File open error. WRITE ( luntrm, 9110 ) timfl(1:lentim) ! Message. 9110 FORMAT ( ' %CHCKPM-F, no date-time file ',A,'.' ) status = 4 ! Severe error. GO TO 9000 9200 CONTINUE WRITE ( luntrm, 9210 ) timfl(1:lentim) 9210 FORMAT ( ' %CHCKPM-F, Read error on file ',A,'.' ) status = 4 GO TO 9000 9300 CONTINUE WRITE ( luntrm, 9310 ) timfl(1:lentim) 9310 FORMAT ( ' %CHCKPM-F, Bad month in data file.' ) status = 4 GO TO 9000 9400 CONTINUE WRITE ( luntrm, 9410 ) notice(1:lennot) 9410 FORMAT ( ' %CHCKPM-F, Could not create ',A,'.' ) status = 4 GO TO 9000 9500 CONTINUE 9550 CONTINUE WRITE ( luntrm, 9510 ) pmtxt(1:lenpm) 9510 FORMAT ( ' %CHCKPM-F, Could not read ',A,'.' ) status = 4 GO TO 9000 C END