*DECK     DCRPT130
00001  IDENTIFICATION DIVISION.                                         09/06/78
       PROGRAM-ID.   RPT130.
*CALL COPYRIGHT 
      *    THIS MODULE EXTRACTS RECORDS FOR INPUT TO THE
      *    HIERARCHY REPORT.
      *    THE INPUT REPORT REQUEST PASSED IN LINKAGE DEFINES 
      *    THE TYPE OF DATA SELECTION TO BE PERFORMED. THE
      *    USER MAY REQUEST THAT COMPONENTS BE RETRIEVED FOR
      *    ALL ENTITIES OF A GIVEN TYPE (GROUP, REC, ETC) OR
      *    IT MAY SPECIFY THAT LOWER LEVEL COMPONENTS ARE TO BE 
      *    EXTRACTED FOR A GIVEN ENTITY. DATA FILE ENTRIES ARE
      *    SUBJECT TO CRITERIA TESTS SPECIFIED IN REPORT REQUEST
      *    SELECTION STATEMENTS.
      *    THE FOLLOWING TYPES OF SELECTION COMMANDS CAN BE PROCESSED 
      * 
      *        ID  DESCRIPTION
      *        40  ENTITY TYPE
      *        45  ENTITY TYPE WITH...
      *        46  ENTITY TYPE HAVING...
      *        80  ENTITY TYPE RANGE
      *        85  ENTITY TYPE RANGE WITH...
      *        86  ENTITY TYPE RANGE HAVING...
      *        90  NAME/VALUE RANGE 
      *        95  NAME/VALUE RANGE WITH... 
      *        96  NAME/VALUE RANGE HAVING... 
00031  ENVIRONMENT DIVISION.                                            DCRPT130
00032  CONFIGURATION SECTION.                                           DCRPT130
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00035  INPUT-OUTPUT SECTION.                                            DCRPT130
00036  FILE-CONTROL.                                                    DCRPT130
*CALL     SELECTS                                                       DCRPT130
           SELECT RELATIONAL-WORK-FILE ASSIGN TO TEMP11.
00039  DATA DIVISION.                                                      CL**2
00040  FILE SECTION.                                                       CL**2
*CALL     MAST1FD                                                       DCRPT130
*CALL     MAST2FD                                                       DCRPT130
*CALL     MAST3FD                                                       DCRPT130
*CALL     RELWKFD                                                          CL**2
*CALL RETSCS
*CALL     WRKSTG77                                                      DCRPT130
00046  77  OPEN-DATA                   PICTURE X.                          CL**2
*CALL     MAST1WS                                                       DCRPT130
*CALL     ENTSAVE                                                          CL**2
*CALL     TESTWACOM                                                        CL**2
*CALL     WRKSTG01                                                      DCRPT130
*CALL     MAST3DD1                                                      DCRPT130
*CALL     CONWORK                                                       DCRPT130
*CALL     WITHHIT4                                                         CL**2
*CALL     EXTWORK4                                                         CL**2
*CALL     MULTSTORE                                                        CL**2
00060                                                                    DCRPT13
00061  PROCEDURE DIVISION.                                              DCRPT130
00065 ******************************************************************DCRPT130
00066 ******************************************************************DCRPT130
00067 *                                                                 DCRPT130
00068 *     PROCESSING RETURNS HERE FROM EXTRACT CONTROL MODULE         DCRPT130
00069 *                                                                 DCRPT130
00070 ******************************************************************DCRPT130
00071 ******************************************************************DCRPT130
00072  0000-BEGIN.                                                      DCRPT130
00073      IF RTBL-MOD-REQ NOT EQUAL TO ZERO                            DCRPT130
00074          GO TO EXT-OUT-RETURN.                                       CL**2
00075 ******************************************************************DCRPT130
00076 ******************************************************************DCRPT130
00077 *                                                                 DCRPT130
00078 *     INITIALIZATION                                              DCRPT130
00079 *                                                                 DCRPT130
00080 ******************************************************************DCRPT130
00081 ******************************************************************DCRPT130
00082      MOVE SPACES TO DATA-ARG-LIST.                                DCRPT130
00083      MOVE SPACES TO DATA-LAST-ENTRY-NAME.                         DCRPT130
00084      MOVE "Y" TO OPEN-DATA.                                       DCRPT130
00085      MOVE SPACES TO REL-ARG-LIST.                                 DCRPT130
00086      MOVE SPACES TO CON-ARG-LIST.                                 DCRPT130
00087      MOVE SPACES TO WORK-HEADER.                                  DCRPT130
00088      MOVE "Y" TO EXTRACT-SW.                                      DCRPT130
00089      MOVE "Y" TO 1ST-CHGQRY-SW.                                      CL**2
00090      MOVE "Y" TO REL-1ST-SW.                                         CL**2
           MOVE "Y" TO 1ST-RECORD-SW. 
00091      MOVE ZEROES TO EXTRACT-RETNO.                                   CL**2
00092      MOVE ZEROES TO EXT-COUNT.                                       CL**2
00093      MOVE "N" TO MSG-SWITCH.                                         CL**2
00094      MOVE 1 TO RTBL-SUB.                                             CL**2
00095 *                                                                 DCRPT130
00096 *     OPEN FILES AFTER GETTING PRIME NUMBERS FROM MAST3           DCRPT130
00097 *                                                                 DCRPT130
00098      PERFORM CON-OPEN THRU CON-OPEN-XIT.                             CL**2
00099      OPEN INPUT MAST1.                                            DCRPT130
00100      PERFORM REL-OPEN THRU REL-OPEN-XIT.                          DCRPT130
           MOVE "3" TO CON-ENTRY-FUNCTION.
00102      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT130
           MOVE "1" TO SUB1.
           PERFORM CHECK-MULT-STC THRU CHECK-MULT-STC-XIT.
00105      IF RTBL-HDR-REQTYPE EQUAL "RC" OR "RH" OR "RJ"                  CL**2
00106          PERFORM BUILD-LOC-TABLE THRU BUILD-LOC-TABLE-XIT.           CL**2
00107 ******************************************************************DCRPT130
00108 *                                                                 DCRPT130
00109 *     DETERMINE REPORT REQUEST RETRIEVAL TYPE                     DCRPT130
00110 *        . USER CAN REQUEST THAT A HIERARCHY BE EXTRACTED         DCRPT130
00111 *          FOR ALL ENTITITIES OF A GIVEN TYPE (GRO,FIL,SYS,ETC)   DCRPT130
00112 *          THIS TYPE OF REQUEST IS CALLED GLOBAL REQUEST          DCRPT130
00113 *        . USER CAN REQUEST THAT A HIERARCHY BE EXTRACTED         DCRPT130
00114 *          ONLY FOR A NAMED ENTRY                                 DCRPT130
00115 ****************************************************************  DCRPT130
00116      IF RTBL-HDR-STARTCNAME NOT EQUAL TO SPACES                      CL**2
00117          MOVE RTBL-HDR-STARTCNAME TO EXTRACT-CNAME                   CL**2
00118          MOVE RTBL-HDR-ENTTYPE TO EXTRACT-ENTTYPE                    CL**2
00119          GO TO 2000-EXTRACT-HIER.                                 DCRPT130
00120                                                                    DCRPT13
00121 ******************************************************************DCRPT130
00122 ******************************************************************DCRPT130
00123 *     GLOBAL REQUEST PROCESSING                                   DCRPT130
00124 *     READS RELATIONAL FILE DC2-ALL-NAMES-RECORD                  DCRPT130
00125 *        AND RETRIEVES ITS POINTERS FROM LEFT TO RIGHT            DCRPT130
00126 *        WHEN A POINTER (ENTRY) IS FOUND OF THE REQUESTED         DCRPT130
00127 *        TYPE THEN ITS HIERARCHY IS PROCESSED.  THEN THE          DCRPT130
00128 *        NEXT POINTER IS PROCESSED.                               DCRPT130
00129 ******************************************************************DCRPT130
00130 ******************************************************************DCRPT130
00131  1000-GLOBAL-EXTRACT.                                             DCRPT130
00132      MOVE ALL-NAMES-LITERAL TO REL-ENTRY-NAME.                    DCRPT130
00133      MOVE "N" TO REL-ENTRY-FUNCTION.                                 CL**2
00134  1100-NAME-READ.                                                  DCRPT130
00135      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT130
00136      IF REL-RETURN-CODE EQUAL TO ZERO                             DCRPT130
00137          GO TO 1115-MOVE-NAME-PTR.                                DCRPT130
00138      IF REL-RETURN-CODE EQUAL TO "1"                              DCRPT130
00139          GO TO 9000-EXTRACT-END.                                  DCRPT130
00140      MOVE "RR" TO REPORT-ERROR-CODE.                              DCRPT130
00141      MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME.                    DCRPT130
00142      GO TO 8000-ABORT.                                            DCRPT130
00143 *                                                                 DCRPT130
00144 *     DETERMINE IF POINTER IS THE TYPE DESIRED                    DCRPT130
00145 *                                                                 DCRPT130
00146  1115-MOVE-NAME-PTR.                                              DCRPT130
00147      MOVE REL-POINTER-TYPE TO ENTRY-TYPE-2.                       DCRPT130
00148      MOVE RTBL-HDR-ENTTYPE TO ENTRY-TYPE-1.                       DCRPT130
00149      PERFORM MATCH-ENTRY-TYPE THRU MATCH-ENTRY-TYPE-XIT.          DCRPT130
00150      IF ENTRY-TYPE-MATCH EQUAL TO "N"                             DCRPT130
00151          GO TO 1100-NAME-READ.                                    DCRPT130
00152 *                                                                 DCRPT130
00153 *     ENTRY IS THE DESIRED TYPE                                   DCRPT130
00154 *                                                                 DCRPT130
00155      MOVE REL-POINTER-NAME TO EXTRACT-CNAME.                      DCRPT130
00156      MOVE REL-POINTER-TYPE TO EXTRACT-ENTTYPE.                    DCRPT130
00157                                                                    DCRPT13
00158 ***************************************************************** DCRPT130
00159 ***************************************************************** DCRPT130
00160 *     RETRIEVE HIERARCH OF NAMED ENTRY                            DCRPT130
00161 *        THIS PROCESSING IS COMMON TO ALL HIERARCHICAL            DCRPT130
00162 *        EXTRACTION REQUESTS                                      DCRPT130
00163 ***************************************************************** DCRPT130
00164 ***************************************************************** DCRPT130
00165  2000-EXTRACT-HIER.                                               DCRPT130
00166      MOVE EXTRACT-CNAME TO DATA-ENTRY-NAME.                       DCRPT130
00167      MOVE 99 TO EXTRACT-RETLEV.                                      CL**2
00168      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
           IF EXTRACT-ENTTYPE GREATER THAN "34" 
               MOVE "800" TO DATA-ENTRY-CAT 
           ELSE 
               IF EXTRACT-ENTTYPE EQUAL "05"
                   MOVE "400" TO DATA-ENTRY-CAT 
               ELSE 
                   MOVE "300" TO DATA-ENTRY-CAT 
               END-IF 
           END-IF 
00173      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                DCRPT130
00174  2005-NEXT.                                                       DCRPT130
00175      IF DATA-RETURN-CODE EQUAL TO ZERO                            DCRPT130
00176          GO TO 2010-CK-COMMENT.                                   DCRPT130
           IF DATA-RETURN-CODE EQUAL TO "2" 
               PERFORM SET-CAT THRU SET-CAT-EXIT
               IF WAY-TO-GO EQUAL "G" 
                   GO TO 2010-CK-COMMENT
               END-IF 
           END-IF 
00177 *                                                                 DCRPT130
00178 *     ENTRY HAS NO STRUCTURE LINES - CK GLOBAL EXTRACT            DCRPT130
00179 *                                                                 DCRPT130
00180      IF RTBL-HDR-STARTCNAME EQUAL TO SPACES                          CL**2
00181          GO TO 1100-NAME-READ.                                    DCRPT130
00182      GO TO 9000-EXTRACT-END.                                      DCRPT130
00183 *                                                                 DCRPT130
00184 *     CHECK FOR STRUCTURE LINE BYPASS CONDITIONS                  DCRPT130
00185 *                                                                 DCRPT130
00186  2010-CK-COMMENT.                                                 DCRPT130
00187      IF CAT-COMMENT EQUAL TO "*"                                  DCRPT130
00188          GO TO 2020-READ-NEXT-STC.                                DCRPT130
00189      IF STC-CNAME EQUAL "FILLER "                                 DCRPT130
00190          GO TO 2020-READ-NEXT-STC.                                DCRPT130
00191      IF STC-CNAME EQUAL SPACES                                    DCRPT130
00192          GO TO 2020-READ-NEXT-STC.                                DCRPT130
00193 *                                                                    CL**2
      *    CHECK FOR LINES TO BYPASS
      * 
           PERFORM ENT-CAT-LINE THRU ENT-CAT-LINE-EXIT. 
           IF WAY-TO-GO EQUAL TO "G"
               GO TO 2100-PROCESS-HIER
           END-IF 
00211  2020-READ-NEXT-STC.                                              DCRPT130
00212      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.              DCRPT130
00213      GO TO 2005-NEXT.                                             DCRPT130
00214 ***************************************************************** DCRPT130
00215 *     PROCESS ENTRY FOR QUALIFICATION                             DCRPT130
00216 *        RETRIEVE-TEST COMPONENT ENTRY-SAVE CURR MAST1 LOC        DCRPT130
00217 ***************************************************************** DCRPT130
00218  2100-PROCESS-HIER.                                               DCRPT130
00219      MOVE SPACES TO HOLD-KEY-AREA.                                DCRPT130
00220      MOVE ZERO TO KEY-CNT.                                        DCRPT130
00221  2110-CHECK-ENTRY.                                                DCRPT130
00222      MOVE STC-PUSE TO HOLD-PUSE.                                  DCRPT130
00223      MOVE STC-CNAME TO QUERY-NAME.                                DCRPT130
00224      MOVE DATA-ENTRY-NAME TO SAVE-NAME.                           DCRPT130
00225      MOVE CAT-CATEGORY TO SAVE-CAT.                               DCRPT130
00226      MOVE CAT-LINE TO SAVE-LINE-NO.                               DCRPT130
00227      MOVE QUERY-NAME TO DATA-ENTRY-NAME.                          DCRPT130
00228      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.            DCRPT130
00229 *                                                                    CL**2
00230 *     SAVE ENTRY TYPE FOR COMPARE IN "DOWN-A-LEVEL"                  CL**2
00231 *                                                                    CL**2
00232      MOVE DATA-HDR-ENT-ID TO SAVE-ID.                                CL**2
00233      IF DATA-RETURN-CODE EQUAL TO "9"                             DCRPT130
00234          MOVE "DR" TO REPORT-ERROR-CODE                           DCRPT130
00235      MOVE DATA-ENTRY-NAME TO REPORT-ERROR-NAME                    DCRPT130
00236          GO TO 8000-ABORT.                                        DCRPT130
00237 *                                                                 DCRPT130
00238 *     PROCESS COMPONENT ENTRY AGAINST SELECTION STATEMENTS (IF ANYDCRPT130
00239 *                                                                 DCRPT130
00240      MOVE 1 TO RTBL-SUB.                                             CL**2
00241      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO SPACES                   CL**2
00242          GO TO 3900-EXTRACT-ENTRY.                                DCRPT130
00243  3000-CHECK-SELECT.                                               DCRPT130
00244      IF RTBL-QRYTYPE-2 (RTBL-SUB) EQUAL TO "8"                    DCRPT130
00245          GO TO 3200-TYPE-RANGE.                                   DCRPT130
00246      IF RTBL-QRYTYPE-2 (RTBL-SUB) EQUAL TO "9"                    DCRPT130
00247          GO TO 3300-NAME-RANGE.                                   DCRPT130
00248 *                                                                 DCRPT130
00249 *     PROCESS SELECT ENTITY (ELE, GRO,ETC) STATEMENT              DCRPT130
00250  3100-ENTITY-SELECT.                                              DCRPT130
00251      MOVE DATA-HDR-ENT-ID TO ENTRY-TYPE-2.                        DCRPT130
00252      MOVE RTBL-SEL1-ENTTYPE (RTBL-SUB) TO ENTRY-TYPE-1.           DCRPT130
00253      PERFORM MATCH-ENTRY-TYPE THRU MATCH-ENTRY-TYPE-XIT.          DCRPT130
00254      MOVE DATA-HDR-ENT-ID TO ENTRY-TYPE-2.                        DCRPT130
00255      IF ENTRY-TYPE-MATCH EQUAL "N"                                DCRPT130
00256          GO TO 3800-NEXT-RTBL.                                    DCRPT130
00257      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO "40" OR "60"             CL**2
00258          GO TO 3900-EXTRACT-ENTRY.                                DCRPT130
00259      GO TO 3600-CHECK-CONDITION.                                  DCRPT130
00260 *                                                                 DCRPT130
00261 *     PROCESS SELECT ENTITY RANGE (ELE TO GRO, ECT) STATEMENT     DCRPT130
00262 *                                                                 DCRPT130
00263  3200-TYPE-RANGE.                                                 DCRPT130
00264      IF DATA-HDR-ENT-ID LESS THAN RTBL-SEL1-ENTTYPE (RTBL-SUB)    DCRPT130
00265          GO TO 3800-NEXT-RTBL.                                    DCRPT130
00266      IF DATA-HDR-ENT-ID GREATER THAN RTBL-SEL2-TOTYPE (RTBL-SUB)  DCRPT130
00267          GO TO 3800-NEXT-RTBL.                                    DCRPT130
00268      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO "80"                  DCRPT130
00269          GO TO 3900-EXTRACT-ENTRY.                                DCRPT130
00270      GO TO 3600-CHECK-CONDITION.                                  DCRPT130
00271 *                                                                 DCRPT130
00272 *     PROCESS SELECT ENTRY RANGE (FROM DCNAME1 TO DCNAME2)        DCRPT130
00273 *                                                                 DCRPT130
00274  3300-NAME-RANGE.                                                 DCRPT130
00275      IF DATA-ENTRY-NAME LESS THAN RTBL-OPT-CNAME (RTBL-SUB)          CL**2
00276          GO TO 3800-NEXT-RTBL.                                    DCRPT130
00277      IF DATA-ENTRY-NAME GREATER THAN RTBL-OPT-CNAME (RTBL-SUB)       CL**2
00278          GO TO 3800-NEXT-RTBL.                                    DCRPT130
00279      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL TO "90"                  DCRPT130
00280          GO TO 3900-EXTRACT-ENTRY.                                DCRPT130
00281 *                                                                 DCRPT130
00282 *     PROCESS SELECT CONDITION CLAUSES WITH.. HAVING..            DCRPT130
00283 *                                                                 DCRPT130
00284  3600-CHECK-CONDITION.                                            DCRPT130
00285      MOVE SPACES TO QTBL-HDR-ENT.                                 DCRPT130
00286      MOVE RTBL-SEL1-QRYTYPE (RTBL-SUB) TO QTBL-OPT-QRYTYPE.          CL**2
00287      MOVE RTBL-SELECT1-ENT (RTBL-SUB) TO QTBL-SELECT1-ENT.        DCRPT130
00288      PERFORM QRY-WITH THRU QRY-HAVE-XIT.                             CL**2
00289      IF HIT-SW EQUAL TO "N"                                       DCRPT130
00290          GO TO 3800-NEXT-RTBL.                                    DCRPT130
00291      GO TO 3900-EXTRACT-ENTRY.                                    DCRPT130
00292 *                                                                 DCRPT130
00293 *     ENTRY DOES NOT QUALIFY                                      DCRPT130
00294 *          INCREMENT TO NEXT SELECT STATEMENT-CK FOR LAST         DCRPT130
00295 *                                                                 DCRPT130
00296  3800-NEXT-RTBL.                                                  DCRPT130
00297      IF RTBL-SUB EQUAL 9                                          DCRPT130
00298          GO TO 4000-DOWN-A-LEVEL.                                 DCRPT130
00299      ADD 1 TO RTBL-SUB.                                           DCRPT130
00300      IF RTBL-QRYTYPE-23 (RTBL-SUB) EQUAL SPACES                   DCRPT130
00301          GO TO 4000-DOWN-A-LEVEL.                                 DCRPT130
00302      GO TO 3000-CHECK-SELECT.                                     DCRPT130
00303 *                                                                 DCRPT130
00304 *     ENTRY QUALIFIES                                             DCRPT130
00305 *                                                                 DCRPT130
00306  3900-EXTRACT-ENTRY.                                              DCRPT130
00307      MOVE DATA-ENTRY-NAME TO EXTRACT-CNAME.                          CL**2
00308      MOVE DATA-HDR-ENT-ID TO EXTRACT-ENTTYPE.                        CL**2
00309      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00310      MOVE "N" TO HIT-SW.                                          DCRPT130
00311 ***************************************************************** DCRPT130
00312 *     RETRIEVE STRUCTURE LINES OF COMPONENT ENTRY                 DCRPT130
00313 ***************************************************************** DCRPT130
00314  4000-DOWN-A-LEVEL.                                               DCRPT130
00315 *                                                                    CL**2
00316 *    TEST STOP ENTRY OPTION                                          CL**2
00317 *                                                                    CL**2
00318      IF RTBL-OPT-STOPNAME EQUAL TO SPACES                            CL**2
00319          GO TO 4010-NON-STOP.                                        CL**2
00320      IF RTBL-OPT-STOPNAME NOT EQUAL TO DATA-ENTRY-NAME               CL**2
00321          GO TO 4010-NON-STOP.                                        CL**2
00322      IF RTBL-HDR-STARTCNAME EQUAL TO SPACES                          CL**2
00323          GO TO 1100-NAME-READ                                        CL**2
00324      ELSE                                                            CL**2
00325          GO TO 9000-EXTRACT-END.                                     CL**2
00326       GO TO 9000-EXTRACT-END.                                        CL**2
00327  4010-NON-STOP.                                                      CL**2
00328      MOVE SAVE-NAME TO DATA-ENTRY-NAME.                           DCRPT130
00329      MOVE SAVE-CAT TO DATA-ENTRY-CAT.                             DCRPT130
00330      MOVE SAVE-LINE-NO TO DATA-ENTRY-LINE.                        DCRPT130
00331      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                      DCRPT130
           IF SAVE-ID EQUAL TO "03" 
00333          GO TO 7000-READ-STCLINE.                                 DCRPT130
00334      IF HOLD-PUSE EQUAL TO "Y"                                    DCRPT130
00335          GO TO 7000-READ-STCLINE.                                 DCRPT130
00336      ADD 1 TO KEY-CNT.                                            DCRPT130
00337      IF KEY-CNT GREATER THAN 30                                   DCRPT130
00338          SUBTRACT 1 FROM KEY-CNT                                  DCRPT130
00339          GO TO 7000-READ-STCLINE.                                 DCRPT130
00340 *                                                                 DCRPT130
00341 *     SAVE CURRENT STRUCTURE LINE LOCATION                        DCRPT130
00342 *                                                                 DCRPT130
00343      MOVE DATA-ENTRY-NAME TO KEY-NAME (KEY-CNT).                  DCRPT130
00344      MOVE CAT-CATEGORY TO KEY-CATEGORY (KEY-CNT).                 DCRPT130
00345      MOVE CAT-LINE TO KEY-LINE (KEY-CNT).                         DCRPT130
00346 *                                                                 DCRPT130
00347 *     RETRIEVE LINE                                               DCRPT130
00348 *                                                                 DCRPT130
00349      MOVE STC-CNAME TO DATA-ENTRY-NAME.                           DCRPT130
           IF SAVE-ID EQUAL TO "05" 
               MOVE "400" TO DATA-ENTRY-CAT 
           ELSE 
               MOVE "300" TO DATA-ENTRY-CAT 
           END-IF 
00351      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                DCRPT130
00352      IF DATA-RETURN-CODE EQUAL TO ZERO                            DCRPT130
00353          GO TO 7500-CK-COMMENT.                                   DCRPT130
00354      IF DATA-RETURN-CODE EQUAL TO "1"                             DCRPT130
00355          MOVE "DR" TO REPORT-ERROR-CODE                           DCRPT130
00356          MOVE DATA-ENTRY-NAME TO REPORT-ERROR-NAME                DCRPT130
00357          GO TO 8000-ABORT.                                        DCRPT130
           PERFORM SET-CAT THRU SET-CAT-EXIT. 
           IF WAY-TO-GO EQUAL TO "S"
               GO TO 6000-RETURN-A-LEVEL
           ELSE 
               GO TO 7500-CK-COMMENT
           END-IF 
00367 ***************************************************************** DCRPT130
00368 *     GO BACK UP TO PREVIOUSLY PROCESSED ENTRY                    DCRPT130
00369 ***************************************************************** DCRPT130
00370  6000-RETURN-A-LEVEL.                                             DCRPT130
00371      IF KEY-CNT NOT LESS THAN 01                                  DCRPT130
00372          GO TO 6010-RESTORE-KEY.                                  DCRPT130
00373      IF RTBL-HDR-STARTCNAME EQUAL TO SPACES                          CL**2
00374          GO TO 1100-NAME-READ.                                    DCRPT130
00375      GO TO 9000-EXTRACT-END.                                      DCRPT130
00376  6010-RESTORE-KEY.                                                DCRPT130
00377      MOVE KEY-NAME (KEY-CNT) TO DATA-ENTRY-NAME.                  DCRPT130
00378      MOVE KEY-CATEGORY (KEY-CNT) TO DATA-ENTRY-CAT.               DCRPT130
00379      MOVE KEY-LINE (KEY-CNT) TO DATA-ENTRY-LINE.                  DCRPT130
00380      SUBTRACT 1 FROM KEY-CNT.                                     DCRPT130
00381      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                      DCRPT130
00382      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                        DCRPT130
00383          MOVE "DR" TO REPORT-ERROR-CODE                           DCRPT130
00384          MOVE DATA-ENTRY-NAME TO REPORT-ERROR-NAME                DCRPT130
00385          GO TO 8000-ABORT.                                           CL**2
00386 ***************************************************************** DCRPT130
00387 *     GET THE NEXT STC LINE                                       DCRPT130
00388 ***************************************************************** DCRPT130
00389  7000-READ-STCLINE.                                               DCRPT130
00390      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.              DCRPT130
           IF DATA-RETURN-CODE EQUAL TO "1" 
               GO TO 6000-RETURN-A-LEVEL
           END-IF 
           IF DATA-RETURN-CODE EQUAL TO "2" 
               PERFORM SET-CAT THRU SET-CAT-EXIT
               IF WAY-TO-GO EQUAL "S" 
                   GO TO 6000-RETURN-A-LEVEL
               END-IF 
           END-IF 
00393  7500-CK-COMMENT.                                                 DCRPT130
00394      IF CAT-COMMENT EQUAL TO "*"                                  DCRPT130
00395          GO TO 7000-READ-STCLINE.                                 DCRPT130
00396      IF STC-CNAME EQUAL TO "FILLER "                              DCRPT130
00397          GO TO 7000-READ-STCLINE.                                 DCRPT130
00398      IF STC-CNAME EQUAL TO SPACES                                 DCRPT130
00399          GO TO 7000-READ-STCLINE.                                 DCRPT130
      *    CHECK FOR LINES TO BYPASS
      * 
           PERFORM ENT-CAT-LINE THRU ENT-CAT-LINE-EXIT. 
           IF WAY-TO-GO EQUAL TO "S"
               GO TO 7000-READ-STCLINE
           ELSE 
               GO TO 2110-CHECK-ENTRY 
           END-IF 
00416 ****************************************************************  DCRPT130
00417 *     UNUSUAL END OF MODULE PROCESSING                            DCRPT130
00418 ****************************************************************  DCRPT130
00419  PROGRAM-END-BAD.                                                    CL**2
00420  8000-ABORT.                                                      DCRPT130
00421      MOVE SPACES TO ERROR-LINE.                                      CL**2
00422      IF REPORT-ERROR-CODE EQUAL "DR"                                 CL**2
00423          MOVE "MAST1 READ ERROR" TO ERROR-TYPE                       CL**2
00424      ELSE                                                            CL**2
00425      MOVE "MAST2 READ ERROR" TO ERROR-TYPE.                          CL**2
00426      MOVE REPORT-ERROR-NAME TO ERROR-NAME.                           CL**2
00427      MOVE "Y" TO MSG-SWITCH.                                         CL**2
00428      PERFORM EXT-OUT THRU EXT-OUT-XIT.                               CL**2
00429      MOVE "8" TO RTBL-MOD-REQ.                                       CL**2
00430      GO TO 9010-ERROR-END.                                           CL**2
00431 ****************************************************************  DCRPT130
00432 *     END OF MODULE PROCESSING                                    DCRPT130
00433 ****************************************************************  DCRPT130
00434  9000-EXTRACT-END.                                                DCRPT130
00435      MOVE "9" TO RTBL-MOD-REQ.                                       CL**2
00436  9010-ERROR-END.                                                     CL**2
00437      PERFORM REL-CLOSE THRU REL-CLOSE-XIT.                        DCRPT130
00438      PERFORM CON-CLOSE THRU CON-CLOSE-XIT.                        DCRPT130
00439      IF OPEN-DATA EQUAL "Y"                                       DCRPT130
00440          CLOSE MAST1.                                             DCRPT130
00441      IF REL-1ST-SW EQUAL "N"                                         CL**2
00442          CLOSE RELATIONAL-WORK-FILE.                                 CL**2
           EXIT PROGRAM.
00444 ****************************************************************  DCRPT130
00445 *     SUBROUTINES                                                 DCRPT130
00446 ****************************************************************  DCRPT130
*CALL MULTLINE
      **************************************************************
      * 
      *    SET CATEGORY PROCEDURE 
      * 
      *    THIS PROCEDURE CHECKS THE CURRENT CATEGORY BEING READ
      *    AND DETERMINES IF AN ENTITY TYPE HAS ANY ADDITIONAL
      *    CATEGORIES WHICH MAY BE USED.  IF SO, THE CATEGORY 
      *    NUMBER IS SET AND A CALL IS MADE TO READ-CATEGORY. 
      *    WHEN AND IF A USEABLE CATEGORY IS FOUND, THE FLAG
      *    WAY-TO-GO IS SET TO "G", OTHERWISE THE FLAG IS SET 
      *    TO "S".
      * 
      ****************************************************************
       SET-CAT. 
           IF DATA-HDR-ENT-ID EQUAL TO "05" OR "13" 
               IF DATA-ENTRY-CAT EQUAL "300"
                   MOVE "400" TO DATA-ENTRY-CAT 
               ELSE 
                   IF DATA-ENTRY-CAT EQUAL "400"
                       MOVE "800" TO DATA-ENTRY-CAT 
                   END-IF 
               END-IF 
               GO TO CAT-READ 
           END-IF 
           IF DATA-HDR-ENT-ID EQUAL TO "22" 
               IF DATA-ENTRY-CAT EQUAL TO "300" 
                   MOVE "400" TO DATA-ENTRY-CAT 
               ELSE 
                   IF DATA-ENTRY-CAT EQUAL TO "400" 
                       MOVE "425" TO DATA-ENTRY-CAT 
                   ELSE 
                       IF DATA-ENTRY-CAT EQUAL TO "425" 
                           MOVE "450" TO DATA-ENTRY-CAT 
                       ELSE 
                           MOVE "800" TO DATA-ENTRY-CAT 
                       END-IF 
                   END-IF 
               END-IF 
               GO TO CAT-READ 
           END-IF 
           IF DATA-HDR-ENT-ID EQUAL TO "26" 
               IF DATA-ENTRY-CAT EQUAL TO "300" 
                   MOVE "450" TO DATA-ENTRY-CAT 
               ELSE 
                   MOVE "800" TO DATA-ENTRY-CAT 
               END-IF 
               GO TO CAT-READ 
           END-IF 
           IF DATA-ENTRY-CAT EQUAL TO "300" 
               MOVE "800" TO DATA-ENTRY-CAT 
           ELSE 
               MOVE "S" TO WAY-TO-GO
               GO TO SET-CAT-EXIT 
           END-IF 
       CAT-READ.
           PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.
           IF DATA-RETURN-CODE EQUAL TO ZERO
               MOVE "G" TO WAY-TO-GO
               GO TO SET-CAT-EXIT 
           END-IF 
           IF DATA-RETURN-CODE EQUAL TO 1 
               MOVE "S" TO WAY-TO-GO
               GO TO SET-CAT-EXIT 
           END-IF 
           IF DATA-RETURN-CODE EQUAL TO 2 
               IF DATA-ENTRY-CAT EQUAL TO "800" 
                   MOVE "S" TO WAY-TO-GO
               ELSE 
                   GO TO SET-CAT
               END-IF 
           END-IF 
       SET-CAT-EXIT.
           EXIT.
      ********************************************************* 
      * 
      *    ENT-CAT-LINE CHECKS FOR SPECIAL ENTRY LINES FOR
      *    THOSE ENTITIES AND CATEGORIES HAVING MULTI-LINE
      *    ENTRIES. 
      * 
      **********************************************************
       ENT-CAT-LINE.
           MOVE "G" TO WAY-TO-GO
           IF DATA-ENTRY-CAT EQUAL TO "300" 
               IF DATA-HDR-ENT-ID EQUAL TO "10" 
                 AND STC-LINE-TYPE NOT EQUAL TO "A" 
                   MOVE "S" TO WAY-TO-GO
               ELSE 
                   IF DATA-HDR-ENT-ID EQUAL TO "13" 
                     AND STC-LINE-TYPE NOT EQUAL TO "A" AND "C" 
                       MOVE "S" TO WAY-TO-GO
                   END-IF 
               END-IF 
               GO TO ENT-CAT-LINE-EXIT
           END-IF 
           IF DATA-HDR-ENT-ID EQUAL TO "22" 
               IF DATA-ENTRY-CAT EQUAL TO "400" 
                   IF STC-LINE-TYPE EQUAL TO "R"
                     OR CTL-ALY-VER EQUAL TO "SYSTEM" 
                       MOVE "S" TO WAY-TO-GO
                   END-IF 
                   GO TO ENT-CAT-LINE-EXIT
               END-IF 
               IF DATA-ENTRY-CAT EQUAL TO "425" 
                   IF STC-LINE-TYPE EQUAL "L" 
                     AND STC-PUSE EQUAL "C" 
                       MOVE "G" TO WAY-TO-GO
                   ELSE 
                       MOVE "S" TO WAY-TO-GO
                   END-IF 
                   GO TO ENT-CAT-LINE-EXIT
               END-IF 
           END-IF 
           IF DATA-HDR-ENT-ID EQUAL TO "26" 
               IF DATA-ENTRY-CAT EQUAL TO "450" 
                   IF STC-LINE-TYPE EQUAL TO "L"
                       MOVE "S" TO WAY-TO-GO
                   END-IF 
                   GO TO ENT-CAT-LINE-EXIT
               ELSE 
                   IF DATA-ENTRY-CAT EQUAL TO "400" 
                       IF STC-LINE-TYPE EQUAL TO "L"
                           MOVE "S" TO WAY-TO-GO
                       END-IF 
                       GO TO ENT-CAT-LINE-EXIT
                   END-IF 
               END-IF 
           END-IF 
           IF DATA-ENTRY-CAT NOT EQUAL TO "400" 
               MOVE "S" TO WAY-TO-GO
           END-IF 
       ENT-CAT-LINE-EXIT. 
           EXIT.
*CALL     MATCHENT                                                      DCRPT130
*CALL     FLDFIND                                                          CL**2
*CALL     QRYWITH4                                                         CL**2
*CALL     EXTOUT4                                                          CL**2
*CALL     MAST1RFL                                                      DCRPT130
*CALL     MAST1RNL                                                      DCRPT130
*CALL     MAST1RFC                                                      DCRPT130
*CALL     MAST1EXT                                                      DCRPT130
*CALL     MAST1READ                                                     DCRPT130
*CALL     MAST1ALG                                                      DCRPT130
*CALL     MAST1RK                                                       DCRPT130
*CALL     MAST3INT                                                         CL**2
*CALL     MAST3IO1                                                         CL**2
*CALL     RELCOM                                                        DCRPT130
*CALL     MAST2RK                                                       DCRPT130
*CALL     RELALG                                                        DCRPT130
