*DECK     DCRPT160
00001  IDENTIFICATION DIVISION.                                         06/23/78
       PROGRAM-ID.   RPT160.
*CALL COPYRIGHT 
      *    THIS MODULE EXPLODES ENTRY USAGE AND COMPONENTS FOR THE
      *    RELATIONAL REPORT. THE INPUT RELATIONAL REPORT WORK FILE 
      *    CONTAINS A RECORD FOR EVERY ENTRY THAT IS TO BE EXPLODED.
      *    THIS FILE IS CREATED BY DCRPT120, DCRPT130, OR DCRPT140. 
      *    THE OUTPUT RECORDS CREATED BY THIS MODULE ARE PASSED 
      *    IN LINKAGE TO THE EXTRACT CONTROL PROGRAM WHICH WRITES 
      *    THEM TO THE EXTRACT FILE.
00015  ENVIRONMENT DIVISION.                                            DCRPT160
00016  CONFIGURATION SECTION.                                           DCRPT160
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00019  INPUT-OUTPUT SECTION.                                            DCRPT160
00020  FILE-CONTROL.                                                    DCRPT160
*CALL     SELECTS                                                       DCRPT160
           SELECT RELATIONAL-WORK-FILE ASSIGN TO TEMP11.
00023  DATA DIVISION.                                                   DCRPT160
00024  FILE SECTION.                                                    DCRPT160
*CALL     MAST1FD                                                       DCRPT160
*CALL     MAST2FD                                                       DCRPT160
*CALL     MAST3FD                                                       DCRPT160
*CALL     RELWKFD                                                       DCRPT160
*CALL RETSCS
*CALL     WRKSTG77                                                      DCRPT160
       77  PASS-FLAG                   PICTURE 9(1) VALUE 1.
       77  ALIAS-CHECK                 PICTURE X(1) VALUE "N".
00030  01  RPT-160-AREAS.                                                  CL**2
00031      03  STRUCTURE-HOLD.                                             CL**2
00032          05  FILLER       PICTURE X(32).                             CL**2
00033          05  STC-ALIAS-LINENO      PICTURE X(4).                     CL**2
00034          05  FILLER                PICTURE X(110).                   CL**2
00035      03  SAVE-NAME            PICTURE X(32).                         CL**2
00036      03  SAVE-CAT             PICTURE XXX.                           CL**2
00037      03  SAVE-LINE-NO         PICTURE 9999.                          CL**2
00038      03  HOLD-PUSE            PICTURE X.                             CL**2
00039      03  HOLD-HKEY-AREAS.                                            CL**2
00040          05  HKEY-AREA OCCURS 30 TIMES.                              CL**2
00041              07  KEY-NAME     PICTURE X(32).                         CL**2
00042              07  KEY-CATEGORY PICTURE XXX.                           CL**2
00043              07  KEY-LINE     PICTURE XXXX.                          CL**2
*CALL     MAST1WS                                                       DCRPT160
*CALL     TESTWACOM                                                        CL**2
*CALL     WRKSTG01                                                      DCRPT160
*CALL     MAST3DD1                                                      DCRPT160
*CALL     CONWORK                                                       DCRPT160
*CALL     RELSAVE                                                       DCRPT160
*CALL     WITHHIT4                                                         CL**2
*CALL     EXTWORK4                                                         CL**2
00056                                                                    DCRPT16
00057  PROCEDURE DIVISION.                                              DCRPT160
00061 ***************************************************************   DCRPT160
00062 ***************************************************************   DCRPT160
00063 *                                                                 DCRPT160
00064 *    PROCESSING RETURN HERE FROM EXTRACT CONTROL MODULE           DCRPT160
00065 *                                                                 DCRPT160
00066 **************************************************************    DCRPT160
00067 **************************************************************    DCRPT160
00068  0000-BEGIN.                                                      DCRPT160
00069      IF RTBL-MOD-REQ NOT EQUAL ZERO                               DCRPT160
00070          GO TO 7090-EXT-OUT-RETURN.                                  CL**2
00071 ***************************************************************   DCRPT160
00072 ***************************************************************   DCRPT160
00073 *                                                                 DCRPT160
00074 *    INITIALIZATION                                               DCRPT160
00075 *                                                                 DCRPT160
00076 **************************************************************    DCRPT160
00077 **************************************************************    DCRPT160
00078      MOVE SPACES TO DATA-ARG-LIST.                                DCRPT160
00079      MOVE SPACES TO DATA-LAST-ENTRY-NAME.                         DCRPT160
00080      MOVE SPACES TO REL-ARG-LIST.                                 DCRPT160
00081      MOVE SPACES TO CON-ARG-LIST.                                 DCRPT160
00082      MOVE SPACES TO WORK-HEADER.                                  DCRPT160
00083      MOVE ZEROES TO EXTRACT-RETNO.                                DCRPT160
00084      MOVE ZEROES TO KSUB1.                                           CL**2
00085      MOVE ZERO TO EXTRACT-RETLEV.                                 DCRPT160
00086      MOVE "N" TO MSG-SWITCH.                                         CL**2
00087      MOVE ZEROES TO KEY-CNT.                                      DCRPT160
00088 *                                                                 DCRPT160
00089 *    OPEN FILES-GET PRIME NUMBERS FOR MAST1  AND MAST2            DCRPT160
00090 *                                                                 DCRPT160
00091      PERFORM CON-OPEN THRU CON-OPEN-XIT.                          DCRPT160
00092      OPEN INPUT MAST1.                                            DCRPT160
00093      PERFORM REL-OPEN THRU REL-OPEN-XIT.                          DCRPT160
00094      MOVE "1" TO CON-ENTRY-FUNCTION.                              DCRPT160
00095      MOVE 1 TO EXT-COUNT.                                            CL**2
00096      PERFORM CON-READ THRU CON-READ-XIT.                          DCRPT160
00099      OPEN INPUT RELATIONAL-WORK-FILE.                             DCRPT160
00100                                                                    DCRPT16
00101 *************************************************************     DCRPT160
00102 *************************************************************     DCRPT160
00103 *                                                                 DCRPT160
00104 *    PART 1. READ RELATIONAL WORK FILE                            DCRPT160
00105 *        READ RECORD FOR SELECTED ENTRY AND                       DCRPT160
00106 *                                                                 DCRPT160
00107 ************************************************************      DCRPT160
00108 ************************************************************      DCRPT160
00109  0100-PART1.                                                      DCRPT160
00110  0150-READ-WORK-FILE.                                             DCRPT160
00111      READ RELATIONAL-WORK-FILE                                    DCRPT160
00112          AT END GO TO 9000-EXTRACT-END.                           DCRPT160
00113 ***************************************************************      CL**2
00114 *                                                                    CL**2
00115 *    FORMAT WHERE DEFINED RELATIONAL FILE RECORD                     CL**2
00116 *                                                                    CL**2
00117 **************************************************************       CL**2
00118      MOVE "4" TO EXT-OUTPUT-IND (EXT-COUNT).                         CL**2
00119      PERFORM 7000-EXT-OUT THRU 7099-EXT-OUT-XIT.                     CL**2
00120      IF RTBL-HDR-IDXFNAME EQUAL "CATNAME"                            CL**2
00121          MOVE "N" TO  ALIAS-STC-SW.                                  CL**2
00122                                                                    DCRPT16
00123 ************************************************************      DCRPT160
00124 ************************************************************      DCRPT160
00125 *                                                                 DCRPT160
00126 *    PART2. PROCESS DATA FILE                                        CL**2
00127 *                                                                    CL**2
00128 *       .FORMATS ALIAS-OF REFERENCE RECORD                           CL**2
00129 *        IF ENTRY HAS NAME IN CONTROL CAT                            CL**2
00130 *                                                                    CL**2
00131 *       *EXPLODES STRUCTURE AND RELATIONAL LINES                     CL**2
00132 *        RETRIEVES HIERARCHY OF NAMED ENTRY AND OUTPUTS           DCRPT160
00133 *        RECORDS TO EXTRACT FILE.                                 DCRPT160
00134 *        IF THE INDIRECT REFERENCE OPTION IS NOT SPECIFIED        DCRPT160
00135 *        ONLY THE ENTRY-S STRUCTURE WILL BE OUTPUT.               DCRPT160
00136 *        IF INDIRECT EXPLOSION IS REQUESTED THEN LOWER            DCRPT160
00137 *        LEVEL STRUCTURES WILL ALSO BE OUTPUT.                    DCRPT160
00138 *                                                                 DCRPT160
00139 ***************************************************************   DCRPT160
00140 ***************************************************************   DCRPT160
00141  1000-PART2.                                                      DCRPT160
00142 **************************************************************       CL**2
00143 *                                                                    CL**2
00144 *    FORMAT ALIAS-OF REFERENCE RECORD IF REPORT IS FOR CATNAME       CL**2
00145 *                                                                    CL**2
00146 ***************************************************************      CL**2
00147      IF RTBL-HDR-IDXFNAME NOT EQUAL "CATNAME"                        CL**2
00148          GO TO 1050-PROC-STC.                                        CL**2
00149      MOVE REL-WORK1-CATNAME TO DATA-ENTRY-NAME.                      CL**2
00150      MOVE "010" TO DATA-ENTRY-CAT.                                   CL**2
00151      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00152  1010-PROC-CTL.                                                      CL**2
00153      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00154          GO TO 1050-PROC-STC.                                        CL**2
00155      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00156          PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT              CL**2
00157          GO TO 1010-PROC-CTL.                                        CL**2
00158      IF CTL-ALY-VER EQUAL SPACES                                     CL**2
00159          GO TO 1050-PROC-STC.                                        CL**2
00160      MOVE CTL-ALY-VER TO HOLD-REF-NAME.                              CL**2
00161      MOVE ZEROES TO HOLD-REF-TYPE.                                   CL**2
00162      MOVE SPACE TO HOLD-REF-USAGE.                                   CL**2
00163      MOVE SPACE TO HOLD-REF-ALIAS.                                   CL**2
00164      MOVE "5" TO EXT-OUTPUT-IND (EXT-COUNT).                         CL**2
00165      PERFORM 7000-EXT-OUT THRU 7099-EXT-OUT-XIT.                     CL**2
00166 ***************************************************************      CL**2
00167 *                                                                    CL**2
00168 *    PROCESS STRUCTURE AND EXPLODE WHEN NECESSARY                    CL**2
00169 *                                                                    CL**2
00170 *************************************************************        CL**2
00171  1050-PROC-STC.                                                      CL**2
           IF REL-WORK1-ENTTYPE EQUAL "03"
00173          GO TO 3000-PART3.                                        DCRPT160
00174      MOVE REL-WORK1-CATNAME TO DATA-ENTRY-NAME.                   DCRPT160
00175      IF REL-WORK1-ENTTYPE LESS THAN "35"                          DCRPT160
               IF REL-WORK1-ENTTYPE EQUAL TO "05" 
                   MOVE "400" TO DATA-ENTRY-CAT 
               ELSE 
                   MOVE "300" TO DATA-ENTRY-CAT 
               END-IF 
           ELSE 
               MOVE "800" TO DATA-ENTRY-CAT 
           END-IF 
00179      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                DCRPT160
00180  1060-NEXT.                                                          CL**2
00181      IF DATA-RETURN-CODE EQUAL TO ZERO                            DCRPT160
00182          GO TO 1070-CK-COMMENT.                                      CL**2
00183      IF DATA-RETURN-CODE EQUAL TO "1"                             DCRPT160
00184          MOVE "DR" TO REPORT-ERROR-CODE                           DCRPT160
00185          MOVE DATA-ENTRY-NAME TO REPORT-ERROR-NAME                DCRPT160
00186          GO TO 8000-ABORT.                                        DCRPT160
00187 *                                                                 DCRPT160
      *    ENTRY EITHER HAS NO LINES IN THE REQUESTED 
      *    CATEGORY OR THE LINES WERE NOT THE TYPE
      *    TO BE USED.  SEE IF THERE ARE OTHER CATEGORIES 
      *    WHICH MAY BE USED. 
      *    DATA-RETURN-CODE IS EQUAL TO 2.
      * 
           PERFORM SET-CAT THRU SET-CAT-EXIT. 
           IF WAY-TO-GO EQUAL "S" 
               GO TO 3000-PART3 
           END-IF 
00191 *                                                                 DCRPT160
00192 *    PROCESS STRUCTURE LINE-CHECK FOR LINE BYPASS CONDITIONS      DCRPT160
00193 *                                                                 DCRPT160
00194  1070-CK-COMMENT.                                                    CL**2
00195      IF CAT-COMMENT EQUAL TO "*"                                  DCRPT160
00196          GO TO 1080-READ-NEXT-STC.                                   CL**2
00197      IF STC-CNAME EQUAL "FILLER "                                 DCRPT160
00198          GO TO 1080-READ-NEXT-STC.                                   CL**2
00199      IF STC-CNAME EQUAL SPACES                                    DCRPT160
00200          GO TO 1080-READ-NEXT-STC.                                   CL**2
00201 *                                                                 DCRPT160
00202 *    BYPASS STRUCTURE LINES WHICH DO NOT HAVE NAMES               DCRPT160
00203 *                                                                 DCRPT160
           PERFORM ENT-CAT-LINE THRU ENT-CAT-LINE-EXIT. 
           IF WAY-TO-GO EQUAL "G" 
               GO TO 1100-PROCESS-HIER
           END-IF 
00219  1080-READ-NEXT-STC.                                                 CL**2
00220      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.              DCRPT160
00221          GO TO 1060-NEXT.                                            CL**2
00222 ***************************************************************   DCRPT160
00223 *                                                                 DCRPT160
00224 *    EXPLODE STRUCTURE UNLESS INDIRECT OPTION = NO                DCRPT160
00225 *                                                                 DCRPT160
00226 **************************************************************    DCRPT160
00227  1100-PROCESS-HIER.                                               DCRPT160
00228      MOVE SPACES TO HOLD-HKEY-AREAS.                                 CL**2
00229      MOVE ZERO TO KEY-CNT.                                        DCRPT160
00230  1110-CHECK-ENTRY.                                                DCRPT160
00231      MOVE STC-PUSE TO HOLD-PUSE.                                  DCRPT160
00232      MOVE STC-CNAME TO QUERY-NAME.                                DCRPT160
00233      MOVE DATA-ENTRY-NAME TO SAVE-NAME.                           DCRPT160
00234      MOVE CAT-CATEGORY TO SAVE-CAT.                               DCRPT160
00235      MOVE CAT-LINE TO SAVE-LINE-NO.                               DCRPT160
00236      MOVE QUERY-NAME TO DATA-ENTRY-NAME.                          DCRPT160
00237      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.            DCRPT160
00238      MOVE DATA-HDR-ENT-ID TO SAVE-ID.                             DCRPT160
00239      IF DATA-RETURN-CODE EQUAL "9"                                DCRPT160
00240          MOVE "DR" TO REPORT-ERROR-CODE                           DCRPT160
00241          MOVE DATA-ENTRY-NAME TO REPORT-ERROR-NAME                DCRPT160
00242          GO TO 8000-ABORT.                                        DCRPT160
00243  1900-EXTRACT-ENTRY.                                              DCRPT160
00244      MOVE DATA-ENTRY-NAME TO HOLD-REF-NAME.                          CL**2
00245      MOVE DATA-HDR-ENT-ID TO HOLD-REF-TYPE.                          CL**2
00246      MOVE SPACE TO HOLD-REF-ALIAS.                                   CL**2
00247      IF HOLD-PUSE EQUAL "Y"                                          CL**2
00248          MOVE HOLD-PUSE TO HOLD-REF-USAGE                            CL**2
00249      ELSE                                                            CL**2
00250          MOVE SPACE TO HOLD-REF-USAGE.                               CL**2
00251      MOVE "5" TO EXT-OUTPUT-IND (EXT-COUNT).                         CL**2
00252      PERFORM 7000-EXT-OUT THRU 7099-EXT-OUT-XIT.                     CL**2
00253 **************************************************************    DCRPT160
00254 *                                                                 DCRPT160
00255 *    RETRIEVE STRUCTURE LINES OF COMPONENT ENTRY                  DCRPT160
00256 *                                                                 DCRPT160
00257 ************************************************************      DCRPT160
00258  2000-DOWN-A-LEVEL.                                               DCRPT160
00259      MOVE SAVE-NAME TO DATA-ENTRY-NAME.                           DCRPT160
00260      MOVE SAVE-CAT TO DATA-ENTRY-CAT.                             DCRPT160
00261      MOVE SAVE-LINE-NO TO DATA-ENTRY-LINE.                        DCRPT160
00262      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                      DCRPT160
00263 *                                                                 DCRPT160
00264 *    CHECK FOR CONDITIONS WHICH TERMINATE EXPLOSION               DCRPT160
00265 *                                                                 DCRPT160
00266      IF SAVE-ID EQUAL "05"                                        DCRPT160
00267          GO TO 2800-READ-STCLINE.                                 DCRPT160
00268      IF HOLD-PUSE EQUAL "Y"                                       DCRPT160
00269          GO TO 2800-READ-STCLINE.                                 DCRPT160
00270      IF RTBL-OPT-INDIRECT EQUAL "N"                                  CL**2
00271        AND KEY-CNT LESS THAN 1                                    DCRPT160
00272          GO TO 2800-READ-STCLINE.                                 DCRPT160
00273      ADD 1 TO KEY-CNT.                                            DCRPT160
00274      IF KEY-CNT GREATER THAN 30                                   DCRPT160
00275          SUBTRACT 1 FROM KEY-CNT                                  DCRPT160
00276          GO TO 2800-READ-STCLINE.                                 DCRPT160
00277 *                                                                 DCRPT160
00278 *    SAVE CURRENT STRUCTURE LINE LOCATION                         DCRPT160
00279 *                                                                 DCRPT160
00280      MOVE DATA-ENTRY-NAME TO KEY-NAME (KEY-CNT).                  DCRPT160
00281      MOVE CAT-CATEGORY TO KEY-CATEGORY (KEY-CNT).                 DCRPT160
00282      MOVE CAT-LINE TO KEY-LINE (KEY-CNT).                         DCRPT160
00283 *                                                                 DCRPT160
00284 *    RETRIEVE THE STRUCTURE LINE                                  DCRPT160
00285 *                                                                 DCRPT160
00286      MOVE STC-CNAME TO DATA-ENTRY-NAME.                           DCRPT160
           IF SAVE-ID EQUAL TO "05" 
               MOVE "400" TO DATA-ENTRY-CAT 
           ELSE 
               MOVE "300" TO DATA-ENTRY-CAT 
           END-IF 
00288      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                DCRPT160
       2010-CHECK-RC. 
00289      IF DATA-RETURN-CODE EQUAL ZERO                               DCRPT160
00290          GO TO 2850-CK-COMMENT.                                   DCRPT160
00291      IF DATA-RETURN-CODE EQUAL "1"                                DCRPT160
00292          MOVE "DR" TO REPORT-ERROR-CODE                           DCRPT160
00293          MOVE DATA-ENTRY-NAME TO REPORT-ERROR-NAME                DCRPT160
00294          GO TO 8000-ABORT.                                        DCRPT160
           PERFORM SET-CAT THRU SET-CAT-EXIT. 
           IF WAY-TO-GO EQUAL "S" 
               GO TO 2600-RETURN-A-LEVEL
           ELSE 
               GO TO 2010-CHECK-RC
           END-IF 
00304 ***************************************************************   DCRPT160
00305 *      RETURN TO STRUCTURE OF HIGHER LEVEL ENTRY                  DCRPT160
00306 **************************************************************    DCRPT160
00307  2600-RETURN-A-LEVEL.                                             DCRPT160
00308      IF KEY-CNT NOT LESS THAN 01                                  DCRPT160
00309          GO TO 2610-RESTORE-KEY.                                  DCRPT160
00310      GO TO 3000-PART3.                                            DCRPT160
00311  2610-RESTORE-KEY.                                                DCRPT160
00312      MOVE KEY-NAME (KEY-CNT) TO DATA-ENTRY-NAME.                  DCRPT160
00313      MOVE KEY-CATEGORY (KEY-CNT) TO DATA-ENTRY-CAT.               DCRPT160
00314      MOVE KEY-LINE (KEY-CNT) TO DATA-ENTRY-LINE.                  DCRPT160
00315      SUBTRACT 1 FROM KEY-CNT.                                        CL**2
00316      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                      DCRPT160
00317      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                        DCRPT160
00318          MOVE "DR" TO REPORT-ERROR-CODE                           DCRPT160
00319          MOVE DATA-ENTRY-NAME TO REPORT-ERROR-NAME                DCRPT160
00320          GO TO 8000-ABORT.                                        DCRPT160
00321 **************************************************************    DCRPT160
00322 *    GET THE NEXT STC LINE                                        DCRPT160
00323 ***************************************************************   DCRPT160
00324  2800-READ-STCLINE.                                               DCRPT160
00325      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.              DCRPT160
           IF DATA-RETURN-CODE EQUAL TO "1" 
               GO TO 2600-RETURN-A-LEVEL
           END-IF 
           IF DATA-RETURN-CODE EQUAL TO "2" 
               PERFORM SET-CAT THRU SET-CAT-EXIT
               IF WAY-TO-GO EQUAL TO "S"
                   GO TO 2600-RETURN-A-LEVEL
               END-IF 
           END-IF 
00328  2850-CK-COMMENT.                                                 DCRPT160
00329      IF CAT-COMMENT EQUAL "*"                                     DCRPT160
00330          GO TO 2800-READ-STCLINE.                                 DCRPT160
00331      IF STC-CNAME EQUAL TO "FILLER "                              DCRPT160
00332          GO TO 2800-READ-STCLINE.                                 DCRPT160
00333      IF STC-CNAME EQUAL TO SPACES                                 DCRPT160
00334          GO TO 2800-READ-STCLINE.                                 DCRPT160
      *    CHECK FOR LINES TO BYPASS
      * 
           PERFORM ENT-CAT-LINE THRU ENT-CAT-LINE-EXIT. 
           IF WAY-TO-GO EQUAL TO "S"
               GO TO 2800-READ-STCLINE
           ELSE 
               GO TO 1110-CHECK-ENTRY 
           END-IF 
00351                                                                    DCRPT16
00352 ***************************************************************   DCRPT160
00353 *************************************************************     DCRPT160
00354 *                                                                 DCRPT160
00355 *    PART 3.  EXPLODE USAGE OF SELECTED ENTRY                     DCRPT160
00356 *        RETRIEVE WHERE USED POINTERS OF SELECTED ENTRY           DCRPT160
00357 *        IF INDIRECT OPTION IS NOT SPECIFIED ONLY THE             DCRPT160
00358 *        ENTRY-S IMMEDIATE USAGE WILL BE EXTRACTED (NAMES         DCRPT160
00359 *        OF ENTRIES WHICH REFEREN E IN STC LINE).                 DCRPT160
00360 *        IF INDIRECT EXPLOSION IS REQUESTED THAN HIGHER LEVEL     DCRPT160
00361 *        WILL BE EXTRACTED.                                       DCRPT160
00362 ***************************************************************   DCRPT160
00363 ***************************************************************   DCRPT160
00364  3000-PART3.                                                      DCRPT160
           MOVE 1 TO PASS-FLAG. 
           MOVE "N" TO ALIAS-CHECK. 
00365      MOVE REL-WORK1-CATNAME TO REL-ENTRY-NAME.                    DCRPT160
00366      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT160
00367      MOVE ZEROES TO KEY-CNT.                                         CL**2
00368  3050-NEXT-PTR.                                                   DCRPT160
00369      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT160
00370      IF REL-RETURN-CODE EQUAL ZERO                                DCRPT160
               GO TO 3100-PROCESS-USAGE.
00372      IF REL-RETURN-CODE NOT EQUAL TO "1"                          DCRPT160
00373          MOVE "RR" TO REPORT-ERROR-CODE                           DCRPT160
00374          MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME                 DCRPT160
00375          GO TO 8000-ABORT.                                        DCRPT160
00376 *                                                                 DCRPT160
00377 *    ENTRY HAS NO USAGE -GET NEXT INPUT REC                       DCRPT160
00378      GO TO 0150-READ-WORK-FILE.                                   DCRPT160
00379 **************************************************************    DCRPT160
00380 *                                                                 DCRPT160
00381 *    EXTRACT RECORD                                               DCRPT160
00382 *                                                                 DCRPT160
00383 ***************************************************************   DCRPT160
00384  3100-PROCESS-USAGE.                                              DCRPT160
00385 *                                                                    CL**2
00386 *    OUTPUT ALIASES REFERENCE RECORDS                                CL**2
00387 *         DO NOT EXPLODE                                             CL**2
00388 *                                                                    CL**2
00389      IF RTBL-HDR-IDXFNAME NOT EQUAL "CATNAME"                        CL**2
00390          GO TO 3200-CHECK-ELE.                                       CL**2
00391      IF REL-POINTER-ALIAS EQUAL "1" OR "2"                           CL**2
00392          MOVE "01" TO HOLD-REF-TYPE                                  CL**2
00393          MOVE REL-POINTER-NAME TO HOLD-REF-NAME                      CL**2
00394          MOVE SPACE TO HOLD-REF-USAGE                                CL**2
00395          MOVE SPACE TO HOLD-REF-ALIAS                                CL**2
00396          MOVE "5" TO EXT-OUTPUT-IND (EXT-COUNT)                      CL**2
00397          PERFORM 7000-EXT-OUT THRU 7099-EXT-OUT-XIT                  CL**2
00398          GO TO 3050-NEXT-PTR.                                        CL**2
00399      GO TO 3890-EXTRACT-INIT.                                        CL**2
00400 **************************************************************       CL**2
00401 *                                                                    CL**2
00402 *    CHECK FOR ELEMENT FIELDS WHICH CAN BE DEFINED IN ALIAS CAT      CL**2
00403 *        ONLY EXPLODE ALIAS IF CALLED OUT BY ALIAS NUMBER-ONLY       CL**2
00404 *        ONLY EXPLODE NON ALIAS IF NO ALIAS LINE NUM                 CL**2
00405 *        IN STC REFERENCE                                            CL**2
00406 *         ABOVE FOR ALL REPORTS BUT CATNAME                          CL**2
00407 *                                                                    CL**2
00408 ***************************************************************      CL**2
00409  3200-CHECK-ELE.                                                     CL**2
           IF REL-HDR-ENTRY-TYPE NOT EQUAL TO 05 AND 13 
00411          GO TO 3890-EXTRACT-INIT.                                    CL**2
00412      IF REL-WORK1-CAT EQUAL 200 OR 211                               CL**2
              MOVE "Y" TO ALIAS-CHECK 
00413          GO TO 3210-CHECK-ALI.                                       CL**2
00414      GO TO 3890-EXTRACT-INIT.                                        CL**2
00415  3210-CHECK-ALI.                                                     CL**2
00416      MOVE REL-POINTER-NAME TO DATA-ENTRY-NAME.                       CL**2
00417      MOVE "300" TO DATA-ENTRY-CAT.                                   CL**2
00418      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00419  3250-NEXT-TEST.                                                     CL**2
           IF PASS-FLAG EQUAL TO 2
             AND DATA-RETURN-CODE NOT EQUAL 0 
               GO TO 6000-READ-NEXT-PTR.
00420      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00421          GO TO 3050-NEXT-PTR.                                        CL**2
00422 *                                                                    CL**2
00423 *     CHECK FOR APPROPRIATE REFERENCE TO FIELD                       CL**2
00424 *                                                                    CL**2
00425  3270-CK-COMMENT.                                                    CL**2
00426      IF CAT-COMMENT EQUAL "*"                                        CL**2
00427          GO TO 3280-READ-NEXT-STC.                                   CL**2
00428      IF STC-CNAME EQUAL "FILLER "                                    CL**2
00429          GO TO 3280-READ-NEXT-STC.                                   CL**2
00430      IF STC-CNAME EQUAL SPACES                                       CL**2
00431          GO TO 3280-READ-NEXT-STC.                                   CL**2
           IF DATA-HDR-ENT-ID EQUAL "10" OR "13"
             AND STC-LINE-TYPE NOT EQUAL TO "A" AND "C" 
               GO TO 3280-READ-NEXT-STC 
           END-IF 
00447      IF STC-CNAME NOT EQUAL REL-WORK1-CATNAME                        CL**2
00448          GO TO 3280-READ-NEXT-STC.                                   CL**2
00449 *                                                                    CL**2
00450 *     CHECK FOR ALIAS LINE NUMBER                                    CL**2
00451 *                                                                    CL**2
           IF DATA-HDR-ENT-ID EQUAL TO "10" OR "13" OR "22" 
00453          GO TO 3272-CHECK-LINE.                                      CL**2
00454      GO TO 3890-EXTRACT-INIT.                                        CL**2
00455  3272-CHECK-LINE.                                                    CL**2
00456      MOVE STRUCTURE-LINE TO STRUCTURE-HOLD.                          CL**2
00457      IF REL-WORK1-CAT EQUAL 200                                      CL**2
00458          GO TO 3275-CHECK-STD.                                       CL**2
00459      IF STC-ALIAS-LINENO EQUAL REL-WORK1-LINE                        CL**2
00460          GO TO 3890-EXTRACT-INIT.                                    CL**2
00461      GO TO 3280-READ-NEXT-STC.                                       CL**2
00462  3275-CHECK-STD.                                                     CL**2
           IF STC-ALIAS-LINENO EQUAL ZERO OR SPACES 
00464          GO TO 3890-EXTRACT-INIT.                                    CL**2
00465  3280-READ-NEXT-STC.                                                 CL**2
00466      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00467      GO TO 3250-NEXT-TEST.                                           CL**2
00468  3890-EXTRACT-INIT.                                                  CL**2
           IF PASS-FLAG EQUAL TO 2
               GO TO 3900-EXTRACT-ENTRY.
00469      MOVE SPACES TO HOLD-KEY-AREA.                                   CL**2
00470      MOVE ZERO TO KEY-CNT.                                           CL**2
00471  3900-EXTRACT-ENTRY.                                                 CL**2
00472      MOVE REL-POINTER-TYPE TO HOLD-REF-TYPE.                         CL**2
00473      MOVE REL-POINTER-NAME TO HOLD-REF-NAME.                         CL**2
00474      MOVE SPACE TO HOLD-REF-ALIAS.                                   CL**2
00475      IF REL-PUSE EQUAL "Y"                                           CL**2
00476          MOVE "Y" TO HOLD-REF-USAGE                                  CL**2
00477      ELSE                                                            CL**2
00478          MOVE SPACE TO HOLD-REF-USAGE.                               CL**2
00479      MOVE "5" TO EXT-OUTPUT-IND (EXT-COUNT).                         CL**2
00480      PERFORM 7000-EXT-OUT THRU 7099-EXT-OUT-XIT.                     CL**2
00481  4000-UP-A-LEVEL.                                                 DCRPT160
00482      IF REL-POINTER-TYPE EQUAL "65"                               DCRPT160
00483          GO TO 6000-READ-NEXT-PTR.                                DCRPT160
00484      IF REL-PUSE EQUAL "Y"                                        DCRPT160
00485          GO TO 6000-READ-NEXT-PTR.                                DCRPT160
00486      IF RTBL-OPT-INDIRECT EQUAL "N"                                  CL**2
00487        AND KEY-CNT LESS THAN 1                                    DCRPT160
00488          GO TO 6000-READ-NEXT-PTR.                                DCRPT160
00489      ADD 1 TO KEY-CNT.                                            DCRPT160
00490      IF KEY-CNT GREATER THAN 30                                   DCRPT160
00491          SUBTRACT 1 FROM KEY-CNT                                     CL**2
00492          GO TO 6000-READ-NEXT-PTR.                                DCRPT160
00493 *                                                                 DCRPT160
00494 *    SAVE LOCATION OF CURRENT POINTER                                CL**2
00495 *                                                                 DCRPT160
00496      MOVE REL-ENTRY-NAME TO KEY-ENTRY-NAME (KEY-CNT).             DCRPT160
00497      MOVE REL-POINTER-NAME TO KEY-POINTER-NAME (KEY-CNT).         DCRPT160
00498      MOVE REL-NEXT-REC TO KEY-NEXT-REC (KEY-CNT).                 DCRPT160
00499 *                                                                 DCRPT160
00500 *     RETRIEVE USAGE                                              DCRPT160
00501 *                                                                 DCRPT160
00502      MOVE REL-POINTER-NAME TO REL-ENTRY-NAME.                     DCRPT160
00503      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT160
00504      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT160
00505      IF REL-RETURN-CODE EQUAL TO ZERO                             DCRPT160
00506          GO TO 3900-EXTRACT-ENTRY.                                DCRPT160
00507      IF REL-RETURN-CODE EQUAL TO "1"                              DCRPT160
00508          GO TO 5000-RETURN-A-LEVEL.                               DCRPT160
00509      MOVE "RR" TO REPORT-ERROR-CODE.                              DCRPT160
00510      MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME.                    DCRPT160
00511      GO TO 8000-ABORT.                                            DCRPT160
00512 *******************************************************           DCRPT160
00513 *                                                                 DCRPT160
00514 *    GO BACK (DOWN) TO PREVIOUSLY PROCESSED REL FILE ENTRY        DCRPT160
00515 *                                                                 DCRPT160
00516 ***************************************************************   DCRPT160
00517  5000-RETURN-A-LEVEL.                                             DCRPT160
00518      IF KEY-CNT NOT LESS THAN 1                                   DCRPT160
00519          GO TO 5100-RESTORE-KEY.                                  DCRPT160
00520      GO TO 0150-READ-WORK-FILE.                                   DCRPT160
00521  5100-RESTORE-KEY.                                                DCRPT160
00522      MOVE KEY-ENTRY-NAME (KEY-CNT) TO REL-ENTRY-NAME.             DCRPT160
00523      MOVE KEY-POINTER-NAME (KEY-CNT) TO REL-POINTER-NAME.         DCRPT160
00524      MOVE KEY-NEXT-REC (KEY-CNT) TO REL-NEXT-REC.                 DCRPT160
00525      SUBTRACT 1 FROM KEY-CNT.                                        CL**2
00526      PERFORM RETURN-POINTER THRU RETURN-POINTER-XIT.              DCRPT160
00527      IF REL-RETURN-CODE NOT EQUAL TO ZERO                         DCRPT160
00528          MOVE "RR" TO REPORT-ERROR-CODE                           DCRPT160
00529          MOVE REL-ENTRY-NAME TO REPORT-ERROR-NAME                 DCRPT160
00530          GO TO 8000-ABORT.                                        DCRPT160
00531 *                                                                 DCRPT160
00532 *    READ POINTER FORM LOWER LEVEL                                DCRPT160
00533 *                                                                 DCRPT160
00534  6000-READ-NEXT-PTR.                                              DCRPT160
00535      MOVE "N" TO REL-ENTRY-FUNCTION.                              DCRPT160
00536      PERFORM REL-READ THRU REL-READ-XIT.                          DCRPT160
00537      IF REL-RETURN-CODE EQUAL TO "1" OR "2"                       DCRPT160
00538          GO TO 5000-RETURN-A-LEVEL.                               DCRPT160
           IF KEY-CNT EQUAL 0 AND ALIAS-CHECK EQUAL "Y" 
               MOVE 2 TO PASS-FLAG
               GO TO 3210-CHECK-ALI.
00539      GO TO 3900-EXTRACT-ENTRY.                                    DCRPT160
00540                                                                    DCRPT16
00541 ***************************************************************   DCRPT160
00542 ***************************************************************   DCRPT160
00543 *                                                                 DCRPT160
00544 *    FORMAT EXTRACT FILE DETAIL RECORDS                           DCRPT160
00545 *        RELATIONAL REPORT.  OUTPUT RECORED                       DCRPT160
00546 *        RELATIONAL REPORT.  OUTPUT RECORDS ARE TABLED AND        DCRPT160
00547 *        WHEN THE TABLE IS FULL CONTROL IS PASSED TO THE          DCRPT160
00548 *        EXTRACT CONTROL MODULE FOR OUTPUT.                       DCRPT160
00549 ***************************************************************   DCRPT160
00550 ***************************************************************   DCRPT160
00551  7000-EXT-OUT.                                                    DCRPT160
00552 *                                                                 DCRPT160
00553 *    OUTPUT ERROR MESSAGE                                         DCRPT160
00554 *                                                                 DCRPT160
00555      IF MSG-SWITCH EQUAL "Y"                                      DCRPT160
00556          MOVE ERROR-LINE TO EXT-OUT-REC (EXT-COUNT)               DCRPT160
00557          MOVE "E" TO EXT-OUTPUT-IND (EXT-COUNT)                   DCRPT160
00558          MOVE "N" TO MSG-SWITCH                                   DCRPT160
00559          GO TO 7080-EXT-OUT-CHECK.                                   CL**2
00560 *                                                                    CL**2
00561 *    OUTPUT WHERE DEFINED RELATIONAL RECORD                          CL**2
00562 *                                                                    CL**2
00563      IF EXT-OUTPUT-IND (EXT-COUNT) NOT EQUAL "4"                     CL**2
00564          GO TO 7020-CHECK-REF.                                       CL**2
00565      MOVE REL-WORK-COMMON TO EXT-RELD-COMMON.                        CL**2
00566      IF RTBL-OPT-SEQ EQUAL "1" OR "2"                                CL**2
00567          MOVE REL-WORK-TYPE TO EXT-RELD-TYPE                         CL**2
00568      ELSE                                                            CL**2
00569          MOVE REL-WORK1-ENTTYPE TO EXT-RELD3-ENTTYPE                 CL**2
00570          MOVE REL-WORK1-NAME     TO EXT-RELD3-NAME                   CL**2
00571          MOVE REL-WORK1-SORTID TO EXT-RELD3-SORTID                   CL**2
00572          MOVE REL-WORK1-RECCODE  TO EXT-RELD3-RECCODE                CL**2
00573          MOVE REL-WORK1-CAT      TO EXT-RELD3-CAT                    CL**2
00574          MOVE REL-WORK1-LINE     TO EXT-RELD3-LINE                   CL**2
00575          MOVE REL-WORK1-CATNAME  TO EXT-RELD3-CATNAME                CL**2
00576          MOVE REL-WORK1-SELNO    TO EXT-RELD3-SELNO.                 CL**2
00577      IF RTBL-OPT-SEQ EQUAL "2"                                       CL**2
00578          SUBTRACT REL-WORK1-ENTTYPE FROM 99                          CL**2
00579                   GIVING EXT-RELD1-ENTTYPE.                          CL**2
00580      MOVE EXT-REL-DEF-REC TO EXT-OUT-REC (EXT-COUNT).                CL**2
00581      GO TO 7080-EXT-OUT-CHECK.                                       CL**2
00582 *                                                                    CL**2
00583 *     OUPUT WHERE REFERENCED REOCRD                                  CL**2
00584 *                                                                    CL**2
00585  7020-CHECK-REF.                                                     CL**2
00586      IF EXT-OUTPUT-IND (EXT-COUNT) NOT EQUAL "5"                     CL**2
00587          GO TO 7080-EXT-OUT-CHECK.                                   CL**2
00588 *   INCREMENT SELECTION COUNT IN RTBL                                CL**2
00589      MOVE REL-WORK1-SELNO TO KSUB1.                                  CL**2
00590      ADD 1 TO RTBL-SELECT-COUNT (KSUB1).                             CL**2
00591      MOVE REL-WORK-COMMON TO EXT-RELR-COMMON.                        CL**2
00592      IF RTBL-OPT-SEQ EQUAL 1                                         CL**2
00593          MOVE REL-WORK1-ENTTYPE TO EXT-RELR1-ENTTYPE                 CL**2
00594          GO TO 7030-FMT-TYPE.                                        CL**2
00595      IF RTBL-OPT-SEQ EQUAL 2                                         CL**2
00596          SUBTRACT REL-WORK1-ENTTYPE FROM 99                          CL**2
00597          GIVING EXT-RELR1-ENTTYPE                                    CL**2
00598          GO TO 7030-FMT-TYPE.                                        CL**2
00599      GO TO 7040-FMT-NAME.                                            CL**2
00600 *                                                                    CL**2
00601 *    SEQUENCE IS TYPE OR REVERSE                                     CL**2
00602 *                                                                    CL**2
00603  7030-FMT-TYPE.                                                      CL**2
00604      MOVE "R" TO EXT-RELR1-RECCODE.                                  CL**2
00605      MOVE REL-WORK1-NAME TO EXT-RELR1-NAME.                          CL**2
00606      MOVE REL-WORK1-SORTID TO EXT-RELR1-SORTID.                      CL**2
00607      MOVE HOLD-REF-NAME TO EXT-RELR1-REFNAME.                        CL**2
00608      MOVE HOLD-REF-TYPE TO EXT-RELR1-REFTYPE.                        CL**2
00609      MOVE HOLD-REF-USAGE TO EXT-RELR1-USAGE.                         CL**2
00610      MOVE HOLD-REF-ALIAS TO EXT-RELR1-ALIAS.                         CL**2
00611      MOVE REL-WORK1-SELNO TO EXT-RELR1-SELNO.                        CL**2
00612      GO TO 7050-TABLE-REF.                                           CL**2
00613 *                                                                    CL**2
00614 *    SEQUENCE IS NAME                                                CL**2
00615 *                                                                    CL**2
00616  7040-FMT-NAME.                                                      CL**2
00617      MOVE REL-WORK1-ENTTYPE TO EXT-RELR3-ENTTYPE.                    CL**2
00618      MOVE REL-WORK1-NAME TO EXT-RELR3-NAME.                          CL**2
00619      MOVE REL-WORK1-SORTID TO EXT-RELR3-SORTID.                      CL**2
00620      MOVE REL-WORK1-SELNO TO EXT-RELR3-SELNO.                        CL**2
00621      MOVE "R" TO EXT-RELR3-RECCODE.                                  CL**2
00622      MOVE HOLD-REF-NAME TO EXT-RELR3-REFNAME.                        CL**2
00623      MOVE HOLD-REF-TYPE TO EXT-RELR3-REFTYPE.                        CL**2
00624      MOVE HOLD-REF-USAGE TO EXT-RELR3-USAGE.                         CL**2
00625      MOVE HOLD-REF-ALIAS TO EXT-RELR3-ALIAS.                         CL**2
00626  7050-TABLE-REF.                                                     CL**2
00627      MOVE EXT-REL-REF-REC TO EXT-OUT-REC (EXT-COUNT).                CL**2
00628  7080-EXT-OUT-CHECK.                                                 CL**2
00629      IF EXT-COUNT GREATER THAN 29                                    CL**2
           CLOSE MAST1                                                  000177
00630          MOVE "4" TO RTBL-MOD-REQ                                    CL**2
           EXIT PROGRAM.
00632      ADD 1 TO EXT-COUNT.                                             CL**2
00633      GO TO 7099-EXT-OUT-XIT.                                         CL**2
00634  7090-EXT-OUT-RETURN.                                                CL**2
           OPEN INPUT MAST1                                             000179
00635      MOVE 1 TO EXT-COUNT.                                            CL**2
00636      MOVE ZERO TO RTBL-MOD-REQ.                                      CL**2
00637  7099-EXT-OUT-XIT.                                                   CL**2
00638      EXIT.                                                           CL**2
00639                                                                    DCRPT16
00640 **************************************************************    DCRPT160
00641 **************************************************************    DCRPT160
00642 *                                                                 DCRPT160
00643 *    UNUSUAL END OF MODULE PROCESSING                             DCRPT160
00644 *                                                                 DCRPT160
00645 ***********************************************************       DCRPT160
00646 ***********************************************************       DCRPT160
00647  PROGRAM-END-BAD.                                                 DCRPT160
00648  8000-ABORT.                                                      DCRPT160
00649      MOVE SPACES TO ERROR-LINE.                                   DCRPT160
00650      IF REPORT-ERROR-CODE EQUAL "DR"                              DCRPT160
               MOVE "MAST1 READ ERROR" TO ERROR-TYPE
00652      ELSE                                                         DCRPT160
               MOVE "MAST2 READ ERROR" TO ERROR-TYPE. 
00654      MOVE REPORT-ERROR-NAME TO ERROR-NAME.                        DCRPT160
00655      MOVE "Y" TO MSG-SWITCH.                                      DCRPT160
00656      PERFORM 7000-EXT-OUT THRU 7099-EXT-OUT-XIT.                  DCRPT160
00657      MOVE "8" TO RTBL-MOD-REQ.                                    DCRPT160
00658      GO TO 9010-ERROR-END.                                        DCRPT160
00659                                                                    DCRPT16
00660 **************************************************************    DCRPT160
00661 **************************************************************    DCRPT160
00662 *                                                                 DCRPT160
00663 *    END OF MODULE PROCESSING                                     DCRPT160
00664 *                                                                 DCRPT160
00665 ***************************************************************   DCRPT160
00666 ***************************************************************   DCRPT160
00667  9000-EXTRACT-END.                                                DCRPT160
00668      MOVE "9" TO RTBL-MOD-REQ.                                    DCRPT160
00669  9010-ERROR-END.                                                  DCRPT160
00670      PERFORM REL-CLOSE THRU REL-CLOSE-XIT.                        DCRPT160
00671      PERFORM CON-CLOSE THRU CON-CLOSE-XIT.                        DCRPT160
00672      CLOSE MAST1.                                                 DCRPT160
00673      CLOSE RELATIONAL-WORK-FILE.                                  DCRPT160
           EXIT PROGRAM.
      **************************************************************
      * 
      *    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     MAST1RFL                                                      DCRPT160
*CALL     MAST1RNL                                                      DCRPT160
*CALL     MAST1RFC                                                      DCRPT160
*CALL     MAST1EXT                                                      DCRPT160
*CALL     MAST1READ                                                     DCRPT160
*CALL     MAST1ALG                                                      DCRPT160
*CALL     MAST1RK                                                       DCRPT160
*CALL     MAST3IO1                                                      DCRPT160
*CALL     RELCOM                                                        DCRPT160
*CALL     MAST2RK                                                       DCRPT160
*CALL     RELALG                                                        DCRPT160
*CALL     MAST3INT                                                      DCRPT160
