*DECK     DCRPT200
00001  IDENTIFICATION DIVISION.                                         10/03/78
       PROGRAM-ID. RPT200.
*CALL COPYRIGHT 
      * THIS MODULE CONTROLS THE CALLING OF REPORT PRINT MODULES
      * IN ADDITION IT PERFORMS ALL PHYSICAL I/O FOR PRINTER
      * AND FILES.  INPUT TO THIS MODULE IS THE SORTED EXTRACT
      * FILE CREATED BY DCRPT100. THE FOLLOWING ARE OUTPUTS - 
      *   1.  CATALOGUE REPORT AND/OR USER FILE 
      *   2.  HIERARCHY REPORT AND/OR USER FILE 
      *   3.  USAGE REPORT AND/OR USER FILE 
      *   4.  INDEX FILE FOR THE ABOVE THREE REPORTS
      *   5.  INDEX REPORT
      *   6.  RELATIONAL REPORT 
      *   7.  RELATIONAL ANALYSIS REPORT. 
00019  ENVIRONMENT DIVISION.                                            DCRPT200
00020  CONFIGURATION SECTION.                                           DCRPT200
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
*CALL OTHSN 
00023  INPUT-OUTPUT SECTION.                                               CL**2
00024  FILE-CONTROL.                                                    DCRPT200
           SELECT MAST1 ASSIGN TO "MAST1" 
               ACCESS MODE IS RANDOM
               ORGANIZATION IS DIRECT 
               RECORD KEY IS DATA-KEY-2.
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
               ACCESS MODE IS RANDOM
               RELATIVE KEY IS CON-KEY
               USE "PRUF = YES".
           SELECT EXTRACT-FILE ASSIGN TO TEMP13 USE "RT=W". 
           SELECT INDEX-FILE ASSIGN TO TEMP14 USE "RT=W". 
           SELECT USER-FILE ASSIGN TO USERFL USE "RT=W".
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
00030  DATA DIVISION.                                                      CL**2
00031  FILE SECTION.                                                       CL**2
*CALL     MAST3FD                                                          CL**2
*CALL     MAST1FD2                                                         CL**2
*CALL     EXTFD2                                                           CL**2
*CALL     INDEXFD                                                          CL**2
*CALL     USERFD                                                           CL**2
*CALL     SYSPRTFD                                                         CL**2
*CALL RPTCS 
*CALL     WRKSTG77                                                      DCRPT200
*CALL     MAST3DD1                                                      DCRPT200
00048  01  RPT-CTL-AREAS.                                               DCRPT200
00049      03  CAT-HDG-CON             PICTURE X(50) VALUE              DCRPT200
00050         "         C A T A L O G U E    R E P O R T".              DCRPT200
00051      03  HIR-HDG-CON.                                             DCRPT200
00052          05  FILLER              PICTURE X(17) VALUE              DCRPT200
00053         "  HIERARCHY  OF  ".                                      DCRPT200
00054          05  HIR-TITLE-NAME      PICTURE X(32).                   DCRPT200
00055          05  FILLER              PICTURE X VALUE SPACE.           DCRPT200
00056      03  USG-HDG-CON.                                             DCRPT200
00057          05  FILLER              PICTURE X(17) VALUE              DCRPT200
00058         "      USAGE  OF  ".                                      DCRPT200
00059          05  USG-TITLE-NAME       PICTURE X(32).                  DCRPT200
00060          05  FILLER              PICTURE X VALUE SPACE.           DCRPT200
00061      03  LITERAL-1               PICTURE X(24) VALUE              DCRPT200
00062         "REPORT DATE-".                                           DCRPT200
00063      03  LITERAL-2               PICTURE X(24) VALUE              DCRPT200
00064         "DATE OF LAST REVISION-".                                 DCRPT200
00065      03  LITERAL-3               PICTURE X(5) VALUE               DCRPT200
00066         "PAGE".                                                   DCRPT200
00067      03  LITERAL-4               PICTURE X(31) VALUE              DCRPT200
00068         "D A T A   C A T A L O G U E   2".                        DCRPT200
00069      03  LITERAL-5               PICTURE X(25)   VALUE               CL**2
00070          "REVISION NUMBER-".                                         CL**2
00071      03  PROP-MSG-SAVE.                                              CL**2
00072          05  FILLER              PICTURE X(44) VALUE                 CL**2
               "DATA CATALOGUE 2                        V2.0".
00074          05  FILLER              PICTURE X(29) VALUE                 CL**2
*CALL LEVEL 
00076      03  RPT-ERROR-MSGS.                                             CL**2
00077          05  NO-DATA-MSG.                                            CL**2
00078              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00079              07  NODATA-MSG      PICTURE X(42) VALUE                 CL**2
00080             "DCRPT-030-I * NO DATA SELECTED FOR REQUEST".            CL**2
00081          05  MAST1-ERR-MSG.                                          CL**2
00082              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00083              07  MAST1-MSG       PICTURE X(25) VALUE                 CL**2
00084             "DCRPT-800-S * MAST1READ ".                              CL**2
00085              07  ERROR-NAME      PICTURE X(32) VALUE SPACES.         CL**2
00086          05  MAST3-ERR-MSG.                                          CL**2
00087              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00088              07  MAST3-MSG       PICTURE X(38) VALUE                 CL**2
00089             "DCRPT-950-F * MAST3 READ CLIENT RECORD".                CL**2
00090          05  NO-INPUT-MSG.                                           CL**2
00091              07  FILLER          PICTURE XX VALUE SPACES.            CL**2
00092              07  NOINPUT-MSG     PICTURE X(34) VALUE                 CL**2
00093             "DCRPT-890-S * NO EXTRACT FILE DATA".                    CL**2
00094      03  OLD-CATNAME             PICTURE X(32).                      CL**2
00095      03  CAT-SWITCHES.                                            DCRPT200
00096          05  1ST-USER-SW         PICTURE X VALUE "Y".             DCRPT200
00097          05  1ST-IDX-SW          PICTURE X VALUE "Y".             DCRPT200
00098          05  EXT-EOF-SW          PICTURE X VALUE "N".             DCRPT200
00099          05  REQ-1STTIME-SW      PICTURE X  VALUE "Y".               CL**2
00100          05  ENDRPT-SW PICTURE X VALUE "N".                          CL**2
00101      03  MAST1-ERR-SW         PICTURE X.                             CL**2
00102      03  CAT-SUBSCRIPTS.                                          DCRPT200
00103          05  ENT-SUB             PICTURE S99 COMP SYNC.              CL**2
00104          05  SEL-SUB             PICTURE S99 COMP SYNC.              CL**2
00105          05  OUT-SUB             PICTURE S99 COMP SYNC.              CL**2
00106          05  LINE-SUB            PICTURE S99 COMP SYNC.              CL**2
00107          05  FILE-SUB            PICTURE S99 COMP SYNC.              CL**2
00108          05  CTL-SUB             PICTURE S99 COMP SYNC.              CL**2
00109          05  SUB-Z               PICTURE S99 COMP SYNC.              CL**2
00110          05  EF-SUB               PICTURE S99  COMP SYNC.            CL**2
00111          05  OUT-NUM-TEMP        PICTURE 9.                          CL**2
00112      03  CAT-ACCUMULATORS.                                           CL**2
00113          05  USER-REC-COUNT      PICTURE 9(4) .                    DCRPT20
00114          05  IDX-REC-COUNT      PICTURE 9(4)  .                    DCRPT20
00115          05  EXT-REC-COUNT      PICTURE 9(4)  .                    DCRPT20
00116          05  FILE-REQ-COUNT      PICTURE S99 .                     DCRPT20
00117          05  REPORT-REQ-COUNT    PICTURE S99 .                     DCRPT20
00118          03  TOTAL-REQ-COUNT     PICTURE S99 .                     DCRPT20
00119      03  CAT-WORK-AREAS.                                          DCRPT200
00120          05  SHORT-ENTTYPE       PICTURE 99.                      DCRPT200
00121          05  LONG-ENTTYPE        PICTURE X(15) VALUE "LONG".      DCRPT200
00122  01  CTL-HEADER-SAVE.                                             DCRPT200
00123      03  CTL-NAME-SAVE           PICTURE X(27).                   DCRPT200
00124      03  CTL-ADDRESS-SAVE        PICTURE X(27).                   DCRPT200
00125      03  CTL-REV-NUM-SAVE        PICTURE S9(5) .                   DCRPT20
00126      03  CTL-DATE-UPD-SAVE       PICTURE X(8).                    DCRPT200
00127      03  CTL-DATE-RES-SAVE       PICTURE X(8).                    DCRPT200
00128      03  CTL-NUM-RES-SAVE        PICTURE S9(5) .                   DCRPT20
00129      03  CTL-DEVICE-SAVE         PICTURE X.                       DCRPT200
00130      03  CTL-MAX-ENT-SAVE        PICTURE S9(5) .                   DCRPT20
00131      03  CTL-CUR-ENT-SAVE        PICTURE S9(5) .                   DCRPT20
00132      03  CTL-AVL-TRK-SAVE        PICTURE S9(5) .                   DCRPT20
00133      03  CTL-PRIME-NUM-SAVE      PICTURE S9(5) .                   DCRPT20
00134      03  CTL-SYN-NUM-SAVE        PICTURE S9(5) .                   DCRPT20
00135      03  CTL-LINES-SAVE          PICTURE S99.                     DCRPT200
00136      03  CTL-EOP-MSG-SAVE        PICTURE X(54).                      CL**2
00137      03  CTL-NUM-DEL-SAVE        PICTURE S9(5) .                   DCRPT20
00138      03  CTL-NUM-INS-SAVE        PICTURE S9(5) .                   DCRPT20
00139      03  CTL-NUM-UPD-SAVE        PICTURE S9(5) .                   DCRPT20
00140      03  CTL-DC-RELEASE          PICTURE XX.                      DCRPT200
00141      03  CTL-PRIME-NUM-REL-SAVE  PICTURE S9(5) .                   DCRPT20
00142      03  CTL-REL-LIMIT-SAVE         PICTURE S99 COMP.                CL**2
00143      03  CTL-DATA-REC-SIZE-SAVE  PICTURE S9(5) .                   DCRPT20
00144      03  CTL-DBMS-SAVE           PICTURE X.                       DCRPT200
00145  01  ENT-TABLE.                                                      CL**2
00147      03  ENT-ENTITY     OCCURS   15   TIMES.                         CL**2
00148          05  ENT-NAME            PICTURE X(15).                      CL**2
00149          05  ENT-ID              PICTURE XX.                         CL**2
00150      03  FILLER                     PICTURE X(2865).                 CL**2
00155 *************************************************************        CL**2
00156 *                                                                    CL**2
00157 *    HEADING AND CONSTANTS  FOR REPORTS                              CL**2
00158 *                                                                    CL**2
00159 **************************************************************       CL**2
00160  01  REQRPT-LINES.                                                   CL**2
00161      03  REQRPT-STARS            PICTURE X(29) VALUE                 CL**2
00162        "*****************************".                              CL**2
00163      03  REQRPT-REQNO-LINE.                                          CL**2
00164          05  FILLER              PICTURE X(27) VALUE                 CL**2
00165        "REPORT/FILE REQUEST NUMBER ".                                CL**2
00166          05  REQRPT-REQNO        PICTURE Z9.                         CL**2
00167      03  REQRPT-TITLE            PICTURE X(50) VALUE                 CL**2
00168        " R E Q U E S T   S U M M A R Y   R E P O R T".               CL**2
00169      03  REQRPT-PARAM-HDG        PICTURE X(44) VALUE                 CL**2
00170        "*** THE FOLLOWING PARAMETERS WERE SPECIFIED-".               CL**2
00171      03  REQRPT-OPTIONS-HDG      PICTURE X(52) VALUE                 CL**2
00172        "*** THE STATUS OF APPLICABLE OPTIONS IS SHOWN BELOW-".       CL**2
00173      03  REQRPT-SEL-HDG          PICTURE X(47) VALUE                 CL**2
00174        "*** ENTRY SELECTION STATUS IS SUMMARIZED BELOW-".            CL**2
00175      03  REQRPT-OPTION-LINE.                                         CL**2
00176          05  FILLER              PICTURE X(7) VALUE SPACES.          CL**2
00177          05  REQRPT-OPTION-KW    PICTURE X(15).                      CL**2
00178          05  FILLER              PICTURE X(3) VALUE                  CL**2
00179        " = ".                                                        CL**2
00180          05  REQRPT-OPTION-VAL   PICTURE X(15).                      CL**2
00181      03  REQRPT-SELTOT-LINE.                                         CL**2
00182          05  FILLER              PICTURE X(10) VALUE                 CL**2
00183        "        * ".                                                 CL**2
00184          05  REQRPT-SELTOT       PICTURE ZZZZ9.                      CL**2
00185          05  FILLER              PICTURE X(43) VALUE                 CL**2
00186        " ENTRIES WERE SELECTED BY SELECT STATEMENT ".                CL**2
00187          05  REQRPT-SELNO        PICTURE 9.                          CL**2
00188      03  REQRPT-REQTOT-LINE.                                         CL**2
00189          05  FILLER              PICTURE X(10) VALUE                 CL**2
00190        "       ** ".                                                 CL**2
00191          05  REQRPT-REQTOT       PICTURE ZZZZZZ9.                    CL**2
00192          05  FILLER              PICTURE X(38) VALUE                 CL**2
00193        " ENTRIES WERE SELECTED BY THIS REQUEST".                     CL**2
00194      03  REQRPT-USERSTMT-LINE.                                       CL**2
00195          05  FILLER              PICTURE X(4) VALUE SPACES.          CL**2
00196          05  REQRPT-USER-STMT    PICTURE X(72).                      CL**2
00197      03  REPORT-CON              PICTURE X(15) VALUE                 CL**2
00198        "REPORT".                                                     CL**2
00199      03  SEQ-CON                 PICTURE X(15) VALUE                 CL**2
00200        "SEQ".                                                        CL**2
00201      03  INDEX-CON               PICTURE X(15) VALUE                 CL**2
00202        "INDEX".                                                      CL**2
00203      03  NEWPAGE-CON             PICTURE X(15) VALUE                 CL**2
00204        "NEWPAGE".                                                    CL**2
00205      03  FORMAT-CON              PICTURE X(15) VALUE                 CL**2
00206        "FORMAT".                                                     CL**2
00207      03  SHOWREQ-CON             PICTURE X(15) VALUE                 CL**2
00208        "SHOWREQ".                                                    CL**2
00209      03  MESSAGE-CON             PICTURE X(15) VALUE                 CL**2
00210        "MESSAGE".                                                    CL**2
00211      03  STOPENT-CON             PICTURE X(15) VALUE                 CL**2
00212        "STOPENT".                                                    CL**2
00213      03  INDENT-CON              PICTURE X(15) VALUE                 CL**2
00214        "INDENTED-INDEX".                                             CL**2
00215      03  YES-CON                 PICTURE X(15) VALUE                 CL**2
00216        "YES".                                                        CL**2
00217      03  NO-CON                  PICTURE X(15) VALUE                 CL**2
00218        "NO".                                                         CL**2
00219      03  TYPE-CON                PICTURE X(15) VALUE                 CL**2
00220        "TYPE".                                                       CL**2
00221      03  NAME-CON                PICTURE X(15) VALUE                 CL**2
00222        "NAME".                                                       CL**2
00223      03  REVERSE-CON             PICTURE X(15) VALUE                 CL**2
00224        "REVERSE".                                                    CL**2
00225      03  RET-CON                 PICTURE X(15) VALUE                 CL**2
00226        "RETRIEVAL".                                                  CL**2
00227      03  STD-CON                 PICTURE X(15) VALUE                 CL**2
00228        "STANDARD".                                                   CL**2
00229      03  DOC-CON                 PICTURE X(15) VALUE                 CL**2
00230        "DOCUM".                                                      CL**2
00231      03  NOSPEC-CON              PICTURE X(15) VALUE                 CL**2
00232        "NONE SPECIFIED".                                             CL**2
00233      03  DIRECT-CON               PICTURE X(15)  VALUE               CL**2
00234      "INDIRECT".                                                     CL**2
00235      03  BRECHR-CON               PICTURE X(15)  VALUE               CL**2
00236      "BREAK CHARACTER".                                              CL**2
00237      03  DASH-CON                 PICTURE X(15)  VALUE               CL**2
00238      "-".                                                            CL**2
00239      03  DESC-CON                 PICTURE X(15)  VALUE               CL**2
00240      "DESCRIPTION".                                                  CL**2
00241      03  LINE-OPTION-VAL          PICTURE ZZZ9  VALUE ZEROES.        CL**2
00242  01  CTLRPT-LINES.                                                   CL**2
00243      03  CTLRPT-TITLE            PICTURE X(50) VALUE                 CL**2
00244        " R E Q U E S T   C O N T R O L   R E P O R T".               CL**2
00245      03  CTLRPT-REQNO-LINE       PICTURE X(27) VALUE                 CL**2
00246        "  RUN TOTALS".                                               CL**2
00247      03  CTLRPT-REQTOT-HDG       PICTURE X(47) VALUE                 CL**2
00248        "*** R E Q U E S T   C O N T R O L   T O T A L S".            CL**2
00249      03  CTLRPT-REQCNT-LINE.                                         CL**2
00250          05  FILLER              PICTURE X(5) VALUE                  CL**2
00251        " *** ".                                                      CL**2
00252          05  CTLRPT-REQCNT       PICTURE Z9.                         CL**2
00253          05  CTLRPT-REQTYPE      PICTURE X(9) VALUE                  CL**2
00254        " $REPORT ".                                                  CL**2
00255          05  FILLER              PICTURE X(23) VALUE                 CL**2
00256            "REQUESTS WERE PROCESSED".                                CL**2
00257      03  CTLRPT-FILE-CON         PICTURE X(9) VALUE                  CL**2
00258            " $FILE   ".                                              CL**2
00259      03  CTLRPT-ENTCNT-HDG.                                          CL**2
00260          05  FILLER              PICTURE X(51) VALUE                 CL**2
00261        "***  E N T R Y  T Y P E  C O N T R O L  T O T A L S".        CL**2
00262      03  CTLRPT-ENTCNT-SHDG1.                                        CL**2
00263          05  FILLER              PICTURE X(29) VALUE SPACES.         CL**2
00264          05  FILLER              PICTURE X(35) VALUE                 CL**2
00265        "N U M B E R    O F    E N T R I E S".                        CL**2
00266      03  CTLRPT-ENTCNT-SHDG2.                                        CL**2
00267          05  FILLER              PICTURE X(6) VALUE SPACES.          CL**2
00268          05  FILLER              PICTURE X(25) VALUE                 CL**2
00269        "TYPE OF ENTRY            ".                                  CL**2
00270          05  FILLER              PICTURE X(44) VALUE                 CL**2
00271        "READ    PRINTED IN    WRITTEN ON    BYPASSED".               CL**2
00272      03  CTLRPT-ENTCNT-SHDG3.                                        CL**2
00273          05  FILLER              PICTURE X(40) VALUE SPACES.         CL**2
00274          05  FILLER              PICTURE X(38) VALUE                 CL**2
00275        "$REPORT       $FILE       (DUPLICATES)".                     CL**2
00276      03  CTLRPT-ENTCNT-LINE.                                         CL**2
00277          05  CTLRPT-ENTCNT-LEV   PICTURE X(6).                       CL**2
00278          05  CTLRPT-ENTCNT-TYPE  PICTURE X(15).                      CL**2
00279          05  FILLER              PICTURE X(8) VALUE SPACES.          CL**2
00280          05  CTLRPT-ENTCNT-READ  PICTURE ZZZZZZ9.                    CL**2
00281          05  FILLER              PICTURE X(4) VALUE SPACES.          CL**2
00282          05  CTLRPT-ENTCNT-PRT   PICTURE ZZZZZZ9.                    CL**2
00283          05  FILLER              PICTURE X(6) VALUE SPACES.          CL**2
00284          05  CTLRPT-ENTCNT-EXT   PICTURE ZZZZZZ9.                    CL**2
00285          05  FILLER              PICTURE X(6) VALUE SPACES.          CL**2
00286          05  CTLRPT-ENTCNT-BYP   PICTURE ZZZZZZ9.                    CL**2
00287      03  CTLRPT-LEVEL          PICTURE X(6) VALUE                    CL**2
00288        " **  ".                                                      CL**2
00289      03  CTLRPT-ENTCNT-MSG       PICTURE X(15) VALUE                 CL**2
00290        "REQUEST TOTALS".                                             CL**2
00291      03  CTLRPT-ENTCNT-MSG2      PICTURE X(15) VALUE                 CL**2
00292        "RUN TOTALS".                                                 CL**2
00293      03  CTLRPT-RECCNT-LINE      PICTURE X(68) VALUE                 CL**2
00294        "***  F I L E   R E C O R D   C O U N T   C O N T R O L   T   CL**2
00295 -      " O T A L S".                                                 CL**2
00296      03  CTLRPT-RECCNT-EXTLINE.                                      CL**2
00297          05  CTLRPT-RECCNT-EXTLEV  PICTURE X(7) VALUE                CL**2
00298        "  **   ".                                                    CL**2
00299          05  CTLRPT-RECCNT-EXTTOT    PICTURE ZZZZZZ9.                CL**2
00300          05  FILLER              PICTURE X(41) VALUE                 CL**2
00301            " RECORDS WERE READ FROM THE EXTRACT FILE".               CL**2
00302      03  CTLRPT-RECCNT-IDXLINE.                                      CL**2
00303          05  CTLRPT-RECCNT-IDXLEV    PICTURE X(7) VALUE              CL**2
00304        "  **   ".                                                    CL**2
00305          05  CTLRPT-RECCNT-IDXTOT    PICTURE ZZZZZZ9.                CL**2
00306          05  FILLER              PICTURE X(39) VALUE                 CL**2
00307        " RECORDS WERE WRITTEN ON THE INDEX FILE".                    CL**2
00308      03  CTLRPT-RECCNT-USELINE.                                      CL**2
00309          05  CTLRPT-RECCNT-USELEV    PICTURE X(7) VALUE              CL**2
00310        "  **   ".                                                    CL**2
00311          05  CTLRPT-RECCNT-USETOT    PICTURE ZZZZZZ9.                CL**2
00312          05  FILLER              PICTURE X(46) VALUE                 CL**2
00313        " RECORDS WERE WRITTEN ON THE USER FILE ($FILE)".             CL**2
00314      03  CTLRPT-ENDREQ-LINE.                                         CL**2
00315          05  FILLER              PICTURE X(37) VALUE                 CL**2
00316         "***** END CONTROL REPORT FOR REQUEST ".                     CL**2
00317          05  CTLRPT-ENDREQ-NO     PICTURE Z9.                        CL**2
00318          05  FILLER              PICTURE X(6) VALUE                  CL**2
00319         " *****".                                                    CL**2
00320      03  CTLRPT-ENDRUN-LINE      PICTURE X(50) VALUE                 CL**2
00321         "******* END $REPORT/FILE REQUEST PROCESSING ******".        CL**2
00322      03  CTLRPT-FINLEV-CON       PICTURE X(7) VALUE                  CL**2
00323        " ***   ".                                                    CL**2
00324  01  CTLRPT-COUNTERS.                                                CL**2
00325      03  CTLRPT-REQUEST-COUNTERS.                                    CL**2
           05  CTLRPT-REQREAD-COUNT    PICTURE S9(7)
00327                                      OCCURS 16 TIMES.                CL**2
           05  CTLRPT-REQBYP-COUNT     PICTURE S9(7)
00329                                      OCCURS 16 TIMES.                CL**2
           05  CTLRPT-REQPRT-COUNT     PICTURE S9(7)
00331                                      OCCURS 16 TIMES.                CL**2
           05  CTLRPT-REQEXT-COUNT     PICTURE S9(7)
00333                                      OCCURS 16 TIMES.                CL**2
00334          05  CTLRPT-REQINDEX-COUNT   PICTURE S9(7) .               DCRPT20
00335          05  CTLRPT-REQUSER-COUNT    PICTURE S9(7) .               DCRPT20
00336          05  CTLRPT-REQEXTRACT-COUNT PICTURE S9(7) .               DCRPT20
00337      03  CTLRPT-RUN-COUNTERS.                                        CL**2
           05  CTLRPT-RUNREAD-COUNT    PICTURE S9(7)
00339                                      OCCURS 16 TIMES.                CL**2
           05  CTLRPT-RUNBYP-COUNT     PICTURE S9(7)
00341                                      OCCURS 16 TIMES.                CL**2
           05  CTLRPT-RUNPRT-COUNT     PICTURE S9(7)
00343                                      OCCURS 16 TIMES.                CL**2
           05  CTLRPT-RUNEXT-COUNT     PICTURE S9(7)
00345                                      OCCURS 16 TIMES.                CL**2
00346          05  CTLRPT-RUNINDEX-COUNT   PICTURE S9(7) .               DCRPT20
00347          05  CTLRPT-RUNUSER-COUNT    PICTURE S9(7) .               DCRPT20
00348          05  CTLRPT-RUNEXTRAC-COUNT  PICTURE S9(7) .               DCRPT20
*CALL CURDATE 
00349                                                                    DCRPT20
00350  PROCEDURE DIVISION.                                              DCRPT200
00351 ******************************************************************DCRPT200
00352 ******************************************************************DCRPT200
00353 *                                                                 DCRPT200
00354 *    INITIALIZATION                                               DCRPT200
00355 *                                                                 DCRPT200
00356 ******************************************************************DCRPT200
00357 ******************************************************************DCRPT200
00358  0000-BEGIN.                                                      DCRPT200
00359      OPEN INPUT MAST1.                                            DCRPT200
00360      OPEN INPUT MAST3.                                            DCRPT200
00361      OPEN INPUT EXTRACT-FILE.                                     DCRPT200
00362      OPEN OUTPUT SYSPRINT.                                        DCRPT200
           MOVE "0" TO RETURN-CODE. 
*CALL ACCEPTDT
00363 ******************************************************************DCRPT200
00364 *    RETRIEVE CONTROL INFORMATION FROM MAST3 AND SAVE             DCRPT200
00365 ******************************************************************DCRPT200
00366      MOVE "1" TO CON-ENTRY-FUNCTION.                              DCRPT200
00367      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT200
00368      IF CON-RETURN-CODE EQUAL TO "9"                              DCRPT200
00369          GO TO 8030-MAST3-READ-ERROR.                                CL**2
00371      MOVE CTL-HEADER TO CTL-HEADER-SAVE.                          DCRPT200
00372 *                                                                 DCRPT200
00373 *    GET ENTITY NAME TABLE FROM MAST3                             DCRPT200
00374 *                                                                 DCRPT200
00375      MOVE "3" TO CON-ENTRY-FUNCTION.                              DCRPT200
00376      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT200
00377      IF CON-RETURN-CODE EQUAL TO "9"                              DCRPT200
00378          GO TO 8030-MAST3-READ-ERROR.                                CL**2
00379      MOVE CTL-RECORD-3 TO ENT-TABLE.                                 CL**2
           CLOSE MAST3. 
00380 *                                                                 DCRPT200
00381 *    INITIALIZE PRINT ROUTINE CONTROL TABLE                       DCRPT200
00382 *        INITIALIZE TABLE ENTRIES THAT ARE COMMON TO ALL REPORTS. DCRPT200
00383 *                                                                 DCRPT200
00384      MOVE CTL-DATE-UPD-SAVE TO DATE-LAST-REVISION.                DCRPT200
00385      MOVE CTL-REV-NUM-SAVE TO REVISION-NUMBER.                    DCRPT200
00386      MOVE CTL-LINES-SAVE TO MAX-LINES.                            DCRPT200
00387      SUBTRACT 1 FROM MAX-LINES.                                   DCRPT200
00388      MOVE CTL-LINES-SAVE TO LINE-CT.                              DCRPT200
00389      MOVE CTL-NAME-SAVE TO CON-USER.                              DCRPT200
00390      MOVE PROP-MSG-SAVE TO CON-TITLE.                             DCRPT200
00391      MOVE SPACE TO MAST1-ERR-SW.                                     CL**2
00392      MOVE CTL-EOP-MSG TO EOP-MSG.                                    CL**2
00393      MOVE CURRENT-DATE TO PRT-CURRENT-DATE.                       DCRPT200
00394      MOVE ZERO TO PAGE-NO.                                        DCRPT200
00395      MOVE ZERO TO HOF-IND.                                           CL**2
00396      MOVE 1 TO SPACE-1.                                              CL**2
00397      MOVE SPACES TO USER-TITLE.                                   DCRPT200
00398      MOVE SPACES TO STD-REPORT-REC.                               DCRPT200
00399      MOVE ZERO TO PRT-CTL.                                        DCRPT200
00400      MOVE "N" TO    8BY11-FLAG.                                   DCRPT200
      *    MOVE DATES, DC2 TITLE AND REVISION NUMBER
      * 
00401      MOVE LITERAL-1 TO PRT-DATE1-HCON.                            DCRPT200
00402      MOVE LITERAL-2 TO    PRT-DATE2-HCON.                         DCRPT200
00403      MOVE LITERAL-3 TO   PRT-PAGE-HCON.                           DCRPT200
00404      MOVE LITERAL-4 TO CON-DC.                                       CL**2
00405      MOVE LITERAL-5   TO   PRT-REV-NO-HCON.                       DCRPT200
00406                                                                    DCRPT20
00407 ******************************************************************DCRPT200
00408 ******************************************************************DCRPT200
00409 *                                                                 DCRPT200
00410 *    PROCESS USER REQUEST                                         DCRPT200
00411 *        BUILD RTBL  (REPORT REQUEST TABLE)                       DCRPT200
00412 *        PRINT REQUEST                                            DCRPT200
00413 *                                                                 DCRPT200
00414 ******************************************************************DCRPT200
00415 ******************************************************************DCRPT200
00416 *                                                                    CL**2
00417 *     INITIALIZE COUNTERS                                            CL**2
00418 *                                                                    CL**2
00419      MOVE ZEROES TO FILE-REQ-COUNT.                                  CL**2
00420      MOVE ZEROES TO REPORT-REQ-COUNT.                                CL**2
00421      MOVE ZEROES TO TOTAL-REQ-COUNT.                                 CL**2
00422      MOVE ZEROES TO RPT-LINE-CT.                                     CL**2
00423      MOVE ZEROES TO USER-COUNT.                                      CL**2
00424      PERFORM 7200-ZERO-COUNTERS THRU 7299-ZERO-COUNTERS-XIT.         CL**2
00425  0100-GET-REQ.                                                    DCRPT200
00426      READ EXTRACT-FILE                                            DCRPT200
00427          AT END GO TO 8050-NO-INPUT.                              DCRPT200
00428      MOVE ALL "Y" TO ENTTYPE-1STTIME-SWITCHES.                       CL**2
00429      MOVE "Y" TO FIRST-ENTRY-SWITCH.                                 CL**2
00430      ADD 1 TO CTLRPT-REQEXTRACT-COUNT.                               CL**2
00431  0110-NEW-REQ.                                                    DCRPT200
00432      MOVE "Y" TO REQ-1STTIME-SW.                                     CL**2
00433      MOVE EXT-HDR-REC TO RTBL-HDR-ENT.                               CL**2
00434      MOVE ALL "Y" TO ENTTYPE-1STTIME-SWITCHES.                       CL**2
00435      MOVE "Y" TO FIRST-ENTRY-SWITCH.                                 CL**2
00436      MOVE ZERO TO PAGE-NO.                                           CL**2
00437      IF RTBL-HDR-REQTYPE EQUAL "RR" OR "RS" OR "RT"                  CL**2
00438            OR "RC" OR "RH" OR "RJ"                                   CL**2
00439          ADD 1 TO REPORT-REQ-COUNT.                                  CL**2
00440      IF RTBL-HDR-REQTYPE EQUAL "RV" OR "RU" OR "RW"                  CL**2
00441          ADD 1 TO FILE-REQ-COUNT.                                    CL**2
00442 *                                                                 DCRPT200
00443 *    STORE OPTIONS                                                DCRPT200
00444 *                                                                 DCRPT200
00445      PERFORM 7500-READ-REQ THRU 7599-READ-REQ-XIT.                DCRPT200
00446      MOVE EXT-OPTIONS-REC TO RTBL-OPTIONS-ENT.                       CL**2
00447 *                                                                 DCRPT200
00448 *    STORE 10 SELECT RECORDS                                      DCRPT200
00449 *                                                                 DCRPT200
00450      MOVE 1 TO SEL-SUB.                                           DCRPT200
00451  0120-GET-SEL.                                                    DCRPT200
00452      PERFORM 7500-READ-REQ THRU 7599-READ-REQ-XIT.                DCRPT200
00453      MOVE EXT-SELECT1-REC TO RTBL-SELECTION-ENTRY (SEL-SUB).         CL**2
00454      ADD 1 TO SEL-SUB.                                            DCRPT200
00455      IF SEL-SUB LESS THAN 11                                      DCRPT200
00456          GO TO 0120-GET-SEL.                                      DCRPT200
00457 *                                                                 DCRPT200
00458 *    STORE 9 OUTPUT RECORDS                                       DCRPT200
00459 *                                                                 DCRPT200
00460      MOVE 1 TO OUT-SUB.                                           DCRPT200
00461  0140-GET-OUT.                                                    DCRPT200
00462      PERFORM 7500-READ-REQ THRU 7599-READ-REQ-XIT.                DCRPT200
00463      MOVE EXT-OUTPUT-REC TO RTBL-OUTPUT-ENTRIES (OUT-SUB).           CL**2
00464      ADD 1 TO OUT-SUB.                                            DCRPT200
00465      IF OUT-SUB LESS THAN 10                                      DCRPT200
00466          GO TO 0140-GET-OUT.                                      DCRPT200
00467 ******************************************************************DCRPT200
00468 *                                                                 DCRPT200
00469 *    PRINT USER REQUEST                                           DCRPT200
00470 *                                                                 DCRPT200
00471 ******************************************************************DCRPT200
00472  0200-PRINT-REQ.                                                  DCRPT200
00473      IF RTBL-OPT-PRTREQ EQUAL "Y"                                    CL**2
00474          GO TO 0220-HDG-OUT.                                         CL**2
00475 *                                                                    CL**2
00476 *     BYPASS PARAMETER RECORDS                                       CL**2
00477  0205-BYPASS-PARAM.                                                  CL**2
00478      PERFORM 7600-READ-DET THRU 7699-READ-DET-XIT.                   CL**2
00479      IF EXT-EOF-SW EQUAL "Y"                                         CL**2
00480          GO TO 2800-NO-REQDATA.                                      CL**2
00481      IF EXT-HDR-RECTYPE EQUAL "6"                                    CL**2
00482          GO TO 0205-BYPASS-PARAM.                                    CL**2
00483      GO TO 0500-IDENTIFY-REQ.                                        CL**2
00484 *                                                                    CL**2
00485 *     OUTPUT HEADING/INITIALIZE                                      CL**2
00486 *                                                                    CL**2
00487  0220-HDG-OUT.                                                       CL**2
00488      MOVE REQRPT-TITLE TO REPORT-TITLE-LONG.                         CL**2
00489      IF RTBL-OPT-FORMAT EQUAL TO "S"                                 CL**2
00490          MOVE "N" TO 8BY11-FLAG                                      CL**2
00491      ELSE                                                            CL**2
00492          MOVE "Y" TO 8BY11-FLAG.                                     CL**2
00493      IF RTBL-OPT-BOTMSG EQUAL TO "Y"                                 CL**2
00494          MOVE CTL-EOP-MSG-SAVE TO EOP-MSG                            CL**2
00495      ELSE                                                            CL**2
00496          MOVE SPACES TO EOP-MSG.                                     CL**2
00497      MOVE 99 TO LINE-CT.                                             CL**2
00498      MOVE 1 TO PRT-CTL.                                              CL**2
00499      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
00500      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00501 *                                                                    CL**2
00502 *     OUTPUT REQUEST ID LINES                                        CL**2
00503 *                                                                    CL**2
00504      MOVE REQRPT-STARS TO STD-REPORT-REC.                            CL**2
00505      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00506      MOVE RTBL-HDR-REQNO TO REQRPT-REQNO.                            CL**2
00507      MOVE REQRPT-REQNO-LINE TO STD-REPORT-REC.                       CL**2
00508      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00509      MOVE REQRPT-STARS TO STD-REPORT-REC.                            CL**2
00510      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00511      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00512 *                                                                    CL**2
00513 *     LIST USER PARAMETERS (TYPE 6 RECORDS IN EXTRACT FILE)          CL**2
00514 *                                                                    CL**2
00515      MOVE REQRPT-PARAM-HDG TO STD-REPORT-REC.                        CL**2
00516      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00517      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00518  0250-PRINT-PARAMS.                                                  CL**2
00519      PERFORM 7600-READ-DET THRU 7699-READ-DET-XIT.                   CL**2
00520      IF EXT-EOF-SW EQUAL TO "Y"                                      CL**2
00521          GO TO 0300-PRINT-OPTIONS.                                   CL**2
00522      IF EXT-HDR-RECTYPE NOT EQUAL TO "6"                             CL**2
00523          GO TO 0300-PRINT-OPTIONS.                                   CL**2
00524      MOVE EXT-PARAM-STATEMENT TO REQRPT-USER-STMT.                   CL**2
00525      MOVE REQRPT-USERSTMT-LINE TO STD-REPORT-REC.                    CL**2
00526      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00527      GO TO 0250-PRINT-PARAMS.                                        CL**2
00528 *                                                                    CL**2
00529 *     PRINT STATUS OF $REPORT/FILE OPTIONS                           CL**2
00530 *                                                                    CL**2
00531  0300-PRINT-OPTIONS.                                                 CL**2
00532      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00533      MOVE REQRPT-OPTIONS-HDG TO STD-REPORT-REC.                      CL**2
00534      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00535      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00536 *                                                                    CL**2
00537 *     PRINT $FILE OPTIONS                                            CL**2
00538 *                                                                    CL**2
00539      IF RTBL-HDR-REQTYPE EQUAL TO "RR" OR "RS" OR "RT"               CL**2
00540          GO TO 0310-REPORT-OPTIONS.                                  CL**2
00541      MOVE REPORT-CON TO REQRPT-OPTION-KW.                            CL**2
00542      IF RTBL-OPT-REPORT EQUAL TO "Y"                                 CL**2
00543          MOVE YES-CON TO REQRPT-OPTION-VAL                           CL**2
00544      ELSE                                                            CL**2
00545          MOVE NO-CON TO REQRPT-OPTION-VAL.                           CL**2
00546      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00547      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00548      IF RTBL-OPT-REPORT EQUAL TO "Y"                                 CL**2
00549          GO TO 0310-REPORT-OPTIONS.                                  CL**2
00550      IF RTBL-HDR-REQTYPE EQUAL TO "RU"                               CL**2
00551          GO TO 0350-PRINT-SELSTATUS.                                 CL**2
00552      GO TO 0330-STOPENT.                                             CL**2
00553 *                                                                    CL**2
00554 *     PRINT $REPORT OPTIONS                                          CL**2
00555 *                                                                    CL**2
00556  0310-REPORT-OPTIONS.                                                CL**2
00557      MOVE SEQ-CON TO REQRPT-OPTION-KW.                               CL**2
00558      IF RTBL-OPT-SEQ EQUAL TO "1"                                    CL**2
00559          MOVE TYPE-CON TO REQRPT-OPTION-VAL                          CL**2
00560          GO TO 0315-PRT-SEQ.                                         CL**2
00561      IF RTBL-OPT-SEQ EQUAL TO "2"                                    CL**2
00562          MOVE REVERSE-CON TO REQRPT-OPTION-VAL                       CL**2
00563          GO TO 0315-PRT-SEQ.                                         CL**2
00564      IF RTBL-OPT-SEQ EQUAL TO "3"                                    CL**2
00565          MOVE NAME-CON TO REQRPT-OPTION-VAL                          CL**2
00566      ELSE                                                            CL**2
00567          MOVE RET-CON TO REQRPT-OPTION-VAL.                          CL**2
00568  0315-PRT-SEQ.                                                       CL**2
00569      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00570      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00571 *                                                                    CL**2
00572 *     INDEX                                                          CL**2
00573 *                                                                    CL**2
00574      IF RTBL-OPT-REQTYPE EQUAL "RJ" OR "RC" OR "RH"                  CL**2
00575          GO TO 0316-FORMAT.                                          CL**2
00576      MOVE INDEX-CON TO REQRPT-OPTION-KW.                             CL**2
00577      IF RTBL-OPT-INDEX EQUAL TO "Y"                                  CL**2
00578          MOVE YES-CON TO REQRPT-OPTION-VAL                           CL**2
00579      ELSE                                                            CL**2
00580          MOVE NO-CON TO REQRPT-OPTION-VAL.                           CL**2
00581      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00582      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00583 *                                                                    CL**2
00584 *     NEWPAGE                                                        CL**2
00585 *                                                                    CL**2
00586      MOVE NEWPAGE-CON TO REQRPT-OPTION-KW.                           CL**2
00587      IF RTBL-OPT-NEWPAGE EQUAL TO "Y"                                CL**2
00588          MOVE YES-CON TO REQRPT-OPTION-VAL                           CL**2
00589      ELSE                                                            CL**2
00590          MOVE NO-CON TO REQRPT-OPTION-VAL.                           CL**2
00591      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00592      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00593 *                                                                    CL**2
00594 *     FORMAT OPTION                                                  CL**2
00595 *                                                                    CL**2
00596  0316-FORMAT.                                                        CL**2
00597      MOVE FORMAT-CON TO REQRPT-OPTION-KW.                            CL**2
00598      IF RTBL-OPT-FORMAT EQUAL TO "S"                                 CL**2
00599          MOVE STD-CON TO REQRPT-OPTION-VAL                           CL**2
00600      ELSE                                                            CL**2
00601          MOVE DOC-CON TO REQRPT-OPTION-VAL.                          CL**2
00602      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00603      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00604 *                                                                    CL**2
00605 *     PRINT REQUEST OPTION                                           CL**2
00606 *                                                                    CL**2
00607      MOVE SHOWREQ-CON TO REQRPT-OPTION-KW.                           CL**2
00608      IF RTBL-OPT-PRTREQ EQUAL TO "Y"                                 CL**2
00609          MOVE YES-CON TO REQRPT-OPTION-VAL                           CL**2
00610      ELSE                                                            CL**2
00611      MOVE NO-CON TO REQRPT-OPTION-VAL.                               CL**2
00612      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00613      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00614 *                                                                    CL**2
00615 *     BOTTOM PAGE MESSAGE OPTION                                     CL**2
00616 *                                                                    CL**2
00617      MOVE MESSAGE-CON TO REQRPT-OPTION-KW.                           CL**2
00618      IF RTBL-OPT-BOTMSG EQUAL TO "Y"                                 CL**2
00619          MOVE YES-CON TO REQRPT-OPTION-VAL                           CL**2
00620      ELSE                                                            CL**2
00621          MOVE NO-CON TO REQRPT-OPTION-VAL.                           CL**2
00622      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00623      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00624      IF RTBL-HDR-REQTYPE NOT EQUAL "RJ"                              CL**2
00625         GO TO 0320-NEXT-OPTION.                                      CL**2
00626 *                                                                    CL**2
00627 *    DIRECT OPTION                                                   CL**2
00628 *                                                                    CL**2
00629      MOVE DIRECT-CON TO REQRPT-OPTION-KW.                            CL**2
00630      IF RTBL-OPT-INDIRECT EQUAL "Y"                                  CL**2
00631      MOVE YES-CON TO REQRPT-OPTION-VAL                               CL**2
00632      ELSE                                                            CL**2
00633          MOVE NO-CON TO REQRPT-OPTION-VAL.                           CL**2
00634      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00635      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00636  0320-NEXT-OPTION.                                                   CL**2
00637      IF RTBL-HDR-REQTYPE NOT EQUAL "RC"                              CL**2
00638         GO TO 0325-CONTINUE.                                         CL**2
00639 *                                                                    CL**2
00640 *    BREAK CHARACTER OPTION                                          CL**2
00641 *                                                                    CL**2
00642      MOVE BRECHR-CON TO REQRPT-OPTION-KW.                            CL**2
00643      IF RTBL-OPT-BRECHR EQUAL TO SPACES                              CL**2
00644          MOVE DASH-CON TO REQRPT-OPTION-VAL                          CL**2
00645      ELSE                                                            CL**2
00646          MOVE RTBL-OPT-BRECHR TO REQRPT-OPTION-VAL.                  CL**2
00647      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00648      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00649 *                                                                    CL**2
00650 *    DESCRIPTION OPTION                                              CL**2
00651 *                                                                    CL**2
00652      MOVE DESC-CON TO REQRPT-OPTION-KW.                              CL**2
00653      IF RTBL-OPT-DESC EQUAL "Y"                                      CL**2
00654          MOVE RTBL-OPT-DESC TO LINE-OPTION-VAL                       CL**2
00655          MOVE LINE-OPTION-VAL TO REQRPT-OPTION-VAL                   CL**2
00656          GO TO 0323-MOVE-IT.                                         CL**2
00657      IF RTBL-OPT-DESC EQUAL "A"                                      CL**2
00658          MOVE "ALL" TO REQRPT-OPTION-VAL                             CL**2
00659          GO TO 0323-MOVE-IT.                                         CL**2
00660      MOVE NOSPEC-CON TO REQRPT-OPTION-VAL.                           CL**2
00661  0323-MOVE-IT.                                                       CL**2
00662      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00663      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00664  0325-CONTINUE.                                                      CL**2
00665 *                                                                    CL**2
00666 *     IF USAGE OR HIERARCHY REPORTS PRINT STOPENT-INDENTED INDEX     CL**2
00667 *                                                                    CL**2
00668      IF RTBL-HDR-REQTYPE EQUAL TO "RU" OR "RR"                       CL**2
00669            OR "RJ" OR "RH" OR "RC"                                   CL**2
00670          GO TO 0350-PRINT-SELSTATUS.                                 CL**2
00671 *                                                                    CL**2
00672 *     INDENTED INDEX                                                 CL**2
00673 *                                                                    CL**2
00674      MOVE INDENT-CON TO REQRPT-OPTION-KW.                            CL**2
00675      IF RTBL-OPT-INDENT EQUAL TO "Y"                                 CL**2
00676          MOVE YES-CON TO REQRPT-OPTION-VAL                           CL**2
00677      ELSE                                                            CL**2
00678          MOVE NO-CON TO REQRPT-OPTION-VAL.                           CL**2
00679      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00680      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00681  0330-STOPENT.                                                       CL**2
00682      MOVE STOPENT-CON TO REQRPT-OPTION-KW.                           CL**2
00683      IF RTBL-OPT-STOPNAME EQUAL TO SPACES                            CL**2
00684          MOVE NOSPEC-CON TO REQRPT-OPTION-VAL                        CL**2
00685      ELSE                                                            CL**2
00686          MOVE RTBL-OPT-STOPNAME TO REQRPT-OPTION-VAL.                CL**2
00687      MOVE REQRPT-OPTION-LINE TO STD-REPORT-REC.                      CL**2
00688      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00689 *                                                                    CL**2
00690 *     PRINT SELECTION (EXTRACT) ENTRY COUNTS (TOTALS BY              CL**2
00691 *                   TYPE OF ENTRY)                                   CL**2
00692 *                                                                    CL**2
00693  0350-PRINT-SELSTATUS.                                               CL**2
00694      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00695      MOVE REQRPT-SEL-HDG TO STD-REPORT-REC.                          CL**2
00696      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00697      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00698 *                                                                    CL**2
00699 *     PRINT TOTAL SELECTED BY SELECTION STATEMENTS                   CL**2
00700 *                                                                    CL**2
00701      MOVE 1 TO SEL-SUB.                                              CL**2
00702  0370-NEXT-SEL.                                                      CL**2
00703      IF RTBL-QRYTYPE-23 (SEL-SUB) EQUAL SPACES                       CL**2
00704          GO TO 0380-TOTAL-SEL.                                       CL**2
00705      MOVE RTBL-SELECT-COUNT (SEL-SUB) TO REQRPT-SELTOT.              CL**2
00706      MOVE SEL-SUB TO REQRPT-SELNO.                                   CL**2
00707      MOVE REQRPT-SELTOT-LINE TO STD-REPORT-REC.                      CL**2
00708      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00709      ADD 1 TO SEL-SUB.                                               CL**2
00710      IF SEL-SUB LESS THAN 10                                         CL**2
00711          GO TO 0370-NEXT-SEL.                                        CL**2
00712 *                                                                    CL**2
00713 *     PRINT GRAND TOTAL OF SELECTED RECORDS                          CL**2
00714 *                                                                    CL**2
00715  0380-TOTAL-SEL.                                                     CL**2
00716      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00717      MOVE RTBL-REQUEST-COUNT TO REQRPT-REQTOT.                       CL**2
00718      MOVE REQRPT-REQTOT-LINE TO STD-REPORT-REC.                      CL**2
00719      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00720      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
00721 ******************************************************************DCRPT200
00722 *                                                                 DCRPT200
00723 *    IDENTIFY TYPE OF REQUEST                                     DCRPT200
00724 *                                                                 DCRPT200
00725 ******************************************************************DCRPT200
00726  0500-IDENTIFY-REQ.                                               DCRPT200
00727      IF RTBL-HDR-REQTYPE EQUAL TO "RR" OR "RS" OR "RT"            DCRPT200
00728                       OR "RU" OR "RV" OR "RW"                     DCRPT200
00729          GO TO 1000-CATALOGUE-REQ.                                DCRPT200
00730      IF RTBL-HDR-REQTYPE EQUAL "RC"                                  CL**2
00731          GO TO 3000-NAME-REPORT.                                     CL**2
00732      IF RTBL-HDR-REQTYPE EQUAL "RJ"                                  CL**2
00733          GO TO 4000-RELATIONAL-REPORT.                               CL**2
00734      IF RTBL-HDR-REQTYPE EQUAL "RH"                                  CL**2
00735          GO TO 5000-INDEX-REPORT.                                    CL**2
00736      GO TO 8050-NO-INPUT.                                            CL**2
00737                                                                    DCRPT20
00738 ******************************************************************DCRPT200
00739 ******************************************************************DCRPT200
00740 *                                                                 DCRPT200
00741 *    CATALOGUE/USAGE/HIERARCHY  $REPORT-FILE  PROCESSING          DCRPT200
00742 *        THESE ROUTINES CONTROL THE PRODUCTION OF ABOVE           DCRPT200
00743 *        REPORTS AND/OR FILES AND ASSOCIATED INDEX FILE           DCRPT200
00744 *        RECORDS.  REPORT FORMATTING IS PERFORMED BY              DCRPT200
00745 *        DEPENDANT MODULES-ONE FOR EACH TYPE OF ENTRY             DCRPT200
00746 *        THESE MODULES ALSO FORMAT DETAIL RECORDS                 DCRPT200
00747 *        FOR BOTH THE USER FILE AND THE INDEX FILE                DCRPT200
00748 *        WHEN NEEDED.                                             DCRPT200
00749 *                                                                 DCRPT200
00750 ******************************************************************DCRPT200
00751 ******************************************************************DCRPT200
00752  1000-CATALOGUE-REQ.                                              DCRPT200
00753      MOVE SPACES TO OLD-CATNAME.                                     CL**2
00754      IF RTBL-HDR-REQTYPE EQUAL TO "RR" OR "RS" OR "RT"               CL**2
00755          GO TO 1200-CAT-REPORT.                                   DCRPT200
00756 ******************************************************************DCRPT200
00757 *                                                                 DCRPT200
00758 *    $FILE REQUEST INITIALIZATION                                 DCRPT200
00759 *        OUTPUT USER FILE ID RECORD ON 1ST $FILE REQUEST          DCRPT200
00760 *        OUTPUT USER FILE REQUEST RECORD EVERY REQUEST            DCRPT200
00761 *                                                                 DCRPT200
00762 ******************************************************************DCRPT200
00763      IF 1ST-USER-SW EQUAL TO "N"                                  DCRPT200
00764          GO TO 1100-USERREQ-REC.                                  DCRPT200
00765 *                                                                 DCRPT200
00766 *    FORMAT USER FILE ID RECORD                                   DCRPT200
00767 *                                                                 DCRPT200
00768      MOVE "N" TO 1ST-USER-SW.                                     DCRPT200
00769      OPEN OUTPUT USER-FILE.                                          CL**2
00770      MOVE ZEROES TO USER-FILE-REQNO.                              DCRPT200
00771      MOVE LOW-VALUES TO  USER-FILE-CNAME.                         DCRPT200
00772      MOVE LOW-VALUES  TO  USER-FILE-ENTTYPE.                      DCRPT200
00773      MOVE "1" TO USER-FILE-RECTYPE.                                  CL**2
00774      MOVE CTL-NAME-SAVE  TO USER-FILE-NAME.                       DCRPT200
00775      MOVE CTL-ADDRESS-SAVE  TO USER-FILE-ADDRESS.                 DCRPT200
00776      MOVE CTL-REV-NUM-SAVE  TO USER-FILE-REV-NUM.                 DCRPT200
00777      MOVE CTL-DATE-UPD-SAVE  TO USER-FILE-DATE-UPD.               DCRPT200
00778      MOVE CTL-DATE-RES-SAVE TO USER-FILE-DATE-RES.                   CL**2
00779      MOVE CTL-NUM-RES-SAVE  TO USER-FILE-NUM-RES.                 DCRPT200
00780      MOVE CURRENT-DATE TO USER-FILE-CURR-DATE.                       CL**2
00781      WRITE USER-FILE-REC.                                         DCRPT200
00782      ADD 1 TO CTLRPT-REQUSER-COUNT.                                  CL**2
00783 *                                                                 DCRPT200
00784 *    FORMAT USER FILE REQUEST RECORD TYPE 3                       DCRPT200
00785 *                                                                 DCRPT200
00786  1100-USERREQ-REC.                                                DCRPT200
00787      MOVE RTBL-HDR-REQNO TO USER-REQ-REQNO.                       DCRPT200
00788      MOVE LOW-VALUES     TO  USER-REQ-CNAME.                      DCRPT200
00789      MOVE LOW-VALUES     TO USER-REQ-ENTTYPEK.                       CL**2
00790      MOVE "2" TO USER-REQ-RECTYPE.                                   CL**2
00791      MOVE RTBL-HDR-RPTNAME  TO USER-REQ-RPTNAME.                  DCRPT200
00792      MOVE RTBL-HDR-STARTCNAME TO USER-REQ-STARTCNAME.             DCRPT200
00793      IF RTBL-HDR-REQTYPE EQUAL "RU"                                  CL**2
00794          MOVE SPACES TO USER-REQ-ENTTYPE                             CL**2
00795      ELSE                                                            CL**2
00796          MOVE RTBL-HDR-ENTTYPE TO SHORT-ENTTYPE                      CL**2
00797          PERFORM 7700-CVT-ENTTYPE THRU 7799-CVT-ENTTYPE-XIT          CL**2
00798          MOVE LONG-ENTTYPE TO USER-REQ-ENTTYPE.                      CL**2
00799      MOVE RTBL-HDR-ENTTYPE  TO SHORT-ENTTYPE.                     DCRPT200
00800      PERFORM 7700-CVT-ENTTYPE THRU 7799-CVT-ENTTYPE-XIT.             CL**2
00801      MOVE LONG-ENTTYPE TO USER-REQ-ENTTYPE.                          CL**2
00802      MOVE RTBL-HDR-ENTITY  TO USER-REQ-ENTITY.                    DCRPT200
00803      MOVE RTBL-OPT-TITLE  TO USER-REQ-TITLE.                      DCRPT200
00804      WRITE USER-REQ-REC.                                          DCRPT200
00805      ADD 1 TO CTLRPT-REQUSER-COUNT.                                  CL**2
00806 *                                                                 DCRPT200
00807 *    CHECK FOR REPORT ALSO OPTION                                 DCRPT200
00808 *                                                                 DCRPT200
00809      IF RTBL-OPT-REPORT EQUAL TO "N"                              DCRPT200
00810          GO TO 1400-GET-1STDET.                                      CL**2
00811 ******************************************************************DCRPT200
00812 *                                                                 DCRPT200
00813 *    $REPORT CATALOGUE USAGE AND HIERARCHY PROCESSING             DCRPT200
00814 *        THIS PROCESSING IS ALSO PERFORMED FOR $FILE REQUESTS     DCRPT200
00815 *        WITH REPORT = YES SPECIFIED                              DCRPT200
00816 *                                                                 DCRPT200
00817 ******************************************************************DCRPT200
00818  1200-CAT-REPORT.                                                 DCRPT200
00819 *                                                                 DCRPT200
00820 *    INITIALIZE REPORT FORMAT/TITLES BASED ON OPTIONS             DCRPT200
00821 *        TITLE  (HIER-USAGE-CATALOGUE)                            DCRPT200
00822 *        FORMAT  (STANDARD OR DOCUM)                              DCRPT200
00823 *        BOTTOM OF PAGE MESSAGE                                   DCRPT200
00824 *                                                                 DCRPT200
00825      IF RTBL-HDR-REQTYPE EQUAL TO "RR" OR "RU"                    DCRPT200
00826          MOVE CAT-HDG-CON TO REPORT-TITLE-LONG                    DCRPT200
00827          GO TO 1210-FORMAT-OPTION.                                DCRPT200
00828      IF RTBL-HDR-REQTYPE EQUAL TO "RS" OR "RV"                       CL**2
00829          GO TO 1205-USAGE-HDG.                                    DCRPT200
00830       IF RTBL-HDR-STARTCNAME EQUAL SPACES                         DCRPT200
00831          MOVE RTBL-HDR-ENTITY TO HIR-TITLE-NAME                   DCRPT200
00832      ELSE                                                         DCRPT200
00833          MOVE RTBL-HDR-STARTCNAME TO HIR-TITLE-NAME.              DCRPT200
00834      MOVE HIR-HDG-CON  TO  REPORT-TITLE-LONG.                     DCRPT200
00835      GO TO 1210-FORMAT-OPTION.                                    DCRPT200
00836  1205-USAGE-HDG.                                                  DCRPT200
00837      IF RTBL-HDR-STARTCNAME EQUAL TO SPACES                       DCRPT200
00838          MOVE RTBL-HDR-ENTITY TO USG-TITLE-NAME                   DCRPT200
00839      ELSE                                                         DCRPT200
00840          MOVE RTBL-HDR-STARTCNAME TO USG-TITLE-NAME.              DCRPT200
00841      MOVE USG-HDG-CON TO REPORT-TITLE-LONG.                          CL**2
00842 *                                                                 DCRPT200
00843 *    FORMAT OPTION                                                DCRPT200
00844 *                                                                 DCRPT200
00845  1210-FORMAT-OPTION.                                              DCRPT200
00846      IF RTBL-OPT-FORMAT EQUAL TO "S"                              DCRPT200
00847          MOVE "N" TO 8BY11-FLAG                                   DCRPT200
00848      ELSE                                                         DCRPT200
00849          MOVE "Y" TO 8BY11-FLAG.                                  DCRPT200
           IF RTBL-OPT-BOTMSG EQUAL TO "Y"
               MOVE CTL-EOP-MSG-SAVE TO EOP-MSG 
           ELSE 
               MOVE SPACES TO EOP-MSG.
00850 *                                                                 DCRPT200
00851 *    TITLE                                                        DCRPT200
00852 *                                                                 DCRPT200
00853      MOVE RTBL-OPT-TITLE TO USER-TITLE.                           DCRPT200
00854 *                                                                 DCRPT200
00855 *    OUTPUT INDEX RECORDS IF INDEX REQUESTED                      DCRPT200
00856 *            FILE REC 1ST TIME THRU                               DCRPT200
00857 *            REQUEST REC FOR EACH REQUEST                         DCRPT200
00858 *            OPTIONS REC FOR EZCH REQUEST                         DCRPT200
00859 *                                                                 DCRPT200
00860  1225-IDX-OPTIONS.                                                DCRPT200
00861      IF RTBL-OPT-INDEX EQUAL TO "Y"                               DCRPT200
00862          GO TO 1250-CK-INDX1ST.                                   DCRPT200
00863      IF RTBL-OPT-INDENT EQUAL TO "N"                              DCRPT200
00864          GO TO 1400-GET-1STDET.                                      CL**2
00865  1250-CK-INDX1ST.                                                 DCRPT200
00866      IF 1ST-IDX-SW EQUAL TO "N"                                   DCRPT200
00867          GO TO 1300-REQ-IDX.                                      DCRPT200
00868      MOVE "N" TO 1ST-IDX-SW.                                      DCRPT200
00869      OPEN OUTPUT INDEX-FILE.                                         CL**2
00870      MOVE LOW-VALUES       TO IDX-FILE-REQTYPE.                   DCRPT200
00871      MOVE ZEROES          TO  IDX-FILE-REQNO.                     DCRPT200
00872      MOVE "1" TO IDX-FILE-RECTYPE.                                   CL**2
00873      MOVE "001"         TO IDX-FILE-RECSEQ.                       DCRPT200
00874      MOVE CTL-REV-NUM-SAVE   TO  IDX-FILE-REV-NUM.                DCRPT200
00875      MOVE CTL-DATE-UPD-SAVE    TO  IDX-FILE-DATE-UPD.             DCRPT200
00876      MOVE CTL-DATE-RES-SAVE    TO  IDX-FILE-DATE-RES.             DCRPT200
00877      MOVE CTL-NUM-RES-SAVE    TO  IDX-FILE-NUM-RES.               DCRPT200
00878      MOVE CURRENT-DATE        TO  IDX-FILE-CURR-DATE.             DCRPT200
00879      MOVE CTL-EOP-MSG-SAVE   TO  IDX-FILE-EOP-MSG.                DCRPT200
00880      MOVE CTL-LINES-SAVE     TO  IDX-FILE-LINES.                  DCRPT200
00881      MOVE SPACES TO IDX-FILE-NAME.                                   CL**2
00882      WRITE IDX-FILE-REC.                                          DCRPT200
00883      ADD 1 TO CTLRPT-REQINDEX-COUNT.                                 CL**2
00884 *                                                                 DCRPT200
00885 *    OUTPUT INDEX REQUEST-RECORD                                  DCRPT200
00886 *                                                                 DCRPT200
00887  1300-REQ-IDX.                                                    DCRPT200
00888      MOVE RTBL-HDR-REQTYPE      TO  IDX-REQ-REQTYPE.              DCRPT200
00889      MOVE RTBL-HDR-REQNO      TO  IDX-REQ-REQNO.                  DCRPT200
00890      MOVE "2"           TO  IDX-REQ-RECTYPE.                      DCRPT200
00891      MOVE "001"         TO  IDX-REQ-RECSEQ.                       DCRPT200
00892      MOVE RTBL-HDR-RPTNAME    TO   IDX-REQ-RPTNAME.               DCRPT200
00893      MOVE RTBL-HDR-STARTCNAME    TO IDX-REQ-STARTCNAME.           DCRPT200
00894      MOVE RTBL-HDR-ENTTYPE     TO  IDX-REQ-ENTTYPE.               DCRPT200
00895      MOVE RTBL-HDR-ENTITY      TO  IDX-REQ-ENTITY.                DCRPT200
00896      MOVE RTBL-HDR-RETRIEVE    TO  IDX-REQ-RETRIEVE.              DCRPT200
00897      MOVE RTBL-HDR-IDXFNAME     TO IDX-REQ-IDXFNAME.              DCRPT200
00898      MOVE RTBL-HDR-PW      TO  IDX-REQ-PW.                        DCRPT200
00899      MOVE ZEROES TO IDX-MOD-REQ.                                     CL**2
00900      MOVE ZEROES TO IDX-REQUEST-COUNT.                               CL**2
00901      WRITE IDX-REQ-REC.                                           DCRPT200
00902      ADD 1 TO CTLRPT-REQINDEX-COUNT.                                 CL**2
00903 *                                                                 DCRPT200
00904 *    OUTPUT INDEX OPTIONS RECORD FOR THIS REQUEST                 DCRPT200
00905 *                                                                 DCRPT200
00906      MOVE RTBL-OPTIONS-ENT    TO IDX-OPT-REC.                     DCRPT200
00907      MOVE "3" TO IDX-OPT-RECTYPE.                                    CL**2
00908      WRITE IDX-OPT-REC.                                           DCRPT200
00909      ADD 1 TO CTLRPT-REQINDEX-COUNT.                                 CL**2
00910 ******************************************************************DCRPT200
00911 *                                                                 DCRPT200
00912 *    PROCESS EXTRACTED DETAIL RECORDS FOR CAT/HIER/USAGE REQ      DCRPT200
00913 *                                                                 DCRPT200
00914 ******************************************************************DCRPT200
00915  1400-GET-1STDET.                                                 DCRPT200
00916      IF EXT-EOF-SW  EQUAL TO "Y"                                  DCRPT200
00917          GO TO 2800-NO-REQDATA.                                   DCRPT200
00918      IF EXT-CAT-RECTYPE  EQUAL TO "1"                             DCRPT200
00919          GO TO 2800-NO-REQDATA.                                   DCRPT200
00920      GO TO 1700-SETUP-CALL.                                       DCRPT200
00921 *                                                                 DCRPT200
00922 *                                                                 DCRPT200
00923 *                                                                 DCRPT200
00924  1500-GET-NXTDET.                                                 DCRPT200
00925      PERFORM 7600-READ-DET THRU 7699-READ-DET-XIT.                DCRPT200
00926      IF EXT-EOF-SW EQUAL TO "Y"                                   DCRPT200
00927          GO TO 9000-END-REPORTS.                                  DCRPT200
00928      IF EXT-CAT-RECTYPE EQUAL TO "1"                              DCRPT200
00929          GO TO 2950-REQ-END.                                      DCRPT200
00930 *                                                                 DCRPT200
00931 *    FORMAT COMMON AREA IN LINKAGE FROM EXTRACT DATA              DCRPT200
00932 *                                                                 DCRPT200
00933  1700-SETUP-CALL.                                                 DCRPT200
00934       MOVE RTBL-HDR-REQTYPE TO EXT-HOLD-REQTYPE.                  DCRPT200
00935 *                                                                 DCRPT200
00936 *    INPUT BY ENTRY TYPE KEY                                      DCRPT200
00937 *                                                                 DCRPT200
00938      IF RTBL-OPT-SEQ EQUAL TO "1"                                 DCRPT200
00939          MOVE EXT-CAT1-ENTTYPE   TO  EXT-HOLD-ENTTYPE             DCRPT200
00940          MOVE EXT-CAT1-CATNAME   TO  EXT-HOLD-CATNAME             DCRPT200
00941          MOVE EXT-CAT1-RETNO     TO  EXT-HOLD-RETNO               DCRPT200
00942          MOVE EXT-CAT1-RETLEV    TO  EXT-HOLD-RETLEV              DCRPT200
00943          MOVE EXT-CAT1-SELNO     TO  EXT-HOLD-SELNO               DCRPT200
00944          GO TO 1750-LOOKUP-ENTTYPE.                               DCRPT200
00945 *                                                                 DCRPT200
00946 *    INPUT BY ENTTYPE COMPLIMENT                                  DCRPT200
00947 *                                                                 DCRPT200
00948      IF RTBL-OPT-SEQ  EQUAL TO "2"                                DCRPT200
00949          SUBTRACT EXT-CAT1-ENTTYPE FROM 99                        DCRPT200
00950          GIVING EXT-HOLD-ENTTYPE                                     CL**2
00951      MOVE EXT-CAT1-CATNAME TO EXT-HOLD-CATNAME                       CL**2
00952      MOVE EXT-CAT1-RETNO TO EXT-HOLD-RETNO                           CL**2
00953      MOVE EXT-CAT1-RETLEV TO EXT-HOLD-RETLEV                         CL**2
00954      MOVE EXT-CAT1-SELNO TO EXT-HOLD-SELNO                           CL**2
00955          GO TO 1750-LOOKUP-ENTTYPE.                               DCRPT200
00956 *                                                                 DCRPT200
00957 *    INPUT BY CATALOGUE NAME                                      DCRPT200
00958 *                                                                 DCRPT200
00959       IF RTBL-OPT-SEQ  EQUAL TO "3"                               DCRPT200
00960          MOVE EXT-CAT3-ENTTYPE   TO EXT-HOLD-ENTTYPE              DCRPT200
00961          MOVE EXT-CAT3-CATNAME    TO  EXT-HOLD-CATNAME            DCRPT200
00962          MOVE EXT-CAT3-RETNO    TO  EXT-HOLD-RETNO                DCRPT200
00963          MOVE EXT-CAT3-RETLEV   TO   EXT-HOLD-RETLEV              DCRPT200
00964          MOVE EXT-CAT3-SELNO   TO   EXT-HOLD-SELNO                DCRPT200
00965          GO TO 1750-LOOKUP-ENTTYPE.                               DCRPT200
00966 *                                                                 DCRPT200
00967 *    INPUT BY ORDER OF RETRIEVAL (SEQ 4 ASSUMED)                     CL**2
00968 *                                                                 DCRPT200
00969      MOVE EXT-CAT4-ENTTYPE TO EXT-HOLD-ENTTYPE                    DCRPT200
00970      MOVE EXT-CAT4-CATNAME TO EXT-HOLD-CATNAME                    DCRPT200
00971      MOVE EXT-CAT4-RETNO TO EXT-HOLD-RETNO                        DCRPT200
00972      MOVE EXT-CAT4-RETLEV TO EXT-HOLD-RETLEV                      DCRPT200
00973      MOVE EXT-CAT4-SELNO TO EXT-HOLD-SELNO.                       DCRPT200
00974 *                                                                 DCRPT200
00975 *     CONVERT NUMERIC ENTRY TYPE TO NAME                          DCRPT200
00976 *                                                                 DCRPT200
00977  1750-LOOKUP-ENTTYPE.                                             DCRPT200
00978      IF EXT-HOLD-SELNO EQUAL ZERO                                    CL**2
00979         GO TO 1760-LOOKUP-ENTTYPE.                                   CL**2
00980      IF EXT-HOLD-SELNO EQUAL SPACES                                  CL**2
00981          MOVE ZERO TO EXT-HOLD-SELNO                                 CL**2
00982          GO TO 1760-LOOKUP-ENTTYPE.                                  CL**2
00983      MOVE RTBL-USEOUT-NUM (EXT-HOLD-SELNO) TO OUT-NUM-TEMP.          CL**2
00984      MOVE OUT-NUM-TEMP TO EXT-HOLD-SELNO.                            CL**2
00985  1760-LOOKUP-ENTTYPE.                                                CL**2
00986      MOVE EXT-HOLD-ENTTYPE TO SHORT-ENTTYPE.                      DCRPT200
00987      PERFORM 7700-CVT-ENTTYPE THRU 7799-CVT-ENTTYPE-XIT.          DCRPT200
00988      MOVE LONG-ENTTYPE TO EXT-HOLD-TYPE.                          DCRPT200
00989      MOVE EXT-HOLD-ENTTYPE TO ENTTYPE-SUB.                        DCRPT200
00990  1175-COUNT-ENTRIES.                                                 CL**2
00991      ADD 1 TO CTLRPT-REQREAD-COUNT (CTL-SUB).                        CL**2
00992 *                                                                    CL**2
00993 *     BYPASS DUPLICATES                                              CL**2
00994 *                                                                    CL**2
00995      IF RTBL-OPT-SEQ EQUAL "4"                                       CL**2
00996          GO TO 1790-COUNT-REQTYPES.                                  CL**2
00997      IF EXT-HOLD-CATNAME NOT EQUAL TO OLD-CATNAME                    CL**2
00998          MOVE EXT-HOLD-CATNAME TO OLD-CATNAME                        CL**2
00999          GO TO 1790-COUNT-REQTYPES.                                  CL**2
01000      ADD 1 TO CTLRPT-REQBYP-COUNT (CTL-SUB).                         CL**2
01001 *                                                                    CL**2
01002 *    OUTPUT INDENTED INDEX RECS FOR DUPES                            CL**2
01003 *                                                                    CL**2
01004      IF RTBL-HDR-REQTYPE EQUAL "RR" OR "RU"                          CL**2
01005          GO TO 2900-ENTRY-END.                                       CL**2
01006      IF RTBL-OPT-INDENT EQUAL "Y"                                    CL**2
01007          MOVE SPACES TO IDX-DET-REC                                  CL**2
01008          MOVE RTBL-HDR-REQTYPE TO IDX-DET-REQTYPE                    CL**2
01009          MOVE RTBL-HDR-REQNO TO IDX-DET-REQNO                        CL**2
01010          MOVE "6" TO IDX-DET-RECTYPE                                 CL**2
01011          MOVE "001" TO IDX-DET-RECSEQ                                CL**2
01012          MOVE EXT-HOLD-RETNO TO IDX-REL-RETNO                        CL**2
01013          MOVE EXT-HOLD-CATNAME TO IDX-REL-CATNAME                    CL**2
01014          MOVE EXT-HOLD-ENTTYPE TO IDX-REL-ENTTYPE                    CL**2
01015          MOVE EXT-HOLD-RETLEV TO IDX-REL-RETLEV                      CL**2
01016          MOVE PAGE-NO TO IDX-REL-PAGENO                              CL**2
01017          WRITE IDX-DET-REC                                           CL**2
01018          ADD 1 TO CTLRPT-REQINDEX-COUNT                              CL**2
01019          GO TO 2900-ENTRY-END.                                       CL**2
01020      GO TO 2900-ENTRY-END.                                           CL**2
01021  1790-COUNT-REQTYPES.                                                CL**2
01022      IF RTBL-HDR-REQTYPE EQUAL TO "RR" OR "RS" OR "RT"               CL**2
01023          ADD 1 TO CTLRPT-REQPRT-COUNT (CTL-SUB)                      CL**2
01024          GO TO 1800-CALL-MODULE.                                     CL**2
01025      ADD 1 TO CTLRPT-REQEXT-COUNT (CTL-SUB).                         CL**2
01026      IF RTBL-OPT-REPORT EQUAL "Y"                                    CL**2
01027          ADD 1 TO CTLRPT-REQPRT-COUNT (CTL-SUB).                     CL**2
01028 *                                                                 DCRPT200
01029 *     DETERMINE WHICH MODULE TO CALL                              DCRPT200
01030 *                                                                 DCRPT200
01031  1800-CALL-MODULE.                                                DCRPT200
01032      MOVE ZERO TO RTBL-MOD-REQ.                                      CL**2
           IF EXT-HOLD-ENTTYPE EQUAL TO "03"
               GO TO 1903-CALL-203
           END-IF 
01033      IF EXT-HOLD-ENTTYPE EQUAL TO "05"                            DCRPT200
01034          GO TO 1905-CALL-205.                                     DCRPT200
01035      IF EXT-HOLD-ENTTYPE EQUAL TO "10"                            DCRPT200
01036          GO TO 1910-CALL-210.                                     DCRPT200
01039      IF EXT-HOLD-ENTTYPE EQUAL TO "20"                            DCRPT200
01040          GO TO 1920-CALL-220.                                     DCRPT200
           IF EXT-HOLD-ENTTYPE EQUAL TO "22"
               GO TO 1922-CALL-222
           END-IF 
           IF EXT-HOLD-ENTTYPE EQUAL TO "24"
               GO TO 1924-CALL-224
           END-IF 
           IF EXT-HOLD-ENTTYPE EQUAL TO "26"
               GO TO 1926-CALL-226
           END-IF 
01041      IF EXT-HOLD-ENTTYPE EQUAL TO "35"                            DCRPT200
01042          GO TO 1935-CALL-235.                                     DCRPT200
01043      IF EXT-HOLD-ENTTYPE EQUAL TO "40"                            DCRPT200
01044          GO TO 1940-CALL-240.                                     DCRPT200
01045      IF EXT-HOLD-ENTTYPE EQUAL TO "45"                            DCRPT200
01046          GO TO 1945-CALL-245.                                     DCRPT200
01047      IF EXT-HOLD-ENTTYPE EQUAL TO "50"                            DCRPT200
01048          GO TO 1950-CALL-250.                                     DCRPT200
01049      IF EXT-HOLD-ENTTYPE EQUAL TO "55"                            DCRPT200
01050          GO TO 1955-CALL-255.                                     DCRPT200
01051      IF EXT-HOLD-ENTTYPE EQUAL TO "60"                            DCRPT200
01052          GO TO 1960-CALL-260.                                     DCRPT200
01053      IF EXT-HOLD-ENTTYPE EQUAL TO "65"                            DCRPT200
01054          GO TO 1965-CALL-265.                                     DCRPT200
01066 *                                                                 DCRPT200
01067 *     CALL TOTAL MODULES                                          DCRPT200
01068 *                                                                 DCRPT200
01069      IF EXT-HOLD-ENTTYPE EQUAL TO "13"                            DCRPT200
01070          GO TO 2113-CALL-213.                                     DCRPT200
01071      IF EXT-HOLD-ENTTYPE EQUAL TO "19"                            DCRPT200
01072          GO TO 2119-CALL-219.                                     DCRPT200
01073      IF EXT-HOLD-ENTTYPE EQUAL TO "32"                               CL**2
01074          GO TO 2132-CALL-232.                                        CL**2
01084                                                                    DCRPT20
01085 ******************************************************************DCRPT200
01086 *     CALL STANDARD PRINT MODS - RESPOND TO I/O REQUESTS          DCRPT200
01087 ******************************************************************DCRPT200
      * 
      *    DBPROC ENTRY 
      * 
       1903-CALL-203. 
           CALL "RPT203". 
           IF RTBL-MOD-REQ EQUAL TO "9" 
               GO TO 2900-ENTRY-END.
           IF RTBL-MOD-REQ EQUAL TO "8" 
               GO TO 8010-BAD-ENTRY.
           PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.
           GO TO 1903-CALL-203. 
      * 
      *    ELEMENT ENTRY
      * 
01088  1905-CALL-205.                                                   DCRPT200
           CALL "RPT205". 
01095      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01096          GO TO 2900-ENTRY-END.                                    DCRPT200
01097      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01098          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01099      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01100      GO TO 1905-CALL-205.                                         DCRPT200
01101 *                                                                 DCRPT200
01102 *     GROUP ENTRY                                                 DCRPT200
01103 *                                                                 DCRPT200
01104  1910-CALL-210.                                                   DCRPT200
           CALL "RPT210". 
01111      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01112          GO TO 2900-ENTRY-END.                                    DCRPT200
01113      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01114          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01115      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01116      GO TO 1910-CALL-210.                                            CL**2
01133 *                                                                 DCRPT200
01134 *     FILE ENTRY                                                  DCRPT200
01135 *                                                                 DCRPT200
01136  1920-CALL-220.                                                   DCRPT200
           CALL "RPT220". 
01143      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01144          GO TO 2900-ENTRY-END.                                    DCRPT200
01145      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01146          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01147      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01148      GO TO 1920-CALL-220.                                         DCRPT200
      * 
      *    AREA ENTRY 
      * 
       1922-CALL-222. 
           CALL "RPT222". 
           IF RTBL-MOD-REQ EQUAL TO "9" 
               GO TO 2900-ENTRY-END.
           IF RTBL-MOD-REQ EQUAL TO "8" 
               GO TO 8010-BAD-ENTRY.
           PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.
           GO TO 1922-CALL-222. 
      * 
      *    SUBSCHEMA ENTRY
      * 
       1924-CALL-224. 
           CALL "RPT224". 
           IF RTBL-MOD-REQ EQUAL TO "9" 
               GO TO 2900-ENTRY-END.
           IF RTBL-MOD-REQ EQUAL TO "8" 
               GO TO 8010-BAD-ENTRY.
           PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.
           GO TO 1924-CALL-224. 
      * 
      *    SCHEMA ENTRY 
      * 
       1926-CALL-226. 
           CALL "RPT226". 
           IF RTBL-MOD-REQ EQUAL TO "9" 
               GO TO 2900-ENTRY-END.
           IF RTBL-MOD-REQ EQUAL TO "8" 
               GO TO 8010-BAD-ENTRY.
           PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.
           GO TO 1926-CALL-226. 
01149 *                                                                 DCRPT200
01150 *     FORM ENTRY                                                  DCRPT200
01151 *                                                                 DCRPT200
01152  1935-CALL-235.                                                   DCRPT200
           CALL "RPT235". 
01159      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01160          GO TO 2900-ENTRY-END.                                    DCRPT200
01161      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01162          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01163      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01164      GO TO 1935-CALL-235.                                         DCRPT200
01165 *                                                                 DCRPT200
01166 *     REPORT ENTRY                                                DCRPT200
01167 *                                                                 DCRPT200
01168  1940-CALL-240.                                                   DCRPT200
           CALL "RPT240". 
01175      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01176          GO TO 2900-ENTRY-END.                                    DCRPT200
01177      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01178          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01179      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01180      GO TO 1940-CALL-240.                                         DCRPT200
01181 *                                                                 DCRPT200
01182 *     EXTERNAL ENTRY                                              DCRPT200
01183 *                                                                 DCRPT200
01184  1945-CALL-245.                                                   DCRPT200
           CALL "RPT245". 
01191      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01192          GO TO 2900-ENTRY-END.                                    DCRPT200
01193      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01194          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01195      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01196      GO TO 1945-CALL-245.                                         DCRPT200
01197 *                                                                 DCRPT200
01198 *     MODULE                                                      DCRPT200
01199 *                                                                 DCRPT200
01200  1950-CALL-250.                                                   DCRPT200
           CALL "RPT250". 
01207      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01208          GO TO 2900-ENTRY-END.                                    DCRPT200
01209      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01210          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01211      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01212      GO TO 1950-CALL-250.                                         DCRPT200
01213 *                                                                 DCRPT200
01214 *     TASK                                                        DCRPT200
01215 *                                                                 DCRPT200
01216  1955-CALL-255.                                                   DCRPT200
           CALL "RPT255". 
01223      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01224          GO TO 2900-ENTRY-END.                                    DCRPT200
01225      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01226          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01227      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01228      GO TO 1955-CALL-255.                                         DCRPT200
01229 *                                                                 DCRPT200
01230 *     SYSTEM                                                      DCRPT200
01231 *                                                                 DCRPT200
01232  1960-CALL-260.                                                   DCRPT200
           CALL "RPT260". 
01239      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01240          GO TO 2900-ENTRY-END.                                    DCRPT200
01241      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01242          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01243      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01244      GO TO 1960-CALL-260.                                         DCRPT200
01245 *                                                                 DCRPT200
01246 *     USER                                                        DCRPT200
01247 *                                                                 DCRPT200
01248  1965-CALL-265.                                                   DCRPT200
           CALL "RPT265". 
01255      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01256          GO TO 2900-ENTRY-END.                                    DCRPT200
01257      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01258          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01259      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01260      GO TO 1965-CALL-265.                                         DCRPT200
01261                                                                    DCRPT20
01329 ******************************************************************DCRPT200
01330 *                                                                 DCRPT200
01331 *     CALL TOTAL PRINT MODS - RESPOND TO I/O REQUESTS             DCRPT200
01332 *                                                                 DCRPT200
01333 ******************************************************************DCRPT200
01334  2113-CALL-213.                                                   DCRPT200
           CALL "RPT213". 
01341      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01342          GO TO 2900-ENTRY-END.                                    DCRPT200
01343      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01344          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01345      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01346      GO TO 2113-CALL-213.                                         DCRPT200
01347 *                                                                 DCRPT200
01348 *    DATASET                                                      DCRPT200
01349 *                                                                 DCRPT200
01350  2119-CALL-219.                                                   DCRPT200
           CALL "RPT219". 
01357      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01358          GO TO 2900-ENTRY-END.                                    DCRPT200
01359      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01360          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01361      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01362      GO TO 2119-CALL-219.                                         DCRPT200
01363 *                                                                 DCRPT200
01364 *     DATA BASE                                                   DCRPT200
01365 *                                                                 DCRPT200
01366  2132-CALL-232.                                                   DCRPT200
           CALL "RPT232". 
01373      IF RTBL-MOD-REQ EQUAL TO "9"                                 DCRPT200
01374          GO TO 2900-ENTRY-END.                                    DCRPT200
01375      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT200
01376          GO TO 8010-BAD-ENTRY.                                    DCRPT200
01377      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                    DCRPT200
01378      GO TO 2132-CALL-232.                                         DCRPT200
01430 ******************************************************************   CL**2
01431 ******************************************************************   CL**2
01432 *                                                                    CL**2
01433 *    END OF ENTRY/REQUEST PROCESSING                                 CL**2
01434 *                                                                    CL**2
01435 ******************************************************************   CL**2
01436 ******************************************************************   CL**2
01437  2800-NO-REQDATA.                                                    CL**2
01438      MOVE 99 TO LINE-CT.                                             CL**2
01439      MOVE 1 TO PRT-CTL.                                              CL**2
01440      MOVE NO-DATA-MSG TO STD-REPORT-REC.                             CL**2
01441      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01442      GO TO 2950-REQ-END.                                             CL**2
01443 *                                                                 DCRPT200
01444 *     EXTRACT ENTRY PROCESSED                                     DCRPT200
01445 *                                                                 DCRPT200
01446  2900-ENTRY-END.                                                  DCRPT200
01447      GO TO 1500-GET-NXTDET.                                       DCRPT200
01448 *                                                                 DCRPT200
01449 *     CATALOGUE/USAGE/HIER REQUEST PROCESSED                      DCRPT200
01450 *                                                                 DCRPT200
01451  2950-REQ-END.                                                    DCRPT200
01452      MOVE "4" TO RTBL-MOD-REQ.                                       CL**2
01453      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                       CL**2
01454      MOVE "5" TO RTBL-MOD-REQ.                                       CL**2
01455      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                       CL**2
01456      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
01457 *                                                                    CL**2
01458 *    PRINT CONTROL REPORT FOR REQUEST                                CL**2
01459 *                                                                    CL**2
01460      MOVE CTLRPT-TITLE TO REPORT-TITLE-LONG.                         CL**2
01461      MOVE 99 TO LINE-CT.                                             CL**2
01462      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
01463      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01464 *                                                                    CL**2
01465 *    OUTPUT REQUEST ID LINES                                         CL**2
01466 *                                                                    CL**2
01467      MOVE REQRPT-STARS TO STD-REPORT-REC.                            CL**2
01468      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01469      MOVE RTBL-HDR-REQNO TO REQRPT-REQNO.                            CL**2
01470      MOVE REQRPT-REQNO-LINE TO STD-REPORT-REC.                       CL**2
01471      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01472      MOVE REQRPT-STARS TO STD-REPORT-REC.                            CL**2
01473      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01474 *                                                                    CL**2
01475 *    OUTPUT ENTRY TYPE CONTROL TOTS AND RECORD COUNTS                CL**2
01476 *                                                                    CL**2
01477      PERFORM 7800-PRT-CTL THRU 7899-PRT-CTL-XIT.                     CL**2
01478      MOVE RTBL-HDR-REQNO TO CTLRPT-ENDREQ-NO.                        CL**2
01479      MOVE CTLRPT-ENDREQ-LINE TO STD-REPORT-REC.                      CL**2
01480      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01481      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
01482      MOVE SPACE TO USER-TITLE.                                       CL**2
01483      IF EXT-EOF-SW NOT EQUAL TO "Y"                                  CL**2
01484          GO TO 0110-NEW-REQ.                                         CL**2
01485      GO TO 9010-PRT-RUNTOTS.                                         CL**2
01486                                                                    DCRPT20
01487 ******************************************************************   CL**2
01488 ******************************************************************   CL**2
01489 *                                                                    CL**2
01490 *    NAME ANALYSIS REPORT PROCESSING                                 CL**2
01491 *        ALL REPORT FORMATTING (INCLUDING HEADINGS) IS DONE BY       CL**2
01492 *        DCRPT400.  THIS MODULE CALLS - RESPONDS TO INPUT REQUESTS   CL**2
01493 *        FOR EXTRACT RECORDS AND MAST1 DATA, AND DOES PHYSICAL I/O   CL**2
01494 *        FOR PRINTER FROM TABLE IN LINKAGE.                          CL**2
01495 ******************************************************************   CL**2
01496 ******************************************************************   CL**2
01497  3000-NAME-REPORT.                                                   CL**2
01498      MOVE ZERO TO RTBL-MOD-REQ.                                      CL**2
01499      PERFORM 7400-TBL-EXTINPUT THRU 7499-TBL-EXTINPUT-XIT.           CL**2
01500  3100-CALL-400.                                                      CL**2
           CALL "RPT400". 
01507 *                                                                    CL**2
01508 *    RESPOND TO REQUESTS FROM RPT400                                 CL**2
01509 *                                                                    CL**2
01510      IF RTBL-MOD-REQ EQUAL "9"                                       CL**2
01511          MOVE "4" TO RTBL-MOD-REQ                                    CL**2
01512          PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT                    CL**2
01513          GO TO 3900-END-NAME.                                        CL**2
01514      IF RTBL-MOD-REQ EQUAL "8"                                       CL**2
01515          MOVE "4" TO RTBL-MOD-REQ                                    CL**2
01516          PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT                    CL**2
01517          GO TO 3800-NAME-ERROR.                                      CL**2
01518      IF RTBL-MOD-REQ EQUAL "3"                                       CL**2
01519          PERFORM 7400-TBL-EXTINPUT THRU 7499-TBL-EXTINPUT-XIT        CL**2
01520          GO TO 3100-CALL-400.                                        CL**2
01521      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                       CL**2
01522      GO TO 3100-CALL-400.                                            CL**2
01523  3800-NAME-ERROR.                                                    CL**2
01524  3900-END-NAME.                                                      CL**2
01525      IF EXT-EOF-SW EQUAL "Y"                                         CL**2
01526          GO TO 9010-PRT-RUNTOTS.                                     CL**2
01527      GO TO 0110-NEW-REQ.                                             CL**2
01528                                                                    DCRPT20
01529 ******************************************************************   CL**2
01530 ******************************************************************   CL**2
01531 *                                                                    CL**2
01532 *    RELATIONAL  REPORT PROCESSING                                   CL**2
01533 *        ALL REPORT FORMATTING (INCLUDING HEADINGS) IS DONE BY       CL**2
01534 *        DCRPT400.  THIS MODULE CALLS - RESPONDS TO INPUT REQUESTS   CL**2
01535 *        FOR EXTRACT RECORDS AND MAST1 DATA, AND DOES PHYSICAL I/O   CL**2
01536 *        FOR PRINTER FROM TABLE IN LINKAGE.                          CL**2
01537 ******************************************************************   CL**2
01538 ******************************************************************   CL**2
01539  4000-RELATIONAL-REPORT.                                             CL**2
01540      MOVE ZERO TO RTBL-MOD-REQ.                                      CL**2
01541      PERFORM 7400-TBL-EXTINPUT THRU 7499-TBL-EXTINPUT-XIT.           CL**2
01542  4100-CALL-400.                                                      CL**2
           CALL "RPT400". 
01549 *                                                                    CL**2
01550 *    RESPOND TO REQUESTS FROM RPT400                                 CL**2
01551 *                                                                    CL**2
01552      IF RTBL-MOD-REQ EQUAL "9"                                       CL**2
01553          MOVE "4" TO RTBL-MOD-REQ                                    CL**2
01554          PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT                    CL**2
01555          GO TO 4900-END-RELATIONAL.                                  CL**2
01556      IF RTBL-MOD-REQ EQUAL "8"                                       CL**2
01557          MOVE "4" TO RTBL-MOD-REQ                                    CL**2
01558          PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT                    CL**2
01559          GO TO 4800-RELATIONAL-ERROR.                                CL**2
01560      IF RTBL-MOD-REQ EQUAL "3"                                       CL**2
01561          PERFORM 7400-TBL-EXTINPUT THRU 7499-TBL-EXTINPUT-XIT        CL**2
01562          GO TO 4100-CALL-400.                                        CL**2
01563      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                       CL**2
01564      GO TO 4100-CALL-400.                                            CL**2
01565  4800-RELATIONAL-ERROR.                                              CL**2
01566  4900-END-RELATIONAL.                                                CL**2
01567      IF EXT-EOF-SW EQUAL "Y"                                         CL**2
01568          GO TO 9010-PRT-RUNTOTS.                                     CL**2
01569      GO TO 0110-NEW-REQ.                                             CL**2
01570                                                                    DCRPT20
01571 ******************************************************************   CL**2
01572 ******************************************************************   CL**2
01573 *                                                                    CL**2
01574 *    INDEX  REPORT PROCESSING                                        CL**2
01575 *        ALL REPORT FORMATTING (INCLUDING HEADINGS) IS DONE BY       CL**2
01576 *        DCRPT400.  THIS MODULE CALLS - RESPONDS TO INPUT REQUESTS   CL**2
01577 *        FOR EXTRACT RECORDS AND MAST1 DATA, AND DOES PHYSICAL I/O   CL**2
01578 *        FOR PRINTER FROM TABLE IN LINKAGE.                          CL**2
01579 ******************************************************************   CL**2
01580 ******************************************************************   CL**2
01581  5000-INDEX-REPORT.                                                  CL**2
01582      MOVE ZERO TO RTBL-MOD-REQ.                                      CL**2
01583      PERFORM 7400-TBL-EXTINPUT THRU 7499-TBL-EXTINPUT-XIT.           CL**2
01584  5100-CALL-400.                                                      CL**2
           CALL "RPT400". 
01591 *                                                                    CL**2
01592 *    RESPOND TO REQUESTS FROM RPT400                                 CL**2
01593 *                                                                    CL**2
01594      IF RTBL-MOD-REQ EQUAL "9"                                       CL**2
01595          MOVE "4" TO RTBL-MOD-REQ                                    CL**2
01596          PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT                    CL**2
01597          GO TO 5900-END-INDEX.                                       CL**2
01598      IF RTBL-MOD-REQ EQUAL "8"                                       CL**2
01599          MOVE "4" TO RTBL-MOD-REQ                                    CL**2
01600          PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT                    CL**2
01601          GO TO 5800-INDEX-ERROR.                                     CL**2
01602      IF RTBL-MOD-REQ EQUAL "3"                                       CL**2
01603          PERFORM 7400-TBL-EXTINPUT THRU 7499-TBL-EXTINPUT-XIT        CL**2
01604          GO TO 5100-CALL-400.                                        CL**2
01605      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                       CL**2
01606      GO TO 5100-CALL-400.                                            CL**2
01607  5800-INDEX-ERROR.                                                   CL**2
01608  5900-END-INDEX.                                                     CL**2
01609      IF EXT-EOF-SW EQUAL "Y"                                         CL**2
01610          GO TO 9010-PRT-RUNTOTS.                                     CL**2
01611      GO TO 0110-NEW-REQ.                                             CL**2
01612 ******************************************************************DCRPT200
01613 *                                                                 DCRPT200
01614 *     RESPOND TO I/O REQUESTS FROM DEPENDANT MODULES              DCRPT200
01615 *          1=PHYSICAL READ OF MAST1                               DCRPT200
01616 *          4=REPORT OUTPUT                                        DCRPT200
01617 *          5=FILE OUTPUT (EITHER USERFILE OR INDEX)               DCRPT200
01618 *                                                                 DCRPT200
01619 ***************************************************************** DCRPT200
01620  7000-IO-REQ.                                                     DCRPT200
01621      IF RTBL-MOD-REQ EQUAL TO "4"                                    CL**2
01622          GO TO 7010-REPORT-PRINT.                                 DCRPT200
01623      IF RTBL-MOD-REQ EQUAL TO "5"                                 DCRPT200
01624          GO TO 7060-OUTPUT-FILES.                                    CL**2
01625 *                                                                 DCRPT200
01626 *     REQUEST FOR DATA FILE PHYSICAL READ                         DCRPT200
01627 *          PASS ENTIRE RECORD IN LINKAGE                          DCRPT200
01628 *                                                                 DCRPT200
           MOVE DATA-KEY TO DATA-KEY-2. 
01630      READ MAST1                                                   DCRPT200
01631          INVALID KEY GO TO 8020-MAST1-READ-ERROR.                    CL**2
01632      MOVE MAST1-RECORD TO DATA-RECORD.                            DCRPT200
01633      GO TO 7099-IO-REQ-XIT.                                       DCRPT200
01634  7010-REPORT-PRINT.                                               DCRPT200
01635 *                                                                 DCRPT200
01636 *     OUTPUT TABLED PRINT LINES                                   DCRPT200
01637 *                                                                 DCRPT200
01638      MOVE 1 TO LINE-SUB.                                          DCRPT200
01639      IF RPT-LINE-CT EQUAL ZEROES                                  DCRPT200
01640      GO TO 7099-IO-REQ-XIT.                                       DCRPT200
01641  7050-NEXT-LINE.                                                  DCRPT200
01642      MOVE RPT-PRT-CTL (LINE-SUB) TO ACTUAL-PRT-CTL.               DCRPT200
01643      MOVE RPT-PRT-LINE (LINE-SUB) TO PRINT-DATA.                  DCRPT200
           WRITE PRINT-LINE.
01645      MOVE SPACES TO PRINT-LINE.                                   DCRPT200
01646      IF LINE-SUB EQUAL TO RPT-LINE-CT                             DCRPT200
01647          MOVE SPACES TO RPTTBL-PRINT-LINES                        DCRPT200
01648          MOVE ZERO TO RPT-LINE-CT                                 DCRPT200
01649          GO TO 7099-IO-REQ-XIT.                                   DCRPT200
01650      ADD 1 TO LINE-SUB.                                           DCRPT200
01651      GO TO 7050-NEXT-LINE.                                        DCRPT200
01652 *                                                                 DCRPT200
01653 *     OUTPUT USER FILE OR INDEX RECORDS                           DCRPT200
01654 *                                                                 DCRPT200
01655  7060-OUTPUT-FILES.                                               DCRPT200
01656      MOVE 1 TO FILE-SUB.                                          DCRPT200
01657      IF USER-COUNT EQUAL ZEROES                                      CL**2
01658          GO TO 7099-IO-REQ-XIT.                                   DCRPT200
01659  7070-NEXT-RECORD.                                                DCRPT200
01660      IF CATTBL-FIL-CTL (FILE-SUB) EQUAL TO "I"                       CL**2
01661          GO TO 7095-INDEX-OUT.                                    DCRPT200
01662  7080-USER-OUT.                                                   DCRPT200
01663      IF CATTBL-REC-TYPE (FILE-SUB) EQUAL TO "3"                      CL**2
01664          MOVE CAT-UENT-REC (FILE-SUB) TO USER-ENTRY-REC              CL**2
01665          WRITE USER-ENTRY-REC                                        CL**2
01666          ADD 1 TO CTLRPT-REQUSER-COUNT                               CL**2
01667          GO TO 7090-CHECK-LAST.                                      CL**2
01668      IF CATTBL-REC-TYPE (FILE-SUB) EQUAL TO "4"                      CL**2
01669          MOVE CAT-U120-REC (FILE-SUB) TO USER-LINE120-REC            CL**2
01670          WRITE USER-LINE120-REC                                      CL**2
01671          ADD 1 TO CTLRPT-REQUSER-COUNT                               CL**2
01672          GO TO 7090-CHECK-LAST.                                   DCRPT200
01673       MOVE CAT-RECORD (FILE-SUB) TO USER-LINE200-REC.                CL**2
01674      WRITE USER-LINE200-REC.                                         CL**2
01675      ADD 1 TO CTLRPT-REQUSER-COUNT.                                  CL**2
01676  7090-CHECK-LAST.                                                 DCRPT200
01677      IF FILE-SUB EQUAL TO USER-COUNT                                 CL**2
01678          MOVE SPACES TO CATTBL-OUTPUT-RECORDS                     DCRPT200
01679          MOVE ZERO TO USER-COUNT                                     CL**2
01680          GO TO 7099-IO-REQ-XIT.                                   DCRPT200
01681      ADD 1 TO FILE-SUB.                                           DCRPT200
01682      GO TO 7070-NEXT-RECORD.                                      DCRPT200
01683  7095-INDEX-OUT.                                                  DCRPT200
01684      MOVE CAT-IDXDET-REC (FILE-SUB) TO IDX-DET-REC.                  CL**2
01685      WRITE IDX-DET-REC.                                           DCRPT200
01686      ADD 1 TO CTLRPT-REQINDEX-COUNT.                                 CL**2
01687      GO TO 7090-CHECK-LAST.                                       DCRPT200
01688  7099-IO-REQ-XIT.                                                 DCRPT200
01689      EXIT.                                                           CL**2
01690 *****************************************************************    CL**2
01691 *                                                                    CL**2
01692 *     ZERO OUT COUNTERS INDIVIDUALLY BECAUSE OF THEIR                CL**2
01693 *          COMP-3 FORMAT                                             CL**2
01694 *                                                                    CL**2
01695 *****************************************************************    CL**2
01696  7200-ZERO-COUNTERS.                                                 CL**2
01697      MOVE 1 TO SUB-Z.                                                CL**2
01698  ZERO-1.                                                             CL**2
01699      MOVE ZEROES TO CTLRPT-REQREAD-COUNT (SUB-Z).                    CL**2
01700      ADD 1 TO SUB-Z.                                                 CL**2
01701      IF SUB-Z NOT GREATER 16                                         CL**2
01702          GO TO ZERO-1.                                               CL**2
01703      MOVE 1 TO SUB-Z.                                                CL**2
01704  ZERO-2.                                                             CL**2
01705      MOVE ZEROES TO CTLRPT-REQBYP-COUNT (SUB-Z).                     CL**2
01706      ADD 1 TO SUB-Z.                                                 CL**2
01707      IF SUB-Z NOT GREATER THAN 16                                    CL**2
01708          GO TO ZERO-2.                                               CL**2
01709      MOVE 1 TO SUB-Z.                                                CL**2
01710  ZERO-3.                                                             CL**2
01711      MOVE ZEROES TO CTLRPT-REQPRT-COUNT (SUB-Z).                     CL**2
01712      ADD 1 TO SUB-Z.                                                 CL**2
01713      IF SUB-Z NOT GREATER THAN 16                                    CL**2
01714          GO TO ZERO-3.                                               CL**2
01715      MOVE 1 TO SUB-Z.                                                CL**2
01716  ZERO-4.                                                             CL**2
01717      MOVE ZEROES TO CTLRPT-REQEXT-COUNT (SUB-Z).                     CL**2
01718      ADD 1 TO SUB-Z.                                                 CL**2
01719      IF SUB-Z NOT GREATER THAN 16                                    CL**2
01720          GO TO ZERO-4.                                               CL**2
01721      MOVE 1 TO SUB-Z.                                                CL**2
01722  ZERO-5.                                                             CL**2
01723      MOVE ZEROES TO CTLRPT-RUNREAD-COUNT (SUB-Z).                    CL**2
01724      ADD 1 TO SUB-Z.                                                 CL**2
01725      IF SUB-Z NOT GREATER THAN 16                                    CL**2
01726          GO TO ZERO-5.                                               CL**2
01727      MOVE 1 TO SUB-Z.                                                CL**2
01728  ZERO-6.                                                             CL**2
01729      MOVE ZEROES TO CTLRPT-RUNBYP-COUNT (SUB-Z).                     CL**2
01730      ADD 1 TO SUB-Z.                                                 CL**2
01731      IF SUB-Z NOT GREATER THAN 16                                    CL**2
01732          GO TO ZERO-6.                                               CL**2
01733      MOVE 1 TO SUB-Z.                                                CL**2
01734  ZERO-7.                                                             CL**2
01735      MOVE ZEROES TO CTLRPT-RUNPRT-COUNT (SUB-Z).                     CL**2
01736      ADD 1 TO SUB-Z.                                                 CL**2
01737      IF SUB-Z NOT GREATER THAN 16                                    CL**2
01738          GO TO ZERO-7.                                               CL**2
01739      MOVE 1 TO SUB-Z.                                                CL**2
01740  ZERO-8.                                                             CL**2
01741      MOVE ZEROES TO CTLRPT-RUNEXT-COUNT (SUB-Z).                     CL**2
01742      ADD 1 TO SUB-Z.                                                 CL**2
01743      IF SUB-Z NOT GREATER 16                                         CL**2
01744          GO TO ZERO-8.                                               CL**2
01745  ZERO-REST.                                                          CL**2
01746      MOVE ZEROES TO CTLRPT-REQINDEX-COUNT.                           CL**2
01747      MOVE ZEROES TO CTLRPT-REQUSER-COUNT.                            CL**2
01748      MOVE ZEROES TO CTLRPT-REQEXTRACT-COUNT.                         CL**2
01749      MOVE ZEROES TO CTLRPT-RUNINDEX-COUNT.                           CL**2
01750      MOVE ZEROES TO CTLRPT-RUNUSER-COUNT.                            CL**2
01751      MOVE ZEROES TO CTLRPT-RUNEXTRAC-COUNT.                          CL**2
01752  7299-ZERO-COUNTERS-XIT.                                             CL**2
01753      EXIT.                                                           CL**2
01754                                                                    DCRPT20
01755 *                                                                    CL**2
01756 *    READ/TABLE RELATIONAL,INDEX AND NAME INPUT                      CL**2
01757 *                                                                    CL**2
01758  7400-TBL-EXTINPUT.                                                  CL**2
01759      MOVE SPACES TO RPT-INPUT-TBL.                                   CL**2
01760      MOVE 1 TO EF-SUB.                                               CL**2
01761      IF REQ-1STTIME-SW EQUAL "Y"                                     CL**2
01762          MOVE "N" TO REQ-1STTIME-SW                                  CL**2
01763          GO TO 7415-NO-READ.                                         CL**2
01764  7410-NEXT-EXTTBL.                                                   CL**2
01765      PERFORM 7600-READ-DET THRU 7699-READ-DET-XIT.                   CL**2
01766  7415-NO-READ.                                                       CL**2
01767      IF EXT-EOF-SW EQUAL "Y"                                         CL**2
01768          GO TO 7480-ENDIT.                                           CL**2
01769      IF EXT-CAT-RECTYPE EQUAL "1"                                    CL**2
01770          GO TO 7480-ENDIT.                                           CL**2
01771      IF EXT-CAT-REQTYPE EQUAL "RC"                                   CL**2
01772          MOVE EXT-NAME-REC TO REPORT-RECORD-IN (EF-SUB)              CL**2
01773          GO TO 7470-CHECK-END.                                       CL**2
01774      IF EXT-CAT-REQTYPE EQUAL "RH"                                   CL**2
01775          MOVE EXT-INDEX-REC TO REPORT-RECORD-IN (EF-SUB)             CL**2
01776          GO TO 7470-CHECK-END.                                       CL**2
01777 *                                                                    CL**2
01778 *    RELATIONAL TYPE                                                 CL**2
01779 *                                                                    CL**2
01780      IF EXT-RELD1-RECCODE EQUAL "D"                                  CL**2
01781          MOVE EXT-REL-DEF-REC TO REPORT-RECORD-IN (EF-SUB)           CL**2
01782      ELSE                                                            CL**2
01783          MOVE EXT-REL-REF-REC TO REPORT-RECORD-IN (EF-SUB).          CL**2
01784  7470-CHECK-END.                                                     CL**2
01785      ADD 1 TO EF-SUB.                                                CL**2
01786      IF EF-SUB EQUAL 21                                              CL**2
01787          GO TO 7499-TBL-EXTINPUT-XIT.                                CL**2
01788      GO TO 7410-NEXT-EXTTBL.                                         CL**2
01789  7480-ENDIT.                                                         CL**2
01790      MOVE HIGH-VALUES TO RPT-INPUT-TYPE (EF-SUB).                    CL**2
01791  7499-TBL-EXTINPUT-XIT.                                              CL**2
01792      EXIT.                                                           CL**2
01793 ***************************************************************** DCRPT200
01794 *     READ EXTRACT FILE REQUEST RECORD                            DCRPT200
01795 ***************************************************************** DCRPT200
01796  7500-READ-REQ.                                                   DCRPT200
01797      READ EXTRACT-FILE                                            DCRPT200
01798          AT END GO TO 8050-NO-INPUT.                                 CL**2
01799      ADD 1 TO CTLRPT-REQEXTRACT-COUNT.                               CL**2
01800  7599-READ-REQ-XIT.                                               DCRPT200
01801      EXIT.                                                        DCRPT200
01802 ***************************************************************** DCRPT200
01803 *     READ EXTRACT FILE DETAIL RECORD                             DCRPT200
01804 ***************************************************************** DCRPT200
01805  7600-READ-DET.                                                   DCRPT200
01806      READ EXTRACT-FILE                                            DCRPT200
01807          AT END MOVE "Y" TO EXT-EOF-SW                               CL**2
01808                 GO TO 7699-READ-DET-XIT.                             CL**2
01809      ADD 1 TO CTLRPT-REQEXTRACT-COUNT.                               CL**2
01810  7699-READ-DET-XIT.                                               DCRPT200
01811      EXIT.                                                        DCRPT200
01812 ***************************************************************** DCRPT200
01813 *     CONVERT ENTITY TYPE ID TO NAME                              DCRPT200
01814 *          SHORTENTTYPE IS INPUT                                  DCRPT200
01815 *          LONGENTTYPE IS OUTPUT                                  DCRPT200
01816 ***************************************************************** DCRPT200
01817  7700-CVT-ENTTYPE.                                                DCRPT200
01818      MOVE 1 TO CTL-SUB.                                           DCRPT200
01819  7710-ENT-COMPARE.                                                DCRPT200
01820      IF ENT-ID (CTL-SUB) EQUAL TO SHORT-ENTTYPE                   DCRPT200
01821          GO TO 7780-LONG-NAME.                                    DCRPT200
01822      ADD 1 TO CTL-SUB.                                            DCRPT200
01823      GO TO 7710-ENT-COMPARE.                                      DCRPT200
01824  7780-LONG-NAME.                                                     CL**2
01825      MOVE ENT-NAME (CTL-SUB) TO LONG-ENTTYPE.                        CL**2
01826  7799-CVT-ENTTYPE-XIT.                                               CL**2
01827      EXIT.                                                           CL**2
01828                                                                    DCRPT20
01829 ***************************************************************      CL**2
01830 *                                                                    CL**2
01831 *    PRINT CONTROL REPORT-COMMON PROCESSING                          CL**2
01832 *         OUTPUTS TOTAL ENTRY LINES AND RECORD COUNT LINES           CL**2
01833 *        AND ROLLS ACCUMULATORS TO NEXT LEVEL.  ZEROES REQUEST       CL**2
01834 *        LEVEL ACCUMULATORS                                          CL**2
01835 ***************************************************************      CL**2
01836  7800-PRT-CTL.                                                       CL**2
01837 *                                                                    CL**2
01838 *        PRINT CONTROL TOTALS FOR ENTRY TYPES PRINTED                CL**2
01839 *                                                                    CL**2
01840      IF ENDRPT-SW EQUAL "Y"                                          CL**2
01841          GO TO 7840-FILE-TOTS.                                       CL**2
01842      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01843      MOVE CTLRPT-ENTCNT-HDG TO STD-REPORT-REC.                       CL**2
01844      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01845      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
01846      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01847      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01848      MOVE CTLRPT-ENTCNT-SHDG1 TO STD-REPORT-REC.                     CL**2
01849      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01850      MOVE CTLRPT-ENTCNT-SHDG2 TO STD-REPORT-REC.                     CL**2
01851      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01852      MOVE CTLRPT-ENTCNT-SHDG3 TO STD-REPORT-REC.                     CL**2
01853      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01854      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01855      MOVE SPACES TO CTLRPT-ENTCNT-LEV.                               CL**2
01856      MOVE 1 TO ENT-SUB.                                              CL**2
01857  7810-MOVE-COUNT.                                                    CL**2
01858      IF ENT-NAME (ENT-SUB) EQUAL TO SPACES                           CL**2
01859          GO TO 7830-NEXT-COUNT.                                      CL**2
01860      IF CTLRPT-REQREAD-COUNT (ENT-SUB) EQUAL 0                       CL**2
01861          GO TO 7830-NEXT-COUNT.                                      CL**2
01862      MOVE ENT-NAME (ENT-SUB) TO CTLRPT-ENTCNT-TYPE.                  CL**2
01863  7820-FINAL-COUNT.                                                   CL**2
01864      MOVE CTLRPT-REQREAD-COUNT (ENT-SUB) TO CTLRPT-ENTCNT-READ.      CL**2
01865      MOVE CTLRPT-REQPRT-COUNT (ENT-SUB) TO CTLRPT-ENTCNT-PRT.        CL**2
01866      MOVE CTLRPT-REQEXT-COUNT (ENT-SUB) TO CTLRPT-ENTCNT-EXT.        CL**2
01867      MOVE CTLRPT-REQBYP-COUNT (ENT-SUB) TO CTLRPT-ENTCNT-BYP.        CL**2
01868      MOVE CTLRPT-ENTCNT-LINE TO STD-REPORT-REC.                      CL**2
01869      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01870 *                                                                    CL**2
01871 *     ROLL TOTALS                                                    CL**2
01872 *                                                                    CL**2
01873      ADD CTLRPT-REQREAD-COUNT (ENT-SUB)                              CL**2
01874          TO CTLRPT-RUNREAD-COUNT (ENT-SUB)                           CL**2
01875      ADD CTLRPT-REQPRT-COUNT (ENT-SUB) TO                            CL**2
01876          CTLRPT-RUNPRT-COUNT (ENT-SUB)                               CL**2
01877      ADD CTLRPT-REQEXT-COUNT (ENT-SUB)                               CL**2
01878          TO CTLRPT-RUNEXT-COUNT (ENT-SUB)                            CL**2
01879      ADD CTLRPT-REQBYP-COUNT (ENT-SUB)                               CL**2
01880          TO CTLRPT-RUNBYP-COUNT (ENT-SUB)                            CL**2
01881      IF ENT-SUB LESS THAN 16                                         CL**2
01882          ADD CTLRPT-REQREAD-COUNT (ENT-SUB)                          CL**2
01883              TO CTLRPT-REQREAD-COUNT (16)                            CL**2
01884          ADD CTLRPT-REQPRT-COUNT (ENT-SUB)                           CL**2
01885              TO CTLRPT-REQPRT-COUNT (16)                             CL**2
01886          ADD CTLRPT-REQEXT-COUNT (ENT-SUB)                           CL**2
01887              TO CTLRPT-REQEXT-COUNT (16)                             CL**2
01888          ADD CTLRPT-REQBYP-COUNT (ENT-SUB)                           CL**2
01889              TO CTLRPT-REQBYP-COUNT (16).                            CL**2
01890      MOVE ZEROES TO CTLRPT-REQREAD-COUNT (ENT-SUB).                  CL**2
01891      MOVE ZEROES TO CTLRPT-REQPRT-COUNT (ENT-SUB).                   CL**2
01892      MOVE ZEROES TO CTLRPT-REQEXT-COUNT (ENT-SUB).                   CL**2
01893      MOVE ZEROES TO CTLRPT-REQBYP-COUNT (ENT-SUB).                   CL**2
01894  7830-NEXT-COUNT.                                                    CL**2
01895      ADD 1 TO ENT-SUB.                                               CL**2
01896      IF ENT-SUB LESS THAN 16                                         CL**2
01897          GO TO 7810-MOVE-COUNT.                                      CL**2
01898      IF ENT-SUB EQUAL TO 16                                          CL**2
01899          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
01900          MOVE CTLRPT-ENTCNT-MSG TO CTLRPT-ENTCNT-TYPE                CL**2
01901          MOVE CTLRPT-LEVEL TO CTLRPT-ENTCNT-LEV                      CL**2
01902          GO TO 7820-FINAL-COUNT.                                     CL**2
01903  7840-FILE-TOTS.                                                     CL**2
01904 *                                                                    CL**2
01905 *    PRINT RECORD COUNTS FOR FILES                                   CL**2
01906 *                                                                    CL**2
01907      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01908      MOVE CTLRPT-RECCNT-LINE TO STD-REPORT-REC.                      CL**2
01909      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01910      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01911      MOVE CTLRPT-REQINDEX-COUNT TO CTLRPT-RECCNT-IDXTOT.             CL**2
01912      MOVE CTLRPT-REQUSER-COUNT TO CTLRPT-RECCNT-USETOT.              CL**2
01913      MOVE CTLRPT-REQEXTRACT-COUNT TO CTLRPT-RECCNT-EXTTOT.           CL**2
01914      ADD CTLRPT-REQINDEX-COUNT TO CTLRPT-RUNINDEX-COUNT.             CL**2
01915      ADD CTLRPT-REQUSER-COUNT TO CTLRPT-RUNUSER-COUNT.               CL**2
01916      ADD CTLRPT-REQEXTRACT-COUNT TO CTLRPT-RUNEXTRAC-COUNT.          CL**2
01917      MOVE ZEROES TO CTLRPT-REQINDEX-COUNT.                           CL**2
01918      MOVE ZEROES TO CTLRPT-REQUSER-COUNT.                            CL**2
01919      MOVE ZEROES TO CTLRPT-REQEXTRACT-COUNT.                         CL**2
01920 *                                                                    CL**2
01921      MOVE CTLRPT-RECCNT-IDXLINE TO STD-REPORT-REC.                   CL**2
01922      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01923      MOVE CTLRPT-RECCNT-USELINE TO STD-REPORT-REC.                   CL**2
01924      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01925      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01926  7899-PRT-CTL-XIT.                                                   CL**2
01927      EXIT.                                                           CL**2
01928  USER-ROUTINE.                                                       CL**2
01929  USER-ROUTINE-XIT.                                                   CL**2
01930      EXIT.                                                           CL**2
01931                                                                    DCRPT20
01932 ***************************************************************** DCRPT200
01933 *                                                                 DCRPT200
01934 *     ERROR ROUTINES                                              DCRPT200
01935 *                                                                 DCRPT200
01936 ***************************************************************** DCRPT200
01937  8010-BAD-ENTRY.                                                     CL**2
01938      GO TO 2900-ENTRY-END.                                           CL**2
01939  8020-MAST1-READ-ERROR.                                           DCRPT200
01940      MOVE "Y" TO MAST1-ERR-SW.                                       CL**2
           MOVE 4 TO RTBL-MOD-REQ.
01942      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                       CL**2
           MOVE 5 TO RTBL-MOD-REQ.
01944      PERFORM 7000-IO-REQ THRU 7099-IO-REQ-XIT.                       CL**2
01945      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
01946      MOVE 99 TO LINE-CT.                                             CL**2
01947      MOVE EXT-HOLD-CATNAME TO ERROR-NAME.                            CL**2
01948      MOVE MAST1-ERR-MSG TO STD-REPORT-REC.                           CL**2
01949      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01950 ************************                                             CL**2
01951 *        FIND NEW REQUEST                                            CL**2
01952 *************************                                            CL**2
01953  8025-FIND-NEW-REQ.                                                  CL**2
01954      PERFORM 7600-READ-DET THRU 7699-READ-DET-XIT.                   CL**2
01955      IF EXT-EOF-SW EQUAL "Y"                                         CL**2
01956          GO TO 9000-END-REPORTS.                                     CL**2
01957      IF EXT-CAT-RECTYPE EQUAL 1                                      CL**2
01958          GO TO 2950-REQ-END.                                         CL**2
01959      GO TO 8025-FIND-NEW-REQ.                                        CL**2
01960  8030-MAST3-READ-ERROR.                                              CL**2
01961      MOVE SPACES TO PRINT-DATA.                                      CL**2
01962      MOVE MAST3-ERR-MSG TO PRINT-DATA.                               CL**2
01963      MOVE 1 TO PRT-CTL.                                              CL**2
01964      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01965      GO TO 9020-CLOSE-FILES.                                         CL**2
01966  8050-NO-INPUT.                                                   DCRPT200
01967      MOVE NO-INPUT-MSG TO STD-REPORT-REC.                            CL**2
01968      MOVE 99 TO LINE-CT.                                             CL**2
01969      MOVE 1 TO PRT-CTL.                                              CL**2
01970      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01971      GO TO 9020-CLOSE-FILES.                                         CL**2
01972                                                                    DCRPT20
01973 ***************************************************************** DCRPT200
01974 *                                                                 DCRPT200
01975 *     END REPORT PRINT PROCESSING                                 DCRPT200
01976 *                                                                 DCRPT200
01977 ***************************************************************** DCRPT200
01978  9000-END-REPORTS.                                                   CL**2
01979 *                                                                    CL**2
01980 *    FINISH PROCESSING OF LAST REQUEST- OUTPUT CTL PRT FOR REQ       CL**2
01981 *                                                                    CL**2
01982      GO TO 2950-REQ-END.                                             CL**2
01983  9010-PRT-RUNTOTS.                                                   CL**2
01984      MOVE 99 TO LINE-CT.                                             CL**2
01985      MOVE SPACES TO STD-REPORT-REC.                                  CL**2
01986      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01987 *                                                                    CL**2
01988 *    OUTPUT FINAL TOTALS                                             CL**2
01989 *                                                                    CL**2
01990      MOVE REQRPT-STARS TO STD-REPORT-REC.                            CL**2
01991      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01992      MOVE CTLRPT-REQNO-LINE TO STD-REPORT-REC.                       CL**2
01993      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01994      MOVE REQRPT-STARS TO STD-REPORT-REC.                            CL**2
01995      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01996      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01997 *                                                                    CL**2
01998 *    PRINT TOTAL REQUESTS SECTION                                    CL**2
01999 *                                                                    CL**2
02000      MOVE CTLRPT-REQTOT-HDG TO STD-REPORT-REC.                       CL**2
02001      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
02002      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
02003      MOVE REPORT-REQ-COUNT TO CTLRPT-REQCNT.                         CL**2
02004      MOVE CTLRPT-REQCNT-LINE TO STD-REPORT-REC.                      CL**2
02005      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
02006      MOVE FILE-REQ-COUNT TO CTLRPT-REQCNT.                           CL**2
02007      MOVE CTLRPT-FILE-CON TO CTLRPT-REQTYPE.                         CL**2
02008      MOVE CTLRPT-REQCNT-LINE TO STD-REPORT-REC.                      CL**2
02009      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
02010      ADD REPORT-REQ-COUNT FILE-REQ-COUNT                             CL**2
02011          GIVING TOTAL-REQ-COUNT.                                     CL**2
02012      MOVE TOTAL-REQ-COUNT TO CTLRPT-REQCNT.                          CL**2
02013      MOVE SPACES TO CTLRPT-REQTYPE.                                  CL**2
02014      MOVE CTLRPT-REQCNT-LINE TO STD-REPORT-REC.                      CL**2
02015      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
02016      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
02017 *                                                                    CL**2
02018 *    PRINT ENTRY AND FILE RECORD COUNT CONTROL TOTALS                CL**2
02019 *                                                                    CL**2
02020      MOVE CTLRPT-RUN-COUNTERS TO CTLRPT-REQUEST-COUNTERS.            CL**2
02021      MOVE ZEROES TO CTLRPT-REQREAD-COUNT (16).                       CL**2
02022      MOVE ZEROES TO CTLRPT-REQPRT-COUNT (16).                        CL**2
02023      MOVE ZEROES TO CTLRPT-REQEXT-COUNT (16).                        CL**2
02024      MOVE ZEROES TO CTLRPT-REQBYP-COUNT (16).                        CL**2
02025      MOVE CTLRPT-FINLEV-CON TO CTLRPT-RECCNT-EXTLEV.                 CL**2
02026      MOVE CTLRPT-FINLEV-CON TO CTLRPT-RECCNT-IDXLEV.                 CL**2
02027      MOVE CTLRPT-FINLEV-CON TO CTLRPT-RECCNT-USELEV.                 CL**2
02028      MOVE "Y" TO ENDRPT-SW.                                          CL**2
02029      PERFORM 7800-PRT-CTL THRU 7899-PRT-CTL-XIT.                     CL**2
02030 *                                                                    CL**2
02031 *    IF NO INDEX RECORDS WERE EXTRACTED SET RETURN CODE TO 4         CL**2
02032 *                                                                    CL**2
02033      IF CTLRPT-RUNINDEX-COUNT EQUAL ZERO                             CL**2
02034          MOVE "4" TO RETURN-CODE.                                    CL**2
02035 *                                                                    CL**2
02036 *    PRINT END OF RUN LINE                                           CL**2
02037 *                                                                    CL**2
02038      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
02039      MOVE CTLRPT-ENDRUN-LINE TO STD-REPORT-REC.                      CL**2
02040      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
02041      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
02042      IF MAST1-ERR-SW EQUAL "Y"                                       CL**2
02043           MOVE 8 TO RETURN-CODE.                                     CL**2
02044  9020-CLOSE-FILES.                                                   CL**2
02045 *                                                                    CL**2
02046 *    CLOSE ALL FILES                                                 CL**2
02047 *                                                                    CL**2
02048      CLOSE MAST1.                                                 DCRPT200
02050      CLOSE EXTRACT-FILE.                                          DCRPT200
02051      CLOSE SYSPRINT.                                              DCRPT200
02052      IF 1ST-IDX-SW EQUAL TO "N"                                   DCRPT200
02053          CLOSE INDEX-FILE.                                        DCRPT200
02054      IF 1ST-USER-SW EQUAL TO "N"                                     CL**2
02055          CLOSE USER-FILE.                                         DCRPT200
           PERFORM RETURN-CODE-00 THRU RETURN-CODE-XIT. 
02056      STOP RUN.                                                       CL**2
*CALL RETCODE 
*CALL     MAST3IO1                                                      DCRPT200
*CALL     DISPLAY2                                                         CL**2
*CALL     WRITELN                                                          CL**2
02060  RPT-PRINT811.                                                       CL**2
02061  RPT-PRINT811-XIT.                                                   CL**2
