       IDENTIFICATION DIVISION.
       PROGRAM-ID. TAPLIB4.
       AUTHOR. DONMCCOY.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. PDP-11.
       OBJECT-COMPUTER. PDP-11.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
            SELECT INVMAST ASSIGN "SX:INMAS.DAT".
            SELECT XTN     ASSIGN "SX:XTN.DAT".
            SELECT REBORD  ASSIGN "SY:PRNT4.DAT".
       DATA DIVISION.
       FILE SECTION.
       FD  INVMAST LABEL RECORD OMITTED DATA RECORD XN.
       01  XN     PICTURE X(80).
       FD  REBORD LABEL RECORD OMITTED DATA RECORD PORTER.
       01  PORTER.
           02  COD        PICTURE X.
           02  CHAN.
               03  JOBB   PICTURE X(5).
               03  FILLER PICTURE X.
               03  RAAL   PICTURE X(5).
               03  FILLER PICTURE X.
               03  LIBEL  PICTURE X(41).
               03  FILLER PICTURE X(12).
               03  CDATE  PICTURE 99/99/99.
               03  TOME   PICTURE BBB9999BBB.
               03  OUNER  PICTURE X(8).
               03  RDATE  PICTURE 99/99/99.
               03  FILLER PICTURE X(36).
       FD  XTN LABEL RECORD OMITTED DATA RECORD GONER.
       01  GONER.
           02  FILLER  PICTURE X(66).
           02  OWN     PICTURE X(5).
           02  FILLER  PICTURE X(9).
       WORKING-STORAGE SECTION.
       77  DATO    PICTURE 9(6)  VALUE ZERO.
       77  HEAD    PICTURE X(26) VALUE "RESERVE TAPES --- BY OWNER".
       77  EJO     PICTURE 99    VALUE ZERO.
       77  OWHD    PICTURE X(5)  VALUE SPACE.
       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  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 99/99/99.
       01  HEAD1.
           02  FILLER PICTURE X(65) VALUE SPACE.
           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  HEAD2.
           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(33) VALUE SPACE.
           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  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.
       PROCEDURE DIVISION.
       DATE-RTN.
           ACCEPT DATER FROM DATE.
           MOVE DMO TO TMO
           MOVE DDA TO TDA
           MOVE DYR TO TYR.
           MOVE TDATE TO DATT.
       LESGOO.
      *    SORT OWNER(67-71) JOB(1-5) LABEL(13-47) TAPE(7-11).
           OPEN INPUT XTN OUTPUT REBORD
           GO TO BODY.
       OVRFLOW.
           MOVE ZERO TO EJO
           MOVE HEADER TO CHAN WRITE PORTER AFTER ADVANCING PAGE.
           MOVE HEAD TO CHAN
           WRITE PORTER MOVE SPACE TO PORTER
           WRITE PORTER MOVE HEAD1 TO CHAN
           WRITE PORTER MOVE SPACE TO PORTER MOVE HEAD2 TO CHAN
           WRITE PORTER MOVE SPACE TO PORTER WRITE PORTER
           ADD 7 TO EJO.
       BODY.
           READ XTN AT END GO TO CONCLUDE.
           IF OWN NOT EQUAL OWHD PERFORM OVRFLOW.
           MOVE OWN TO OWHD  MOVE GONER TO DETR
           IF EJO GREATER 58 PERFORM OVRFLOW.
           MOVE CORR DETR TO CHAN.
           WRITE PORTER ADD 1 TO EJO MOVE SPACE TO PORTER GO TO BODY.
       CONCLUDE.
           WRITE PORTER AFTER ADVANCING PAGE.
           CLOSE XTN REBORD.
           STOP RUN.
