*DECK     DCRPT100
00001  IDENTIFICATION DIVISION.                                         10/03/78
       PROGRAM-ID.   RPT100.
*CALL COPYRIGHT 
      *    THIS MODULE CONTROLS THE CALLING OF REPORT AND FILE
      *    EXTRACTION MODULES AND ALSO DOES THEIR I/O FOR THE 
      *    EXTRACT FILE AND PRINTER. INPUT TO THIS MODULE IS
      *    THE REPORT REQUEST FILE. OUTPUT IS THE EXTRACT FILE
      *    AND EXTRACT CONTROL REPORT.
00012  ENVIRONMENT DIVISION.                                            DCRPT100
00013  CONFIGURATION SECTION.                                           DCRPT100
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00016  INPUT-OUTPUT SECTION.                                            DCRPT100
00017  FILE-CONTROL.                                                    DCRPT100
           SELECT MAST3 ASSIGN TO "MAST3" 
               ORGANIZATION IS RELATIVE 
               ACCESS MODE IS RANDOM
               RELATIVE KEY IS CON-KEY
               USE "PRUF = YES".
           SELECT REPORT-REQUESTS ASSIGN TO TEMP10 USE "RT=W".
           SELECT EXTRACT-FILE ASSIGN TO TEMP12 USE "RT=W". 
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
00024  DATA DIVISION.                                                   DCRPT100
00025  FILE SECTION.                                                    DCRPT100
*CALL     MAST3FD                                                       DCRPT100
*CALL     RPTREQFD                                                      DCRPT100
*CALL     EXTFD2                                                           CL**2
*CALL     SYSPRTFD                                                      DCRPT100
*CALL RETSCS
00030  WORKING-STORAGE SECTION.                                         DCRPT100
       77  CURRENT-DATE      PICTURE X(8).
00031  77  SEL-SUB                     PICTURE S99 COMP SYNC.              CL**2
00032  77  OUT-SUB                     PICTURE S99 COMP SYNC.              CL**2
00033  77  EXT-SUB                     PICTURE S99 COMP SYNC.              CL**2
*CALL     MAST3DD1                                                      DCRPT100
00037  01  LITERAL-TABLE.                                               DCRPT100
00038      03  LITERAL-1               PICTURE X(24) VALUE              DCRPT100
00039        "REPORT DATE-".                                            DCRPT100
00040      03  LITERAL-2               PICTURE X(24) VALUE              DCRPT100
00041        "DATE OF LAST REVISION-".                                  DCRPT100
00042      03  LITERAL-3               PICTURE X(5) VALUE               DCRPT100
00043        "PAGE".                                                    DCRPT100
00044      03  LITERAL-4               PICTURE X(31) VALUE              DCRPT100
00045        "D A T A   C A T A L O G U E   2".                         DCRPT100
00046      03  LITERAL-5               PICTURE X(25) VALUE              DCRPT100
00047        "REVISION NUMBER-".                                        DCRPT100
00048      03  LITERAL-6               PICTURE X(50) VALUE              DCRPT100
00049        "   E X T R A C T   C O N T R O L   R E P O R T".          DCRPT100
00050  01  PROP-MSG.                                                    DCRPT100
00051      03  FILLER                  PICTURE X(44) VALUE              DCRPT100
               "DATA CATALOGUE 2                       V2.0-".
00053      03  FILLER                  PICTURE X(29) VALUE              DCRPT100
*CALL LEVEL 
00055  01  NO-DATA-MSG             PICTURE X(34)   VALUE                   CL**2
00056       "DCRPT-870-S*  NO REQUEST FILE DATA".                          CL**2
00057  01  CTL-ERR-MSG             PICTURE X(38)   VALUE                   CL**2
00058      "DCRPT-950-F*  MAST3 READ CLIENT RECORD".                       CL**2
00059 *                                                                 DCRPT100
00060 *    SUMMARY REPORT LINE DEFINITIONS                              DCRPT100
00061 *                                                                 DCRPT100
00062  01  EXTRPT-LINES.                                                DCRPT100
00063      03  EXTRPT-STARS            PICTURE X(29) VALUE              DCRPT100
00064        "*****************************".                           DCRPT100
00065      03  EXTRPT-REQNO-LINE.                                       DCRPT100
00066          05  FILLER              PICTURE X(27) VALUE              DCRPT100
00067        "REPORT/FILE REQUEST NUMBER ".                             DCRPT100
00068          05  EXTRPT-REQNO        PICTURE Z9.                      DCRPT100
00069      03  EXTRPT-RPTID-LINE.                                       DCRPT100
00070          05  FILLER              PICTURE XX VALUE SPACES.         DCRPT100
00071          05  EXTRPT-REQTYP       PICTURE X(8).                    DCRPT100
00072          05  EXTRPT-RPTNAM       PICTURE X(32).                      CL**2
00073          05  EXTRPT-WORDOF       PICTURE X(4).                    DCRPT100
00074          05  EXTRPT-STNAME       PICTURE X(32).                   DCRPT100
00075          05  EXTRPT-WORDUSAGE    PICTURE X(6).                    DCRPT100
00076      03  EXTRPT-RPTID2-LINE.                                         CL**2
00077          05  FILLER                PICTURE XX VALUE SPACES.          CL**2
00078          05  EXTID2-REQTYPE        PICTURE X(8).                     CL**2
00079          05  EXTID2-RPTNAM         PICTURE X(32).                    CL**2
00080          05  EXTID2-WORDBY         PICTURE X(4).                     CL**2
00081          05  EXTID2-SN             PICTURE X(8).                     CL**2
00082          05  EXTID2-WORDFOR        PICTURE X(5).                     CL**2
00083          05  EXTID2-CATNAME        PICTURE X(32).                    CL**2
00084          05  EXTID2-WORDUSAGE      PICTURE X(6).                     CL**2
00085      03  EXTRPT-SELTOT-LINE.                                      DCRPT100
00086          05  FILLER              PICTURE X(10) VALUE              DCRPT100
00087            "        * ".                                             CL**2
00088          05  EXTRPT-SELTOT       PICTURE ZZZZ9.                   DCRPT100
00089          05  FILLER              PICTURE X(44) VALUE              DCRPT100
00090            " RECORDS WERE EXTRACTED BY SELECT STATEMENT ".        DCRPT100
00091          05  EXTRPT-SELNO        PICTURE 9.                       DCRPT100
00092      03  EXTRPT-REQTOT-LINE.                                      DCRPT100
00093          05  FILLER              PICTURE X(10) VALUE              DCRPT100
00094            "       ** ".                                             CL**2
00095          05  EXTRPT-REQTOT       PICTURE ZZZZZZ9.                    CL**2
00096          05  FILLER              PICTURE X(40) VALUE              DCRPT100
00097            " RECORDS WERE EXTRACTED BY THIS REQUEST ".            DCRPT100
00098      03  EXTRPT-DASH-LINE.                                        DCRPT100
00099          05  FILLER              PICTURE X(80) VALUE              DCRPT100
00100            "- - - - - - - - - - - - - - - - - - - - - - - - - - - DCRPT100
00101 -          "- - - - - - - - - - - - - ".                          DCRPT100
00102      03  EXTRPT-TOTREQS-LINE.                                     DCRPT100
00103          05  FILLER              PICTURE X(10) VALUE              DCRPT100
00104            "      *** ".                                          DCRPT100
00105          05  EXTRPT-TOTREQS      PICTURE ZZZ9.                    DCRPT100
00106          05  FILLER              PICTURE X(36) VALUE              DCRPT100
00107            " REPORT/FILE REQUESTS WERE PROCESSED".                DCRPT100
00108      03  EXTRPT-TOTRECS-LINE.                                     DCRPT100
00109          05  FILLER              PICTURE X(10) VALUE              DCRPT100
00110            "      *** ".                                          DCRPT100
00111          05  EXTRPT-TOTRECS      PICTURE ZZZZZZ9.                 DCRPT100
00112          05  FILLER              PICTURE X(35) VALUE              DCRPT100
00113            " RECORDS WERE EXTRACTED BY THIS RUN".                 DCRPT100
00114      03  EXTRPT-EOR-LINE.                                         DCRPT100
00115          05  FILLER              PICTURE X(34) VALUE              DCRPT100
00116            "*** END EXTRACT CONTROL REPORT ***".                  DCRPT100
00117      03  EXTRPT-TITLE-LINE.                                       DCRPT100
00118          05  FILLER              PICTURE X(9) VALUE               DCRPT100
00119            "  TITLE =".                                           DCRPT100
00120          05  EXTRPT-USER-TITLE   PICTURE X(50).                   DCRPT100
00121  01  EXTRPT-AREAS.                                                DCRPT100
00122      03  RUN-TOTAL               PICTURE 9(7) VALUE ZEROES.       DCRPT100
00123      03  NUMBER-REQ              PICTURE 999 VALUE ZEROES.        DCRPT100
00124      03  EXT-CAT-HOLD            PICTURE X(65).                   DCRPT100
00125      03  REQ-IN-COUNT            PICTURE 9(7) VALUE ZEROES.       DCRPT100
00126      03  EXT-EOF-SW       PICTURE X VALUE "N".                       CL**2
*CALL CURDATE 
00130                                                                    DCRPT10
00131  PROCEDURE DIVISION.                                              DCRPT100
00133 ***************************************************************** DCRPT100
00134 ***************************************************************** DCRPT100
00135 *                                                                 DCRPT100
00136 *    INITIALIZATION                                               DCRPT100
00137 *                                                                 DCRPT100
00138 ***************************************************************** DCRPT100
00139 ***************************************************************** DCRPT100
00140  0000-START.                                                      DCRPT100
00141      OPEN INPUT MAST3.                                            DCRPT100
00142      OPEN INPUT REPORT-REQUESTS.                                  DCRPT100
00143      OPEN OUTPUT SYSPRINT.                                        DCRPT100
           OPEN OUTPUT EXTRACT-FILE.
*CALL ACCEPTDT
00145 *                                                                 DCRPT100
00146 *    INITIALIZE GENERALIZED PRINT FOR CONTROL REPORT              DCRPT100
00147 *        RETRIEVE HADING DATA FROM CTL FILE AND                   DCRPT100
00148 *        INITIALIZE RELATED FIELDS IN PRINT CONTROL               DCRPT100
00149 *        TABLE.  SET UP HEADING CONSTANTS AND INITIAL BALUES      DCRPT100
00150 *                                                                 DCRPT100
           MOVE 1 TO CON-KEY. 
00152      READ MAST3                                                   DCRPT100
00153          INVALID KEY GO TO 8030-CTL-ERR.                          DCRPT100
00154      MOVE CTL-DATE-UPD TO DATE-LAST-REVISION.                     DCRPT100
00155      MOVE CTL-REV-NUM TO REVISION-NUMBER.                         DCRPT100
00156      MOVE CTL-EOP-MSG TO EOP-MSG.                                    CL**2
00157      MOVE CTL-LINES TO MAX-LINES.                                 DCRPT100
00158      SUBTRACT 1 FROM MAX-LINES.                                   DCRPT100
00159      MOVE CTL-LINES TO LINE-CT.                                   DCRPT100
00160      MOVE CTL-NAME TO CON-USER.                                   DCRPT100
00161      MOVE PROP-MSG TO CON-TITLE.                                  DCRPT100
00162 *                                                                 DCRPT100
00163      MOVE CURRENT-DATE TO PRT-CURRENT-DATE.                       DCRPT100
00164      MOVE ZERO TO PAGE-NO.                                        DCRPT100
00165      MOVE SPACES TO USER-TITLE.                                   DCRPT100
00166      MOVE SPACES TO STD-REPORT-REC.                               DCRPT100
00167      MOVE 1 TO PRT-CTL.                                              CL**2
00168      MOVE "N" TO 8BY11-FLAG.                                      DCRPT100
00169      MOVE LITERAL-6 TO REPORT-TITLE-LONG.                         DCRPT100
00170      MOVE LITERAL-4 TO CON-DC.                                       CL**2
00171      MOVE LITERAL-1 TO PRT-DATE1-HCON.                            DCRPT100
00172      MOVE LITERAL-2 TO PRT-DATE2-HCON.                            DCRPT100
00173      MOVE LITERAL-3 TO PRT-PAGE-HCON.                             DCRPT100
00174      MOVE LITERAL-5 TO PRT-REV-NO-HCON.                           DCRPT100
00175      MOVE ZERO TO HOF-IND.                                        DCRPT100
00176      MOVE 1 TO SPACE-1.                                           DCRPT100
00177      MOVE SPACES TO STD-REPORT-REC.                               DCRPT100
00178      MOVE SPACES TO PRINT-LINE.                                   DCRPT100
00179      MOVE SPACES TO PRINT-LINE1.                                     CL**2
00180      MOVE SPACES TO PRINT-LINE-811.                                  CL**2
00181      MOVE SPACES TO PRINT-CONUSER-811.                               CL**2
00182      MOVE 99 TO LINE-CT.                                             CL**2
00183      MOVE SPACES TO EXTRACT-TABLE.                                   CL**2
00184      MOVE ZEROES TO EXT-COUNT.                                       CL**2
00185      MOVE "N" TO EXT-EOF-SW.                                         CL**2
00186      CLOSE MAST3.                                                    CL**2
00187 ***************************************************************** DCRPT100
00188 ***************************************************************** DCRPT100
00189 *                                                                 DCRPT100
00190 *    PROCESS REPORT REQUEST FILE-CREATE RTBL FOR EXTRACT MODS     DCRPT100
00191 *              AND COPY USER REQUEST TABLE TO EXTRACT FILE        DCRPT100
00192 *                                                                 DCRPT100
00193 ****************************************************************  DCRPT100
00194 ****************************************************************  DCRPT100
00195  0100-GET-REQ.                                                    DCRPT100
00196      READ REPORT-REQUESTS AT END                                     CL**2
00197          GO TO 8040-NO-DATA.                                         CL**2
00198  0110-GET-REQ2.                                                      CL**2
00199      MOVE RPT-HDR-REC TO RTBL-HDR-ENT.                               CL**2
00200      MOVE ZEROES TO RTBL-REQUEST-COUNT.                              CL**2
00201 *                                                                 DCRPT100
00202 *    STORE OPTIONS                                                DCRPT100
00203 *                                                                 DCRPT100
00204      PERFORM 7500-READ-REQ THRU 7599-READ-REQ-XIT.                DCRPT100
00205      MOVE RPT-OPTIONS-REC TO RTBL-OPTIONS-ENT.                       CL**2
00206 *                                                                 DCRPT100
00207 *     STORE 10 SELECT RECORDS                                     DCRPT100
00208 *                                                                 DCRPT100
00209      MOVE 1 TO SEL-SUB.                                           DCRPT100
00210  0200-GET-SEL.                                                    DCRPT100
00211      PERFORM 7500-READ-REQ THRU 7599-READ-REQ-XIT.                DCRPT100
00212      MOVE RPT-SELECT1-REC TO RTBL-SELECTION-ENTRY (SEL-SUB).      DCRPT100
00213      MOVE ZEROES TO RTBL-SELECT-COUNT (SEL-SUB).                     CL**2
00214      ADD 1 TO SEL-SUB.                                            DCRPT100
00215      IF SEL-SUB LESS THAN 11                                      DCRPT100
00216          GO TO 0200-GET-SEL.                                      DCRPT100
00217 *                                                                 DCRPT100
00218 *    STORE OUTPUT RECORDS- ALL 9 OF THEM                          DCRPT100
00219 *                                                                 DCRPT100
00220      MOVE 1 TO OUT-SUB.                                           DCRPT100
00221  0300-GET-OUT.                                                    DCRPT100
00222      PERFORM 7500-READ-REQ THRU 7599-READ-REQ-XIT.                DCRPT100
00223      MOVE RPT-OUTPUT-REC TO RTBL-OUTPUT-ENTRIES (OUT-SUB).        DCRPT100
00224      ADD 1 TO OUT-SUB.                                            DCRPT100
00225      IF OUT-SUB LESS THAN 10                                      DCRPT100
00226          GO TO 0300-GET-OUT.                                      DCRPT100
00227 ***************************************************************** DCRPT100
00228 ***************************************************************** DCRPT100
00229 *                                                                 DCRPT100
00230 *    CALL THE EXTRACTION MODULES AND RESPOND TO THEIR I/O REQUESTSDCRPT100
00231 *                                                                 DCRPT100
00232 ****************************************************************  DCRPT100
00233 ****************************************************************  DCRPT100
00234      IF RTBL-HDR-STARTCNAME NOT EQUAL SPACES                         CL**2
00235          GO TO 0400-HIER-USAGE.                                      CL**2
00236      IF RTBL-HDR-ENTITY NOT EQUAL SPACES                             CL**2
00237          GO TO 0400-HIER-USAGE.                                      CL**2
00238      GO TO 1000-CALL-EXTCAT.                                         CL**2
00239  0400-HIER-USAGE.                                                    CL**2
00240      IF RTBL-HDR-RETRIEVE EQUAL "U"                               DCRPT100
00241          GO TO 3000-CALL-USAGE.                                   DCRPT100
00242      GO TO 2000-CALL-HIER.                                        DCRPT100
00243 ****************************************************************  DCRPT100
00244 *                                                                 DCRPT100
00245 *    PROCESS CATALOGUE (SCAN OF FILE) EXTRACTION REQUEST          DCRPT100
00246 *                                                                 DCRPT100
00247 ****************************************************************  DCRPT100
00248  1000-CALL-EXTCAT.                                                DCRPT100
00249      MOVE ZERO TO RTBL-MOD-REQ.                                   DCRPT100
00250      PERFORM 7100-PRINT-ID THRU 7199-PRINT-ID-XIT.                DCRPT100
00251  1010-PROC-RETURN.                                                DCRPT100
           CALL "RPT120". 
00255      IF RTBL-HDR-REQTYPE EQUAL "RJ"                                  CL**2
00256          GO TO 4000-CHECK-RELATIONAL.                                CL**2
00257 *                                                                 DCRPT100
00258 *    RESPOND TO MODULE REQUESTS                                   DCRPT100
00259 *                                                                 DCRPT100
           IF RTBL-MOD-REQ EQUAL "8" OR "9" 
00261          MOVE "4" TO RTBL-MOD-REQ                                 DCRPT100
00262          PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT         DCRPT100
00263          PERFORM 7200-OUTPUT-TOT THRU 7299-OUTPUT-TOT-XIT         DCRPT100
00264          GO TO 0110-GET-REQ2.                                        CL**2
00270      PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT.               CL**2
00271      GO TO 1010-PROC-RETURN.                                      DCRPT100
00272 ****************************************************************  DCRPT100
00273 *                                                                 DCRPT100
00274 *    PROCESS HIERARCHY EXTRACTION REQUEST                         DCRPT100
00275 *                                                                 DCRPT100
00276 ****************************************************************  DCRPT100
00277  2000-CALL-HIER.                                                  DCRPT100
00278      PERFORM 7100-PRINT-ID THRU 7199-PRINT-ID-XIT.                DCRPT100
00279      MOVE ZERO TO RTBL-MOD-REQ.                                   DCRPT100
00280  2010-PROC-RETURN.                                                DCRPT100
           CALL "RPT130". 
00284      IF RTBL-HDR-REQTYPE EQUAL "RJ"                                  CL**2
00285          GO TO 4000-CHECK-RELATIONAL.                                CL**2
00286 *                                                                 DCRPT100
00287 *    RESPOND TO MODULE REQUESTS                                   DCRPT100
00288 *                                                                 DCRPT100
           IF RTBL-MOD-REQ EQUAL "8" OR "9" 
00290          MOVE "4" TO RTBL-MOD-REQ                                 DCRPT100
00291          PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT            CL**2
00292          PERFORM 7200-OUTPUT-TOT THRU 7299-OUTPUT-TOT-XIT         DCRPT100
00293          GO TO 0110-GET-REQ2.                                        CL**2
00299      PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT.            DCRPT100
00300      GO TO 2010-PROC-RETURN.                                         CL**2
00301 ****************************************************************  DCRPT100
00302 *                                                                 DCRPT100
00303 *    PROCESS USAGE EXTRACTION REQUEST                             DCRPT100
00304 *                                                                 DCRPT100
00305 ****************************************************************  DCRPT100
00306  3000-CALL-USAGE.                                                 DCRPT100
00307      PERFORM 7100-PRINT-ID THRU 7199-PRINT-ID-XIT.                DCRPT100
00308      MOVE ZERO TO RTBL-MOD-REQ.                                   DCRPT100
00309  3010-PROC-RETURN.                                                DCRPT100
           CALL "RPT140". 
00313      IF RTBL-HDR-REQTYPE EQUAL "RJ"                                  CL**2
00314          GO TO 4000-CHECK-RELATIONAL.                                CL**2
00315 *                                                                 DCRPT100
00316 *    RESPOMD TO MODULE REQUESTS                                   DCRPT100
00317 *                                                                 DCRPT100
00318      IF RTBL-MOD-REQ EQUAL "9"                                    DCRPT100
00319          MOVE "4" TO RTBL-MOD-REQ                                 DCRPT100
00320          PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT            CL**2
00321          PERFORM 7200-OUTPUT-TOT THRU 7299-OUTPUT-TOT-XIT         DCRPT100
00322          GO TO 0110-GET-REQ2.                                        CL**2
00323      IF RTBL-MOD-REQ EQUAL TO "8"                                 DCRPT100
00324          MOVE "4" TO RTBL-MOD-REQ                                 DCRPT100
00325          PERFORM 7200-OUTPUT-TOT THRU 7299-OUTPUT-TOT-XIT            CL**2
00326          GO TO 0110-GET-REQ2.                                        CL**2
00327      PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT.            DCRPT100
00328      GO TO 3010-PROC-RETURN.                                      DCRPT100
00329                                                                    DCRPT10
00330 ************************************************                     CL**2
00331 *                                                                    CL**2
00332 *    RELATIONAL REPORT PROCESSING                                    CL**2
00333 *       IF REQUEST IS FOR RELATIONAL REPORT CALL                     CL**2
00334 *       THE EXPLOSION MODULE TO EXTRACT USAGE AND                    CL**2
00335 *       COMPONENTS FOR EVERY ENTRY SELECTED BY THIS                  CL**2
00336 *       MODULE                                                       CL**2
00337 ************************************************                     CL**2
00338  4000-CHECK-RELATIONAL.                                              CL**2
00339      MOVE "4" TO RTBL-MOD-REQ.                                       CL**2
00340      PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT.               CL**2
00341  4100-CALL-RELATIONAL.                                               CL**2
00342      MOVE ZERO TO RTBL-MOD-REQ.                                      CL**2
00343  4110-PROC-RETURN.                                                   CL**2
           CALL "RPT160". 
           IF RTBL-MOD-REQ EQUAL "8" OR "9" 
00348          MOVE "4" TO RTBL-MOD-REQ                                    CL**2
00349          PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT            CL**2
00350          PERFORM 7200-OUTPUT-TOT THRU 7299-OUTPUT-TOT-XIT            CL**2
00351          GO TO 0110-GET-REQ2.                                        CL**2
00357      PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT.               CL**2
00358      GO TO 4110-PROC-RETURN.                                         CL**2
00359                                                                    DCRPT10
00360 ***************************************************************   DCRPT100
00361 ***************************************************************   DCRPT100
00362 *                                                                 DCRPT100
00363 *    RESPOND TO MODULE I/O REQUESTS                               DCRPT100
00364 *                                                                 DCRPT100
00365 ***************************************************************   DCRPT100
00366 ***************************************************************   DCRPT100
00367  7000-OUTPUT-REQ.                                                 DCRPT100
00368      IF EXT-COUNT EQUAL ZERO                                      DCRPT100
00369          GO TO 7099-OUTPUT-REQ-XIT.                               DCRPT100
00370      MOVE 1 TO EXT-SUB.                                           DCRPT100
00371  7010-NEXT-ENTRY.                                                 DCRPT100
00372      IF EXT-OUTPUT-IND (EXT-SUB) EQUAL TO "E"                     DCRPT100
00373          MOVE EXT-OUT-REC (EXT-SUB) TO STD-REPORT-REC                CL**2
00374          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCRPT100
00375          GO TO 7080-CHECK-END.                                    DCRPT100
00376      IF EXT-OUTPUT-IND (EXT-SUB) EQUAL TO "1"                     DCRPT100
00377          MOVE EXT-OUT-REC (EXT-SUB) TO EXT-CATRPT-REC                CL**2
00378          WRITE EXT-CATRPT-REC                                        CL**2
00379          GO TO 7080-CHECK-END.                                       CL**2
00380      IF EXT-OUTPUT-IND (EXT-SUB) EQUAL "2"                           CL**2
00381          MOVE EXT-OUT-REC (EXT-SUB) TO EXT-INDEX-REC                 CL**2
00382          WRITE EXT-INDEX-REC                                         CL**2
00383          GO TO 7080-CHECK-END.                                       CL**2
00384      IF EXT-OUTPUT-IND (EXT-SUB) EQUAL "3"                           CL**2
00385          MOVE EXT-OUT-REC (EXT-SUB) TO EXT-NAME-REC                  CL**2
00386          WRITE EXT-NAME-REC                                          CL**2
00387          GO TO 7080-CHECK-END.                                       CL**2
00388      IF EXT-OUTPUT-IND (EXT-SUB) EQUAL "4"                           CL**2
00389          MOVE EXT-OUT-REC (EXT-SUB) TO EXT-REL-DEF-REC               CL**2
00390          WRITE EXT-REL-DEF-REC                                       CL**2
00391          GO TO 7080-CHECK-END.                                       CL**2
00392      IF EXT-OUTPUT-IND (EXT-SUB) EQUAL "5"                           CL**2
00393          MOVE EXT-OUT-REC (EXT-SUB) TO EXT-REL-REF-REC               CL**2
00394          WRITE EXT-REL-REF-REC                                       CL**2
00395          GO TO 7080-CHECK-END.                                       CL**2
00396  7080-CHECK-END.                                                  DCRPT100
00397      IF EXT-SUB EQUAL TO EXT-COUNT                                DCRPT100
00398          GO TO 7090-OUTPUT-RESET.                                 DCRPT100
00399      ADD 1 TO EXT-SUB.                                            DCRPT100
00400      GO TO 7010-NEXT-ENTRY.                                       DCRPT100
00401  7090-OUTPUT-RESET.                                               DCRPT100
00402      MOVE SPACES TO EXTRACT-TABLE.                                DCRPT100
00403  7099-OUTPUT-REQ-XIT.                                             DCRPT100
00404      EXIT.                                                        DCRPT100
00405 ****************************************************************  DCRPT100
00406 ****************************************************************  DCRPT100
00407 *                                                                 DCRPT100
00408 *    ROUTINES TO FORMAT EXTRACT CONTROL REPORT                    DCRPT100
00409 *                                                                 DCRPT100
00410 ****************************************************************  DCRPT100
00411 ****************************************************************  DCRPT100
00412  7100-PRINT-ID.                                                   DCRPT100
00413 *                                                                 DCRPT100
00414 *    OUTPUT REPORT ID DATA                                        DCRPT100
00415 *                                                                 DCRPT100
00416      MOVE EXTRPT-STARS TO STD-REPORT-REC.                         DCRPT100
00417      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00418      MOVE RTBL-HDR-REQNO TO EXTRPT-REQNO.                         DCRPT100
00419      MOVE EXTRPT-REQNO-LINE TO STD-REPORT-REC.                    DCRPT100
00420      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00421      MOVE EXTRPT-STARS TO STD-REPORT-REC.                         DCRPT100
00422      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00423 *                                                                    CL**2
00424 *     TEST FOR INDEX, RELATIONAL AND NAMES-ANALYSIS                  CL**2
00425 *                                                                    CL**2
00426      IF RTBL-HDR-REQTYPE EQUAL "RC" OR "RH" OR "RJ"                  CL**2
00427          GO TO 7110-REL-REPORTS.                                     CL**2
00428      MOVE SPACES TO EXTRPT-STNAME.                                DCRPT100
00429      MOVE SPACES TO EXTRPT-WORDOF.                                DCRPT100
00430      MOVE SPACES TO EXTRPT-WORDUSAGE.                             DCRPT100
00431      MOVE RTBL-HDR-RPTNAME TO EXTRPT-RPTNAM.                         CL**2
00432 *                                                                 DCRPT100
00433 *     FORMAT $REPORT/FILE LINE                                    DCRPT100
00434 *                                                                 DCRPT100
00435      IF RTBL-HDR-REQTYPE EQUAL TO "RU" OR "RV" OR "RW"            DCRPT100
00436          MOVE "$FILE   " TO EXTRPT-REQTYP                         DCRPT100
00437      ELSE                                                         DCRPT100
00438          MOVE "$REPORT " TO EXTRPT-REQTYP.                        DCRPT100
00439      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                   DCRPT100
00440          MOVE RTBL-HDR-STARTCNAME TO EXTRPT-STNAME                DCRPT100
00441          MOVE " OF" TO EXTRPT-WORDOF                                 CL**2
00442          GO TO 7105-PRINT-ID-LINE.                                   CL**2
00443      IF RTBL-HDR-ENTITY NOT EQUAL TO SPACES                          CL**2
00444          MOVE RTBL-HDR-ENTITY TO EXTRPT-STNAME                       CL**2
00445          MOVE " OF " TO EXTRPT-WORDOF.                               CL**2
00446  7105-PRINT-ID-LINE.                                                 CL**2
00447      MOVE EXTRPT-RPTID-LINE TO STD-REPORT-REC.                       CL**2
00448      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00449      GO TO 7120-CHECK-TITLE.                                         CL**2
00450  7110-REL-REPORTS.                                                   CL**2
00451 *                                                                    CL**2
00452 *    FORMAT ID LINE FOR INDEX, RELATIONAL, NAMES                     CL**2
00453 *                                                                    CL**2
00454      MOVE SPACES TO EXTRPT-RPTID2-LINE.                              CL**2
00455      MOVE "$REPORT "           TO EXTID2-REQTYPE.                    CL**2
00456      MOVE RTBL-HDR-RPTNAME     TO EXTID2-RPTNAM.                     CL**2
00457      MOVE " BY "               TO EXTID2-WORDBY.                     CL**2
00458      MOVE RTBL-HDR-IDXFNAME    TO EXTID2-SN.                         CL**2
00459      IF RTBL-HDR-STARTCNAME NOT EQUAL SPACES                         CL**2
00460          MOVE RTBL-HDR-STARTCNAME TO EXTID2-CATNAME                  CL**2
00461          MOVE " FOR " TO             EXTID2-WORDFOR                  CL**2
00462          GO TO 7112-CHECK-USAGE.                                     CL**2
00463      IF RTBL-HDR-ENTITY NOT EQUAL SPACES                             CL**2
00464          MOVE RTBL-HDR-ENTITY TO EXTID2-CATNAME                      CL**2
00465          MOVE " FOR " TO EXTID2-WORDFOR                              CL**2
00466          GO TO 7112-CHECK-USAGE.                                     CL**2
00467      GO TO 7115-PRINT-ID-LINE.                                       CL**2
00468  7112-CHECK-USAGE.                                                   CL**2
00469      IF RTBL-HDR-RETRIEVE EQUAL "U"                                  CL**2
00470          MOVE " USAGE" TO EXTID2-WORDUSAGE.                          CL**2
00471  7115-PRINT-ID-LINE.                                              DCRPT100
00472      MOVE EXTRPT-RPTID2-LINE TO STD-REPORT-REC.                      CL**2
00473      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00474 *                                                                 DCRPT100
00475 *    CHECK FOR USER TITLE                                         DCRPT100
00476 *                                                                 DCRPT100
00477  7120-CHECK-TITLE.                                                   CL**2
00478      IF RTBL-OPT-TITLE NOT EQUAL TO SPACES                        DCRPT100
00479          MOVE RTBL-OPT-TITLE TO EXTRPT-USER-TITLE                 DCRPT100
00480          MOVE EXTRPT-TITLE-LINE TO STD-REPORT-REC                 DCRPT100
00481          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.              DCRPT100
00482  7199-PRINT-ID-XIT.                                               DCRPT100
00483      EXIT.                                                        DCRPT100
00484 *                                                                 DCRPT100
00485 *    OUTPUT TOTALS FOR REPORT-ACCUMULATE RUN TOTALS               DCRPT100
00486 *                                                                 DCRPT100
00487  7200-OUTPUT-TOT.                                                 DCRPT100
00488      MOVE 1 TO SEL-SUB.                                           DCRPT100
00489      IF RTBL-QRYTYPE-23 (SEL-SUB) EQUAL SPACES                    DCRPT100
00490          ADD RTBL-SELECT-COUNT (1) TO RTBL-REQUEST-COUNT             CL**2
00491          GO TO 7250-REQ-TOT.                                      DCRPT100
00492  7210-DO-SELECT.                                                     CL**2
00493      ADD RTBL-SELECT-COUNT (SEL-SUB) TO RTBL-REQUEST-COUNT.          CL**2
00494      MOVE RTBL-SELECT-COUNT (SEL-SUB) TO EXTRPT-SELTOT.           DCRPT100
00495      MOVE SEL-SUB TO EXTRPT-SELNO.                                DCRPT100
00496      MOVE EXTRPT-SELTOT-LINE TO STD-REPORT-REC.                   DCRPT100
00497      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00498      ADD 1 TO SEL-SUB.                                            DCRPT100
00499      IF SEL-SUB EQUAL 10                                             CL**2
00500          GO TO 7250-REQ-TOT.                                         CL**2
00501      IF RTBL-QRYTYPE-23 (SEL-SUB) NOT EQUAL SPACES                   CL**2
00502          GO TO 7210-DO-SELECT.                                       CL**2
00503 *                                                                 DCRPT100
00504 *     OUTPUT TOTAL RECORDD FOR THIS REQUEST                       DCRPT100
00505 *                                                                 DCRPT100
00506  7250-REQ-TOT.                                                       CL**2
00507      ADD 1 TO NUMBER-REQ.                                         DCRPT100
00508      MOVE RTBL-REQUEST-COUNT TO EXTRPT-REQTOT.                    DCRPT100
00509      MOVE EXTRPT-REQTOT-LINE TO STD-REPORT-REC.                   DCRPT100
00510      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00511      ADD RTBL-REQUEST-COUNT TO RUN-TOTAL.                         DCRPT100
00512 *                                                                 DCRPT100
00513 *    OUTPUT DASH LINES                                            DCRPT100
00514 *                                                                 DCRPT100
00515      MOVE EXTRPT-DASH-LINE TO STD-REPORT-REC.                     DCRPT100
00516      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00517 *    WRITE REQUEST TO EXTRACT FILE                                   CL**2
00518 *                                                                    CL**2
00519      WRITE EXT-HDR-REC FROM RTBL-HDR-ENT.                            CL**2
00520      WRITE EXT-OPTIONS-REC FROM RTBL-OPTIONS-ENT.                    CL**2
00521      MOVE ZEROES TO RTBL-REQUEST-COUNT.                              CL**2
00522 *    OUTPUT THE 10 SELECTION RECORDS                                 CL**2
00523      MOVE 1 TO SEL-SUB.                                              CL**2
00524  7260-OUTPUT-SEL.                                                    CL**2
00525      WRITE EXT-SELECT1-REC FROM RTBL-SELECTION-ENTRY (SEL-SUB).      CL**2
00526      ADD 1 TO SEL-SUB.                                               CL**2
00527      IF SEL-SUB LESS THAN 11                                         CL**2
00528          GO TO 7260-OUTPUT-SEL.                                      CL**2
00529 *     OUTPUT THE 9 OUTPUT RECORDS                                    CL**2
00530      MOVE 1 TO OUT-SUB.                                              CL**2
00531  7270-OUTPUT-OUT.                                                    CL**2
00532      WRITE EXT-OUTPUT-REC FROM RTBL-OUTPUT-ENTRIES (OUT-SUB).        CL**2
00533      ADD 1 TO OUT-SUB.                                               CL**2
00534      IF OUT-SUB LESS THAN 10                                         CL**2
00535          GO TO 7270-OUTPUT-OUT.                                      CL**2
00536 *                                                                    CL**2
00537 *     COPY USER PARAMETERS TO EXTRACT FILE                           CL**2
00538 *                                                                    CL**2
00539  7280-COPY-PARAM.                                                    CL**2
00540      READ REPORT-REQUESTS                                            CL**2
00541          AT END GO TO 9000-EXTRACT-END.                              CL**2
00542      IF RPT-HDR-RECTYPE EQUAL "6"                                    CL**2
00543          WRITE EXT-PARAM-REC FROM RPT-PARAM-REC                      CL**2
00544          GO TO 7280-COPY-PARAM.                                      CL**2
00545  7299-OUTPUT-TOT-XIT.                                             DCRPT100
00546      EXIT.                                                        DCRPT100
00547 *************************************************************        CL**2
00548 *                                                                    CL**2
00549 *    READ REPORT REQUEST FILE                                        CL**2
00550 *                                                                    CL**2
00551 *************************************************************        CL**2
00552  7500-READ-REQ.                                                      CL**2
00553      READ REPORT-REQUESTS                                            CL**2
00554          AT END GO TO 8040-NO-DATA.                                  CL**2
00555  7599-READ-REQ-XIT.                                                  CL**2
00556      EXIT.                                                           CL**2
00557  USER-ROUTINE.                                                       CL**2
00558  USER-ROUTINE-XIT.                                                   CL**2
00559      EXIT.                                                           CL**2
00560 ***************************************************************   DCRPT100
00561 ***************************************************************   DCRPT100
00562 *                                                                 DCRPT100
00563 *       ERROR ROUTINES                                            DCRPT100
00564 *                                                                 DCRPT100
00565 ***************************************************************   DCRPT100
00566 ***************************************************************   DCRPT100
00567  8000-ABORT.                                                      DCRPT100
00568  8030-CTL-ERR.                                                       CL**2
00569      MOVE CTL-ERR-MSG TO STD-REPORT-REC.                             CL**2
00570      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00571      GO TO 9000-EXTRACT-END.                                         CL**2
00572  8040-NO-DATA.                                                       CL**2
00573      MOVE NO-DATA-MSG TO STD-REPORT-REC.                             CL**2
00574      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00575      GO TO 9000-EXTRACT-END.                                         CL**2
00576 ****************************************************************  DCRPT100
00577 ****************************************************************  DCRPT100
00578 *                                                                 DCRPT100
00579 *     END OF EXTRACT PROCESSING                                   DCRPT100
00580 *                                                                 DCRPT100
00581 ****************************************************************  DCRPT100
00582 ****************************************************************  DCRPT100
00583  9000-EXTRACT-END.                                                DCRPT100
00584      PERFORM 7000-OUTPUT-REQ THRU 7099-OUTPUT-REQ-XIT.            DCRPT100
00585 *                                                                 DCRPT100
00586 *    OUTPUT TOTALS FOR THIS RUN                                   DCRPT100
00587 *                                                                 DCRPT100
00588      MOVE NUMBER-REQ TO EXTRPT-TOTREQS.                           DCRPT100
00589      MOVE EXTRPT-TOTREQS-LINE TO STD-REPORT-REC.                  DCRPT100
00590      MOVE 99 TO LINE-CT.                                             CL**2
00591      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00592      MOVE RUN-TOTAL TO EXTRPT-TOTRECS.                            DCRPT100
00593      MOVE EXTRPT-TOTRECS-LINE TO STD-REPORT-REC.                  DCRPT100
00594      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00595      MOVE 99 TO LINE-CT.                                             CL**2
00596      MOVE EXTRPT-EOR-LINE TO STD-REPORT-REC.                      DCRPT100
00597      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCRPT100
00598      IF RTBL-OPT-BOTMSG EQUAL "N"                                    CL**2
00599          MOVE SPACES TO EOP-MSG.                                     CL**2
00600      PERFORM EOP-RT THRU EOP-RT-XIT.                                 CL**2
00601 *                                                                 DCRPT100
00602 *    CLOSE FILES                                                  DCRPT100
00603 *                                                                 DCRPT100
00605      CLOSE REPORT-REQUESTS.                                       DCRPT100
00606      CLOSE SYSPRINT.                                              DCRPT100
00607      CLOSE EXTRACT-FILE.                                          DCRPT100
           EXIT PROGRAM.
*CALL     DISPLAYLN                                                     DCRPT100
*CALL     WRITELN                                                          CL**2
