*DECK     DCRPT120
00001  IDENTIFICATION DIVISION.                                         09/06/78
       PROGRAM-ID.   RPT120.
*CALL COPYRIGHT 
      *    THIS MODULE EXTRACTS RECORDS FOR INPUT TO THE CATALOGUE REPORT.
      *    THE INPUT REPORT REQUEST PASSED IN LINKAGE DEFINES THE TYPE
      *    OF DATA SELECTION TO BE PERFORMED. THE USER MAY REQUEST THE
      *    FOLLOWING TYPE OF SELECTION COMMANDS - 
      *        ID  DESCRIPTION
      *        04  SHOW A NAMED ENTRY 
      *        10  ALIASES OF A NAMED ENTRY 
      *        15  ALIASES OF A NAMED ENTRY WITH... 
      *        16  ALIASES OF A NAMED ENTRY HAVING... 
      *        20  VERSIONS OF A NAMED ENTRY
      *        25  VERSIONS OF A NAMED ENTRY WITH...
      *        26  VERSIONS OF A NAMED ENTRY HAVING...
      *        30  ENTITY TYPE
      *        35  ENTITY TYPE WITH...
      *        36  ENTITY TYPE HAVING...
      *        80  ENTITY TYPE RANGE
      *        85  ENTITY TYPE RANGE WITH...
      *        86  ENTITY TYPE RANGE HAVING...
      *        90  ENTRY NAME RANGE 
      *        95  ENTRY NAME RANGE WITH... 
      *        96  ENTRY NAME RANGE HAVING
00030  ENVIRONMENT DIVISION.                                            DCRPT120
00031  CONFIGURATION SECTION.                                           DCRPT120
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00034  INPUT-OUTPUT SECTION.                                            DCRPT120
00035  FILE-CONTROL.                                                    DCRPT120
*CALL     SELECTS                                                       DCRPT120
           SELECT RELATIONAL-WORK-FILE ASSIGN TO TEMP11.
00038  DATA DIVISION.                                                      CL**2
00039  FILE SECTION.                                                       CL**2
*CALL     MAST1FD                                                       DCRPT120
*CALL     MAST2FD                                                       DCRPT120
*CALL     MAST3FD                                                       DCRPT120
*CALL     RELWKFD                                                          CL**2
*CALL RETSCS
*CALL     WRKSTG77                                                      DCRPT120
00045  77  OPEN-DATA                   PICTURE X.                       DCRPT120
00046  01  REF-HOLD.                                                       CL**2
00047      03  REF-HOLD-FST3 PICTURE XXX.                                  CL**2
00048      03  FILLER        PICTURE X(47).                                CL**2
*CALL     MAST1WS                                                       DCRPT120
*CALL     TESTWACOM                                                        CL**2
*CALL     WRKSTG01                                                      DCRPT120
*CALL     MAST3DD1                                                      DCRPT120
*CALL     CONWORK                                                       DCRPT120
*CALL     RELSAVE                                                       DCRPT120
*CALL     WITHHIT4                                                         CL**2
*CALL     EXTWORK4                                                         CL**2
*CALL     MULTSTORE                                                        CL**2
00062                                                                    DCRPT12
00063  PROCEDURE DIVISION.                                              DCRPT120
00067 ************************************************************      DCRPT120
00068 ************************************************************      DCRPT120
00069 *                                                                 DCRPT120
00070 *    PROCESSING RETURN HERE FROM EXTRACT CONTROL MODULE           DCRPT120
00071 *                                                                 DCRPT120
00072  0000-BEGIN.                                                      DCRPT120
00073      IF RTBL-MOD-REQ NOT EQUAL ZERO                               DCRPT120
00074          GO TO EXT-OUT-RETURN.                                       CL**2
00075 ***********************************************************       DCRPT120
00076 ***********************************************************       DCRPT120
00077 *                                                                 DCRPT120
00078 *    INITIALIZATION                                               DCRPT120
00079 *                                                                 DCRPT120
00080 ********************************************************          DCRPT120
00081 ********************************************************          DCRPT120
00082      MOVE SPACES TO DATA-ARG-LIST.                                DCRPT120
00083      MOVE SPACES TO DATA-LAST-ENTRY-NAME.                         DCRPT120
00084      MOVE SPACES TO REL-ARG-LIST.                                 DCRPT120
00085      MOVE SPACES TO CON-ARG-LIST.                                 DCRPT120
00086      MOVE SPACES TO WORK-HEADER.                                  DCRPT120
00087      MOVE ZEROES TO EXTRACT-RETNO.                                DCRPT120
00088      MOVE ZEROES TO EXTRACT-RETLEV.                               DCRPT120
00089      MOVE "Y" TO OPEN-DATA.                                       DCRPT120
00090      MOVE "Y" TO EXTRACT-SW.                                      DCRPT120
00091      MOVE "Y" TO 1ST-CHGQRY-SW.                                      CL**2
00092      MOVE "Y" TO REL-1ST-SW.                                         CL**2
           MOVE "Y" TO 1ST-RECORD-SW. 
00093      MOVE ZEROES TO EXTRACT-RETNO.                                   CL**2
00094      MOVE 1 TO RTBL-SUB.                                             CL**2
00095      MOVE ZEROES TO KEY-CNT.                                         CL**2
00096      MOVE ZEROES TO EXT-COUNT.                                       CL**2
00097      MOVE "N" TO MSG-SWITCH.                                         CL**2
00098 *                                                                 DCRPT120
00099 *    OPEN FILES AFTER GETTING PRIME NUMBERS FROM MAST3            DCRPT120
00100 *                                                                 DCRPT120
00101      PERFORM CON-OPEN THRU CON-OPEN-XIT.                             CL**2
00102      OPEN INPUT MAST1.                                            DCRPT120
00103      PERFORM REL-OPEN THRU REL-OPEN-XIT.                          DCRPT120
           MOVE "3" TO CON-ENTRY-FUNCTION.
           PERFORM CON-READ THRU CON-READ-XIT.
           MOVE 1 TO SUB1.
           PERFORM CHECK-MULT-STC THRU
                   CHECK-MULT-STC-XIT.
00108      IF RTBL-HDR-REQTYPE EQUAL "RC" OR "RH" OR "RJ"                  CL**2
00109          GO TO 0050-CHECK-CATNAME.                                   CL**2
00110      GO TO 0100-PART-1.                                              CL**2
00111  0050-CHECK-CATNAME.                                                 CL**2
00112      IF RTBL-HDR-IDXFNAME NOT EQUAL "CATNAME"                        CL**2
00113          PERFORM BUILD-LOC-TABLE THRU BUILD-LOC-TABLE-XIT.           CL**2
00114                                                                    DCRPT12
00115 ***************************************************************** DCRPT120
00116 ***************************************************************** DCRPT120
00117 *    PART 1.  PROCESS SELECTS FOR SHOW ENTRY AND ALIAS/VERSIONS   DCRPT120
00118 *            ALL  SELECTS ARE REVIEWED.  IF THE USER HAS          DCRPT120
00119 *            SPECIFIED THE TYPES LISTED BELOW THEN                DCRPT120
00120 *            THEY ARE PROCESSED HERE.                             DCRPT120
00121 *             ID     DESCRIPTION                                  DCRPT120
00122 *             04    SHOW NAMED ENTRY                              DCRPT120
00123 *             10     ALIAS                                        DCRPT120
00124 *             15    ALIAS WITH ....                               DCRPT120
00125 *             16    ALIAS HAVING ....                             DCRPT120
00126 *        20     VERSIONS OF A NAMED ENTRY                         DCRPT120
00127 *             25  VERSION WITH ....                               DCRPT120
00128 *             26    VERSION HAVING ....                           DCRPT120
00129 *                                                                 DCRPT120
00130 *****************************************************************    CL**2
00131 *****************************************************************    CL**2
00132  0100-PART-1.                                                     DCRPT120
00133      IF RTBL-QRYTYPE-23 (1) EQUAL TO SPACES                       DCRPT120
00134          GO TO 1000-PART-2.                                       DCRPT120
00135      MOVE 1 TO RTBL-SUB.                                          DCRPT120
00136 *                                                                 DCRPT120
00137 *    PROCESS SINGLE ENTRY SELECT                                  DCRPT120
00138 *                                                                 DCRPT120
00139  0200-CK-TYPE.                                                       CL**2
00140      IF  RTBL-QRYTYPE-23 (RTBL-SUB) NOT EQUAL TO "04"             DCRPT120
00141          GO TO 0500-TEST-ALIAS.                                   DCRPT120
00142      MOVE RTBL-OPT-CNAME (RTBL-SUB) TO EXTRACT-CNAME.                CL**2
00143      MOVE RTBL-OPT-ENTTYPE (RTBL-SUB) TO EXTRACT-ENTTYPE.         DCRPT120
00144      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00145      GO TO 0900-NEXT-RTBL.                                        DCRPT120
00146 *                                                                 DCRPT120
00147 *    PROCESS ALIAS/VERSION SELECT                                 DCRPT120
00148 *                                                                 DCRPT120
00149  0500-TEST-ALIAS.                                                 DCRPT120
00150      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO                       DCRPT120
00151              "10" OR "15" OR "20" OR "25" OR "26"                 DCRPT120
00152          GO TO 0520-EXT-ALIAS.                                    DCRPT120
00153      GO TO 0900-NEXT-RTBL.                                        DCRPT120
00154  0520-EXT-ALIAS.                                                  DCRPT120
00155      MOVE RTBL-OPT-CNAME (RTBL-SUB) TO REL-ENTRY-NAME.            DCRPT120
00156  0530-GET-ALIAS-PTR.                                              DCRPT120
00157      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT120
00158      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT120
00159      IF REL-RETURN-CODE EQUAL ZERO                                DCRPT120
00160          GO TO 0550-MOVE-ALIAS-PTR.                               DCRPT120
00161      IF REL-RETURN-CODE EQUAL TO "1"                              DCRPT120
00162          GO TO 0900-NEXT-RTBL.                                    DCRPT120
00163      MOVE "RR" TO REPORT-ERROR-CODE.                              DCRPT120
00164      MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME.                    DCRPT120
00165      GO TO 8000-ABORT.                                            DCRPT120
00166  0550-MOVE-ALIAS-PTR.                                             DCRPT120
00167      IF REL-POINTER-ALIAS EQUAL TO "1" OR "2"                     DCRPT120
00168          GO TO 0600-CHECK-CONDITION.                              DCRPT120
00169      GO TO 0530-GET-ALIAS-PTR.                                    DCRPT120
00170 *                                                                 DCRPT120
00171 *    PROCESS SELECT CONDITION CLAUSES -WITH AND HAVEING           DCRPT120
00172 *                                                                 DCRPT120
00173  0600-CHECK-CONDITION.                                               CL**2
00174      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO "10" OR "20"          DCRPT120
00175          GO TO 0700-ALIAS-HIT.                                    DCRPT120
00176      MOVE SPACES TO QTBL-HDR-ENT.                                 DCRPT120
00177      MOVE RTBL-SELECT1-ENT (RTBL-SUB) TO QTBL-SELECT1-ENT.        DCRPT120
00178      MOVE REL-POINTER-NAME TO QUERY-NAME.                            CL**2
00179      PERFORM QRY-WITH THRU QRY-HAVE-XIT.                             CL**2
00180      IF HIT-SW EQUAL TO "N"                                       DCRPT120
00181          GO TO 0530-GET-ALIAS-PTR.                                DCRPT120
00182 *                                                                 DCRPT120
00183 *    EXTRACT ALIAS/VERSION                                        DCRPT120
00184 *                                                                 DCRPT120
00185  0700-ALIAS-HIT.                                                  DCRPT120
00186      MOVE REL-POINTER-NAME TO EXTRACT-CNAME.                         CL**2
00187      MOVE REL-POINTER-TYPE TO EXTRACT-ENTTYPE.                    DCRPT120
00188      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00189      GO TO 0530-GET-ALIAS-PTR.                                    DCRPT120
00190 *                                                                 DCRPT120
00191 *    INCREMENT TO NEXT SELECT                                     DCRPT120
00192 *                                                                 DCRPT120
00193  0900-NEXT-RTBL.                                                  DCRPT120
00194      IF RTBL-SUB EQUAL 9                                          DCRPT120
00195          GO TO 0950-CHECK-EOJ.                                    DCRPT120
00196      ADD 1 TO RTBL-SUB.                                           DCRPT120
00197      IF RTBL-QRYTYPE-23 (RTBL-SUB) NOT EQUAL TO SPACES            DCRPT120
00198          GO TO 0200-CK-TYPE.                                         CL**2
00199 *                                                                 DCRPT120
00200 *    CHECK IF ONLY 04, 10, 15, 16, 20, 25, 26 SPECIFIED           DCRPT120
00201 *                                                                 DCRPT120
00202  0950-CHECK-EOJ.                                                  DCRPT120
00203      MOVE 1 TO RTBL-SUB.                                          DCRPT120
00204  0955-TEST-TYPE.                                                  DCRPT120
00205      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO SPACES                DCRPT120
00206          GO TO 9000-EXTRACT-END.                                  DCRPT120
00207      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO                       DCRPT120
00208         "04" OR "10" OR "15" OR "16" OR "20" OR "25" OR "26"      DCRPT120
00209          ADD 1 TO RTBL-SUB                                        DCRPT120
00210      ELSE                                                         DCRPT120
00211          GO TO 1000-PART-2.                                       DCRPT120
00212      IF RTBL-SUB GREATER THAN 9                                   DCRPT120
00213          GO TO 9000-EXTRACT-END.                                  DCRPT120
00214      GO TO 0955-TEST-TYPE.                                        DCRPT120
00215                                                                    DCRPT12
00216 **************************************************************    DCRPT120
00217 **************************************************************    DCRPT120
00218 *                                                                 DCRPT120
00219 *    PART 2.  PROCESS SELECTS FOR ENTITY TYPE AND RANGES          DCRPT120
00220 *         ALL DC2-ALL-NAMES-RECORD POINTERS ARE RETRIEVED         DCRPT120
00221 *        AND CHECKED FOR QUALIFICATION.  THE FOLLOWING            DCRPT120
00222 *        SELECTION TYPES ARE PROCESSED.                           DCRPT120
00223 *                                                                 DCRPT120
00224 *                                                                 DCRPT120
00225 *        ID   DESCRIPTION                                         DCRPT120
00226 *                                                                 DCRPT120
00227 *        30  ENTITY QUERY                                         DCRPT120
00228 *        35  ENTITY WITH .... QUERY                               DCRPT120
00229 *        36  ENTITY HAVING ..... SELECT                           DCRPT120
00230 *        80  ENTITY RANGE SELECT                                  DCRPT120
00231 *        85  ENTITY RANGE WITH .....SELECT                        DCRPT120
00232 *        86   ENTITY RANGE HAVING .....   SELECT                  DCRPT120
00233 *        90   ENTRY RANGE  SELECT                                 DCRPT120
00234 *        95    ENTRY RANGE WITN ......   SELECT                   DCRPT120
00235 *        96  ENTRY RANGE HAVING ..... SELECT                      DCRPT120
00236 *                                                                 DCRPT120
00237 ***********************************************************       DCRPT120
00238 ***********************************************************       DCRPT120
00239  1000-PART-2.                                                     DCRPT120
00240      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                    DCRPT120
00241  1010-NAME-READ.                                                  DCRPT120
00242      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT120
00243      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT120
00244      IF REL-RETURN-CODE EQUAL TO ZERO                             DCRPT120
00245          GO TO 2110-CHECK-ENTRY.                                  DCRPT120
00246      IF REL-RETURN-CODE EQUAL TO "1"                              DCRPT120
00247          GO TO 9000-EXTRACT-END.                                  DCRPT120
00248      MOVE "RR" TO REPORT-ERROR-CODE.                              DCRPT120
00249      MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME.                    DCRPT120
00250      GO TO 8000-ABORT.                                            DCRPT120
00251 *                                                                 DCRPT120
00252 *    PROCESS ENTRY AGAINST SELECTS (IF ANY)                       DCRPT120
00253  2110-CHECK-ENTRY.                                                DCRPT120
00254      MOVE 1 TO RTBL-SUB.                                             CL**2
00255      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO SPACES                   CL**2
00256          GO TO 3900-EXTRACT-ENTRY.                                DCRPT120
00257  3000-CHECK-SELECT.                                               DCRPT120
00258      IF RTBL-QRYTYPE-2 (RTBL-SUB) EQUAL "8"                       DCRPT120
00259          GO TO 3200-TYPE-RANGE.                                   DCRPT120
00260      IF RTBL-QRYTYPE-2 (RTBL-SUB) EQUAL "9"                       DCRPT120
00261          GO TO 3300-NAME-RANGE.                                   DCRPT120
00262      IF RTBL-QRYTYPE-2 (RTBL-SUB) EQUAL "3"                       DCRPT120
00263          GO TO 3100-ENTITY-SELECT.                                DCRPT120
00264      GO TO 3800-NEXT-RTBL.                                           CL**2
00265 *                                                                 DCRPT120
00266 *    PROCESS SELECT ENTITY (ELE, GRO, ECT) STATEMENT              DCRPT120
00267 *                                                                 DCRPT120
00268  3100-ENTITY-SELECT.                                              DCRPT120
00269      MOVE REL-POINTER-TYPE TO ENTRY-TYPE-1.                       DCRPT120
00270      MOVE RTBL-SEL1-ENTTYPE (RTBL-SUB) TO ENTRY-TYPE-2.           DCRPT120
00271      PERFORM MATCH-ENTRY-TYPE THRU MATCH-ENTRY-TYPE-XIT.          DCRPT120
00272      IF ENTRY-TYPE-MATCH EQUAL "N"                                DCRPT120
00273          GO TO 3800-NEXT-RTBL.                                    DCRPT120
00274      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL "30"                     DCRPT120
00275          GO TO 3900-EXTRACT-ENTRY.                                DCRPT120
00276      GO TO 3600-CHECK-CONDITION.                                  DCRPT120
00277 *                                                                 DCRPT120
00278 *    PROCESS SELECT ENTITY RANGE (ELE, TO GRO, ECT)               DCRPT120
00279 *                                                                 DCRPT120
00280  3200-TYPE-RANGE.                                                 DCRPT120
00281      IF REL-POINTER-TYPE LESS THAN RTBL-SEL1-ENTTYPE (RTBL-SUB)   DCRPT120
00282          GO TO 3800-NEXT-RTBL.                                    DCRPT120
00283      IF REL-POINTER-TYPE GREATER THAN RTBL-SEL2-TOTYPE (RTBL-SUB) DCRPT120
00284          GO TO 3800-NEXT-RTBL.                                    DCRPT120
00285      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL  TO "80"                 DCRPT120
00286          GO TO 3900-EXTRACT-ENTRY.                                DCRPT120
00287      GO TO 3600-CHECK-CONDITION.                                  DCRPT120
00288 *                                                                 DCRPT120
00289 *    PROCESS SELECT ENTRY RANGE (FROM DCNAME TO DCNAME)           DCRPT120
00290 *                                                                 DCRPT120
00291  3300-NAME-RANGE.                                                 DCRPT120
00292      IF REL-POINTER-NAME LESS THAN RTBL-OPT-CNAME (RTBL-SUB)      DCRPT120
00293          GO TO 3800-NEXT-RTBL.                                    DCRPT120
00294      IF REL-POINTER-NAME GREATER THAN RTBL-SEL2-TOCNAME (RTBL-SUB)DCRPT120
00295          GO TO 3800-NEXT-RTBL.                                    DCRPT120
00296      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL "90"                     DCRPT120
00297          GO TO 3900-EXTRACT-ENTRY.                                DCRPT120
00298 *                                                                 DCRPT120
00299 *    PROCESS SELECT CLAUSES- WITH AND HAVING                      DCRPT120
00300 *                                                                 DCRPT120
00301  3600-CHECK-CONDITION.                                            DCRPT120
00302      MOVE SPACES TO QTBL-HDR-ENT.                                    CL**2
00303      MOVE RTBL-SEL1-QRYTYPE (RTBL-SUB) TO QTBL-OPT-QRYTYPE.          CL**2
00304      MOVE RTBL-SELECT1-ENT (RTBL-SUB) TO QTBL-SELECT1-ENT.           CL**2
00305      IF RTBL-QRYTYPE-3 (RTBL-SUB) EQUAL "6" OR "8"                DCRPT120
00306          GO TO 3610-CHECK-REF.                                    DCRPT120
00307      GO TO 3620-CHECK-DATA.                                       DCRPT120
00308  3610-CHECK-REF.                                                  DCRPT120
00309      MOVE QTBL-SEL1-FLDVALUE (1) TO REF-HOLD.                        CL**2
00310      IF REF-HOLD-FST3 EQUAL "REF" OR "NOR"                           CL**2
00311          GO TO 3700-HAVE-REF.                                     DCRPT120
00312 *                                                                 DCRPT120
00313 *    CHECK DATA FILE FOR WITH ... HAVING ... CONDITION            DCRPT120
00314 *                                                                 DCRPT120
00315  3620-CHECK-DATA.                                                 DCRPT120
00316      MOVE REL-POINTER-NAME TO QUERY-NAME.                            CL**2
00317      PERFORM QRY-WITH THRU QRY-HAVE-XIT.                             CL**2
00318      IF HIT-SW EQUAL TO "N"                                       DCRPT120
00319          GO TO 3800-NEXT-RTBL.                                    DCRPT120
00320      GO TO 3900-EXTRACT-ENTRY.                                    DCRPT120
00321 *                                                                 DCRPT120
00322 *    CHECK HAVING REFERENCE/NO REFERENCE CLAUSE                   DCRPT120
00323 *        RETRIEVE RELATIONAL FILE ENTRY TO SEE IF IT IS           DCRPT120
00324 *        REFERENCED BY ANOTHER ENTRY-IF IT HAS POINTER            DCRPT120
00325 *        IT IS                                                    DCRPT120
00326 *                                                                 DCRPT120
00327  3700-HAVE-REF.                                                   DCRPT120
00328      MOVE REL-ENTRY-NAME TO ENTRY-NAME-SAVE.                      DCRPT120
00329      MOVE REL-POINTER-NAME TO POINTER-NAME-SAVE.                  DCRPT120
00330      MOVE REL-NEXT-REC TO NEXT-REC-SAVE.                             CL**2
00331      MOVE REL-POINTER-NAME TO REL-ENTRY-NAME.                     DCRPT120
00332      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT120
00333      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT120
00334      IF REL-RETURN-CODE EQUAL TO ZERO                             DCRPT120
00335          GO TO 3760-HAS-POINTER.                                  DCRPT120
00336      IF REL-RETURN-CODE EQUAL "1"                                 DCRPT120
00337          GO TO 3770-NO-POINTER.                                   DCRPT120
00338      MOVE "RR" TO REPORT-ERROR-CODE.                              DCRPT120
00339      MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME.                    DCRPT120
00340      GO TO 8000-ABORT.                                            DCRPT120
00341 *                                                                 DCRPT120
00342 *     DETERMINE IF ENTRY QUALIFIES                                DCRPT120
00343 *                                                                 DCRPT120
00344  3760-HAS-POINTER.                                                DCRPT120
00345      IF QTBL-SEL1-LOGIND (1) EQUAL TO "EQ"                           CL**2
00346          GO TO 3780-EXTRACT-ENTRY.                                DCRPT120
00347      GO TO 3790-NO-EXTRACT.                                       DCRPT120
00348  3770-NO-POINTER.                                                 DCRPT120
00349      IF QTBL-SEL1-LOGIND (1) EQUAL TO "NE"                           CL**2
00350          GO TO 3780-EXTRACT-ENTRY.                                DCRPT120
00351      GO TO 3790-NO-EXTRACT.                                          CL**2
00352  3780-EXTRACT-ENTRY.                                              DCRPT120
00353      MOVE REL-ENTRY-NAME TO EXTRACT-CNAME.                           CL**2
00354      MOVE REL-ENTRY-TYPE TO EXTRACT-ENTTYPE.                         CL**2
00355      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00356  3790-NO-EXTRACT.                                                 DCRPT120
00357 *                                                                 DCRPT120
00358 *    REPOSITION REL FILE TO ALL NAMES RECORD                      DCRPT120
00359 *                                                                 DCRPT120
00360      MOVE ENTRY-NAME-SAVE TO REL-ENTRY-NAME.                      DCRPT120
00361      MOVE POINTER-NAME-SAVE TO REL-POINTER-NAME.                  DCRPT120
00362      MOVE NEXT-REC-SAVE TO REL-NEXT-REC.                          DCRPT120
00363      PERFORM RETURN-POINTER THRU RETURN-POINTER-XIT.              DCRPT120
00364 *                                                                 DCRPT120
00365 *    INCREMENT TO NEXT SELECT STATEMENT                           DCRPT120
00366 *                                                                 DCRPT120
00367  3800-NEXT-RTBL.                                                  DCRPT120
00368      IF RTBL-SUB EQUAL TO 9                                       DCRPT120
00369          GO TO 1010-NAME-READ.                                    DCRPT120
00370      ADD 1 TO RTBL-SUB.                                           DCRPT120
00371      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL SPACES                   DCRPT120
00372          GO TO 1010-NAME-READ.                                    DCRPT120
00373      GO TO 3000-CHECK-SELECT.                                     DCRPT120
00374 *                                                                 DCRPT120
00375 *     ENTRY QUALIFIES                                             DCRPT120
00376 *                                                                 DCRPT120
00377  3900-EXTRACT-ENTRY.                                              DCRPT120
00378      ADD 1 TO EXTRACT-RETNO.                                         CL**2
00379      MOVE RTBL-SUB TO EXTRACT-SELNO.                                 CL**2
00380      MOVE REL-POINTER-NAME TO EXTRACT-CNAME.                         CL**2
00381      MOVE REL-POINTER-TYPE TO EXTRACT-ENTTYPE.                       CL**2
00382      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00383      GO TO 1010-NAME-READ.                                           CL**2
00384 *************************************************************     DCRPT120
00385 *************************************************************     DCRPT120
00386 *                                                                 DCRPT120
00387 *     UNUSUAL END OF MODULE PROCESSING                            DCRPT120
00388 *                                                                 DCRPT120
00389 *************************************************************     DCRPT120
00390 *************************************************************     DCRPT120
00391  PROGRAM-END-BAD.                                                    CL**2
00392  8000-ABORT.                                                      DCRPT120
00393      MOVE SPACES TO ERROR-LINE.                                      CL**2
00394      IF REPORT-ERROR-CODE EQUAL "DR"                                 CL**2
00395          MOVE "MAST1 READ ERROR" TO ERROR-TYPE                       CL**2
00396      ELSE                                                            CL**2
00397      MOVE "MAST2 READ ERROR" TO ERROR-TYPE.                          CL**2
00398      MOVE REPORT-ERROR-NAME TO ERROR-NAME.                           CL**2
00399      MOVE "Y" TO MSG-SWITCH.                                         CL**2
00400      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00401      MOVE "8" TO RTBL-MOD-REQ.                                       CL**2
00402      GO TO 9010-ERROR-END.                                           CL**2
00403 *************************************************************     DCRPT120
00404 *************************************************************     DCRPT120
00405 *                                                                 DCRPT120
00406 *    END OF MODULE PROCESSING                                     DCRPT120
00407 *                                                                 DCRPT120
00408 *****************************************************************    CL**2
00409 *****************************************************************    CL**2
00410  9000-EXTRACT-END.                                                DCRPT120
00411      MOVE "9" TO RTBL-MOD-REQ.                                       CL**2
00412  9010-ERROR-END.                                                     CL**2
00413      PERFORM REL-CLOSE THRU REL-CLOSE-XIT.                        DCRPT120
00414      PERFORM CON-CLOSE THRU CON-CLOSE-XIT.                        DCRPT120
00415      IF OPEN-DATA EQUAL "Y"                                       DCRPT120
00416          CLOSE MAST1.                                             DCRPT120
00417      IF REL-1ST-SW EQUAL "N"                                         CL**2
00418          CLOSE RELATIONAL-WORK-FILE.                                 CL**2
           EXIT PROGRAM.
*CALL MULTLINE
*CALL     MATCHENT                                                      DCRPT120
*CALL     FLDFIND                                                          CL**2
*CALL     QRYWITH4                                                         CL**2
*CALL     EXTOUT4                                                          CL**2
*CALL     MAST1RFL                                                      DCRPT120
*CALL     MAST1RNL                                                         CL**2
*CALL     MAST1RFC                                                      DCRPT120
*CALL     MAST1EXT                                                      DCRPT120
*CALL     MAST1READ                                                     DCRPT120
*CALL     MAST1ALG                                                      DCRPT120
*CALL     MAST1RK                                                       DCRPT120
*CALL     MAST3IO1                                                      DCRPT120
*CALL     RELCOM                                                        DCRPT120
*CALL     MAST2RK                                                       DCRPT120
*CALL     RELALG                                                        DCRPT120
*CALL     MAST3INT                                                         CL**2
