*DECK     DCRPT140
00001  IDENTIFICATION DIVISION.                                         09/06/78
       PROGRAM-ID.   RPT140.
*CALL COPYRIGHT 
      *    THIS MODULE EXTRACTS RECORDS FOR INPUT TO THE USAGE REPORT. THE
      *    INPUT REPORT REQUEST PASSED IN LINKAGE DEFINES THE TYPE OF 
      *    DATA SELECTION TO BE PERFORMED. THE USER MAY REQUEST THAT USAGE
      *    BE RETRIEVED FOR ALL ENTITIES OF A GIVEN TYPE (ELE, REC, ETC) OR 
      *    IT MAY SPECIFY THAT USAGE IS TO BE EXTRACTED FOR A GIVEN ENTITY. 
      *    USAGE DATA IS SUBJECT TO CRITERIA SPECIFIED IN THE SELECTION 
      *    STATEMENTS OF THE REPORT REQUEST.  THE FOLLOWING TYPES OF
      *    SELECTION COMMANDS CAN BE PROCESSED -
      *        ID  DESCRIPTION
      *        50  ENTITY TYPE
      *        55  ENTITY TYPE WITH...
      *        56  ENTITY TYPE HAVING...
      *        80  ENTITY TYPE RANGE
      *        8   ENTITY TYPE RANGE WITH...
      *        86  ENTITY TYPE RANGE HAVING...
      *        90  NAME/VALUE RANGE 
      *        95  NAME/VALUE RANGE WITH... 
      *        96  NAME/VALUE RANGE HAVING... 
00028  ENVIRONMENT DIVISION.                                            DCRPT140
00029  CONFIGURATION SECTION.                                           DCRPT140
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00032  INPUT-OUTPUT SECTION.                                            DCRPT140
00033  FILE-CONTROL.                                                    DCRPT140
*CALL     SELECTS                                                       DCRPT140
           SELECT RELATIONAL-WORK-FILE ASSIGN TO TEMP11.
00036  DATA DIVISION.                                                      CL**2
00037  FILE SECTION.                                                       CL**2
*CALL     MAST1FD                                                       DCRPT140
*CALL     MAST2FD                                                       DCRPT140
*CALL     MAST3FD                                                       DCRPT140
*CALL     RELWKFD                                                          CL**2
*CALL RETSCS
*CALL     WRKSTG77                                                      DCRPT140
00043  77  OPEN-DATA                   PICTURE X.                       DCRPT140
*CALL     MAST1WS                                                       DCRPT140
*CALL     TESTWACOM                                                     DCRPT140
*CALL     WRKSTG01                                                      DCRPT140
*CALL     MAST3DD1                                                      DCRPT140
*CALL     CONWORK                                                       DCRPT140
*CALL     RELSAVE                                                       DCRPT140
*CALL     WITHHIT4                                                         CL**2
*CALL     EXTWORK4                                                         CL**2
*CALL     MULTSTORE                                                        CL**2
00057                                                                    DCRPT14
00058  PROCEDURE DIVISION.                                              DCRPT140
00062 ******************************************************************DCRPT140
00063 ******************************************************************DCRPT140
00064 *                                                                 DCRPT140
00065 *    PROCESS RETURNS FROM EXTRACT CONTROL                         DCRPT140
00066 *                                                                 DCRPT140
00067 ******************************************************************DCRPT140
00068 ******************************************************************DCRPT140
00069  0000-BEGIN.                                                      DCRPT140
00070      IF RTBL-MOD-REQ NOT EQUAL TO ZERO                            DCRPT140
00071          GO TO EXT-OUT-RETURN.                                       CL**2
00072 ******************************************************************DCRPT140
00073 ******************************************************************DCRPT140
00074 *                                                                 DCRPT140
00075 *    INITIALIZATION                                               DCRPT140
00076 *        THIS PROCESSING IS PERFORMED THE 1ST TIME THAT RHE       DCRPT140
00077 *        MODULE IS CALLED FOR A REPORT REQUEST                    DCRPT140
00078 *                                                                 DCRPT140
00079 ******************************************************************DCRPT140
00080 ******************************************************************DCRPT140
00081      MOVE SPACES TO DATA-ARG-LIST.                                DCRPT140
00082      MOVE SPACES TO DATA-LAST-ENTRY-NAME.                         DCRPT140
00083      MOVE SPACES TO REL-ARG-LIST.                                 DCRPT140
00084      MOVE SPACES TO CON-ARG-LIST.                                 DCRPT140
00085      MOVE SPACES TO WORK-HEADER.                                  DCRPT140
00086      MOVE "Y" TO OPEN-DATA.                                       DCRPT140
00087      MOVE "Y" TO EXTRACT-SW.                                      DCRPT140
00088      MOVE "Y" TO 1ST-CHGQRY-SW.                                      CL**2
00089      MOVE "Y" TO REL-1ST-SW.                                         CL**2
           MOVE "Y" TO 1ST-RECORD-SW. 
00090      MOVE ZEROES TO EXTRACT-RETNO.                                   CL**2
00091      MOVE ZEROES TO EXT-COUNT.                                       CL**2
00092      MOVE "N" TO MSG-SWITCH.                                         CL**2
00093      MOVE 1 TO RTBL-SUB.                                             CL**2
00094 *                                                                 DCRPT140
00095 *    OPEN FILES AFTER GETTING PRIME NUMBERS FROM MAST3            DCRPT140
00096 *                                                                 DCRPT140
00097      OPEN INPUT MAST1.                                            DCRPT140
00098      PERFORM REL-OPEN THRU REL-OPEN-XIT.                          DCRPT140
00099      PERFORM CON-OPEN THRU CON-OPEN-XIT.                          DCRPT140
           MOVE "3" TO CON-ENTRY-FUNCTION.
00101      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT140
           MOVE "1" TO SUB1.
           PERFORM CHECK-MULT-STC THRU CHECK-MULT-STC-XIT.
00104      IF RTBL-HDR-REQTYPE EQUAL "RC" OR "RH" OR "RJ"                  CL**2
00105          PERFORM BUILD-LOC-TABLE THRU BUILD-LOC-TABLE-XIT.           CL**2
00106 *                                                                 DCRPT140
00107 *    DETERMINE REPORT REQUEST TYPE                                DCRPT140
00108 *        -USER CAN REQUEST THAT USAGE BE PRODUCED FOR ENTITIES    DCRPT140
00109 *         OF A GIVEN TYPE-GLOBAL REQUEST                          DCRPT140
00110 *        -USER CAN REQUEST THAT USAGE BE PRODUCED ONLY FOR        DCRPT140
00111 *         A SPECIFIED ENTRY                                       DCRPT140
00112 *                                                                 DCRPT140
00113 *                                                                 DCRPT140
00114      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                      CL**2
00115          MOVE RTBL-HDR-STARTCNAME TO EXTRACT-CNAME                   CL**2
00116          MOVE RTBL-HDR-ENTTYPE TO EXTRACT-ENTTYPE                 DCRPT140
00117      GO TO 2000-RETRIEVE-USAGE.                                      CL**2
00118                                                                    DCRPT14
00119 ******************************************************************DCRPT140
00120 ******************************************************************DCRPT140
00121 *                                                                 DCRPT140
00122 *    GLOBAL REQUEST PROCESSING                                    DCRPT140
00123 *        READS RELATIONAL FILE DC2-ALL-NAMES-RECORD               DCRPT140
00124 *        AND RETRIEVES ITS POINTERS FROM LEFT TO RIGHT            DCRPT140
00125 *        WHEN A POINTER (ENTRY) IS FOUND OF THE REQUESTED         DCRPT140
00126 *        TYPE THEN ITS USAGE IS EXTRACTED.  THEN THE NEXT         DCRPT140
00127 *        POINTER IS PROCESSED.                                    DCRPT140
00128 *                                                                 DCRPT140
00129 ******************************************************************DCRPT140
00130 ******************************************************************DCRPT140
00131  1000-GLOBAL-EXTRACT.                                             DCRPT140
00132      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                    DCRPT140
00133      GO TO 1110-NAME-READ.                                        DCRPT140
00134 *                                                                 DCRPT140
00135 *    REPOSITION TO LAST RETRIEVED DC2-ALL-NAMES POINTER           DCRPT140
00136 *                                                                 DCRPT140
00137  1100-GET-ENTITY-NAME.                                            DCRPT140
00138      MOVE ENTRY-NAME-SAVE TO REL-ENTRY-NAME.                      DCRPT140
00139      MOVE POINTER-NAME-SAVE TO REL-POINTER-NAME.                  DCRPT140
00140      MOVE NEXT-REC-SAVE TO REL-NEXT-REC.                          DCRPT140
00141      PERFORM RETURN-POINTER THRU RETURN-POINTER-XIT.              DCRPT140
00142      IF REL-RETURN-CODE NOT EQUAL TO ZERO                         DCRPT140
00143          MOVE "RR" TO REPORT-ERROR-CODE                           DCRPT140
00144          MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME                 DCRPT140
00145          GO TO 8000-ABORT.                                        DCRPT140
00146 *                                                                 DCRPT140
00147 *    RETRIEVE NEXT NAME POINTER FROM DC2-ALL-NAMES-RECORD         DCRPT140
00148 *                                                                 DCRPT140
00149  1110-NAME-READ.                                                  DCRPT140
00150      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT140
00151      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT140
00152      IF REL-RETURN-CODE EQUAL TO ZERO                             DCRPT140
00153          GO TO 1115-MOVE-NAME-PTR.                                DCRPT140
00154      IF REL-RETURN-CODE EQUAL TO "1"                              DCRPT140
00155          GO TO 9000-EXTRACT-END.                                  DCRPT140
00156      MOVE "RR" TO REPORT-ERROR-CODE.                              DCRPT140
00157      MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME.                    DCRPT140
00158      GO TO 8000-ABORT.                                            DCRPT140
00159 *                                                                 DCRPT140
00160 *    DETERMINE IF POINTER IS THE TYPE DESIRED                     DCRPT140
00161 *                                                                 DCRPT140
00162  1115-MOVE-NAME-PTR.                                              DCRPT140
00163      MOVE REL-ENTRY-NAME TO ENTRY-NAME-SAVE.                      DCRPT140
00164      MOVE REL-POINTER-NAME TO POINTER-NAME-SAVE.                  DCRPT140
00165      MOVE REL-NEXT-REC TO NEXT-REC-SAVE.                          DCRPT140
00166      MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2.                       DCRPT140
00167      MOVE RTBL-HDR-ENTTYPE TO ENTRY-TYPE-1.                       DCRPT140
00168      PERFORM MATCH-ENTRY-TYPE THRU MATCH-ENTRY-TYPE-XIT.          DCRPT140
00169      IF ENTRY-TYPE-MATCH EQUAL TO "N"                             DCRPT140
00170          GO TO 1110-NAME-READ.                                    DCRPT140
00171 *                                                                 DCRPT140
00172 *    ENTRY IS THE DESIRED TYPE                                    DCRPT140
00173 *                                                                 DCRPT140
00174      MOVE REL-POINTER-NAME TO EXTRACT-CNAME.                      DCRPT140
00175      MOVE REL-POINTER-TYPE TO EXTRACT-ENTTYPE.                    DCRPT140
00176                                                                    DCRPT14
00177 ******************************************************************DCRPT140
00178 ******************************************************************DCRPT140
00179 *                                                                 DCRPT140
00180 *    RETRIEVE USAGE FOR NAMED ENTRY                               DCRPT140
00181 *        THIS PROCESSING IS COMMON TO ALL USAGE                   DCRPT140
00182 *        EXTRACTION REQUEST                                       DCRPT140
00183 *                                                                 DCRPT140
00184 ******************************************************************DCRPT140
00185 ******************************************************************DCRPT140
00186  2000-RETRIEVE-USAGE.                                             DCRPT140
00187      MOVE EXTRACT-CNAME TO REL-ENTRY-NAME.                        DCRPT140
00188      MOVE 99 TO EXTRACT-RETLEV.                                      CL**2
00189      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00190      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT140
00191  2050-NEXT-PTR.                                                      CL**2
00192      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT140
00193      IF REL-RETURN-CODE EQUAL TO ZERO                             DCRPT140
00194          GO TO 2100-PROCESS-USAGE.                                DCRPT140
00195      IF REL-RETURN-CODE NOT EQUAL TO "1"                          DCRPT140
00196          MOVE "RR" TO REPORT-ERROR-CODE                           DCRPT140
00197          MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME                 DCRPT140
00198          GO TO 8000-ABORT.                                        DCRPT140
00199 *                                                                 DCRPT140
00200 *    ENTRY HAS NO USAGE-CHECK GLOBAL EXTRACT                      DCRPT140
00201 *                                                                 DCRPT140
00202      IF RTBL-HDR-STARTCNAME EQUAL TO SPACES                          CL**2
00203          GO TO 1100-GET-ENTITY-NAME.                              DCRPT140
00204      GO TO 9000-EXTRACT-END.                                      DCRPT140
00205 ******************************************************************DCRPT140
00206 *                                                                 DCRPT140
00207 *    PROCESS USAGE FOR QUALIFICATION                              DCRPT140
00208 *                                                                 DCRPT140
00209 ******************************************************************DCRPT140
00210  2100-PROCESS-USAGE.                                              DCRPT140
00211      IF REL-POINTER-ALIAS EQUAL "1" OR "2"                           CL**2
00212          GO TO 2050-NEXT-PTR.                                        CL**2
00213      MOVE SPACES TO HOLD-KEY-AREA.                                DCRPT140
00214      MOVE ZERO TO KEY-CNT.                                        DCRPT140
00215 *                                                                 DCRPT140
00216 *    PROCESS EACH ENTRY AGAINST SELECTION STATEMENTS IF ANY       DCRPT140
00217 *                                                                 DCRPT140
00218  3000-FIRST-SELECT.                                                  CL**2
00219      MOVE 1 TO RTBL-SUB.                                             CL**2
00220      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO SPACES                   CL**2
00221          MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2                       CL**2
00222          GO TO 3900-EXTRACT-ENTRY.                                DCRPT140
00223  3100-NEXT-SELECT.                                                   CL**2
00224      IF RTBL-QRYTYPE-2 (RTBL-SUB) EQUAL TO "8"                    DCRPT140
00225          GO TO 3200-TYPE-RANGE.                                   DCRPT140
00226      IF RTBL-QRYTYPE-2 (RTBL-SUB)  EQUAL TO "9"                   DCRPT140
00227          GO TO 3300-NAME-RANGE.                                   DCRPT140
00228 *                                                                 DCRPT140
00229 *    PROCESS SELECT ENTITY (ELE,GRO,ETC) STATEMENT                DCRPT140
00230 *                                                                 DCRPT140
00231  3100-ENTITY-SELECT.                                              DCRPT140
00232      MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2.                       DCRPT140
00233      IF RTBL-QRYTYPE-2 (RTBL-SUB) EQUAL TO "7"                       CL**2
00234          MOVE RTBL-SEL2-TOTYPE (RTBL-SUB) TO ENTRY-TYPE-1            CL**2
00235      ELSE                                                            CL**2
00236          MOVE RTBL-SEL1-ENTTYPE (RTBL-SUB) TO ENTRY-TYPE-1.          CL**2
00237      PERFORM MATCH-ENTRY-TYPE THRU MATCH-ENTRY-TYPE-XIT.          DCRPT140
00238      MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2.                       DCRPT140
00239      IF ENTRY-TYPE-MATCH EQUAL "N"                                DCRPT140
00240          GO TO 3800-NEXT-RTBL.                                    DCRPT140
00241      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO "50" OR "70"             CL**2
00242          GO TO 3900-EXTRACT-ENTRY.                                DCRPT140
00243      GO TO 3600-CHECK-CONDITION.                                  DCRPT140
00244 *                                                                 DCRPT140
00245 *    PROCESS SELECT ENTITY RANGE (ELE TO GRO, ETC) STATEMENT      DCRPT140
00246 *                                                                 DCRPT140
00247  3200-TYPE-RANGE.                                                 DCRPT140
00248      IF REL-POINTER-TYPE LESS THAN RTBL-SEL1-ENTTYPE (RTBL-SUB)   DCRPT140
00249          GO TO 3800-NEXT-RTBL.                                    DCRPT140
00250      IF REL-POINTER-TYPE GREATER THAN                             DCRPT140
00251          RTBL-SEL2-TOTYPE (RTBL-SUB)                              DCRPT140
00252              GO TO 3800-NEXT-RTBL.                                DCRPT140
00253      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO "80"                  DCRPT140
00254          MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2                       CL**2
00255          GO TO 3900-EXTRACT-ENTRY.                                DCRPT140
00256      GO TO 3600-CHECK-CONDITION.                                  DCRPT140
00257 *                                                                 DCRPT140
00258 *    PROCESS SELECT ENTRY RANGE (FROM DCNAME1 TO DCNAME2)         DCRPT140
00259 *                                                                 DCRPT140
00260  3300-NAME-RANGE.                                                 DCRPT140
00261      IF REL-POINTER-NAME LESS THAN RTBL-OPT-CNAME (RTBL-SUB)      DCRPT140
00262          GO TO 3800-NEXT-RTBL.                                       CL**2
00263      IF REL-POINTER-NAME GREATER THAN RTBL-SEL2-TOCNAME (RTBL-SUB)DCRPT140
00264          GO TO 3800-NEXT-RTBL.                                    DCRPT140
00265      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO "90"                  DCRPT140
00266          MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2                       CL**2
00267          GO TO 3900-EXTRACT-ENTRY.                                DCRPT140
00268 *                                                                 DCRPT140
00269 *    PROCESS SELECT CONDITION CLAUSES-WITH...HAVING...            DCRPT140
00270 *                                                                 DCRPT140
00271  3600-CHECK-CONDITION.                                            DCRPT140
00272      MOVE SPACES TO QTBL-HDR-ENT.                                 DCRPT140
00273      MOVE RTBL-SELECT1-ENT (RTBL-SUB) TO QTBL-SELECT1-ENT.        DCRPT140
00274      MOVE RTBL-SEL1-QRYTYPE (RTBL-SUB) TO QTBL-OPT-QRYTYPE.          CL**2
00275      MOVE REL-POINTER-NAME TO QUERY-NAME.                            CL**2
00276      PERFORM QRY-WITH THRU QRY-HAVE-XIT.                             CL**2
00277      IF HIT-SW EQUAL TO "N"                                       DCRPT140
00278          GO TO 3800-NEXT-RTBL.                                    DCRPT140
00279      MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2.                          CL**2
00280      GO TO 3900-EXTRACT-ENTRY.                                    DCRPT140
00281 *                                                                 DCRPT140
00282 *    ENTRY DOES NOT QUALIFY                                       DCRPT140
00283 *        INCREMENT TO NEXT SELECT STATEMENT-CK FOR LAST           DCRPT140
00284 *                                                                 DCRPT140
00285  3800-NEXT-RTBL.                                                  DCRPT140
00286      IF RTBL-SUB EQUAL 9                                          DCRPT140
00287          GO TO 4000-UP-A-LEVEL.                                   DCRPT140
00288      ADD 1 TO RTBL-SUB.                                              CL**2
00289      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL SPACES                   DCRPT140
00290          GO TO 4000-UP-A-LEVEL.                                   DCRPT140
00291      GO TO 3100-NEXT-SELECT.                                         CL**2
00292 *                                                                 DCRPT140
00293 *    ENTRY QUALIFIES                                              DCRPT140
00294 *                                                                 DCRPT140
00295  3900-EXTRACT-ENTRY.                                              DCRPT140
00296      MOVE ENTRY-TYPE-2 TO EXTRACT-ENTTYPE.                           CL**2
00297      MOVE REL-POINTER-NAME TO EXTRACT-CNAME.                         CL**2
00298      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00299      MOVE "N" TO HIT-SW.                                          DCRPT140
00300 ******************************************************************DCRPT140
00301 ******************************************************************DCRPT140
00302 *                                                                 DCRPT140
00303 *    RETRIEVE USAGE POINTERS OF CURRENT USAGE POINTER             DCRPT140
00304 *                                                                 DCRPT140
00305 ******************************************************************DCRPT140
00306 ******************************************************************DCRPT140
00307  4000-UP-A-LEVEL.                                                 DCRPT140
00308 *                                                                    CL**2
00309 *    TEST STOP ENTRY OPTION                                          CL**2
00310 *                                                                    CL**2
00311      IF RTBL-OPT-STOPNAME EQUAL TO SPACES                            CL**2
00312          GO TO 4010-NON-STOP.                                        CL**2
00313      IF RTBL-OPT-STOPNAME NOT EQUAL TO REL-POINTER-NAME              CL**2
00314          GO TO 4010-NON-STOP.                                        CL**2
00315      IF RTBL-HDR-STARTCNAME EQUAL TO SPACES                          CL**2
00316          GO TO 1100-GET-ENTITY-NAME                                  CL**2
00317      ELSE                                                            CL**2
00318          GO TO 9000-EXTRACT-END.                                     CL**2
00319       GO TO 9000-EXTRACT-END.                                        CL**2
00320  4010-NON-STOP.                                                      CL**2
00321      IF ENTRY-TYPE-2 EQUAL TO "65"                                DCRPT140
00322          GO TO 6000-READ-NEXT-PTR.                                DCRPT140
00323      IF REL-PUSE EQUAL "Y"                                           CL**2
00324          GO TO 6000-READ-NEXT-PTR.                                   CL**2
00325      ADD 1 TO KEY-CNT.                                               CL**2
00326      IF KEY-CNT GREATER THAN 30                                      CL**2
00327          SUBTRACT 1 FROM KEY-CNT                                     CL**2
00328          GO TO 6000-READ-NEXT-PTR.                                   CL**2
00329 *                                                                 DCRPT140
00330 *    SAVE LOCATION OF CURRENT POINTER                             DCRPT140
00331 *                                                                 DCRPT140
00332      MOVE REL-ENTRY-NAME TO KEY-ENTRY-NAME (KEY-CNT).             DCRPT140
00333      MOVE REL-POINTER-NAME TO KEY-POINTER-NAME (KEY-CNT).         DCRPT140
00334      MOVE REL-NEXT-REC TO KEY-NEXT-REC (KEY-CNT).                 DCRPT140
00335 *                                                                 DCRPT140
00336 *    RETRIEVE USAGE                                               DCRPT140
00337 *                                                                 DCRPT140
00338      MOVE REL-POINTER-NAME TO REL-ENTRY-NAME.                     DCRPT140
00339      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT140
00340      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT140
00341      IF REL-RETURN-CODE EQUAL TO ZERO                             DCRPT140
00342          GO TO 3000-FIRST-SELECT.                                    CL**2
00343      IF REL-RETURN-CODE EQUAL TO "1"                              DCRPT140
00344          GO TO 5000-RETURN-A-LEVEL.                               DCRPT140
00345      MOVE "RR" TO REPORT-ERROR-CODE.                              DCRPT140
00346      MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME.                    DCRPT140
00347      GO TO 8000-ABORT.                                            DCRPT140
00348 ******************************************************************DCRPT140
00349 ******************************************************************DCRPT140
00350 *                                                                 DCRPT140
00351 *    GO DOWN TO PREVIOUSLY PROCESSED REL FILE ENTRY               DCRPT140
00352 *                                                                 DCRPT140
00353 ******************************************************************DCRPT140
00354 ******************************************************************DCRPT140
00355  5000-RETURN-A-LEVEL.                                             DCRPT140
00356      IF KEY-CNT NOT LESS THAN 1                                   DCRPT140
00357          GO TO 5100-RESTORE-KEY.                                  DCRPT140
00358      IF RTBL-HDR-STARTCNAME EQUAL TO SPACES                          CL**2
00359          GO TO 1100-GET-ENTITY-NAME                                  CL**2
00360      ELSE                                                         DCRPT140
00361          GO TO 9000-EXTRACT-END.                                  DCRPT140
00362  5100-RESTORE-KEY.                                                DCRPT140
00363      MOVE KEY-ENTRY-NAME (KEY-CNT) TO REL-ENTRY-NAME.             DCRPT140
00364      MOVE KEY-POINTER-NAME (KEY-CNT) TO REL-POINTER-NAME.         DCRPT140
00365      MOVE KEY-NEXT-REC (KEY-CNT) TO REL-NEXT-REC.                 DCRPT140
00366      SUBTRACT 1 FROM KEY-CNT.                                     DCRPT140
00367      PERFORM RETURN-POINTER THRU RETURN-POINTER-XIT.              DCRPT140
00368      IF REL-RETURN-CODE NOT EQUAL TO ZERO                         DCRPT140
00369          MOVE "RR" TO REPORT-ERROR-CODE                           DCRPT140
00370          MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME                 DCRPT140
00371          GO TO 8000-ABORT.                                        DCRPT140
00372 ******************************************************************DCRPT140
00373 ******************************************************************DCRPT140
00374 *                                                                 DCRPT140
00375 *    READ POINTER FROM LOWER LEVEL                                DCRPT140
00376 *                                                                 DCRPT140
00377 ******************************************************************DCRPT140
00378 ******************************************************************DCRPT140
00379  6000-READ-NEXT-PTR.                                              DCRPT140
00380      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT140
00381      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT140
00382      IF REL-RETURN-CODE EQUAL TO "1" OR "2"                       DCRPT140
00383          GO TO 5000-RETURN-A-LEVEL.                               DCRPT140
00384      GO TO 3000-FIRST-SELECT.                                        CL**2
00385 ******************************************************************DCRPT140
00386 *                                                                 DCRPT140
00387 *    UNUSUAL END TO MODULE PROCESSING                             DCRPT140
00388 *                                                                 DCRPT140
00389 ******************************************************************DCRPT140
00390  PROGRAM-END-BAD.                                                    CL**2
00391  8000-ABORT.                                                      DCRPT140
00392      MOVE SPACES TO ERROR-LINE.                                      CL**2
00393      IF REPORT-ERROR-CODE EQUAL "DR"                                 CL**2
00394          MOVE "MAST1 READ ERROR" TO ERROR-TYPE                       CL**2
00395      ELSE                                                            CL**2
00396      MOVE "MAST2 READ ERROR" TO ERROR-TYPE.                          CL**2
00397      MOVE REPORT-ERROR-NAME TO ERROR-NAME.                           CL**2
00398      MOVE "Y" TO MSG-SWITCH.                                         CL**2
00399      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00400      MOVE "8" TO RTBL-MOD-REQ.                                       CL**2
00401      GO TO 9010-ERROR-END.                                           CL**2
00402 ******************************************************************DCRPT140
00403 *                                                                 DCRPT140
00404 *    END OF MODULE PROCESSING                                     DCRPT140
00405 *                                                                 DCRPT140
00406 ******************************************************************DCRPT140
00407  9000-EXTRACT-END.                                                DCRPT140
00408      MOVE "9" TO RTBL-MOD-REQ.                                       CL**2
00409  9010-ERROR-END.                                                     CL**2
00410      PERFORM REL-CLOSE THRU REL-CLOSE-XIT.                        DCRPT140
00411      PERFORM CON-CLOSE THRU CON-CLOSE-XIT.                        DCRPT140
00412      IF OPEN-DATA EQUAL TO "Y"                                    DCRPT140
00413          CLOSE MAST1.                                             DCRPT140
00414      IF REL-1ST-SW EQUAL "N"                                         CL**2
00415          CLOSE RELATIONAL-WORK-FILE.                                 CL**2
           EXIT PROGRAM.
00417 ******************************************************************DCRPT140
00418 *                                                                 DCRPT140
00419 *    S U B R O U T I N E S                                        DCRPT140
00420 *                                                                 DCRPT140
00421 ******************************************************************DCRPT140
*CALL MULTLINE
*CALL     MATCHENT                                                      DCRPT140
*CALL     FLDFIND                                                          CL**2
*CALL     QRYWITH4                                                         CL**2
*CALL     EXTOUT4                                                          CL**2
*CALL     MAST1RFL                                                      DCRPT140
*CALL     MAST1RNL                                                      DCRPT140
*CALL     MAST1RFC                                                      DCRPT140
*CALL     MAST1EXT                                                      DCRPT140
*CALL     MAST1READ                                                     DCRPT140
*CALL     MAST1ALG                                                      DCRPT140
*CALL     MAST3INT                                                         CL**2
*CALL     MAST3IO1                                                      DCRPT140
*CALL     RELCOM                                                        DCRPT140
*CALL     MAST2RK                                                       DCRPT140
*CALL     RELALG                                                        DCRPT140
