; BRDUPD.DBL DELETES 'OLD' BULLETIN 'BOARD' RECORDS AND OPTIONALLY REORGS FILE ; COMPILE BRDUPD=BRDUPD.DBL ; LINK AS BRDUPD.TSD=BRDUPD,XOPEN,XDATE ; REBUILD WITH BOARD.COM ; PROGRAMMER RON TENNY 12/22/82 ; ; COMMENTS This program deletes the out of date messages in the 'board.ism' FILE ; ; ; This program should be run after hours when no-one is using ; the "BOARD" program to PURGE old records out of the file .INCLUDE 'SRC:COM.DBL' .INCLUDE 'SRC:BOARD.FD' PROC (1) .INCLUDE 'SRC:INI.DBL' ;INITIALIZE THE PARAMETERS DISPLAY (TT,DIS,HOME,CLEAR,'BRDUPD',DIS,40,32,'DELETING OLD "BULLETIN BOARD" RECORDS',CRLF,LF) CLOSE TT SLEEP 20 XCALL XOPEN (1,'SU','BOARD.ISM') LOOP, READS (1,BLINE,EOF) IF(BCODE.EQ.'ZZZ') GOTO EOF ;LAST RECORD REACHED IF(BKEY(4,18).EQ.'***************') GOTO LOOP ;IT IS A HEADER, LOOP FOR MESSAGE LINES AGE, IF(DATE(5,6).GT.BDATE(1,2)) BDATE(1,2)=BDATE(1,2) -4 ;CORRECT FOR LEAP YEAR WORK=(DATE(5,6)-BDATE(1,2))*365+(DATE(1,2)-BDATE(3,4))*30+(DATE(3,4)-BDATE(5,6)) IF(WORK.GE.BDAYS) DELETE (1,BKEY) ;IT HAS PAST ITS NUMBER OF DAYS TO RUN, SO KILL IT GOTO LOOP ;--------------------------------------------------------------------------------------------------------- EOF, CLOSE 1 XCALL FLAGS ('01000000') ;SUPRESS STOP MESSAGE STOP