IDENTIFICATION DIVISION. PROGRAM-ID. TAPLIB2. AUTHOR. DONMCCOY. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. PDP-11. OBJECT-COMPUTER. PDP-11. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT LIBRY ASSIGN "SX:LIBRY.DAT". SELECT INVADD ASSIGN "SX:INV.DAT". SELECT LIBRARY ASSIGN "SX:LIBR.DAT". SELECT XTN ASSIGN "SX:RESERVES.;". SELECT INVMAST ASSIGN "SX:INMAS.DAT". SELECT PORTER ASSIGN "SY:PRNT2.DAT". DATA DIVISION. FILE SECTION. FD XTN LABEL RECORD OMITTED DATA RECORD XN. 01 XN PICTURE X(80). FD INVMAST LABEL RECORD OMITTED DATA RECORD MAST. 01 MAST PICTURE X(80). FD LIBRARY LABEL RECORD OMITTED DATA RECORD LIBWA. 01 LIBWA. 02 FILLER PICTURE X(53). 02 RECD PICTURE 9. 02 FILLER PICTURE X(26). FD LIBRY LABEL RECORD OMITTED DATA RECORD GONER. 01 GONER. 02 JOBID PICTURE 9(5). 02 FILLER PICTURE X. 02 REELM PICTURE X(5). 02 FILLER PICTURE X. 02 FNAME PICTURE X(35). 02 SDATE PICTURE 9(6). 02 SDATER REDEFINES SDATE. 03 CDDM PICTURE 9999. 03 CDM PICTURE 99. 02 RECTP PICTURE 9. 02 CDATE PICTURE 9(6). 02 FILLER PICTURE X. 02 CTIME PICTURE 9999. 02 FILLER PICTURE X. 02 0NAME PICTURE X(5). 02 FILLER PICTURE X. 02 RDAT PICTURE 9(6). 02 FILLER PICTURE X. 02 DRIV PICTURE X. FD INVADD LABEL RECORD OMITTED DATA RECORD CHANGE. 01 CHANGE. 02 FILLER PICTURE X(6). 02 REELA PICTURE X(5). 02 FILLER PICTURE X(36). 02 SDATEA PICTURE 9(6). 02 SS REDEFINES SDATEA PICTURE X(6). 02 RECTPA PICTURE 9. 02 CDATEA PICTURE 9(6). 02 CC REDEFINES CDATEA PICTURE X(6). 02 FILLER PICTURE X. 02 CTIMEA PICTURE 9999. 02 TT REDEFINES CTIMEA PICTURE XXXX. 02 FILLER PICTURE X(7). 02 RDATEA PICTURE 9(6). 02 DREDO REDEFINES RDATEA. 04 RETCH PICTURE 999. 04 RR PICTURE 999. 02 FILLER PICTURE X. 02 CLNCNT PICTURE 9. FD PORTER LABEL RECORD OMITTED. 01 OUTLINE. 02 CODER PICTURE X. 02 CHAN. 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 99B99B99. 05 FILLER PICTURE XXXX. 05 CDATE PICTURE 99B99B99. 05 TOME PICTURE BBB9999BBB. 05 OUNER PICTURE X(8). 05 RDATE PICTURE 99B99B99. 05 FILLER PICTURE X(24). WORKING-STORAGE SECTION. 77 DATR PICTURE X(22) VALUE "RETENTION DATE REACHED". 77 DATO PICTURE 9(6) VALUE ZERO. 77 EJO PICTURE 99 VALUE ZERO. 77 EJON PICTURE 99 VALUE ZERO. 77 FUN PICTURE X(7) VALUE " CARD :". 77 FOO PICTURE X(7) VALUE "STATUS:". 77 CHECK PICTURE 9 VALUE ZERO. 77 CHUCK PICTURE 9 VALUE ZERO. 77 SKRTAPES PICTURE 9999 VALUE ZERO. 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 ODAT. 02 CDD PICTURE 9999 VALUE ZERO. 02 CDFIX PICTURE 99 VALUE ZERO. 01 HEADER. 02 FILLER PICTURE X(22) VALUE "TAPE LIBRARY INVENTORY". 02 FILLER PICTURE X(75) VALUE SPACE. 02 FILLER PICTURE X(5) VALUE "DATE ". 02 DATT PICTURE 99B99B99. 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 LASTLINE. 02 FILLER PICTURE X(10) VALUE SPACE. 02 FILLER PICTURE X(22) VALUE "THE NUMBER OF TAPES IN". 02 FILLER PICTURE X(16) VALUE " THE LIBRARY IS ". 02 NUMTAPES PICTURE 9999 VALUE ZERO. 02 FILLER PICTURE X(18) VALUE ". RESERVE TAPES = ". 02 RESTAPES PICTURE 9999 VALUE ZERO. 02 FILLER PICTURE X(18) VALUE ". SCRATCH TAPES = ". 02 SKRTAPED PICTURE ZZZ9 VALUE ZERO. 02 FILLER PICTURE X(20) VALUE ". TOTAL TAPES IN LIB". 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 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(28) VALUE " TAPE LIBRARY --- RESERVE". 02 FILLER PICTURE X(7) VALUE " ERRORS". 02 FILLER PICTURE X(74) VALUE SPACE. 02 FILLER PICTURE X(5) VALUE "DATE ". 02 DOTE PICTURE 99B99B99. 02 FILLER PICTURE X(7) 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 "RESERVE STATUS". 01 DIAG2. 02 FILLER PICTURE X(21) VALUE "CAUSE: PROGRAM ERROR". 01 DIAG3. 02 FILLER PICTURE X(26) VALUE "CAUSE: THIS REEL IS BEING". 02 FILLER PICTURE X(25) VALUE " RESERVED TOO MANY TIMES ". 01 WDATE. 02 MOS PICTURE 99. 02 DDATE PICTURE 99. 02 YRDATE PICTURE 99. 01 WRKDATE REDEFINES WDATE PICTURE 9(6). PROCEDURE DIVISION. DATE-RTN. ACCEPT DATER FROM DATE. MOVE DYR TO TYR MOVE DMO TO TMO MOVE DDA TO TDA. MOVE TDATE TO DATO WDATE MOVE DATO TO DOTE INSPECT DOTE REPLACING ALL " " BY "/". MOVE DATO TO ODAT IF CDD GREATER 600 SUBTRACT 601 FROM CDD ELSE SUBTRACT 1 FROM CDFIX ADD 599 TO CDD. LESGOO. * SORT TAPE(7-11) OPEN OUTPUT PORTER LIBRARY INPUT LIBRY INVADD. READ LIBRY AT END MOVE 5 TO CHECK. OVRFLOW. MOVE ZERO TO EJO MOVE SPACE TO OUTLINE. ADD 1 TO EJON MOVE EJON TO SHEET. MOVE HEAD1 TO CHAN. WRITE OUTLINE AFTER ADVANCING PAGE. MOVE SPACE TO OUTLINE WRITE OUTLINE. MOVE HEAD2 TO CHAN WRITE OUTLINE MOVE SPACE 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. IF CC NOT NUMERIC MOVE ZERO TO CDATEA. IF TT NOT NUMERIC MOVE ZERO TO CTIMEA. MOVE ZERO TO RETCH. IF RDATEA EQUAL ZERO PERFORM RDATERR. IF RDATEA GREATER THAN 999 PERFORM RDATERR. 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 LIBRY 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 REELM GREATER REELA GO TO MISTAKE. IF REELA NOT EQUAL REELM GO TO SCRIBE ELSE IF RECTP EQUAL 3 GO TO SCRIBE ELSE IF RECTP EQUAL 1 GO TO MISTOOK ELSE MOVE 1 TO RECTPA. IF RDATEA NOT EQUAL ZERO PERFORM GETRDAT THRU MTHR. WRITE LIBWA FROM CHANGE IF CHECK NOT EQUAL 5 READ LIBRY AT END MOVE 5 TO CHECK. GO TO READER. ENRY. IF EJO GREATER 60 PERFORM OVRFLOW. MOVE SPACE TO OUTLINE WRITE OUTLINE. MOVE HEAD3 TO CHAN . WRITE OUTLINE MOVE SPACE TO OUTLINE MOVE CHANGE TO DETR MOVE CORRESPONDING DETR TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE PERFORM GETRDAT THRU MTHR MOVE 1 TO RECTPA WRITE LIBWA FROM CHANGE ADD 3 TO EJO GO TO READER. GETRDAT. IF RDATEA NOT EQUAL ZERO IF RDATEA GREATER 30 SUBTRACT 30 FROM RDATEA ADD 1 TO MOS. IF RDATEA GREATER 30 GO TO GETRDAT. ADD RDATEA TO DDATE. IF DDATE GREATER 30 SUBTRACT 30 FROM DDATE ADD 1 TO MOS. MTHR. IF MOS GREATER 12 SUBTRACT 12 FROM MOS ADD 1 TO YRDATE. IF MOS GREATER 12 GO TO MTHR. IF YRDATE LESS THAN 69 STOP " CORRECT DATE-RESTART JOB". IF WDATE NOT EQUAL DATO MOVE WRKDATE TO RDATEA MOVE DATO TO WDATE. SCRIBE. IF RECTP NOT EQUAL 1 MOVE 2 TO RECTP. WRITE LIBWA FROM GONER GO TO READM. MISTAKE. IF EJO GREATER 60 PERFORM OVRFLOW. MOVE " " TO RECTPA MOVE FUN TO WONG MOVE CHANGE TO DETR MOVE CORRESPONDING DETR TO BALANCE WRITE OUTLINE MOVE FOO TO CHANGE MOVE GONER TO DETR MOVE CORRESPONDING DETR TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE MOVE DIAG3 TO CHAN WRITE OUTLINE MOVE SPACE TO OUTLINE ADD 4 TO EJO GO TO READER. MISTOOK. IF EJO GREATER 60 PERFORM OVRFLOW. IF RECTP EQUAL 1 MOVE ZERO TO CODER 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 SPACE TO OUTLINE MOVE DIAG1 TO CHAN WRITE OUTLINE MOVE SPACE TO OUTLINE ELSE MOVE DIAG2 TO CHAN WRITE OUTLINE MOVE SPACE TO OUTLINE. ADD 4 TO EJO GO TO READER. RDATERR. MOVE FUN TO WONG. MOVE CHANGE TO DETR. MOVE CORR DETR TO BALANCE. WRITE OUTLINE ADD 1 TO EJO. MOVE " THIS TAPE WILL BE ASSIGNED A 30 DAY RETENTION CYCLE." TO BALANCE. WRITE OUTLINE. ADD 1 TO MOS. MOVE WRKDATE TO RDATEA MOVE DATO TO WDATE. CONCLUDE. CLOSE LIBRY INVADD LIBRARY OPEN INPUT LIBRARY. OPEN OUTPUT INVMAST. AGAIN. MOVE ZERO TO EJO MOVE DATO TO DATT INSPECT DATT REPLACING ALL SPACE BY "/" MOVE HEADER TO CHAN WRITE OUTLINE AFTER ADVANCING PAGE. MOVE SPACE TO OUTLINE WRITE OUTLINE MOVE "SCRATCH TAPES" TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE WRITE OUTLINE ADD 6 TO EJO. AGAIN1. READ LIBRARY AT END GO TO FINALE. IF RECD EQUAL 1 WRITE MAST FROM LIBWA ADD 1 TO RESTAPES GO TO AGAIN1. ADD 1 TO SKRTAPES. IF EJO GREATER 60 PERFORM AGAIN. MOVE LIBWA TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE ADD 1 TO EJO. GO TO AGAIN1. FINALE. CLOSE INVMAST. CLOSE LIBRARY OPEN INPUT LIBRARY. PERFORM LST-HDG. FINALE1. READ LIBRARY AT END GO TO ATLAST. IF RECD EQUAL 3 GO TO FINALE1. ADD 1 TO NUMTAPES. MOVE LIBWA TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE. ADD 1 TO EJO IF EJO GREATER 57 PERFORM LST-HDG. GO TO FINALE1. LST-HDG. MOVE 0 TO EJO. MOVE HEADER TO CHAN WRITE OUTLINE AFTER ADVANCING PAGE. MOVE SPACE TO OUTLINE WRITE OUTLINE MOVE "LIST OF ALL LIBRARY TAPES" TO BALANCE WRITE OUTLINE MOVE SPACE TO OUTLINE WRITE OUTLINE. ADD 4 TO EJO. ATLAST. WRITE OUTLINE. MOVE SKRTAPES TO SKRTAPED. MOVE LASTLINE TO OUTLINE. WRITE OUTLINE. MOVE SPACE TO OUTLINE. WRITE OUTLINE AFTER ADVANCING PAGE. CLOSE LIBRARY PORTER STOP RUN.