       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.
