IDENTIFICATION DIVISION. PROGRAM-ID. TAPLIB1. AUTHOR. DONMCCOY. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. PDP-11. OBJECT-COMPUTER. PDP-11. SPECIAL-NAMES. LINE-PRINTER IS JOT. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT LIBRARY ASSIGN "SX:LIBR.DAT". SELECT INVADD ASSIGN "SX:INV.DAT". SELECT LIBRY ASSIGN "SX:LIBRY.DAT". SELECT XTN ASSIGN "SX:SCRATCHES.;". SELECT PORTER ASSIGN "SY:PRNT1.DAT". DATA DIVISION. FILE SECTION. FD XTN LABEL RECORD OMITTED. 01 XTNIN PICTURE X(80). FD LIBRY LABEL RECORD OMITTED. 01 LIBWA PICTURE X(80). FD LIBRARY LABEL RECORD OMITTED. 01 GONER. 02 CHKMD. 03 JOBID PICTURE 9(5). 03 FILLER PICTURE X. 03 REELM PICTURE X(5). 03 FILLER PICTURE X. 03 FNAME PICTURE X(35). 03 SDATE PICTURE 9(6). 03 RECTP PICTURE 9. 03 CDATE PICTURE 9(6). 03 FILLER PICTURE X. 03 CTIME PICTURE 9999. 03 FILLER PICTURE X. 03 ONAME PICTURE X(5). 03 FILLER PICTURE X. 02 RDAT. 03 RDAT1 PICTURE 9(4). 03 RDAT2 PICTURE 99. 02 FILLER PICTURE X. 02 CLNCNT PICTURE 9. FD INVADD LABEL RECORD OMITTED. 01 CHANGE. 02 CHKDD. 03 ADDIT PICTURE X(6). 03 REELA PICTURE X(5). 03 FILLER PICTURE X(36). 03 SDATEA PICTURE 9(6). 03 SS REDEFINES SDATEA PICTURE X(6). 03 RECTPA PICTURE 9. 03 CDATEA PICTURE 9(6). 03 CC REDEFINES CDATEA PICTURE X(6). 03 FILLER PICTURE X. 03 CTIMEA PICTURE 9999. 03 TT REDEFINES CTIMEA PICTURE XXXX. 03 FILLER PICTURE X(7). 02 RDATEA PICTURE 9(6). 02 RR REDEFINES RDATEA PICTURE X(6). 02 FILLER PICTURE X. 02 CLNCNTA PICTURE 9. FD PORTER LABEL RECORD OMITTED. 01 OUTLINE. 02 CODER PICTURE X. 02 HEIRO. 03 WONG PICTURE X(8). 03 BALANCE. 05 JOBB PICTURE X(5). 05 FILLER PICTURE X. 05 RAAL PICTURE X(5). 05 FILLER PICTURE X. 05 LIBEL PICTURE X(41). 05 SDATE PICTURE 99/99/99. 05 FILLER PICTURE XXXX. 05 CDATE PICTURE 99/99/99. 05 TOME PICTURE BBB9999BBB. 05 OUNER PICTURE X(8). 05 RDATE PICTURE 99/99/99. 05 FILLER PICTURE X(24). WORKING-STORAGE SECTION. 77 DATR PICTURE X(22) VALUE "RETENTION DATE REACHED". 77 EJO PICTURE 99 VALUE ZERO. 77 EJON PICTURE 99 VALUE ZERO. 77 FUN PICTURE X(6) VALUE "CARD :". 77 PCNT PICTURE 999. 77 FOO PICTURE X(7) VALUE "STATUS:". 77 CHECK PICTURE 9 VALUE ZERO. 77 CHUCK PICTURE 9 VALUE ZERO. 77 CLNCNTR PICTURE 9. 77 RCNTR PICTURE 9(5). 77 TCNT PICTURE 9(6). 01 CLNTAB. 02 RLNO PICTURE 9(5) OCCURS 50 TIMES. 01 DATER. 02 DYR PICTURE 99. 02 DMO PICTURE 99. 02 DDA PICTURE 99. 01 TDATE. 02 TMO PICTURE 99. 02 TDA PICTURE 99. 02 TYR PICTURE 99. 01 DATO PICTURE 9(6) VALUE IS 40180. 01 DIM REDEFINES DATO. 02 DATO1 PICTURE 9(4). 02 DATO2 PICTURE 99. 01 BETWEEN. 02 FILLER PICTURE X(6) VALUE SPACE. 02 SAVJOOB PICTURE X(5). 02 FILLER PICTURE X(42) VALUE SPACE. 02 RECODE PICTURE 9 VALUE ZERO. 02 FILLER PICTURE X(26) VALUE SPACE. 01 HEADA. 02 FILLER PICTURE X(54) VALUE SPACE. 02 FILLER PICTURE X(11) VALUE "DATE ". 02 FILLER PICTURE X(11) VALUE " DATE ". 02 FILLER PICTURE X(4) VALUE "TIME". 02 FILLER PICTURE X(10) VALUE SPACE. 02 FILLER PICTURE X(9) VALUE "RETENTION". 01 HEADB. 02 FILLER PICTURE X(6) VALUE " JOB ". 02 FILLER PICTURE X(6) VALUE " REEL ". 02 FILLER PICTURE X(18) VALUE " EXTERNAL LABEL ". 02 FILLER PICTURE X(22) VALUE SPACE. 02 FILLER PICTURE X(11) VALUE " SCRATCHED ". 02 FILLER PICTURE X(11) VALUE " CREATED ". 02 FILLER PICTURE X(7) VALUE "CREATED". 02 FILLER PICTURE X(8) VALUE " OWNER ". 02 FILLER PICTURE X(9) VALUE " DATE ". 01 DETR. 02 JOBB PICTURE X(5). 02 FILLER PICTURE X. 02 RAAL PICTURE X(5). 02 FILLER PICTURE X. 02 LIBEL PICTURE X(35). 02 SDATE PICTURE 9(6). 02 SDATEA REDEFINES SDATE PICTURE X(6). 02 FILLER PICTURE X. 02 CDATE PICTURE 9(6). 02 FILLER PICTURE X. 02 TOME PICTURE 9999. 02 FILLER PICTURE X. 02 OUNER PICTURE X(5). 02 FILLER PICTURE X. 02 RDATE PICTURE 999999. 02 FILLER PICTURE XX. 01 HEAD1. 02 FILLER PICTURE X(27) VALUE " TAPE LIBRARY --- TAPES ". 02 FILLER PICTURE X(18) VALUE "TO BE SCRATCHED ". 02 FILLER PICTURE X(50) VALUE SPACE. 02 FILLER PICTURE X(5) VALUE "DATE ". 02 DOTE PICTURE 99/99/99. 02 FILLER PICTURE X(9) VALUE " PAGE ". 02 SHEET PICTURE 99 VALUE ZERO. 01 HEAD2. 02 FILLER PICTURE X(28) VALUE " ERROR CARD AND CAUSE". 01 HEAD3. 02 FILLER PICTURE X(10) VALUE "NEW TAPES:". 01 DIAG1. 02 FILLER PICTURE X(26) VALUE "CAUSE: THIS TAPE WAS NOT ". 02 FILLER PICTURE X(23) VALUE "RELEASED FROM PREVIOUS ". 02 FILLER PICTURE X(14) VALUE "SCRATCH STATUS". 01 DIAG2. 02 FILLER PICTURE X(21) VALUE "CAUSE: PROGRAM ERROR". 01 DIAG3. 02 FILLER PICTURE X(26) VALUE "CAUSE: ONE OR MORE ITEMS ". 02 FILLER PICTURE X(12) VALUE "DO NOT AGREE". PROCEDURE DIVISION. DATE-RTN. ACCEPT DATER FROM DATE. MOVE DYR TO TYR MOVE DMO TO TMO MOVE DDA TO TDA. MOVE TDATE TO DATO. MOVE DATO TO DOTE INSPECT DOTE REPLACING ALL " " BY "/". SRTXTN. * SORT TAPE(7-11) OPEN OUTPUT PORTER LIBRY INPUT LIBRARY INVADD. READ LIBRARY AT END MOVE 5 TO CHECK. MOVE SPACE TO CLNTAB. OERFLOWV. MOVE ZERO TO EJO ADD 1 TO EJON MOVE EJON TO SHEET MOVE HEAD1 TO OUTLINE. WRITE OUTLINE AFTER ADVANCING PAGE. MOVE SPACES TO OUTLINE WRITE OUTLINE. MOVE HEADA TO BALANCE WRITE OUTLINE. MOVE SPACE TO OUTLINE MOVE HEADB TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE WRITE OUTLINE ADD 7 TO EJO. READER. MOVE SPACE TO CHANGE. IF CHUCK NOT EQUAL 5 READ INVADD AT END MOVE 5 TO CHUCK. IF SS NOT NUMERIC MOVE ZERO TO SDATEA OF CHANGE. IF CC NOT NUMERIC MOVE ZERO TO CDATEA. IF TT NOT NUMERIC MOVE ZERO TO CTIMEA. IF RR NOT NUMERIC MOVE ZERO TO RDATEA. IF CHECK EQUAL 5 IF CHUCK EQUAL 5 GO TO CONCLUDE ELSE GO TO ENRY. IF CHUCK EQUAL 5 GO TO SCRIBE ELSE GO TO CONSIDER. READM. MOVE SPACE TO GONER. IF CHECK NOT EQUAL 5 READ LIBRARY AT END MOVE 5 TO CHECK. IF CHECK EQUAL 5 IF CHUCK EQUAL 5 GO TO CONCLUDE ELSE GO TO ENRY. IF CHUCK EQUAL 5 GO TO SCRIBE. CONSIDER. IF REELA GREATER REELM GO TO SCRIBE. IF REELA LESS REELM GO TO NOTHERE. IF ADDIT EQUAL "DELETE" GO TO READM. IF RECTP EQUAL 3 MOVE REELM TO RCNTR MOVE CLNCNT TO CLNCNTR GO TO SCRIB. IF RECTP EQUAL 2 GO TO MISTOOK ELSE MOVE 1 TO RECTPA. IF CDATE OF GONER NOT EQUAL CDATEA GO TO MISTAKE. MOVE REELA TO SAVJOOB. MOVE 2 TO RECODE. WRITE LIBWA FROM BETWEEN. IF EJO GREATER 57 PERFORM OERFLOWV. MOVE "SCRATCH:" TO WONG. MOVE CHANGE TO DETR. MOVE CORR DETR TO BALANCE. WRITE OUTLINE. MOVE SPACE TO OUTLINE. ADD 1 TO EJO. MOVE SPACE TO GONER. IF CHECK NOT EQUAL 5 READ LIBRARY AT END MOVE 5 TO CHECK. GO TO READER. NOTHERE. IF ADDIT EQUAL "ADD" MOVE SPACE TO ADDIT WRITE LIBWA FROM CHANGE GO TO READER. IF EJO GREATER 60 PERFORM OERFLOWV. MOVE SPACE TO OUTLINE. WRITE OUTLINE. MOVE "FOLLOWING TAPE DELETED" TO BALANCE WRITE OUTLINE. MOVE SPACE TO OUTLINE MOVE CHANGE TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE WRITE OUTLINE ADD 4 TO EJO GO TO READER. ENRY. IF ADDIT EQUAL "DELETE" GO TO READER. IF EJO GREATER 57 PERFORM OERFLOWV. MOVE SPACE TO OUTLINE WRITE OUTLINE. MOVE HEAD3 TO HEIRO. WRITE OUTLINE MOVE SPACE TO OUTLINE MOVE CHANGE TO DETR MOVE CORRESPONDING DETR TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE MOVE 2 TO RECTPA WRITE LIBWA FROM CHANGE ADD 3 TO EJO GO TO READER. SCRIBE. IF RECTP EQUAL 3 GO TO SCRIB. IF RDAT EQUAL ZERO GO TO SCRIB. IF RDAT EQUAL SPACE GO TO SCRIB. IF RDAT2 GREATER DATO2 GO TO SCRIB. IF RDAT1 EQUAL ZERO IF RDAT2 EQUAL ZERO GO TO SCRIB. IF RDAT2 EQUAL DATO2 IF RDAT1 GREATER DATO1 GO TO SCRIB. IF EJO GREATER 60 PERFORM OERFLOWV. MOVE DATR TO HEIRO WRITE OUTLINE MOVE SPACE TO OUTLINE MOVE GONER TO DETR MOVE CORR DETR TO BALANCE. WRITE OUTLINE MOVE SPACE TO OUTLINE WRITE OUTLINE ADD 3 TO EJO. SCRIB. WRITE LIBWA FROM GONER GO TO READM. MISTAKE. IF EJO GREATER 57 PERFORM OERFLOWV. MOVE " " TO RECTPA MOVE HEAD2 TO HEIRO WRITE OUTLINE MOVE SPACE TO OUTLINE WRITE OUTLINE. ADD 1 TO EJO MOVE FUN TO WONG MOVE CHANGE TO DETR MOVE CORRESPONDING DETR TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE MOVE FOO TO CHANGE MOVE GONER TO DETR MOVE CORRESPONDING DETR TO BALANCE. WRITE OUTLINE MOVE DIAG3 TO HEIRO WRITE OUTLINE MOVE SPACE TO OUTLINE ADD 4 TO EJO GO TO READER. MISTOOK. IF EJO GREATER 57 PERFORM OERFLOWV. MOVE HEAD2 TO HEIRO WRITE OUTLINE MOVE SPACE TO OUTLINE ADD 1 TO EJO WRITE OUTLINE. MOVE FUN TO WONG MOVE CHANGE TO DETR MOVE CORRESPONDING DETR TO BALANCE. WRITE OUTLINE MOVE SPACE TO OUTLINE. MOVE FOO TO WONG MOVE GONER TO DETR MOVE CORRESPONDING DETR TO BALANCE WRITE OUTLINE. MOVE DIAG1 TO HEIRO WRITE OUTLINE. MOVE SPACE TO OUTLINE. ADD 4 TO EJO GO TO READER. CLNLIST. MOVE RLNO(PCNT) TO RAAL OF OUTLINE. ADD 1 TO PCNT. WRITE OUTLINE. CONCLUDE. WRITE OUTLINE AFTER ADVANCING PAGE. CLOSE LIBRARY. MOVE HEAD1 TO HEIRO MOVE SPACE TO LIBEL OF HEIRO WRITE OUTLINE MOVE " FOLLOWING TAPES NEED CLEANING-" TO OUTLINE WRITE OUTLINE. MOVE SPACE TO OUTLINE. MOVE 1 TO PCNT. PERFORM CLNLIST TCNT TIMES. MOVE SPACE TO OUTLINE. WRITE OUTLINE AFTER ADVANCING PAGE. CLOSE INVADD LIBRY PORTER STOP RUN.