       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.
