*DECK     DCRPT300
00001  IDENTIFICATION DIVISION.                                         10/03/78
       PROGRAM-ID. RPT300.
*CALL COPYRIGHT 
      * THIS PROGRAM PRODUCES THREE TYPES OF INDICES TO SUPPORT 
      * CATALOGUE, USAGE, AND HIERARCHY REPORTS. THESE AR - 
      *   1. INDEX BY ENTRY TYPE
      *   2. INDEX BY CATNAME 
      *   3. INDENTED INDEX-USAGE/HIERARCHY REPORTS ONLY
00012  ENVIRONMENT DIVISION.                                            DCRPT300
00013  CONFIGURATION SECTION.                                           DCRPT300
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
*CALL OTHSN 
00016  INPUT-OUTPUT SECTION.                                            DCRPT300
00017  FILE-CONTROL.                                                    DCRPT300
           SELECT INDEX-FILE ASSIGN TO TEMP15 USE "RT=W". 
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
               ACCESS MODE IS RANDOM
               RELATIVE KEY IS CON-KEY
               USE "PRUF = YES".
00023  DATA DIVISION.                                                   DCRPT300
00024  FILE SECTION.                                                    DCRPT300
*CALL     INDEXFD                                                       DCRPT300
*CALL     MAST3FD                                                       DCRPT300
*CALL     SYSPRTFD                                                      DCRPT300
*CALL     WRKSTG77                                                      DCRPT300
       77  RETURN-CODE PIC XX.
*CALL     MAST3DD1                                                      DCRPT300
00030  01  PRINT-WORK-AREA.                                                CL**2
*CALL     WKPRINT2                                                         CL**2
00032 *                                                                 DCRPT300
00033 *    SAVE AREA FOR ENTRY TYPE TBL                                 DCRPT300
00034 *                                                                 DCRPT300
00035  01  SAVE-RECORD-3.                                               DCRPT300
           03  SAVE-ENTRY OCCURS 17 TIMES.
00038          05  SAVE-ENTRY-NAME     PICTURE X(15).                   DCRPT300
00039          05  SAVE-ENTRY-ID       PICTURE XX.                      DCRPT300
00040  01  SAVE-REQ-REC.                                                DCRPT300
00041      03  SAVE-REQ-REQTYPE        PICTURE XX.                      DCRPT300
00042      03  SAVE-REQ-REQNO          PICTURE 99.                      DCRPT300
00043      03  SAVE-REQ-RECTYPE        PICTURE 9.                       DCRPT300
00044      03  SAVE-REQ-RECSEQ         PICTURE 999.                     DCRPT300
00045      03  SAVE-REQ-RPTNAME        PICTURE X(32).                   DCRPT300
00046      03  SAVE-REQ-STARTCNAME     PICTURE X(32).                   DCRPT300
00047      03  SAVE-REQ-ENTTYPE        PICTURE XX.                      DCRPT300
00048      03  SAVE-REQ-ENTITY         PICTURE X(15).                   DCRPT300
00049      03  SAVE-REQ-RETRIEVE       PICTURE X.                       DCRPT300
00050      03  SAVE-REQ-INDXFNAME      PICTURE X(8).                    DCRPT300
00051      03  SAVE-REQ-PW             PICTURE X(5).                    DCRPT300
00052      03  SAVE-REQ-MOD-REQ        PICTURE X.                       DCRPT300
00053      03  SAVE-REQ-COUNT          PICTURE 9(7).                    DCRPT300
00054      03  FILLER                  PICTURE X.                       DCRPT300
00055  01  SAVE-OPT-REC.                                                DCRPT300
00056      03  SAVE-OPT-REQTYPE        PICTURE XX.                      DCRPT300
00057      03  SAVE-OPT-REQNO          PICTURE 99.                      DCRPT300
00058      03  SAVE-OPT-RECTYPE        PICTURE 9.                       DCRPT300
00059      03  SAVE-OPT-RECSEQ         PICTURE 999.                     DCRPT300
00060      03  SAVE-OPT-REPORT         PICTURE X.                       DCRPT300
00061      03  SAVE-OPT-TITLE          PICTURE X(50).                   DCRPT300
00062      03  SAVE-OPT-SEQ            PICTURE X.                       DCRPT300
00063      03  SAVE-OPT-INDEX          PICTURE X.                       DCRPT300
00064      03  SAVE-OPT-NEWPAGE        PICTURE X.                       DCRPT300
00065      03  SAVE-OPT-FORMAT         PICTURE X.                       DCRPT300
00066      03  SAVE-OPT-ALIAS          PICTURE X.                       DCRPT300
00067      03  SAVE-OPT-VERSION        PICTURE X.                       DCRPT300
00068      03  SAVE-OPT-UNREF          PICTURE X.                       DCRPT300
00069      03  SAVE-OPT-DESC           PICTURE X.                       DCRPT300
00070      03  SAVE-OPT-LINES          PICTURE 9(4).                    DCRPT300
00071      03  SAVE-OPT-BRECHR         PICTURE X.                       DCRPT300
00072      03  SAVE-OPT-PRTREQ         PICTURE X.                       DCRPT300
00073      03  SAVE-OPT-STOPLNAME      PICTURE X(32).                   DCRPT300
00074      03  SAVE-OPT-BOTMSG         PICTURE X.                       DCRPT300
00075      03  SAVE-OPT-SUMMARY        PICTURE X.                       DCRPT300
00076      03  SAVE-OPT-DIRECT         PICTURE X.                       DCRPT300
00077      03  SAVE-OPT-INDIRECT       PICTURE X.                       DCRPT300
00078      03  SAVE-OPT-DETAIL         PICTURE X.                       DCRPT300
00079      03  SAVE-OPT-ORIGIN         PICTURE X.                       DCRPT300
00080      03  SAVE-OPT-INDENT         PICTURE X.                       DCRPT300
00081  01  REPORT-HEADINGS.                                             DCRPT300
00082      03  HDG-1.                                                   DCRPT300
00083          05  FILLER              PICTURE X(15) VALUE              DCRPT300
00084        "REQUEST NUMBER ".                                         DCRPT300
00085          05  HDG1-REQNO          PICTURE Z9.                      DCRPT300
00086          05  FILLER              PICTURE X(13) VALUE SPACES.      DCRPT300
00087          05  HDG1-IDX-TITLE      PICTURE X(39).                      CL**2
00088      03  HDG-2C.                                                  DCRPT300
00089          05  HDG2C-REQTYPE       PICTURE X(7).                    DCRPT300
00090          05  FILLER              PICTURE X(10) VALUE              DCRPT300
00091        " CATALOGUE".                                              DCRPT300
00092      03  HDG-2H.                                                  DCRPT300
00093          05  HDG2H-REQTYPE       PICTURE X(7).                    DCRPT300
00094          05  FILLER              PICTURE X(14) VALUE              DCRPT300
00095        " HIERARCHY OF ".                                          DCRPT300
00096          05  HDG2H-NAME          PICTURE X(32).                   DCRPT300
00097      03  HDG-2U.                                                  DCRPT300
00098      05  HDG2U-REQTYPE           PICTURE X(7).                    DCRPT300
00099          05  FILLER              PICTURE X(10) VALUE              DCRPT300
00100        " USAGE OF ".                                              DCRPT300
00101          05  HDG2U-NAME          PICTURE X(32).                   DCRPT300
00102      03  HDG-3.                                                   DCRPT300
00103          05  FILLER              PICTURE X(8) VALUE               DCRPT300
00104        "TITLE = ".                                                DCRPT300
00105          05  HDG3-TITLE          PICTURE X(50).                      CL**2
00106      03  FLDHDG-TYPE.                                             DCRPT300
00107          05  FILLER              PICTURE X(19) VALUE SPACES.      DCRPT300
00108          05  FILLER              PICTURE X(19) VALUE              DCRPT300
00109        "ENTRY TYPE     PAGE".                                     DCRPT300
00110      03  FLDHDG-CATNAME-S        PICTURE X(52) VALUE              DCRPT300
00111        "  DATA CATALOGUE NAME             ENTRY TYPE    PAGE".    DCRPT300
00112      03  FLDHDG-CATNAME-L        PICTURE X(115) VALUE             DCRPT300
00113        "  DATA CATALOGUE NAME            ENTRY TYPE    PAGE       DCRPT300
      -      "       DATA CATALOGUE NAME            ENTRY TYPE    PAGE".
00115      03  FLDHDG-INDENT.                                           DCRPT300
00116          05  FILLER              PICTURE X(35) VALUE              DCRPT300
00117        " RELATIVE LEVEL/DATA CATALOGUE NAME".                     DCRPT300
00118          05  FILLER              PICTURE X(28) VALUE SPACES.      DCRPT300
00119          05  FILLER              PICTURE X(16) VALUE              DCRPT300
00120        "ENTRY TYPE  PAGE".                                        DCRPT300
00121      03  HDG-2                   PICTURE X(53).                      CL**2
00122      03  HDG-4                   PICTURE X(115).                     CL**2
00123      03  NAME-HCON               PICTURE X(39) VALUE              DCRPT300
00124        "C A T A L O G U E   N A M E   I N D E X".                 DCRPT300
00125      03  TYPE-HCON               PICTURE X(39) VALUE              DCRPT300
00126        "    E N T R Y   T Y P E   I N D E X    ".                 DCRPT300
00127      03  INDENT-HCON             PICTURE X(39) VALUE              DCRPT300
00128        "      I N D E N T E D   I N D E X      ".                 DCRPT300
00129      03  LITERAL-1               PICTURE X(24) VALUE              DCRPT300
00130        "REPORT DATE-".                                            DCRPT300
       03  LITERAL-2                   PICTURE X(23) VALUE
            "DATE OF LAST REVISION- ".
00133      03  LITERAL-3               PICTURE X(5) VALUE               DCRPT300
00134        "PAGE".                                                    DCRPT300
00135      03  LITERAL-4               PICTURE X(31) VALUE              DCRPT300
00136        "D A T A   C A T A L O G U E   2".                         DCRPT300
00137      03  LITERAL-5               PICTURE X(25) VALUE              DCRPT300
00138        "REVISION NUMBER-".                                        DCRPT300
00139      03  PROP-MSG.                                                DCRPT300
00140          05  FILLER              PICTURE X(44) VALUE              DCRPT300
               "DATA CATALOGUE 2                       V2.0". 
00142          05  FILLER              PICTURE X(29) VALUE              DCRPT300
*CALL LEVEL 
00144  01  DETAIL-LINES.                                                DCRPT300
00145      03  TYPE-LINE.                                               DCRPT300
00146          05  FILLER              PICTURE X(19) VALUE SPACES.      DCRPT300
00147          05  TYPE-LINE-TYPE      PICTURE X(8).                    DCRPT300
00148          05  FILLER              PICTURE X(6) VALUE SPACES.       DCRPT300
00149          05  TYPE-LINE-PAGE      PICTURE ZZZZZ9.                  DCRPT300
00150          05  FILLER              PICTURE X(94) VALUE SPACES.      DCRPT300
00151      03  NAME-LINE-S.                                             DCRPT300
00152          05  NAME-LINE-NAME-S    PICTURE X(32).                   DCRPT300
00153          05  FILLER              PICTURE XX VALUE SPACES.         DCRPT300
00154          05  NAME-LINE-TYPE-S    PICTURE X(8).                    DCRPT300
00155          05  FILLER              PICTURE XXX VALUE SPACES.        DCRPT300
00156          05  NAME-LINE-PAGE-S    PICTURE ZZZZZ9.                  DCRPT300
00157          05  FILLER              PICTURE X(81) VALUE SPACES.      DCRPT300
00158      03  NAME-LINE-L.                                             DCRPT300
00159          05  NAME-LINE-NAME1-L   PICTURE X(32).                   DCRPT300
00160          05  FILLER              PICTURE XX VALUE SPACES.         DCRPT300
00161          05  NAME-LINE-TYPE1-L   PICTURE X(8).                    DCRPT300
00162          05  FILLER              PICTURE XXX VALUE SPACES.        DCRPT300
00163          05  NAME-LINE-PAGE1-L   PICTURE ZZZZZ9.                  DCRPT300
00164          05  FILLER              PICTURE X(13) VALUE SPACES.      DCRPT300
00165          05  NAME-LINE-NAME2-L   PICTURE X(32).                   DCRPT300
00166          05  FILLER              PICTURE XX VALUE SPACES.         DCRPT300
00167          05  NAME-LINE-TYPE2-L   PICTURE X(8).                    DCRPT300
00168          05  FILLER              PICTURE XXX VALUE SPACES.        DCRPT300
00169          05  NAME-LINE-PAGE2-L   PICTURE ZZZZZ9.                  DCRPT300
00170          05  FILLER              PICTURE X(17) VALUE SPACES.      DCRPT300
00171      03  INDENT-LINE.                                             DCRPT300
00172          05  IBET-RELCAT         PICTURE X(63).                   DCRPT300
00173          05  FILLER              PICTURE XX VALUE SPACES.         DCRPT300
00174          05  I-LINE-TYPE         PICTURE X(8).                    DCRPT300
00175          05  FILLER              PICTURE X VALUE SPACE.           DCRPT300
00176          05  I-LINE-PAGE         PICTURE ZZZZZ9.                  DCRPT300
00177          05  FILLER              PICTURE X(80) VALUE SPACES.      DCRPT300
00178  01  CONSTANTS-SWITCHES.                                          DCRPT300
00179      03  REPORT-CON              PICTURE X(7)    VALUE            DCRPT300
00180         "$REPORT".                                                DCRPT300
00181      03  FILE-CON                PICTURE X(7)    VALUE            DCRPT300
00182         "$FILE  ".                                                DCRPT300
00183      03  TYPE-SW                 PICTURE X    VALUE "N".          DCRPT300
00184      03  TYPE-1ST-SW             PICTURE X    VALUE "N".          DCRPT300
00185      03  NAME-SW                 PICTURE X    VALUE "N".          DCRPT300
00186      03  NAME-1ST-SW             PICTURE X    VALUE "N".          DCRPT300
00187      03  INDENT-SW               PICTURE X    VALUE "N".          DCRPT300
00188      03  INDENT-1ST-SW           PICTURE X    VALUE "N".          DCRPT300
00189      03  SHORT-ENTTYPE-HOLD      PICTURE 99    VALUE ZEROES.      DCRPT300
00190      03  LONG-ENTTYPE-HOLD       PICTURE X(8)    VALUE SPACES.    DCRPT300
00191      03  IDX-EOF-SW              PICTURE X    VALUE "N".          DCRPT300
00192      03  ENT-SUB                 PICTURE S99 COMP SYNC.              CL**2
00193      03  SAVE-EOP-MSG            PICTURE X(54)  VALUE SPACE.         CL**2
00194      03  NO-DATA-MSG             PICTURE X(38)    VALUE           DCRPT300
00195     "DCRPT-860-F*  NO INDEX DATA ON FILE".                           CL**2
00196      03  NO-IDX-DATA-MSG         PICTURE X(50)    VALUE              CL**2
00197     "DCRPT-030-I*  NO DATA SELECTED FOR THIS REQUEST".            DCRPT300
00198      03  END-INDEX-MSG           PICTURE X(35)   VALUE               CL**2
00199     "  *** E N D   O F   I N D E X   ***".                        DCRPT300
00200      03  SEQ-ERR-MSG             PICTURE X(43)    VALUE           DCRPT300
00201     "DCRPT-850-F*  INDEX FILE SEQUENCE ERROR".                       CL**2
00202      03  MAST3-ERROR-MSG         PICTURE X(38)    VALUE           DCRPT300
00203     "  DCRPT-950-F *  MAST3 READ ERROR".                          DCRPT300
00204  01  RELATIVE-ENTRY-TABLE.                                        DCRPT300
00205      03  RET-1.                                                   DCRPT300
00206          05  FILLER              PICTURE XX VALUE ". ".           DCRPT300
00207          05  RET-CAT1            PICTURE X(61) VALUE SPACES.      DCRPT300
00208      03  RET-2.                                                   DCRPT300
00209          05  FILLER              PICTURE XXXX VALUE ". . ".       DCRPT300
00210          05  RET-CAT2            PICTURE X(59) VALUE SPACES.      DCRPT300
00211      03  RET-3.                                                   DCRPT300
00212          05  FILLER              PICTURE X(6) VALUE ". . . ".     DCRPT300
00213          05  RET-CAT3            PICTURE X(57) VALUE SPACES.      DCRPT300
00214      03  RET-4.                                                   DCRPT300
00215          05  FILLER              PICTURE X(8) VALUE ". . . . ".   DCRPT300
00216          05  RET-CAT4            PICTURE X(55) VALUE SPACES.      DCRPT300
00217      03  RET-5.                                                   DCRPT300
00218          05  FILLER              PICTURE X(10) VALUE              DCRPT300
00219            ". . . . . ".                                          DCRPT300
00220          05  RET-CAT5            PICTURE X(53) VALUE SPACES.      DCRPT300
00221      03  RET-6.                                                   DCRPT300
00222          05  FILLER              PICTURE X(12) VALUE              DCRPT300
00223            ". . . . . . ".                                        DCRPT300
00224          05  RET-CAT6            PICTURE X(51) VALUE SPACES.      DCRPT300
00225      03  RET-7.                                                   DCRPT300
00226          05  FILLER              PICTURE X(14) VALUE              DCRPT300
00227            ". . . . . . . ".                                      DCRPT300
00228          05  RET-CAT7            PICTURE X(49) VALUE SPACES.      DCRPT300
00229      03  RET-8.                                                   DCRPT300
00230          05  FILLER              PICTURE X(16) VALUE              DCRPT300
00231            ". . . . . . . . ".                                    DCRPT300
00232          05  RET-CAT8            PICTURE X(47) VALUE SPACES.      DCRPT300
00233      03  RET-9.                                                   DCRPT300
00234          05  FILLER              PICTURE X(18) VALUE              DCRPT300
00235            ". . . . . . . . . ".                                  DCRPT300
00236          05  RET-CAT9            PICTURE X(45) VALUE SPACES.      DCRPT300
00237      03  RET-10.                                                  DCRPT300
00238          05  FILLER              PICTURE X(20) VALUE              DCRPT300
00239            ". . . . . . . . . . ".                                DCRPT300
00240          05  RET-CAT10           PICTURE X(43) VALUE SPACES.      DCRPT300
00241      03  RET-11.                                                  DCRPT300
00242          05  FILLER              PICTURE X(22) VALUE              DCRPT300
00243            ". . . . . . . . . . . ".                              DCRPT300
00244          05  RET-CAT11           PICTURE X(41) VALUE SPACES.      DCRPT300
00245      03  RET-12.                                                  DCRPT300
00246          05  FILLER              PICTURE X(24) VALUE              DCRPT300
00247            ". . . . . . . . . . . . ".                            DCRPT300
00248          05  RET-CAT12           PICTURE X(39) VALUE SPACES.      DCRPT300
00249      03  RET-13.                                                  DCRPT300
00250          05  FILLER              PICTURE X(26) VALUE              DCRPT300
00251            ". . . . . . . . . . . . . ".                          DCRPT300
00252          05  RET-CAT13           PICTURE X(37) VALUE SPACES.      DCRPT300
00253      03  RET-14.                                                  DCRPT300
00254          05  FILLER              PICTURE X(28) VALUE              DCRPT300
00255            ". . . . . . . . . . . . . . ".                        DCRPT300
00256          05  RET-CAT14           PICTURE X(35) VALUE SPACES.      DCRPT300
00257      03  RET-15.                                                  DCRPT300
00258          05  FILLER              PICTURE X(30) VALUE              DCRPT300
00259            ". . . . . . . . . . . . . . . ".                      DCRPT300
00260          05  RET-CAT15           PICTURE X(33) VALUE SPACES.      DCRPT300
00261 *                                                                    CL**2
00262 *    WORK AREA FOR SEQUENCE CHECK                                    CL**2
00263 *                                                                    CL**2
00264  01  NEW-KEY.                                                        CL**2
00265      03  NEW-COMMON.                                                 CL**2
00266          05  NEW-REQ              PICTURE XX.                        CL**2
00267          05  FILLER              PICTURE X(6).                       CL**2
00268      03  FILLER            PICTURE X(48).                            CL**2
00269  01  OLD-KEY.                                                        CL**2
00270      03  OLD-COMMON.                                                 CL**2
00271          05  OLD-REQ             PICTURE XX.                         CL**2
00272          05  FILLER              PICTURE X(6).                       CL**2
00273      03  FILLER            PICTURE X(48).                            CL**2
00274                                                                    DCRPT30
00275  PROCEDURE DIVISION.                                              DCRPT300
00276 ***************************************************************** DCRPT300
00277 ***************************************************************** DCRPT300
00278 *                                                                 DCRPT300
00279 *     INITIALIZATION                                              DCRPT300
00280 *                                                                 DCRPT300
00281 ***************************************************************** DCRPT300
00282 ***************************************************************** DCRPT300
00283  0000-BEGIN.                                                      DCRPT300
00284      OPEN INPUT INDEX-FILE.                                       DCRPT300
00285      OPEN INPUT MAST3.                                            DCRPT300
00286      OPEN OUTPUT SYSPRINT.                                        DCRPT300
00287 *                                                                 DCRPT300
00288 *     GET TABLE OF ENTITY ID"S                                    DCRPT300
00289 *                                                                 DCRPT300
           MOVE "0" TO RETURN-CODE. 
00290      MOVE LOW-VALUES TO NEW-KEY.                                     CL**2
           MOVE 3 TO CON-KEY. 
00292      READ MAST3                                                   DCRPT300
00293          INVALID KEY GO TO 8040-MAST3-ERROR.                      DCRPT300
00294      MOVE CTL-RECORD-3 TO SAVE-RECORD-3.                          DCRPT300
00295      PERFORM 7000-READ-IDX THRU 7099-READ-IDX-XIT.                DCRPT300
00296      IF IDX-EOF-SW EQUAL "Y"                                      DCRPT300
00297          GO TO 8020-NODATA-ERR.                                      CL**2
00298      MOVE SPACES TO SAVE-OPT-TITLE.                                  CL**2
00299      MOVE LITERAL-4 TO CON-DC.                                       CL**2
00300      MOVE SPACES TO STD-REPORT-REC.                               DCRPT300
00301      MOVE SPACES TO PRINT-LINE.                                   DCRPT300
00302      MOVE IDX-FILE-DATE-UPD TO DATE-LAST-REVISION.                DCRPT300
00303      MOVE IDX-FILE-REV-NUM TO REVISION-NUMBER.                    DCRPT300
00304      MOVE IDX-FILE-CURR-DATE TO PRT-CURRENT-DATE.                 DCRPT300
00305      MOVE IDX-FILE-EOP-MSG TO SAVE-EOP-MSG.                       DCRPT300
00306      MOVE IDX-FILE-LINES TO MAX-LINES.                            DCRPT300
00307      SUBTRACT 1 FROM MAX-LINES.                                   DCRPT300
00308      MOVE IDX-FILE-LINES TO LINE-CT.                              DCRPT300
00309      MOVE IDX-FILE-NAME TO CON-USER.                              DCRPT300
00310      MOVE PROP-MSG TO CON-TITLE.                                  DCRPT300
00311      MOVE ZERO TO PAGE-NO.                                        DCRPT300
00312      MOVE SPACES TO USER-TITLE.                                   DCRPT300
00313      MOVE 1 TO PRT-CTL.                                              CL**2
00314      MOVE LITERAL-1 TO PRT-DATE1-HCON.                            DCRPT300
00315      MOVE LITERAL-2 TO PRT-DATE2-HCON.                            DCRPT300
00316      MOVE LITERAL-3 TO PRT-PAGE-HCON.                             DCRPT300
00317      MOVE LITERAL-5 TO PRT-REV-NO-HCON.                           DCRPT300
00318      MOVE ZERO TO HOF-IND.                                        DCRPT300
00319      MOVE 1 TO SPACE-1.                                           DCRPT300
00320      MOVE "N" TO SEC-PAGE-SW.                                        CL**2
00321      PERFORM 7000-READ-IDX THRU 7099-READ-IDX-XIT.                DCRPT300
00322      IF IDX-EOF-SW EQUAL "Y"                                      DCRPT300
00323          GO TO 8020-NODATA-ERR.                                      CL**2
00324                                                                    DCRPT30
00325 ***************************************************************** DCRPT300
00326 ***************************************************************** DCRPT300
00327 *                                                                 DCRPT300
00328 *     INITIALIZE FOR NEW REQUEST                                  DCRPT300
00329 *                                                                 DCRPT300
00330 *          TYPE 2 AND 3 INDEX FILE RECORDS ARE SAVES              DCRPT300
00331 *          THESE DEFINE TYPE OF REQUEST AND OPTIONS               DCRPT300
00332 *          THAT WERE SPECIFIED                                    DCRPT300
00333 *                                                                 DCRPT300
00334 ***************************************************************** DCRPT300
00335 ***************************************************************** DCRPT300
00336  0100-NEW-REQUEST.                                                DCRPT300
00337 *                                                                 DCRPT300
00338 *    SAVE REQUEST HEADER (TYPE-2) AND OPTIONS RECORD (TYPE-3)     DCRPT300
00339 *                                                                 DCRPT300
00340      MOVE IDX-REQ-REC TO SAVE-REQ-REC.                            DCRPT300
00341      PERFORM 7000-READ-IDX THRU 7099-READ-IDX-XIT.                DCRPT300
00342      MOVE IDX-OPT-REC TO SAVE-OPT-REC.                            DCRPT300
00343  0150-INIT-HDG1.                                                     CL**2
00344      MOVE IDX-FILE-REQNO TO HDG1-REQNO.                              CL**2
00345 *                                                                 DCRPT300
00346 *    INITIALIZE REQUEST IDENTIFICATION HEADING (2ND HEADING)      DCRPT300
00347 *                                                                 DCRPT300
00348  0200-INIT-HDG2.                                                  DCRPT300
00349      IF SAVE-OPT-REQTYPE EQUAL TO "RR" OR "RU"                    DCRPT300
00350          GO TO 0210-INIT-CATHDG2.                                 DCRPT300
00351      IF SAVE-OPT-REQTYPE EQUAL TO "RS" OR "RV"                    DCRPT300
00352          GO TO 0220-INIT-USGHDG2.                                 DCRPT300
00353      GO TO 0230-INIT-HIRHDG2.                                     DCRPT300
00354 *                                                                 DCRPT300
00355 *    CATALOGUE REPORT OR FILE                                     DCRPT300
00356 *                                                                 DCRPT300
00357  0210-INIT-CATHDG2.                                               DCRPT300
00358      IF SAVE-OPT-REQTYPE EQUAL TO "RR"                            DCRPT300
00359          MOVE REPORT-CON TO HDG2C-REQTYPE                         DCRPT300
00360      ELSE                                                         DCRPT300
00361          MOVE FILE-CON TO HDG2C-REQTYPE.                          DCRPT300
00362      MOVE HDG-2C TO HDG-2.                                        DCRPT300
00363      GO TO 0300-INIT-HDG3.                                        DCRPT300
00364 *                                                                 DCRPT300
00365 *    USAGE REPORT OR FILE                                         DCRPT300
00366 *                                                                 DCRPT300
00367  0220-INIT-USGHDG2.                                               DCRPT300
00368      IF SAVE-OPT-REQTYPE EQUAL TO "RS"                            DCRPT300
00369          MOVE REPORT-CON TO HDG2U-REQTYPE                         DCRPT300
00370      ELSE                                                         DCRPT300
00371          MOVE FILE-CON TO HDG2U-REQTYPE.                          DCRPT300
00372      IF SAVE-REQ-STARTCNAME EQUAL TO SPACES                       DCRPT300
00373          MOVE SPACES TO HDG2U-NAME                                DCRPT300
00374          MOVE SAVE-REQ-ENTITY TO HDG2U-NAME                       DCRPT300
00375      ELSE                                                         DCRPT300
00376          MOVE SAVE-REQ-STARTCNAME TO HDG2U-NAME.                  DCRPT300
00377      MOVE HDG-2U TO HDG-2                                         DCRPT300
00378      GO TO 0300-INIT-HDG3.                                        DCRPT300
00379 *                                                                 DCRPT300
00380  0230-INIT-HIRHDG2.                                               DCRPT300
00381      IF SAVE-OPT-REQTYPE EQUAL TO "RT"                            DCRPT300
00382          MOVE REPORT-CON TO HDG2H-REQTYPE                         DCRPT300
00383      ELSE                                                         DCRPT300
00384          MOVE FILE-CON TO HDG2H-REQTYPE.                          DCRPT300
00385      IF SAVE-REQ-STARTCNAME EQUAL SPACES                          DCRPT300
00386          MOVE SPACES TO HDG2H-NAME                                DCRPT300
00387          MOVE SAVE-REQ-ENTITY TO HDG2H-NAME                       DCRPT300
00388      ELSE                                                         DCRPT300
00389          MOVE SAVE-REQ-STARTCNAME TO HDG2H-NAME.                  DCRPT300
00390      MOVE HDG-2H TO HDG-2.                                        DCRPT300
00391 *                                                                 DCRPT300
00392 *    INITIALIZE TITLE HEADING                                     DCRPT300
00393 *                                                                 DCRPT300
00394  0300-INIT-HDG3.                                                  DCRPT300
00395      MOVE SAVE-OPT-TITLE TO HDG3-TITLE.                           DCRPT300
00396 *                                                                 DCRPT300
00397 *    INITIALIZE PRINT FORMAT FOR REQUESTED FORMAT AND             DCRPT300
00398 *    END OF PAGE MESSAGE                                          DCRPT300
00399 *                                                                 DCRPT300
00400      IF SAVE-OPT-BOTMSG EQUAL TO "Y"                              DCRPT300
00401          MOVE SAVE-EOP-MSG TO EOP-MSG                             DCRPT300
00402      ELSE                                                         DCRPT300
00403          MOVE SPACES TO EOP-MSG.                                  DCRPT300
00404      IF SAVE-OPT-FORMAT EQUAL TO "S"                                 CL**2
00405          MOVE "N" TO 8BY11-FLAG                                      CL**2
00406      ELSE                                                            CL**2
00407          MOVE "Y" TO 8BY11-FLAG.                                     CL**2
00408 *                                                                 DCRPT300
00409 *    DETERMINE WHICH INDICES ARE TO BE PRINTED FOR                DCRPT300
00410 *    THIS REQUEST-SET CONTROL SWITCHES                            DCRPT300
00411 *        IF INDEX=YES AND SEQ=1 OR 2 THEN TYPE AND NAME INDICES   DCRPT300
00412 *        IF INDEX=YES AND SEQ NOT 1 OR 2 THEN ONLY NAME           DCRPT300
00413 *        IF INDENT=YES THEN OUTPUT INDENTED INDEX                 DCRPT300
00414 *                                                                 DCRPT300
00415  0500-SET-REQUEST-CONTROL.                                        DCRPT300
00416      MOVE "Y" TO TYPE-1ST-SW.                                     DCRPT300
00417      MOVE "Y" TO NAME-1ST-SW.                                     DCRPT300
00418      MOVE "Y" TO INDENT-1ST-SW.                                   DCRPT300
00419      IF SAVE-OPT-INDEX EQUAL TO "N"                               DCRPT300
00420          MOVE "Y" TO INDENT-SW                                    DCRPT300
00421          MOVE "N" TO TYPE-SW                                      DCRPT300
00422          MOVE "N" TO NAME-SW                                      DCRPT300
00423          GO TO 0800-GET-DETAIL.                                   DCRPT300
00424      MOVE "Y" TO NAME-SW.                                         DCRPT300
00425      IF SAVE-OPT-SEQ EQUAL TO 1                                      CL**2
00426          MOVE "Y" TO TYPE-SW                                      DCRPT300
00427      ELSE                                                         DCRPT300
00428          MOVE "N" TO TYPE-SW.                                     DCRPT300
00429      IF SAVE-OPT-INDENT EQUAL TO "Y"                              DCRPT300
00430          MOVE "Y" TO INDENT-SW                                    DCRPT300
00431      ELSE                                                         DCRPT300
00432          MOVE "N" TO INDENT-SW.                                   DCRPT300
00433                                                                    DCRPT30
00434 ***************************************************************** DCRPT300
00435 ***************************************************************** DCRPT300
00436 *                                                                 DCRPT300
00437 *     CONTROL ROUTINE FOR INDEX PRODUCTION                        DCRPT300
00438 *                                                                 DCRPT300
00439 *    TYPE-SW,NAME-SW AND INDENT-SW REMAIN ON UNTIL THE            DCRPT300
00440 *    RESPECTIVE INDEX HAS BEEN PRINTED                            DCRPT300
00441 *                                                                 DCRPT300
00442 ***************************************************************** DCRPT300
00443 ***************************************************************** DCRPT300
00444  0800-GET-DETAIL.                                                 DCRPT300
00445      PERFORM 7000-READ-IDX THRU 7099-READ-IDX-XIT.                DCRPT300
00446  0810-TEST-TYPE.                                                  DCRPT300
00447      IF TYPE-SW EQUAL TO "Y"                                      DCRPT300
00448          GO TO 1000-ENTITY-INDEX.                                 DCRPT300
00449  0820-TEST-NAME.                                                  DCRPT300
00450      IF NAME-SW EQUAL TO "Y"                                      DCRPT300
00451          GO TO 2000-CATNAME-INDEX.                                DCRPT300
00452  0830-TEST-INDENT.                                                DCRPT300
00453      IF INDENT-SW EQUAL TO "Y"                                    DCRPT300
00454          GO TO 3000-INDENTED-INDEX.                               DCRPT300
00455  0840-TEST-END.                                                   DCRPT300
00456      IF IDX-EOF-SW EQUAL TO "Y"                                   DCRPT300
00457          GO TO 9000-IDX-END.                                      DCRPT300
00458      GO TO 0100-NEW-REQUEST.                                      DCRPT300
00459                                                                    DCRPT30
00460 ***************************************************************** DCRPT300
00461 ***************************************************************** DCRPT300
00462 *                                                                 DCRPT300
00463 *     PRODUCE ENTRY TYPE INDEX                                    DCRPT300
00464 *          SET UP APPROPRIATE SUBHEADINGS                         DCRPT300
00465 *          FORMAT DETAIL LINES                                    DCRPT300
00466 *          FORMAT END OF INDEX MESSAGE                            DCRPT300
00467 *                                                                 DCRPT300
00468 ***************************************************************** DCRPT300
00469 ***************************************************************** DCRPT300
00470  1000-ENTITY-INDEX.                                               DCRPT300
00471      IF TYPE-1ST-SW EQUAL TO "N"                                  DCRPT300
00472          GO TO 1100-PRINT-LINE.                                   DCRPT300
00473 *                                                                 DCRPT300
00474 *    FIRST TIME THRU                                              DCRPT300
00475 *        INITIALIZE HEADINGS FOR INDEX AND THEN OUTPUT MESSAGE    DCRPT300
00476 *        IF NO INPUT FOR INDEX                                    DCRPT300
00477 *                                                                 DCRPT300
00478      MOVE "N" TO TYPE-1ST-SW.                                     DCRPT300
00479      MOVE SPACE TO HDG1-IDX-TITLE.                                   CL**2
00480      MOVE SPACES TO REPORT-TITLE-LONG.                            DCRPT300
00481      MOVE TYPE-HCON TO REPORT-TITLE-LONG.                            CL**2
00482      MOVE FLDHDG-TYPE TO HDG-4.                                   DCRPT300
00483      MOVE SPACES TO STD-REPORT-REC.                               DCRPT300
00484      MOVE SPACES TO PRINT-LINE.                                   DCRPT300
00485      MOVE 1 TO PRT-CTL.                                              CL**2
00486      MOVE 99 TO LINE-CT.                                          DCRPT300
00487      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00488      IF IDX-EOF-SW EQUAL "Y"                                         CL**2
00489          GO TO 1050-NO-DATA.                                      DCRPT300
00490      IF IDX-DET-RECTYPE EQUAL TO "4"                                 CL**2
00491          GO TO 1100-PRINT-LINE.                                   DCRPT300
00492  1050-NO-DATA.                                                    DCRPT300
00493      MOVE NO-IDX-DATA-MSG TO STD-REPORT-REC.                      DCRPT300
00494      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00495      GO TO 1200-END-INDEX.                                        DCRPT300
00496 *                                                                 DCRPT300
00497 *    PRINT-ENTRY TYPE INDEX DETAIL LINE                           DCRPT300
00498 *                                                                 DCRPT300
00499  1100-PRINT-LINE.                                                 DCRPT300
00500      IF IDX-DET-RECTYPE NOT EQUAL "4"                             DCRPT300
00501          GO TO 1200-END-INDEX.                                    DCRPT300
00502      MOVE IDX-ENT-ENTTYPE TO SHORT-ENTTYPE-HOLD.                     CL**2
00503      PERFORM 7100-LOOKUP-TYPE THRU 7199-LOOKUP-TYPE-XIT.          DCRPT300
00504      MOVE LONG-ENTTYPE-HOLD TO TYPE-LINE-TYPE.                    DCRPT300
00505      MOVE IDX-ENT-PAGENO TO TYPE-LINE-PAGE.                       DCRPT300
00506      MOVE TYPE-LINE TO STD-REPORT-REC.                            DCRPT300
00507      MOVE 1 TO PRT-CTL.                                              CL**2
00508      IF LINE-CT GREATER THAN MAX-LINES                               CL**2
00509          MOVE "Y" TO SEC-PAGE-SW.                                    CL**2
00510      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00511      IF SEC-PAGE-SW EQUAL TO "Y"                                     CL**2
00512          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00513          MOVE "N" TO SEC-PAGE-SW.                                    CL**2
00514      GO TO 0800-GET-DETAIL.                                       DCRPT300
00515 *                                                                 DCRPT300
00516 *    END OF ENTRY TYPE INDEX                                      DCRPT300
00517 *                                                                 DCRPT300
00518  1200-END-INDEX.                                                  DCRPT300
00519      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00520      MOVE END-INDEX-MSG TO STD-REPORT-REC.                        DCRPT300
00521      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00522      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
00523      MOVE "N" TO TYPE-SW.                                         DCRPT300
00524      GO TO 0820-TEST-NAME.                                        DCRPT300
00525                                                                    DCRPT30
00526 ***************************************************************** DCRPT300
00527 ***************************************************************** DCRPT300
00528 *                                                                 DCRPT300
00529 *     PRODUCE CATALOGUE NAME INDEX                                DCRPT300
00530 *                                                                 DCRPT300
00531 ***************************************************************** DCRPT300
00532  2000-CATNAME-INDEX.                                              DCRPT300
00533      IF NAME-1ST-SW EQUAL TO "N"                                  DCRPT300
00534          GO TO 2100-PRINT-LINE.                                   DCRPT300
00535 *                                                                 DCRPT300
00536 *    FIRST TIME THRU                                              DCRPT300
00537 *        INITIALIZE HEADINGS FOR INDEX AND THEN OUTPUT            DCRPT300
00538 *        IF NO INPUT FOR INDEX MESSAGE                            DCRPT300
00539 *                                                                 DCRPT300
00540      MOVE SPACE TO  NAME-LINE-NAME1-L                             DCRPT300
00541      MOVE "N" TO NAME-1ST-SW.                                     DCRPT300
00542      MOVE SPACE TO HDG1-IDX-TITLE.                                   CL**2
00543      MOVE SPACES TO REPORT-TITLE-LONG.                            DCRPT300
00544      MOVE NAME-HCON TO REPORT-TITLE-LONG.                            CL**2
00545      IF SAVE-OPT-FORMAT EQUAL TO "D"                                 CL**2
00546          MOVE SPACES TO HDG-4                                        CL**2
00547          MOVE FLDHDG-CATNAME-S TO HDG-4                              CL**2
00548      ELSE                                                         DCRPT300
00549          MOVE SPACES TO NAME-LINE-NAME1-L                         DCRPT300
00550          MOVE SPACES TO NAME-LINE-TYPE1-L                         DCRPT300
00551          MOVE ZEROES TO NAME-LINE-PAGE1-L                            CL**2
00552          MOVE SPACES TO NAME-LINE-NAME2-L                         DCRPT300
00553          MOVE SPACES TO NAME-LINE-TYPE2-L                         DCRPT300
00554          MOVE ZEROES TO NAME-LINE-PAGE2-L                            CL**2
00555          MOVE FLDHDG-CATNAME-L TO HDG-4.                          DCRPT300
00556      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
00557      MOVE SPACES TO PRINT-LINE.                                   DCRPT300
00558      MOVE 1 TO PRT-CTL.                                              CL**2
00559      MOVE 99 TO LINE-CT.                                          DCRPT300
00560      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00561      IF IDX-EOF-SW EQUAL TO "Y"                                      CL**2
00562          GO TO 2050-NO-DATA.                                      DCRPT300
00563      IF IDX-DET-RECTYPE EQUAL TO "5"                              DCRPT300
00564          GO TO 2100-PRINT-LINE.                                   DCRPT300
00565  2050-NO-DATA.                                                    DCRPT300
00566      MOVE NO-IDX-DATA-MSG TO STD-REPORT-REC.                      DCRPT300
00567      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00568      GO TO 2200-END-INDEX.                                        DCRPT300
00569 *                                                                 DCRPT300
00570 *    PRINT CATNAME INDEX DETAIL LINE                              DCRPT300
00571 *        FORMATS DIFFER FOR STANDARD AND DOC                      DCRPT300
00572 *                                                                 DCRPT300
00573  2100-PRINT-LINE.                                                 DCRPT300
00574      IF IDX-EOF-SW EQUAL TO "Y"                                   DCRPT300
00575          GO TO 2200-END-INDEX.                                    DCRPT300
00576      IF IDX-DET-RECTYPE NOT EQUAL TO "5"                          DCRPT300
00577          GO TO 2200-END-INDEX.                                    DCRPT300
00578      MOVE IDX-CAT-ENTTYPE TO SHORT-ENTTYPE-HOLD.                     CL**2
00579      PERFORM 7100-LOOKUP-TYPE THRU 7199-LOOKUP-TYPE-XIT.          DCRPT300
00580      IF SAVE-OPT-FORMAT EQUAL TO "D"                                 CL**2
00581          MOVE IDX-CAT-CATNAME TO NAME-LINE-NAME-S                 DCRPT300
00582          MOVE LONG-ENTTYPE-HOLD TO NAME-LINE-TYPE-S                  CL**2
00583          MOVE IDX-CAT-PAGENO TO NAME-LINE-PAGE-S                  DCRPT300
00584          MOVE NAME-LINE-S TO STD-REPORT-REC                          CL**2
00585      MOVE 1 TO PRT-CTL                                               CL**2
00586          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCRPT300
00587          GO TO 0800-GET-DETAIL.                                   DCRPT300
00588 *                                                                 DCRPT300
00589 *    FORMAT STANDARD 2 NAMES PER LINE                             DCRPT300
00590 *                                                                 DCRPT300
00591      IF NAME-LINE-NAME1-L EQUAL SPACES                            DCRPT300
00592          MOVE IDX-CAT-CATNAME TO NAME-LINE-NAME1-L                DCRPT300
00593          MOVE IDX-CAT-PAGENO TO NAME-LINE-PAGE1-L                 DCRPT300
00594          MOVE LONG-ENTTYPE-HOLD TO NAME-LINE-TYPE1-L              DCRPT300
00595          GO TO 0800-GET-DETAIL.                                   DCRPT300
00596      MOVE IDX-CAT-CATNAME TO NAME-LINE-NAME2-L.                   DCRPT300
00597      MOVE IDX-CAT-PAGENO TO NAME-LINE-PAGE2-L.                    DCRPT300
00598      MOVE LONG-ENTTYPE-HOLD TO NAME-LINE-TYPE2-L.                 DCRPT300
00599      MOVE NAME-LINE-L TO STD-REPORT-REC.                          DCRPT300
00600      MOVE 1 TO PRT-CTL.                                              CL**2
00601      IF LINE-CT GREATER THAN MAX-LINES                               CL**2
00602          MOVE "Y" TO SEC-PAGE-SW.                                    CL**2
00603      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00604      IF SEC-PAGE-SW EQUAL TO "Y"                                     CL**2
00605          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00606          MOVE "N" TO SEC-PAGE-SW.                                    CL**2
00607      MOVE SPACES TO NAME-LINE-NAME1-L.                            DCRPT300
00608      MOVE SPACES TO NAME-LINE-TYPE1-L.                            DCRPT300
00609      MOVE ZEROES TO NAME-LINE-PAGE1-L.                               CL**2
00610      MOVE SPACES TO NAME-LINE-NAME2-L.                            DCRPT300
00611      MOVE SPACES TO NAME-LINE-TYPE2-L.                            DCRPT300
00612      MOVE ZEROES TO NAME-LINE-PAGE2-L.                               CL**2
00613      GO TO 0800-GET-DETAIL.                                       DCRPT300
00614 *                                                                 DCRPT300
00615 *    END OF CATNAME INDEX                                         DCRPT300
00616 *                                                                 DCRPT300
00617  2200-END-INDEX.                                                  DCRPT300
00618      IF NAME-LINE-NAME1-L NOT EQUAL TO SPACES                     DCRPT300
00619          MOVE NAME-LINE-L TO STD-REPORT-REC                          CL**2
00620          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.              DCRPT300
00621      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00622      MOVE END-INDEX-MSG TO STD-REPORT-REC.                        DCRPT300
00623      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00624      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
00625      MOVE "N" TO NAME-SW.                                         DCRPT300
00626      GO TO 0830-TEST-INDENT.                                         CL**2
00627                                                                    DCRPT30
00628 ***************************************************************** DCRPT300
00629 ***************************************************************** DCRPT300
00630 *                                                                 DCRPT300
00631 *     PRODUCE INDENTED INDEX                                      DCRPT300
00632 *          SET UP SUBHEADINGS                                     DCRPT300
00633 *          FORMAT DETAIL LINES                                    DCRPT300
00634 *          FORMAT END OF INDEX MESSAGE                            DCRPT300
00635 *                                                                 DCRPT300
00636 ***************************************************************** DCRPT300
00637 ***************************************************************** DCRPT300
00638  3000-INDENTED-INDEX.                                             DCRPT300
00639      IF INDENT-1ST-SW EQUAL TO "N"                                DCRPT300
00640          GO TO 3100-PRINT-LINE.                                   DCRPT300
00641 *                                                                 DCRPT300
00642 *     FIRST TIME THRU                                             DCRPT300
00643 *          INITIALIZE HEADINGS FOR INDEX AND THEN OUTPUT MESSAGE  DCRPT300
00644 *          IF NO INPUT FOR INDEX                                  DCRPT300
00645 *                                                                 DCRPT300
00646      MOVE "N" TO INDENT-1ST-SW.                                   DCRPT300
00647      MOVE SPACES TO HDG1-IDX-TITLE.                                  CL**2
00648      MOVE SPACES TO REPORT-TITLE-LONG.                            DCRPT300
00649      MOVE INDENT-HCON TO REPORT-TITLE-LONG.                          CL**2
00650      MOVE FLDHDG-INDENT TO HDG-4.                                 DCRPT300
00651      MOVE SPACES TO STD-REPORT-REC.                               DCRPT300
00652      MOVE SPACES TO PRINT-LINE.                                   DCRPT300
00653      MOVE 1 TO PRT-CTL.                                              CL**2
00654      MOVE 99 TO LINE-CT.                                          DCRPT300
00655      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00656      IF IDX-EOF-SW EQUAL TO "Y"                                      CL**2
00657          GO TO 3050-NO-DATA.                                      DCRPT300
00658      IF IDX-DET-RECTYPE EQUAL TO "6"                              DCRPT300
00659          GO TO 3100-PRINT-LINE.                                   DCRPT300
00660  3050-NO-DATA.                                                    DCRPT300
00661      MOVE NO-IDX-DATA-MSG TO STD-REPORT-REC.                      DCRPT300
00662      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00663      GO TO 3500-END-INDEX.                                        DCRPT300
00664 *                                                                 DCRPT300
00665 *     PRINT INDENTED INDEX DETAIL LINE                            DCRPT300
00666 *                                                                 DCRPT300
00667  3100-PRINT-LINE.                                                 DCRPT300
00668      IF IDX-EOF-SW EQUAL TO "Y"                                   DCRPT300
00669          GO TO 3500-END-INDEX.                                    DCRPT300
00670      IF IDX-DET-RECTYPE NOT EQUAL TO 6                            DCRPT300
00671          GO TO 3500-END-INDEX.                                    DCRPT300
00672      MOVE IDX-REL-ENTTYPE TO SHORT-ENTTYPE-HOLD.                  DCRPT300
00673      PERFORM 7100-LOOKUP-TYPE THRU 7199-LOOKUP-TYPE-XIT.          DCRPT300
00674      MOVE LONG-ENTTYPE-HOLD TO I-LINE-TYPE.                       DCRPT300
00675      MOVE IDX-REL-PAGENO TO I-LINE-PAGE.                          DCRPT300
00676      ADD 1 TO IDX-REL-RETLEV.                                        CL**2
00677  3400-REL-LEVEL.                                                  DCRPT300
00678      GO TO 3401-RET-1                                             DCRPT300
00679            3402-RET-2                                             DCRPT300
00680            3403-RET-3                                             DCRPT300
00681            3404-RET-4                                             DCRPT300
00682            3405-RET-5                                             DCRPT300
00683            3406-RET-6                                             DCRPT300
00684            3407-RET-7                                             DCRPT300
00685            3408-RET-8                                             DCRPT300
00686            3409-RET-9                                             DCRPT300
00687            3410-RET-10                                            DCRPT300
00688            3411-RET-11                                            DCRPT300
00689            3412-RET-12                                            DCRPT300
00690            3413-RET-13                                            DCRPT300
00691            3414-RET-14                                            DCRPT300
00692          3415-RET-15 DEPENDING ON IDX-REL-RETLEV.                 DCRPT300
00693      MOVE SPACES TO IBET-RELCAT.                                  DCRPT300
00694      GO TO 3490-CONTINUE.                                         DCRPT300
00695  3401-RET-1.                                                      DCRPT300
00696      MOVE IDX-REL-CATNAME TO RET-CAT1.                               CL**2
00697      MOVE RET-1 TO IBET-RELCAT.                                   DCRPT300
00698      GO TO 3490-CONTINUE.                                         DCRPT300
00699  3402-RET-2.                                                      DCRPT300
00700      MOVE IDX-REL-CATNAME TO RET-CAT2.                            DCRPT300
00701      MOVE RET-2 TO IBET-RELCAT.                                   DCRPT300
00702      GO TO 3490-CONTINUE.                                         DCRPT300
00703  3403-RET-3.                                                      DCRPT300
00704      MOVE IDX-REL-CATNAME TO RET-CAT3.                            DCRPT300
00705      MOVE RET-3 TO IBET-RELCAT.                                   DCRPT300
00706      GO TO 3490-CONTINUE.                                         DCRPT300
00707  3404-RET-4.                                                      DCRPT300
00708      MOVE IDX-REL-CATNAME TO RET-CAT4.                            DCRPT300
00709      MOVE RET-4 TO IBET-RELCAT.                                   DCRPT300
00710      GO TO 3490-CONTINUE.                                         DCRPT300
00711  3405-RET-5.                                                      DCRPT300
00712      MOVE IDX-REL-CATNAME TO RET-CAT5.                            DCRPT300
00713      MOVE RET-5 TO IBET-RELCAT.                                   DCRPT300
00714      GO TO 3490-CONTINUE.                                         DCRPT300
00715  3406-RET-6.                                                      DCRPT300
00716      MOVE IDX-REL-CATNAME TO RET-CAT6.                            DCRPT300
00717      MOVE RET-6 TO IBET-RELCAT.                                   DCRPT300
00718      GO TO 3490-CONTINUE.                                         DCRPT300
00719  3407-RET-7.                                                      DCRPT300
00720      MOVE IDX-REL-CATNAME TO RET-CAT7.                            DCRPT300
00721      MOVE RET-7 TO IBET-RELCAT.                                   DCRPT300
00722      GO TO 3490-CONTINUE.                                         DCRPT300
00723  3408-RET-8.                                                      DCRPT300
00724      MOVE IDX-REL-CATNAME TO RET-CAT8.                            DCRPT300
00725      MOVE RET-8 TO IBET-RELCAT.                                   DCRPT300
00726      GO TO 3490-CONTINUE.                                         DCRPT300
00727  3409-RET-9.                                                      DCRPT300
00728      MOVE IDX-REL-CATNAME TO RET-CAT9.                            DCRPT300
00729      MOVE RET-9 TO IBET-RELCAT.                                   DCRPT300
00730      GO TO 3490-CONTINUE.                                         DCRPT300
00731  3410-RET-10.                                                     DCRPT300
00732      MOVE IDX-REL-CATNAME TO RET-CAT10.                           DCRPT300
00733      MOVE RET-10 TO IBET-RELCAT.                                  DCRPT300
00734      GO TO 3490-CONTINUE.                                         DCRPT300
00735  3411-RET-11.                                                     DCRPT300
00736      MOVE IDX-REL-CATNAME TO RET-CAT11.                           DCRPT300
00737      MOVE RET-11 TO IBET-RELCAT.                                  DCRPT300
00738      GO TO 3490-CONTINUE.                                         DCRPT300
00739  3412-RET-12.                                                     DCRPT300
00740      MOVE IDX-REL-CATNAME TO RET-CAT12.                           DCRPT300
00741      MOVE RET-12 TO IBET-RELCAT.                                  DCRPT300
00742      GO TO 3490-CONTINUE.                                         DCRPT300
00743  3413-RET-13.                                                     DCRPT300
00744      MOVE IDX-REL-CATNAME TO RET-CAT13.                           DCRPT300
00745      MOVE RET-13 TO IBET-RELCAT.                                  DCRPT300
00746      GO TO 3490-CONTINUE.                                         DCRPT300
00747  3414-RET-14.                                                     DCRPT300
00748      MOVE IDX-REL-CATNAME TO RET-CAT14.                           DCRPT300
00749      MOVE RET-14 TO IBET-RELCAT.                                  DCRPT300
00750      GO TO 3490-CONTINUE.                                         DCRPT300
00751  3415-RET-15.                                                     DCRPT300
00752      MOVE IDX-REL-CATNAME TO RET-CAT15.                           DCRPT300
00753      MOVE RET-15 TO IBET-RELCAT.                                  DCRPT300
00754  3490-CONTINUE.                                                   DCRPT300
00755      MOVE INDENT-LINE TO STD-REPORT-REC.                          DCRPT300
00756      IF LINE-CT GREATER THAN MAX-LINES                               CL**2
00757          MOVE "Y" TO SEC-PAGE-SW.                                    CL**2
00758      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00759      IF SEC-PAGE-SW EQUAL TO "Y"                                     CL**2
00760          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00761          MOVE "N" TO SEC-PAGE-SW.                                    CL**2
00762      GO TO 0800-GET-DETAIL.                                       DCRPT300
00763 *                                                                 DCRPT300
00764 *     END OF ENTRY TYPE INDEX                                     DCRPT300
00765 *                                                                 DCRPT300
00766  3500-END-INDEX.                                                  DCRPT300
00767      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00768      MOVE END-INDEX-MSG TO STD-REPORT-REC.                        DCRPT300
00769      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00770      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
00771      MOVE "N" TO INDENT-SW.                                          CL**2
00772      GO TO 0840-TEST-END.                                         DCRPT300
00773                                                                    DCRPT30
00774 ***************************************************************** DCRPT300
00775 ***************************************************************** DCRPT300
00776 *                                                                 DCRPT300
00777 *     READ INDEX FILE                                             DCRPT300
00778 *          READS AND SEQUENCE CHECKS FILE                         DCRPT300
00779 *                                                                 DCRPT300
00780 ***************************************************************** DCRPT300
00781 ***************************************************************** DCRPT300
00782  7000-READ-IDX.                                                   DCRPT300
00783      MOVE NEW-KEY TO OLD-KEY.                                        CL**2
00784      READ INDEX-FILE                                              DCRPT300
00785          AT END MOVE "Y" TO IDX-EOF-SW                            DCRPT300
00786          MOVE SPACES TO NEW-KEY                                      CL**2
00787          GO TO 7099-READ-IDX-XIT.                                 DCRPT300
00788      IF IDX-FILE-RECTYPE EQUAL TO 1 OR 2 OR 3                        CL**2
00789          MOVE SPACES TO NEW-KEY                                      CL**2
00790          MOVE IDX-FILE-KEY TO NEW-COMMON                             CL**2
00791      ELSE                                                            CL**2
00792          MOVE IDX-DET-REC TO NEW-KEY.                                CL**2
00793      MOVE ZEROES TO NEW-REQ.                                         CL**2
00794      MOVE ZEROES TO OLD-REQ.                                         CL**2
00795      IF SAVE-OPT-SEQ EQUAL "4"                                       CL**2
00796          GO TO 7099-READ-IDX-XIT.                                    CL**2
00797      IF NEW-KEY NOT GREATER THAN OLD-KEY                             CL**2
00798          GO TO 8010-IDX-SEQERR.                                      CL**2
00799  7099-READ-IDX-XIT.                                               DCRPT300
00800      EXIT.                                                        DCRPT300
00801 *                                                                 DCRPT300
00802 *     CONVERT 2 DIGIT ENTRY TYPE TO CTL FILE NAME                 DCRPT300
00803  7100-LOOKUP-TYPE.                                                DCRPT300
00804      MOVE 0 TO ENT-SUB.                                           DCRPT300
00805  7110-MATCH.                                                      DCRPT300
00806      ADD 1 TO ENT-SUB.                                            DCRPT300
00807      IF SAVE-ENTRY-ID (ENT-SUB) EQUAL TO SHORT-ENTTYPE-HOLD       DCRPT300
00808          MOVE SAVE-ENTRY-NAME (ENT-SUB) TO LONG-ENTTYPE-HOLD      DCRPT300
00809          GO TO 7199-LOOKUP-TYPE-XIT.                                 CL**2
           IF ENT-SUB GREATER THAN 17 
00811          GO TO 8040-MAST3-ERROR.                                     CL**2
00812      GO TO 7110-MATCH.                                            DCRPT300
00813  7199-LOOKUP-TYPE-XIT.                                            DCRPT300
00814      EXIT.                                                        DCRPT300
00815                                                                    DCRPT30
00816 ******************************************************************DCRPT300
00817 ******************************************************************DCRPT300
00818 *     ERROR ROUTINES                                              DCRPT300
00819 ******************************************************************DCRPT300
00820 ******************************************************************DCRPT300
00821 *                                                                 DCRPT300
00822 *     SEQUENCE ERROR                                              DCRPT300
00823 *                                                                 DCRPT300
00824  8010-IDX-SEQERR.                                                 DCRPT300
00825      MOVE SEQ-ERR-MSG TO STD-REPORT-REC.                          DCRPT300
00826  8015-COMMON-END.                                                 DCRPT300
00827      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT300
00828      MOVE 12 TO RETURN-CODE.                                      DCRPT300
00829      GO TO 9000-IDX-END.                                          DCRPT300
00830 *                                                                 DCRPT300
00831 *     NO DATA ON FILE                                             DCRPT300
00832 *                                                                 DCRPT300
00833  8020-NODATA-ERR.                                                 DCRPT300
00834      MOVE NO-DATA-MSG TO STD-REPORT-REC.                          DCRPT300
00835      GO TO 8015-COMMON-END.                                       DCRPT300
00836 *                                                                 DCRPT300
00837 *     NO REQUEST ON FILE                                          DCRPT300
00838 *                                                                 DCRPT300
00839  8030-NOREQ-ERR.                                                  DCRPT300
00840      MOVE NO-DATA-MSG TO STD-REPORT-REC.                             CL**2
00841      GO TO 8015-COMMON-END.                                       DCRPT300
00842 *                                                                 DCRPT300
00843 *     MAST3 INVALID KEY                                           DCRPT300
00844 *                                                                 DCRPT300
00845  8040-MAST3-ERROR.                                                DCRPT300
00846      MOVE MAST3-ERROR-MSG TO STD-REPORT-REC.                      DCRPT300
00847      GO TO 8015-COMMON-END.                                       DCRPT300
00848                                                                    DCRPT30
00849 ******************************************************************DCRPT300
00850 ******************************************************************DCRPT300
00851 *                                                                 DCRPT300
00852 *     END OF JOB PROCESSING                                       DCRPT300
00853 *                                                                 DCRPT300
00854 ******************************************************************DCRPT300
00855 ******************************************************************DCRPT300
00856  9000-IDX-END.                                                    DCRPT300
00857      CLOSE INDEX-FILE.                                            DCRPT300
00858      CLOSE MAST3.                                                 DCRPT300
00859      CLOSE SYSPRINT.                                              DCRPT300
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT. 
00860      STOP RUN.                                                    DCRPT300
*CALL     DISPLAY2                                                         CL**2
*CALL     WRITELN                                                       DCRPT300
00863  USER-ROUTINE.                                                    DCRPT300
00864      MOVE HDG-1 TO PRINT-DATA.                                       CL**2
00865      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
00866      ADD 4 TO LINE-CT.                                               CL**2
00867      MOVE HDG-2 TO PRINT-DATA.                                    DCRPT300
00868      ADD 3 TO LINE-CT.                                            DCRPT300
00869      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                      DCRPT300
00870      MOVE HDG-3 TO PRINT-DATA.                                    DCRPT300
00871      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                      DCRPT300
00872      MOVE SPACES TO PRINT-DATA.                                   DCRPT300
00873      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                      DCRPT300
00874      MOVE HDG-4 TO PRINT-DATA.                                    DCRPT300
00875      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                      DCRPT300
00876  USER-ROUTINE-XIT.                                                DCRPT300
00877      EXIT.                                                        DCRPT300
00878  RPT-PRINT811.                                                       CL**2
00879      GO TO RPT-PRINT811-XIT.                                         CL**2
00880  RPT-PRINT811-XIT.                                                   CL**2
*CALL RETCODE 
