C WRITTEN BY C JOHN DALTON 18-JAN-83 TO RUN ON YOUTH CENTER PDP-11. C IT INPUTS A LIST OF IMPORTANT DATES 'IMPDAT.FIL' C AND TELLS YOU WHAT DATES ARE COMING IN THE NEXT 7 DAYS. C ON APR 22 1983 JOHN DALTON UPDATED THIS PROGRAM C BY ADDING A DELETE CAPABILITY. C >> USE THE TKB OPTIONS ACTFIL=2,UNITS=2,ASG=TI:2 C WHEN BUILDING THIS TASK. C ARRAY SIZE REFERENCES ARE MARKED BY A ** INTEGER SYSMN,SYSDY,SYSYR !setting up for system date DIMENSION ITXT(75,32) !**array for impdat.fil OPEN(UNIT=1,NAME='IMPDAT.FIL',TYPE='OLD') CALL IDATE(SYSMN,SYSDY,SYSYR) !THIS BRINGS IN SYSTEM DATE READ(1,108) IFMN,IFDAY !brings in FILE MONTH, FILE DAY 108 FORMAT(1X,I2,1X,I2) 3 READ(1,105,END=4) ((ITXT(I,J), J=1,32), I=1,75) !**load array 105 FORMAT(1X,I2,1X,I2,3X,30A) 4 IMAX=I-1 !incase not all used up REWIND 1 !HERE WE GO IF(IFMN.NE.SYSMN.OR.IFDAY.NE.SYSDY) GOTO 2 !NOT SEEN TODAY WRITE(2,110) 110 FORMAT(/,2X,'DATA PREVIOUSLY DISPLAYED.',/ 1,' REVIEW DATA AGAIN (Y/N)[N]? ',$) READ (2,69) ANS 69 FORMAT(A1) IF (ANS.EQ.'Y'.OR.ANS.EQ.'y') GOTO 2 GOTO 999 !skip to more records question. 2 WRITE (2,103) SYSMN,SYSDY,SYSYR !display on terminal 103 FORMAT(/,2X,'READING FROM USER FILE - IMPDAT.FIL',/, 1,' TODAY IS ',I2,'/',I2,'/',I2,/) MINMN = SYSMN !this section creates limits MAXMN = SYSMN !of the search into future MINDY = SYSDY !for matching dates in the MAXDY = SYSDY + 7 !array ITXT IF ((MINMN.EQ.4.OR.MINMN.EQ.6.OR.MINMN.EQ.9.OR.MINMN.EQ.11) 1.AND.(MAXDY.GT.30)) CALL MTHCHG(MAXDY,30,MAXMN) !need month change IF (MINMN.EQ.2.AND.MAXDY.GT.29) CALL MTHCHG(MAXDY,29,MAXMN) IF (MAXDY.GT.31) CALL MTHCHG(MAXDY,31,MAXMN) !need month change DO 995 I=1,IMAX !compare array, if match want delete? K=I IF(MINMN.EQ.MAXMN.AND.ITXT(I,1).EQ.MINMN.AND.ITXT(I,2).GE.MINDY 1.AND.ITXT(I,2).LE.MAXDY) CALL KILREC(ITXT,K) !call kill record IF (MINMN.NE.MAXMN.AND.((ITXT(I,2).LE.MAXDY.AND.ITXT(I,1) 1.EQ.MAXMN).OR.(ITXT(I,2).GE.MINDY.AND.ITXT(I,1).EQ.MINMN))) 1 CALL KILREC(ITXT,K) !call kill record 995 CONTINUE 999 WRITE (2,104) 104 FORMAT(/,2X,'END OF FILE ENCOUNTERED',/ 1,' ADD TO DATE FILE (Y/N)[N]? ',$) !input more dates? READ(2,69) ANS IF (ANS.EQ.'Y'.OR.ANS.EQ.'y') CALL MORREC(ITXT,IMAX) WRITE(1,79) SYSMN,SYSDY,SYSYR !update output record 79 FORMAT(1X,I2,'/',I2,'/',I2) DO 55 I=1,IMAX !write updated impdat.fil from array IF(ITXT(I,1).NE.0) WRITE(1,56)(ITXT(I,J), J=1,32) !no deletes 56 FORMAT(1X,I2,'/',I2,3X,30A) 55 CONTINUE 9998 WRITE(2,106) !display on terminal 106 FORMAT(/,2X,'END OF EXECUTION') CLOSE (UNIT=1) 9999 STOP 'EXIT' END SUBROUTINE KILREC(ITXT,I) DIMENSION ITXT(75,32) !** WRITE (2,101) (ITXT(I,J), J=1,32) !DISPLAY RECORD FOUND 101 FORMAT(/,1X,I2,'/',I2,3X,30A) WRITE (2,102) 102 FORMAT(2X,'DELETE? (Y,N)[N] ',$) !ASK IF DELETE WANTED READ(2,69)ANS 69 FORMAT(A1) IF (ANS.EQ.'Y'.OR.ANS.EQ.'y') ITXT(I,1)=0 !flag for output write RETURN END SUBROUTINE MORREC(ITXT,IMAX) DIMENSION ITXT(75,32) !** IRECMX=75 !**maximum number of records in array WRITE(2,43) 43 FORMAT(/,' ENTER 0 FOR MONTH TO STOP'/) 1 I=IMAX+1 !keep track of number of records IF(I.LE.IRECMX) GOTO 89 !kick out if over irecmx WRITE (2,67) 67 FORMAT(1X,'NO MORE ROOM IN ARRAY (ITXT)..SEE PROGRAMMER.') RETURN 89 WRITE(2,101) 101 FORMAT(/,' MONTH (0-12)? ',$) READ(2,102) ITXT(I,1) !enter new month IF(ITXT(I,1).NE.0) GOTO 5 !THIS IS WHERE WE GO BACK RETURN 5 IF (ITXT(I,1).GT.12) WRITE(2,107) !WATCH OUT FOR GOOF-UPS IF (ITXT(I,1).GT.12) GOTO 89 2 WRITE(2,103) 103 FORMAT(1X,' DAY (1-31)? ',$) READ(2,102) ITXT(I,2) !enter new day 102 FORMAT(I2) IF(ITXT(I,2).LT.1.OR.ITXT(I,2).GT.31) WRITE(2,107) !WATCH OUT IF(ITXT(I,2) .LT.1.OR.ITXT(I,2).GT.31) GOTO 2 WRITE(2,104) 104 FORMAT(1X,' TEXT OF MESSAGE,UP TO 60 CHARACTERS') READ(2,105) (ITXT(I,J), J=3,32) !enter new message 105 FORMAT(30A) 107 FORMAT(2X,' INPUT ERROR, PLEASE TRY AGAIN!!',/) IMAX=I GOTO 1 END SUBROUTINE MTHCHG(MAXDY,MAX,MAXMN) MAXDY=MAXDY-MAX MAXMN=MAXMN+1 IF(MAXMN.GT.12)MAXMN=1 RETURN END