*DECK     DCCBL315
00001  IDENTIFICATION DIVISION.                                         10/05/78
       PROGRAM-ID. CBL315.
00003  ENVIRONMENT DIVISION.                                               LV002
00004  CONFIGURATION SECTION.                                           DCCBL315
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00007  DATA DIVISION.                                                   DCCBL315
*CALL GENCS 
*CALL     WRKSTG77                                                         CL**5
*CALL     MAST1WS                                                          CL**5
*CALL     TESTWACOM                                                        CL**5
*CALL DCDWA13 
*CALL     DCDWA10                                                          CL**5
*CALL     DCDWA05                                                          CL**5
*CALL     GEN20DAT                                                         CL**2
*CALL     CBL15DAT                                                         CL**5
*CALL     CBL10DAT                                                         CL**5
*CALL     GEN10DAT                                                         CL**5
*CALL     CBL05DAT                                                         CL**5
*CALL     GEN05DAT                                                         CL**5
*CALL     CBLDEF                                                           CL**2
00030                                                                    DCCBL31
00031  PROCEDURE DIVISION.                                              DCCBL315
00035 *************************************************                    CL**2
00036 *************************************************                    CL**2
00037 *                                                                    CL**2
00038 *    CHECK CALLING MODULES RETURNS FROM I/O REQUESTS                 CL**2
00039 *                                                                    CL**2
00040 *************************************************                    CL**2
00041 *************************************************                    CL**2
00042  0000-BEGIN.                                                         CL**2
00043      IF GTBL-MOD-REQ EQUAL "1"                                       CL**2
00044          GO TO DATA-READ-RETURN.                                     CL**2
00045      IF GTBL-MOD-REQ EQUAL "4"                                       CL**2
00046          GO TO CBL-OUT-RETURN.                                       CL**2
00047 *****************************************************                CL**2
00048 *****************************************************                CL**2
00049 *                                                                    CL**2
00050 *      INITIALIZATION                                                CL**2
00051 *                                                                    CL**2
00052 ****************************************************                 CL**2
00053 ****************************************************                 CL**2
00054      MOVE 0 TO GROUP-SUB.                                            CL**2
00055      MOVE 0 TO GTBL-COUNT.                                           CL**2
00056      MOVE SPACES TO DATA-ARG-LIST.                                   CL**2
00057      MOVE SPACES TO DATA-LAST-ENTRY-NAME.                            CL**2
00058      MOVE "N" TO MSG-SWITCH, DES-NOTES-SWITCH.                       CL**2
00060      PERFORM LEVEL-INIT THRU LEVEL-INIT-XIT.                         CL**2
00061      IF GTBL-SEL-TYPE EQUAL "15" OR "13"                             CL**2
00062          MOVE GTBL-SEL-CNAME TO DATA-ENTRY-NAME                      CL**2
00063          GO TO 0075-CBL15.                                           CL**2
00064      IF GTBL-SEL-TYPE EQUAL "20" OR "19"                             CL**2
00065          GO TO 0010-CBL15.                                           CL**2
00066 ******************************************************************   CL**2
00067 *     TOTAL RECORD GENERATION FROM DATABASE                          CL**2
00068 ****************************************************************     CL**2
00069      MOVE GTBL-SEL-CNAME TO DATA-ENTRY-NAME.                         CL**2
00070      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00071      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00072  0001-CBL15.                                                         CL**2
00073      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00074      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00075          PERFORM 9010-NO-STC-MSSG THRU 9010-NO-STC-MSSG-XIT          CL**2
00076          GO TO 8000-CBL15-END.                                       CL**2
00077  0002-CBL15.                                                         CL**2
           IF STC-SR-CNAME EQUAL SPACES 
               GO TO 0005-CBL15.
00078      MOVE DATA-SEARCH TO GEN32-SAVE-SEARCH.                          CL**2
00079      MOVE CAT-LINE TO GEN32-DATA-ENTRY-LINE.                         CL**2
00080      MOVE STC-SR-CNAME TO DATA-ENTRY-NAME.                           CL**2
00081      GO TO 0012-CBL15.                                               CL**2
00082  0003-CBL15.                                                         CL**2
00083      MOVE GEN32-SAVE-SEARCH TO DATA-SEARCH.                          CL**2
00084      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
00085  0005-CBL15.                                                         CL**2
00086      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00087      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00088      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00089          GO TO 8000-CBL15-END.                                       CL**2
00090      GO TO 0002-CBL15.                                               CL**2
00091 ****************************************************************     CL**2
00092 *     GENERATE AT FILE LEVEL     TYPE 20   19                        CL**2
00093 ****************************************************************     CL**2
00094  0010-CBL15.                                                         CL**2
00095      MOVE GTBL-SEL-CNAME TO DATA-ENTRY-NAME.                         CL**2
00096  0012-CBL15.                                                         CL**2
00097      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00098      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00099  0013-CBL15.                                                         CL**2
00100      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00101      IF DATA-RETURN-CODE EQUAL TO 0                                  CL**2
00102          GO TO 0019-CBL15.                                           CL**2
00103      PERFORM 9010-NO-STC-MSSG THRU 9010-NO-STC-MSSG-XIT.             CL**2
00104      GO TO 0030-CBL15.                                               CL**2
00105  0017-CBL15.                                                         CL**2
00106      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00107      GO TO 0013-CBL15.                                               CL**2
00108 *                                                                    CL**2
00109 *    CHECK FOR TYPE 15                                               CL**2
00110 *                                                                    CL**2
00111  0019-CBL15.                                                         CL**2
           IF STC-SR-CNAME EQUAL SPACES 
               PERFORM 9080-BLANK-STC THRU 9080-BLANK-STC-XIT 
               GO TO 0017-CBL15.
00112      MOVE DATA-SEARCH TO GEN20-SAVE-SEARCH.                          CL**2
00113      MOVE CAT-LINE TO SAVE-DATA-ENTRY-LINE.                          CL**2
           MOVE MINUS-ASTER TO SAVE-STC.
00115      MOVE STC-SR-CNAME TO DATA-ENTRY-NAME.                           CL**2
00116      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00117      IF DATA-HDR-ENT-ID EQUAL "15" OR "13"                           CL**2
00118          GO TO 0075-CBL15.                                           CL**2
00119      PERFORM 9040-BAD-DATA-MSSG THRU 9040-BAD-DATA-MSSG-XIT.         CL**2
00120      MOVE GEN20-SAVE-SEARCH TO DATA-SEARCH.                          CL**2
00121      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
00122      GO TO 0017-CBL15.                                               CL**2
00123 *                                                                    CL**2
00124 *    CHECK FOR TYPE 20                                               CL**2
00125 *                                                                    CL**2
00126  0020-CBL15.                                                         CL**2
00127      IF GTBL-SEL-TYPE EQUAL "20" OR "19" OR "32"                     CL**2
00128          NEXT SENTENCE                                               CL**2
00129      ELSE                                                            CL**2
00130          GO TO 8000-CBL15-END.                                       CL**2
00131      MOVE GEN20-SAVE-SEARCH TO DATA-SEARCH.                          CL**2
00132      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
00133  0025-CBL15.                                                         CL**2
00134      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00135      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00136      IF DATA-RETURN-CODE EQUAL TO 0                                  CL**2
00137          GO TO 0019-CBL15.                                           CL**2
00138  0030-CBL15.                                                         CL**2
00139      IF GTBL-SEL-TYPE NOT EQUAL 32                                   CL**2
00140          GO TO 8000-CBL15-END.                                       CL**2
00141      GO TO 0003-CBL15.                                               CL**2
00142                                                                    DCCBL31
00143 ***************************************************************      CL**2
00144 *                                                                    CL**2
00145 *    PROCESS RECORD ENTRY                                            CL**2
00146 *                                                                    CL**2
00147 ***************************************************************      CL**2
00148  0075-CBL15.                                                         CL**2
           MOVE 1 TO LEVEL-IDX. 
           MOVE SPACES TO GROUP-SAVE-AREAS. 
00149 ***************************************************************      CL**2
00150 *     GET RECORD NAME                                                CL**2
00151 ***************************************************************      CL**2
00152      PERFORM CHECK-DESCRIPTION THRU CHECK-DESCRIPTION-XIT.           CL**2
           MOVE DATA-ENTRY-NAME TO ITEM-CATNAME.
           MOVE SPACES TO ITEM-ALIAS. 
           PERFORM FIND-DATANAME THRU FIND-DATANAME-XIT.
00165      MOVE SPACES TO CBL-CARD-IMAGE.                                  CL**2
00166      MOVE WORK-DATA-NAME TO CBL-NAME-01.                             CL**2
00167      MOVE LEVEL-01 TO CBL-01                                         CL**2
00168      MOVE CBL-CARD-IMAGE TO SCAN-AREA.                               CL**2
00169      PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE-XIT.         CL**2
00170 ***************************************************************      CL**2
00171 *    GET FIRST STRUCTURE LINE                                        CL**2
00172 ***********************************************************          CL**2
00173      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00174      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
           PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.
           MOVE "N" TO FOUND-STC. 
  
       0100-CBL15.
  
      * LOOK FOR INCLUDED STRUCTURE LINE OF STANDARD LINETYPE.
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             IF (CAT-LINE-TYPE = "A" OR SPACE)
               AND STC-DBD-INC NOT = "N"
             THEN 
               MOVE "Y" TO FOUND-STC
               IF STC-SR-CNAME = SPACES 
               THEN 
                 PERFORM 9080-BLANK-STC THRU 9080-BLANK-STC-XIT 
               ELSE 
                 MOVE DATA-ENTRY-NAME TO GROUP-ENTRY-NAME (LEVEL-IDX) 
                 MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
                 MOVE SPACES TO SAVE-ELE-STC-CAT
                 MOVE MINUS-ASTER TO SAVE-ELE-STC-A 
  
      * CHECK FOR OCCURS STRUCTURE LINE.
                 PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
                 PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
                 IF CAT-LINE-TYPE = "O" 
                   AND DATA-RETURN-CODE = ZERO
                 THEN 
                   MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
                   MOVE MINUS-ASTER TO SAVE-ELE-STC-O 
                 END-IF 
                 GO TO 0200-CBL15 
               END-IF 
             END-IF 
  
      * IF NOT AN INCLUDED STANDARD LINE, READ NEXT LINE INTO "CAT-WORK"
             PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
             PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
           END-PERFORM
  
      * ERROR IF NO INCLUDED STRUCTURE LINE FOUND.
           IF FOUND-STC = "N" 
           THEN 
             PERFORM 9010-NO-STC-MSSG THRU 9010-NO-STC-MSSG-XIT 
           END-IF 
  
      * LOOP BACK FOR NEXT RECORD.
           GO TO 0020-CBL15.
  
       0200-CBL15.
  
      * FIRST CHECK FOR "FILLER" ENTRY. 
           IF SAVE-ELE-STC-CNAME = FILLERKW 
           THEN 
             PERFORM PROC-FILLER THRU PROC-FILLER-XIT 
             GO TO 0500-CBL15 
           END-IF 
  
      * READ FIRST RECORD OF NEXT STRUCTURE LEVEL.
           MOVE SAVE-ELE-STC-CNAME TO DATA-ENTRY-NAME.
00197      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00198      IF DATA-RETURN-CODE NOT EQUAL ZERO                              CL**2
00199          PERFORM 9030-NO-DATA-MSSG THRU 9030-NO-DATA-MSSG-XIT        CL**2
00200          GO TO 0500-CBL15.                                           CL**2
00201      IF DATA-HDR-ENT-ID EQUAL TO "09" OR "10"                        CL**2
               MOVE SAVE-ELE-STC-CAT TO SAVE-GRP-STC-CAT
               MOVE SPACES TO SAVE-ELE-STC-CAT
00203          GO TO 5000-CBL15.                                           CL**2
00204      IF DATA-HDR-ENT-ID EQUAL "05"                                   CL**2
00206          MOVE SPACES TO SAVE-GRP-ATTR-CAT                            CL**2
00207          MOVE ZERO TO GROUP-SUB                                      CL**2
00208          GO TO 1000-CBL15.                                           CL**2
00209      PERFORM 9020-BAD-ENTITY THRU 9020-BAD-ENTITY-XIT.               CL**2
00210  0500-CBL15.                                                         CL**2
           PERFORM RESTORE-STRUCTURE THRU RESTORE-STRUCTURE-XIT.
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.
           PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.
           GO TO 0100-CBL15.
00228                                                                    DCCBL31
00229 *****************************************************************    CL**2
00230 *****************************************************************    CL**2
00231 *                                                                *   CL**2
00232 *     PROCESS ELEMENT                                            *   CL**2
00233 *                                                                *   CL**2
00234 *****************************************************************    CL**2
00235 *****************************************************************    CL**2
00236  1000-CBL15.                                                         CL**2
00237      PERFORM CHECK-DESCRIPTION THRU CHECK-DESCRIPTION-XIT.           CL**2
00238      MOVE SAVE-ELE-STC-CNAME TO GEN-ELEMENT-NAME.                    CL**2
00239 *****************************************************************    CL**2
00240 *     RETREIVE DATA NAME (PREFERRED)                                 CL**2
00241 *****************************************************************    CL**2
00242      MOVE NAME-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00243      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00244      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00245      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00246          MOVE GEN-ELEMENT-NAME TO ELE-DATA-NAME                      CL**2
00247          GO TO 1010-CBL15.                                           CL**2
00248      IF NAME-DATA-NAME EQUAL SPACES                                  CL**2
00249          MOVE GEN-ELEMENT-NAME TO ELE-DATA-NAME                      CL**2
00250      ELSE                                                            CL**2
00251          MOVE NAME-DATA-NAME TO ELE-DATA-NAME.                       CL**2
00252 *****************************************************************    CL**2
00253 *     RETREIVE ATTRIBUTES CATEGORY PLACE IN ATTRIUBUTES WORK AREA*   CL**2
00254 *****************************************************************    CL**2
00255  1010-CBL15.                                                         CL**2
00256      MOVE ATTR-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00257      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00258      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00259      IF DATA-RETURN-CODE EQUAL ZERO                                  CL**2
               MOVE MINUS-ASTER TO ELEMENT-ATTRIBUTES 
00261          MOVE CAT-LINE TO ELE-ATTR-LAST                              CL**2
00262          MOVE SPACE TO ELE-ALIAS-CODE                                CL**2
00263      ELSE                                                            CL**2
00264          MOVE SPACES TO ELEMENT-ATTRIBUTES.                          CL**2
00265 *****************************************************************    CL**2
00266 *     CHECK FOR ALIAS CATEGORY REFERENCE IN STRUCTURE LINE           CL**2
00267 *     USE ALIAS CATEGORY ATTRIBUTES IF SO                            CL**2
00268 ******************************************************************   CL**2
00269  1015-CBL15.                                                         CL**2
00270      IF SAVE-ELE-STC-ALY-NO EQUAL TO SPACES                          CL**2
00271          GO TO 1100-CBL15.                                           CL**2
00272      MOVE ALIAS-CAT-NO TO DATA-ENTRY-CAT.                            CL**2
00273      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00274  1025-CBL15.                                                         CL**2
00275      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00276          GO TO 1100-CBL15.                                           CL**2
00277      IF CAT-LINE EQUAL SAVE-ELE-STC-ALY-NO                           CL**2
00278          GO TO 1050-CBL15.                                           CL**2
00279      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00280      GO TO 1025-CBL15.                                               CL**2
00281  1050-CBL15.                                                         CL**2
00282 *                                                                    CL**2
00283 *    IF THE ALIAS LINE NUMBER FOUND MATCHES AND                      CL**2
00284 *        IT IS A COMMENT LINE---MUST CHECK FOR A REDEFINITION        CL**2
00285 *        OF THE ENTRY CURRENTLY BEING PROCESSED                      CL**2
00286 *                                                                    CL**2
00287      IF CAT-COMMENT NOT EQUAL TO "*"                                 CL**2
00288          GO TO 1075-CBL15.                                           CL**2
00289      MOVE 0 TO LEN-P.                                                CL**2
00290      MOVE MINUS-ASTER TO SCAN-AREA.                                  CL**2
           PERFORM FIND-REDEFINE THRU FIND-REDEFINE-XIT.
00292      IF LITERAL-SW EQUAL TO "Y"                                      CL**2
               GO TO 1125-CBL15.
00294      PERFORM 9080-REDEFINE-MSSG THRU 9080-REDEFINE-MSSG-XIT.         CL**2
00295      IF IN-GROUP-SW EQUAL TO "Y"                                     CL**2
00296          GO TO 6390-CBL15.                                           CL**2
00297      GO TO 0500-CBL15.                                               CL**2
00298  1075-CBL15.                                                         CL**2
00299      IF ALY-DATA-NAME NOT EQUAL TO SPACES                            CL**2
00300          MOVE ALY-DATA-NAME TO ELE-DATA-NAME.                        CL**2
00301      IF ALY-PIC NOT EQUAL TO SPACES                                  CL**2
00302          MOVE ALY-PIC TO ELE-PIC.                                    CL**2
00303      IF ALY-LENGTH NOT EQUAL TO SPACES                               CL**2
00304          MOVE ALY-LENGTH TO ELE-LENGTH.                              CL**2
00305      IF ALY-FORMAT NOT EQUAL TO SPACES                               CL**2
00306          MOVE ALY-FORMAT TO ELE-FORMAT.                              CL**2
00307      IF ALY-JUST NOT EQUAL TO SPACES                                 CL**2
00308          MOVE ALY-JUST TO ELE-JUST.                                  CL**2
00309      IF ALY-SYNC NOT EQUAL TO SPACES                                 CL**2
00310          MOVE ALY-SYNC TO ELE-SYNC.                                  CL**2
00311      IF ALY-INT-VALUE NOT EQUAL TO SPACES                            CL**2
00312          MOVE ALY-INT-VALUE TO ELE-INT-VALUE.                        CL**2
00313      MOVE CAT-LINE TO ELE-ATTR-LAST.                                 CL**2
00314      MOVE "Y" TO ELE-ALIAS-CODE.                                     CL**2
00315 *****************************************************************    CL**2
00316 *     CHECK TO SEE IF GROUP ATTRIBUTES ARE TO BE USED                CL**2
00317 *     THESE OVERRIDE ELEMENT ATTRIBUTES                              CL**2
00318 *****************************************************************    CL**2
00319  1100-CBL15.                                                         CL**2
00320      IF SAVE-GRP-ATTR-LENGTH NOT EQUAL TO SPACES                     CL**2
00321          MOVE SAVE-GRP-ATTR-LENGTH TO ELE-LENGTH.                    CL**2
00322      IF SAVE-GRP-ATTR-FORMAT NOT EQUAL TO SPACES                     CL**2
00323          MOVE SAVE-GRP-ATTR-FORMAT TO ELE-FORMAT.                    CL**2
00324      IF SAVE-GRP-ATTR-PICTURE NOT EQUAL TO SPACES                    CL**2
00325          MOVE SAVE-GRP-ATTR-PICTURE TO ELE-PIC.                      CL**2
00326      IF SAVE-GRP-ATTR-JUST NOT EQUAL TO SPACES                       CL**2
00327          MOVE SAVE-GRP-ATTR-JUST TO ELE-JUST.                        CL**2
00328      IF SAVE-GRP-ATTR-SYNC NOT EQUAL TO SPACES                       CL**2
00329          MOVE SAVE-GRP-ATTR-SYNC TO ELE-SYNC.                        CL**2
00330 ******************************************************************   CL**2
00331 *     GENERATE LEVEL NUMBER AND NAME                                 CL**2
00332 *****************************************************************    CL**2
00333  1125-CBL15.                                                         CL**2
00334      MOVE ELE-DATA-NAME TO WS-DATA-NAME.                             CL**2
00335      PERFORM INSERT-PREFIX THRU INSERT-PREFIX-XIT.                   CL**2
00336      PERFORM LAYOUT-PCH-CARD THRU LAYOUT-PCH-CARD-XIT.               CL**2
00337      IF LITERAL-SW NOT EQUAL TO "Y"                                  CL**2
00338          GO TO 1175-CBL15.                                           CL**2
00339      MOVE CBL-CARD-IMAGE TO SCAN-AREA.                               CL**2
00340      PERFORM FLOAT-PERIOD THRU FLOAT-PERIOD-XIT.                     CL**2
00341      MOVE SCAN-AREA TO HOLD-CARD-IMAGE.                              CL**2
00342      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00343 *                                                                    CL**2
00344 *    READ NEXT LINE OF ALIAS CATEGORY TO DETERMINE IF                CL**2
00345 *        REDEFINITION OF ELEMENT IS FINISHED                         CL**2
00346 *                                                                    CL**2
00347  1130-CBL15.                                                         CL**2
00348      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00349      IF CAT-COMMENT NOT EQUAL TO "*"                                 CL**2
00350          GO TO 1150-CBL15.                                           CL**2
00351      MOVE 0 TO LEN-P.                                                CL**2
           MOVE MINUS-ASTER TO SCAN-AREA. 
00353      PERFORM FIND-REDEFINE THRU FIND-REDEFINE-XIT.                   CL**2
00354      IF LITERAL-SW EQUAL TO "X"                                      CL**2
00355          MOVE "N" TO LITERAL-SW                                      CL**2
               GO TO 1300-CBL15.
00357      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00358      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
           THEN 
             PERFORM 9080-REDEFINE-MSSG THRU 9080-REDEFINE-MSSG-XIT 
             MOVE "N" TO LITERAL-SW 
             IF IN-GROUP-SW = "Y" 
             THEN 
               GO TO 6390-CBL15 
             ELSE 
               GO TO 0500-CBL15 
             END-IF 
           END-IF 
00361 *                                                                    CL**2
00362 *    ALIAS LINE EXISTS AND IS A REDEFINITION OF CURRENT ENTRY        CL**2
00363 *                                                                    CL**2
00364  1150-CBL15.                                                         CL**2
00365      MOVE ALY-DATA-NAME TO ELE-DATA-NAME.                            CL**2
00366      MOVE ALY-PIC TO ELE-PIC.                                        CL**2
00367      MOVE ALY-LENGTH TO ELE-LENGTH.                                  CL**2
00368      MOVE ALY-FORMAT TO ELE-FORMAT.                                  CL**2
00369      MOVE ALY-JUST TO ELE-JUST.                                      CL**2
00370      MOVE ALY-SYNC TO ELE-SYNC.                                      CL**2
00371      MOVE ALY-INT-VALUE TO ELE-INT-VALUE.                            CL**2
00372      MOVE ELE-DATA-NAME TO WS-DATA-NAME.                             CL**2
00373      ADD 1 TO GROUP-SUB.                                             CL**2
00374      PERFORM INSERT-PREFIX THRU INSERT-PREFIX-XIT.                   CL**2
00375      PERFORM LAYOUT-PCH-CARD THRU LAYOUT-PCH-CARD-XIT.               CL**2
00376      GO TO 1300-CBL15.                                               CL**2
00377 *************                                                        CL**2
00378 *     CHECK FOR REDEFINES CLAUSE                                     CL**2
00379 **********                                                           CL**2
       1175-CBL15.
00380      IF SAVE-ELE-STC-REDEFINES EQUAL SPACES                          CL**2
00381          GO TO 1300-CBL15.                                           CL**2
00382      MOVE CBL-CARD-IMAGE TO HOLD-CARD-IMAGE.                         CL**2
00383      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00384      MOVE SPACES TO CARD-IMAGE-RED.                                  CL**2
00385      MOVE REDEFKW TO C-RED-DEF.                                      CL**2
00386 ******************************************************               CL**2
00387 *          RETRIEVE PREFERRED DATA NAME OF REDEFINES CLAUSE          CL**2
00388 ******************************************************               CL**2
           MOVE SAVE-ELE-STC-REDEFINES TO ITEM-CATNAME. 
           MOVE SAVE-ELE-STC-REDEF-ALIAS TO ITEM-ALIAS. 
           PERFORM FIND-DATANAME THRU FIND-DATANAME-XIT.
           MOVE WORK-DATA-NAME TO C-RED-VAL.
           MOVE CARD-IMAGE-RED TO HOLD-CARD-IMAGE.
00407      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00408 *********************************************                        CL**2
00409 *     CHECK FOR PICTURE CLAUSE                                       CL**2
00410 *********************************************                        CL**2
00411  1300-CBL15.                                                         CL**2
00412      MOVE SPACES TO CARD-IMAGE-PIC.                                  CL**2
00413      IF ELE-PIC EQUAL SPACES                                         CL**2
00414          GO TO 1302-CBL15.                                           CL**2
00415      MOVE PICTUREKW TO C-PIC-DEF.                                    CL**2
00416      MOVE ELE-PIC TO C-PIC-VAL.                                      CL**2
00417      IF ELE-FORMAT EQUAL "B"                                         CL**2
00418          MOVE COMPKW TO C-PIC-USAGE.                                 CL**2
00419      IF ELE-FORMAT EQUAL "P"                                         CL**2
00420          MOVE COMP3KW TO C-PIC-USAGE.                                CL**2
00421      IF ELE-FORMAT EQUAL "F"                                         CL**2
00422          MOVE COMP1KW TO C-PIC-USAGE.                                CL**2
00423      IF SAVE-ELE-STC-REDEFINES NOT EQUAL TO SPACES                   CL**2
00424          MOVE CARD-IMAGE-PIC TO SCAN-AREA                            CL**2
00425          PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE-XIT      CL**2
00426          GO TO 1940-CBL15.                                           CL**2
00427      PERFORM PLACE-PICTURE THRU PLACE-PICTURE-XIT.                   CL**2
00428      GO TO 1330-CBL15.                                               CL**2
00429 ************                                                         CL**2
00430 *     IF FORMAT OR LENGTH MISSING SET TO DEFAULT                     CL**2
00431 ****************                                                     CL**2
00432  1302-CBL15.                                                         CL**2
00433      IF ELE-LENGTH EQUAL SPACES                                      CL**2
00434          MOVE 1 TO ELE-LENGTH                                        CL**2
00435          GO TO 1305-CBL15.                                           CL**2
00436      IF ELE-FORMAT EQUAL SPACES                                      CL**2
00437          MOVE "C" TO ELE-FORMAT                                      CL**2
00438          PERFORM 9050-PIC-DEFAULT THRU 9050-PIC-DEFAULT-XIT.         CL**2
00439      GO TO 1320-CBL15.                                               CL**2
00440  1305-CBL15.                                                         CL**2
00441      IF ELE-FORMAT EQUAL SPACES                                      CL**2
00442          MOVE "C" TO ELE-FORMAT.                                     CL**2
00443      PERFORM 9050-PIC-DEFAULT THRU 9050-PIC-DEFAULT-XIT.             CL**2
00444 **********                                                           CL**2
00445 *     PICTURE CLAUSE MUST BE CONSTRUCTED                             CL**2
00446 ***********                                                          CL**2
00447  1320-CBL15.                                                         CL**2
00448      MOVE SPACES TO CARD-IMAGE-BLANK-PIC.                            CL**2
00449      MOVE PICTUREKW TO C-BLANK-PIC-DEF.                              CL**2
00450      MOVE LEFTPAREN TO C-BLANK-PIC-L-PAREN.                          CL**2
00451      MOVE ELE-LENGTH TO C-BLANK-PIC-LENGTH.                          CL**2
00452      IF ELE-FORMAT EQUAL "C"                                         CL**2
00453          MOVE XKW TO C-BLANK-PIC-MODE                                CL**2
00454      ELSE                                                            CL**2
00455          MOVE 9KW TO C-BLANK-PIC-MODE.                               CL**2
00456      IF ELE-FORMAT EQUAL "P"                                         CL**2
00457          MOVE COMP3KW TO C-BLANK-PIC-USAGE.                          CL**2
00458      IF ELE-FORMAT EQUAL "B"                                         CL**2
00459          MOVE COMPKW TO C-BLANK-PIC-USAGE.                           CL**2
00460      IF ELE-FORMAT EQUAL "F"                                         CL**2
00461          MOVE COMP1KW TO C-BLANK-PIC-USAGE.                          CL**2
00462      PERFORM SQUEEZE-PICTURE THRU SQUEEZE-PICTURE-XIT.               CL**2
00463      IF SAVE-ELE-STC-REDEFINES NOT EQUAL TO SPACES                   CL**2
00464          MOVE CARD-IMAGE-PIC TO SCAN-AREA                            CL**2
00465          PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE-XIT      CL**2
00466          GO TO 1940-CBL15.                                           CL**2
00467      PERFORM PLACE-PICTURE THRU PLACE-PICTURE-XIT.                   CL**2
00468  1330-CBL15.                                                         CL**2
00469      IF SAVE-ELE-STC-OCC-FROM NOT EQUAL SPACES                       CL**2
00470          PERFORM CBL-OUT THRU CBL-OUT-XIT                            CL**2
00471          GO TO 1400-CBL15.                                           CL**2
00472      IF SAVE-ELE-STC-OCC-TO NOT EQUAL SPACES                         CL**2
00473          PERFORM CBL-OUT THRU CBL-OUT-XIT                            CL**2
00474          GO TO 1500-CBL15.                                           CL**2
00475      IF ELE-JUST EQUAL "R"                                           CL**2
00476          PERFORM CBL-OUT THRU CBL-OUT-XIT                            CL**2
00477          GO TO 1910-CBL15.                                           CL**2
00478      IF ELE-SYNC EQUAL "Y"                                           CL**2
00479          PERFORM CBL-OUT THRU CBL-OUT-XIT                            CL**2
00480          GO TO 1915-CBL15.                                           CL**2
00481      IF ELE-INT-VALUE NOT EQUAL SPACES                               CL**2
00482          GO TO 1920-CBL15.                                           CL**2
00483      MOVE HOLD-CARD-IMAGE TO SCAN-AREA.                              CL**2
00484      PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE-XIT.         CL**2
00485      GO TO 1940-CBL15.                                               CL**2
00486 *****************************************************************    CL**2
00487 *     CHECK FOR OCCURS CLAUSE                                        CL**2
00488 *****************************************************************    CL**2
00489  1400-CBL15.                                                         CL**2
00490      MOVE SPACES TO CARD-IMAGE-OCC.                                  CL**2
00491      MOVE OCCURKW1 TO C-OCCUR-DEF.                                   CL**2
00492      MOVE OCCURKW2 TO C-FROM.                                        CL**2
00493      MOVE SAVE-ELE-STC-OCC-FROM TO C-FROM-VAL.                       CL**2
00494      MOVE OCCURKW3 TO C-TO.                                          CL**2
00495      MOVE SAVE-ELE-STC-OCC-TO TO C-TO-VAL.                           CL**2
00496      MOVE TIMESKW TO C-TO-TIMES.                                     CL**2
00497      GO TO 1600-CBL15.                                               CL**2
00498  1500-CBL15.                                                         CL**2
00499      MOVE SPACES TO CARD-IMAGE-OCC.                                  CL**2
00500      MOVE OCCURKW1 TO C-OCCUR-DEF.                                   CL**2
00501      MOVE TIMESKW TO C-TIMES.                                        CL**2
00502      MOVE SAVE-ELE-STC-OCC-TO TO C-OCCUR-VAL.                        CL**2
00503  1600-CBL15.                                                         CL**2
00504      MOVE CARD-IMAGE-OCC TO HOLD-CARD-IMAGE.                         CL**2
00505 *****************************************************************    CL**2
00506 *     CHECK TOR DEPENDING ON CLAUSE                                  CL**2
00507 *****************************************************************    CL**2
00508  1700-CBL15.                                                         CL**2
00509      IF SAVE-ELE-STC-DEPEND EQUAL TO SPACES                          CL**2
00510          GO TO 1800-CBL15.                                           CL**2
00511      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00512      MOVE SPACES TO CARD-IMAGE-DEP.                                  CL**2
00513      MOVE DEPENDKW TO C-DEP-DEF.                                     CL**2
           MOVE SAVE-ELE-STC-DEPEND TO ITEM-CATNAME.
           MOVE SAVE-ELE-STC-DEP-ALIAS TO ITEM-ALIAS. 
           MOVE "Y" TO DATANAME-OK. 
           PERFORM FIND-DATANAME THRU FIND-DATANAME-XIT.
00516      MOVE WORK-DATA-NAME TO C-DEP-NAME.                              CL**2
00517      MOVE CARD-IMAGE-DEP TO HOLD-CARD-IMAGE.                         CL**2
00518 *****************************************************************    CL**2
00519 *     CHECK FOR INDEXED BY CLAUSE                                    CL**2
00520 *****************************************************************    CL**2
00521  1800-CBL15.                                                         CL**2
           PERFORM RESTORE-STRUCTURE THRU RESTORE-STRUCTURE-XIT.
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.
           PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.
           MOVE "Y" TO FIRST-INDEX. 
  
       1810-CBL15.
           IF CAT-LINE-TYPE = "I" 
             AND DATA-RETURN-CODE = ZERO
           THEN 
             MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
             MOVE MINUS-ASTER TO SAVE-ELE-STC-INDEX 
             PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
             PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
           END-IF 
  
00522      IF SAVE-ELE-STC-INDEX EQUAL TO SPACES                           CL**2
               GO TO 1850-CBL15.
00524      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00525      MOVE SPACES TO CARD-IMAGE-IND.                                  CL**2
           IF FIRST-INDEX = "Y" 
           THEN 
             MOVE INDEXKW TO C-IND-DEF
             MOVE "N" TO FIRST-INDEX
           END-IF 
00527      MOVE SAVE-ELE-STC-INDEX TO WS-DATA-NAME.                        CL**2
00528      PERFORM INSERT-PREFIX THRU INSERT-PREFIX-XIT.                   CL**2
00529      MOVE WORK-DATA-NAME TO C-IND-VAL.                               CL**2
00530      MOVE CARD-IMAGE-IND TO HOLD-CARD-IMAGE.                         CL**2
           MOVE SPACES TO SAVE-ELE-STC-INDEX. 
           GO TO 1810-CBL15.
  
      ******************************************************************
      *    CHECK FOR KEY IS CLAUSE. 
      ******************************************************************
       1850-CBL15.
           IF CAT-LINE-TYPE = "K" 
             AND DATA-RETURN-CODE = ZERO
           THEN 
             MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
             MOVE MINUS-ASTER TO SAVE-ELE-STC-K 
             PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
             PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
           END-IF 
  
      * KEY AND INDEX MAY BE GIVEN IN EITHER ORDER. 
           IF SAVE-ELE-STC-OCC-KEY = SPACES 
           THEN 
             IF CAT-LINE-TYPE = "I" 
               AND DATA-RETURN-CODE = ZERO
             THEN 
               GO TO 1800-CBL15 
             ELSE 
               GO TO 1900-CBL15 
             END-IF 
           END-IF 
  
           MOVE SPACES TO CARD-IMAGE-KEY. 
           IF SAVE-ELE-STC-OCC-KORDER NOT = SPACE 
           THEN 
             MOVE KWKEYIS TO C-KEY-IS 
             IF SAVE-ELE-STC-OCC-KORDER = "A" 
             THEN 
               MOVE KWASCEND TO C-KEY-ORDER 
             END-IF 
             IF SAVE-ELE-STC-OCC-KORDER = "D" 
             THEN 
               MOVE KWDESCEND TO C-KEY-ORDER
             END-IF 
           END-IF 
  
           MOVE SAVE-ELE-STC-OCC-KEY TO ITEM-CATNAME. 
           MOVE SAVE-ELE-STC-OCC-KALIAS TO ITEM-ALIAS.
           PERFORM FIND-DATANAME THRU FIND-DATANAME-XIT.
           MOVE WORK-DATA-NAME TO C-KEY-NAME. 
           PERFORM CBL-OUT THRU CBL-OUT-XIT.
           MOVE CARD-IMAGE-KEY TO HOLD-CARD-IMAGE.
           MOVE SPACES TO SAVE-ELE-STC-K. 
           GO TO 1850-CBL15.
  
00532 *****************************************************************    CL**2
00533 *     GENERATE SYNCHRONIZED OR JUSTIFIED CLAUSE                      CL**2
00534 *****************************************************************    CL**2
00535  1900-CBL15.                                                         CL**2
           IF ELE-JUST = "R"
           THEN 
             PERFORM CBL-OUT THRU CBL-OUT-XIT 
             GO TO 1910-CBL15 
           END-IF 
  
           IF ELE-SYNC = "Y"
           THEN 
             PERFORM CBL-OUT THRU CBL-OUT-XIT 
             GO TO 1915-CBL15 
           END-IF 
  
           IF ELE-INT-VALUE NOT = SPACES
           THEN 
             GO TO 1920-CBL15 
           END-IF 
  
00541      MOVE HOLD-CARD-IMAGE TO SCAN-AREA.                              CL**2
00542      PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE-XIT.         CL**2
00543      GO TO 1940-CBL15.                                               CL**2
00544  1910-CBL15.                                                         CL**2
00545      MOVE SPACES TO CARD-IMAGE-SYC-JUST.                             CL**2
00546      MOVE JUSTIFIEDRKW TO C-SYNC.                                    CL**2
00547      MOVE CARD-IMAGE-SYC-JUST TO HOLD-CARD-IMAGE.                    CL**2
00548      IF ELE-SYNC EQUAL "Y"                                           CL**2
00549          PERFORM CBL-OUT THRU CBL-OUT-XIT                            CL**2
00550          GO TO 1915-CBL15.                                           CL**2
00551      IF ELE-INT-VALUE NOT EQUAL SPACES                               CL**2
00552          GO TO 1920-CBL15.                                           CL**2
00553      MOVE HOLD-CARD-IMAGE TO SCAN-AREA.                              CL**2
00554      PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE-XIT.         CL**2
00555      GO TO 1940-CBL15.                                               CL**2
00556  1915-CBL15.                                                         CL**2
00557      MOVE SPACES TO CARD-IMAGE-SYC-JUST.                             CL**2
00558      MOVE SYNCHRONIZEDKW TO C-SYNC.                                  CL**2
00559      MOVE CARD-IMAGE-SYC-JUST TO HOLD-CARD-IMAGE.                    CL**2
00560      IF ELE-INT-VALUE NOT EQUAL SPACES                               CL**2
00561          GO TO 1920-CBL15.                                           CL**2
00562      MOVE HOLD-CARD-IMAGE TO SCAN-AREA.                              CL**2
           PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE-XIT.
00566      GO TO 1940-CBL15.                                               CL**2
00567 *                                                                    CL**2
00568 *     SUPRESS INITIAL VALUE GENERATION AT FD LEVEL                   CL**2
00569 *                                                                    CL**2
00570  1920-CBL15.                                                         CL**2
00571      IF GTBL-SEL-TYPE EQUAL "20"                                     CL**2
00572          MOVE HOLD-CARD-IMAGE TO SCAN-AREA                           CL**2
00573          PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE-XIT      CL**2
00574          GO TO 1940-CBL15.                                           CL**2
00575      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00576 *****************************************************************    CL**2
00577 *     GENERATE VALUE CLAUSE                                          CL**2
00578 *****************************************************************    CL**2
00579      MOVE SPACES TO CARD-IMAGE-VAL.                                  CL**2
00580      MOVE VALUEKW TO C-VAL-DEF.                                      CL**2
00581      IF ELE-INT-VALUE EQUAL "SPACE                    "              CL**2
00582          GO TO 1925-CBL15.                                           CL**2
00583      IF ELE-INT-VALUE EQUAL "SPACES                   "              CL**2
00584          GO TO 1925-CBL15.                                           CL**2
00585      IF ELE-INT-VALUE EQUAL "ZERO                     "              CL**2
00586          GO TO 1925-CBL15.                                           CL**2
00587      IF ELE-INT-VALUE EQUAL "ZEROS                    "              CL**2
00588          GO TO 1925-CBL15.                                           CL**2
00589      IF ELE-INT-VALUE EQUAL "ZEROES                   "              CL**2
00590          GO TO 1925-CBL15.                                           CL**2
00591      IF ELE-INT-VALUE EQUAL "HIGH-VALUES              "              CL**2
00592          GO TO 1925-CBL15.                                           CL**2
00593      IF ELE-INT-VALUE EQUAL "LOW-VALUES               "              CL**2
00594          GO TO 1925-CBL15.                                           CL**2
00595      IF ELE-INT-VALUE EQUAL "HIGH-VALUE               "              CL**2
00596          GO TO 1925-CBL15.                                           CL**2
00597      IF ELE-INT-VALUE EQUAL "LOW-VALUE                "              CL**2
00598          GO TO 1925-CBL15.                                           CL**2
00599      IF ELE-INT-VALUE EQUAL "QUOTE                    "              CL**2
00600          GO TO 1925-CBL15.                                           CL**2
00601      IF ELE-INT-VALUE EQUAL "QUOTES                   "              CL**2
00602          GO TO 1925-CBL15.                                           CL**2
00603      MOVE ELE-INT-VALUE TO INITIAL-VALUE-IMAGE.                      CL**2
00604      IF WORD-1 NOT EQUAL TO "NEXT"                                   CL**2
00605          GO TO TEST-FORMAT-IMAGE.                                    CL**2
00606      IF WORD-3 NOT EQUAL TO "LINES DEFINE"                           CL**2
00607          GO TO TEST-FORMAT-IMAGE.                                    CL**2
00608      GO TO 1960-CBL15.                                               CL**2
00609  TEST-FORMAT-IMAGE.                                                  CL**2
00610      IF ELE-FORMAT NOT EQUAL "C"                                     CL**2
00611          GO TO 1925-CBL15.                                           CL**2
00612      MOVE SPACES TO VAL-HOLD.                                        CL**2
00613      MOVE ELE-INT-VALUE TO VAL-HOLD.                                 CL**2
00614      MOVE 26 TO SUB3.                                                CL**2
00615      IF GTBL-OPT-QUOTE EQUAL TO "Y"                                  CL**2
00616          MOVE LITERAL-1 TO QUOTE-VAL                                 CL**2
00617      ELSE MOVE QUOTE TO QUOTE-VAL.                                   CL**2
00618  QUOTE-LOOP.                                                         CL**2
00619      IF H-VAL (SUB3) NOT EQUAL TO SPACE                              CL**2
00620          ADD 1 TO SUB3                                               CL**2
00621          MOVE QUOTE-VAL TO H-VAL (SUB3)                              CL**2
00622          MOVE VAL-QUOTE TO C-VAL-VAL                                 CL**2
00623          GO TO 1930-CBL15.                                           CL**2
00624      SUBTRACT 1 FROM SUB3.                                           CL**2
00625      IF SUB3 GREATER THAN ZERO                                       CL**2
00626          GO TO QUOTE-LOOP.                                           CL**2
00627  1925-CBL15.                                                         CL**2
00628      MOVE ELE-INT-VALUE TO C-VAL-VAL.                                CL**2
00629  1930-CBL15.                                                         CL**2
00630      MOVE CARD-IMAGE-VAL TO SCAN-AREA.                               CL**2
00631      PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE-XIT.         CL**2
00632 ****************************************************************     CL**2
00633 *     GENERATE 88 LEVELS                                             CL**2
00634 ****************************************************************     CL**2
00635  1940-CBL15.                                                         CL**2
00636      IF LITERAL-SW EQUAL TO "Y"                                      CL**2
00637          SUBTRACT 1 FROM GROUP-SUB                                   CL**2
00638          GO TO 1130-CBL15.                                           CL**2
00639      PERFORM 88-GEN THRU 88-GEN-XIT.                                 CL**2
00640      IF IN-GROUP-SW EQUAL "Y"                                        CL**2
00641          GO TO 6390-CBL15.                                           CL**2
00642      GO TO 0500-CBL15.                                               CL**2
00643 ******************************************************************   CL**2
00644 *    INITIAL VALUE CLAUSE CARRIED OVER FROM MANY LINES               CL**2
00645 ******************************************************************   CL**2
00646  1960-CBL15.                                                         CL**2
00647      IF ELE-ALIAS-CODE EQUAL TO "Y"                                  CL**2
00648          MOVE ALIAS-CAT-NO TO DATA-ENTRY-CAT                         CL**2
00649      ELSE                                                            CL**2
00650          MOVE ATTR-CAT-NO TO DATA-ENTRY-CAT.                         CL**2
00651      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00652      IF CAT-LINE NOT EQUAL TO ELE-ATTR-LAST                          CL**2
00653          MOVE ELE-ATTR-LAST TO CAT-LINE.                             CL**2
00654      MOVE 1 TO SUB-Z.                                                CL**2
00655  1965-CBL15.                                                         CL**2
00656      MOVE SPACES TO CARD-INIT-VALUE, CARD-INIT-VALUE2.               CL**2
00657      IF SUB-Z EQUAL TO 1                                             CL**2
00658          MOVE VALUEKW TO QUOTE-VALKW                                 CL**2
00659          MOVE CARD-INIT-VALUE TO HOLD-CARD-IMAGE                     CL**2
00660          PERFORM CBL-OUT THRU CBL-OUT-XIT                            CL**2
00661          MOVE SPACES TO CARD-INIT-VALUE                              CL**2
00662      ELSE                                                            CL**2
00663          MOVE SPACES TO QUOTE-VALKW.                                 CL**2
00664      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00665      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00666          GO TO 1940-CBL15.                                           CL**2
00667      IF GTBL-OPT-QUOTE EQUAL TO "Y"                                  CL**2
00668          MOVE LITERAL-1 TO QUOTE-VALUE                               CL**2
00669      ELSE                                                            CL**2
00670          MOVE QUOTE TO QUOTE-VALUE.                                  CL**2
00671      IF ELE-ALIAS-CODE EQUAL TO "Y"                                  CL**2
00672          MOVE ALY-INT-VALUE TO VALUE-INITIAL                         CL**2
00673      ELSE                                                            CL**2
00674          MOVE ATTR-INT-VALUE TO VALUE-INITIAL.                       CL**2
00675      IF SUB-Z GREATER THAN 1                                         CL**2
00676          MOVE "-" TO FILLER-DASH.                                    CL**2
00677      MOVE CARD-INIT-VALUE TO HOLD-CARD-IMAGE.                        CL**2
00678      ADD 1 TO SUB-Z.                                                 CL**2
00679      MOVE HOLD-CARD-IMAGE TO SCAN-AREA.                              CL**2
00680      PERFORM FLOAT-QUOTE THRU FLOAT-QUOTE-XIT.                       CL**2
00681      IF SUB-Z GREATER THAN WORD-2                                    CL**2
00682          GO TO SET-QUOTE-LAST.                                       CL**2
00683      MOVE SCAN-AREA TO HOLD-CARD-IMAGE.                              CL**2
00684      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00685      GO TO 1965-CBL15.                                               CL**2
00686  SET-QUOTE-LAST.                                                     CL**2
00687      PERFORM FLOAT-PERIOD THRU FLOAT-PERIOD-XIT.                     CL**2
00688      MOVE SCAN-AREA TO HOLD-CARD-IMAGE.                              CL**2
00689      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00690      GO TO 1940-CBL15.                                               CL**2
00691                                                                    DCCBL31
00692 *****************************************************************    CL**2
00693 *****************************************************************    CL**2
00694 *                                                                    CL**2
00695 *    PROCESS GROUP ENTRY                                             CL**2
00696 *                                                                    CL**2
00697 ****************************************************************     CL**2
00698 ****************************************************************     CL**2
00699  5000-CBL15.                                                         CL**2
00700 *****************************************************************    CL**2
00701 *                                                                    CL**2
00702 *    INITIALIZATION                                                  CL**2
00703 *                                                                    CL**2
00704 ***************************************************************      CL**2
00705      MOVE ZERO TO GROUP-SUB.                                         CL**2
00706 ***************************************************************      CL**2
00707 *                                                                    CL**2
00708 *     RETRIEVE CHARACTERISTICS OF THIS GROUP                         CL**2
00709 *                                                                    CL**2
00710 ***************************************************************      CL**2
00711  5100-CBL15.                                                         CL**2
00712      MOVE SAVE-GRP-STC-CNAME TO DATA-ENTRY-NAME.                     CL**2
00713      MOVE SAVE-GRP-STC-CNAME TO GEN-GROUP-NAME.                      CL**2
00714      PERFORM CHECK-DESCRIPTION THRU CHECK-DESCRIPTION-XIT.           CL**2
00715  5120-CBL15.                                                         CL**2
00716 *                                                                    CL**2
00717 *    RETRIEVE DATA NAME TO BE USED                                   CL**2
00718 *                                                                    CL**2
           MOVE GEN-GROUP-NAME TO ITEM-CATNAME. 
           MOVE SPACES TO ITEM-ALIAS. 
           PERFORM FIND-DATANAME THRU FIND-DATANAME-XIT.
00729 *                                                                    CL**2
00730 *    RETRIEVE ATTRIBUTES OF GROUP TO USE FOR COMPONENT ELEMENTS      CL**2
00731 *                                                                    CL**2
00732  5150-CBL15.                                                         CL**2
00733      MOVE SPACES TO SAVE-GRP-ATTR-CAT.                               CL**2
00734      MOVE ATTR-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00735      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00736      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00737      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00738          GO TO 5200-CBL15.                                           CL**2
           MOVE MINUS-ASTER TO SAVE-GRP-ATTR-CAT. 
00740 ****************************************************************     CL**2
00741 *                                                                    CL**2
00742 *    GENERATE COBOL STATEMENTS FOR GROUP                             CL**2
00743 *                                                                    CL**2
00744 ***************************************************************      CL**2
00745  5200-CBL15.                                                         CL**2
           PERFORM LAYOUT-PCH-CARD THRU LAYOUT-PCH-CARD-XIT.
           MOVE CBL-CARD-IMAGE TO HOLD-CARD-IMAGE.
  
           IF SAVE-GRP-STC-REDEFINES = SPACES 
           THEN 
             GO TO 5300-CBL15 
           END-IF 
  
00759 ******************************************************               CL**2
00760 *          RETRIEVE PREFERRED DATA NAME OF REDEFINES CLAUSE          CL**2
00761 ******************************************************               CL**2
           MOVE SAVE-GRP-STC-REDEFINES TO ITEM-CATNAME. 
           MOVE SAVE-GRP-STC-REDEF-ALIAS TO ITEM-ALIAS. 
           PERFORM FIND-DATANAME THRU FIND-DATANAME-XIT.
  
           MOVE SPACES TO CARD-IMAGE-RED. 
           MOVE REDEFKW TO C-RED-DEF. 
           MOVE WORK-DATA-NAME TO C-RED-VAL.
           PERFORM CBL-OUT THRU CBL-OUT-XIT.
           MOVE CARD-IMAGE-RED TO HOLD-CARD-IMAGE.
00781 *                                                                    CL**2
00782 *    CHECK FOR OCCURS CLAUSE                                         CL**2
00783 *                                                                    CL**2
00784  5300-CBL15.                                                         CL**2
00785      MOVE SPACES TO CARD-IMAGE-OCC.                                  CL**2
00786      IF SAVE-GRP-STC-OCC-FROM EQUAL SPACE                            CL**2
00787          GO TO 5400-CBL15.                                           CL**2
00788      MOVE OCCURKW1 TO C-OCCUR-DEF.                                   CL**2
00789      MOVE OCCURKW2 TO C-FROM.                                        CL**2
00790      MOVE SAVE-GRP-STC-OCC-FROM TO C-FROM-VAL.                       CL**2
00791      MOVE OCCURKW3 TO C-TO.                                          CL**2
00792      MOVE SAVE-GRP-STC-OCC-TO TO C-TO-VAL.                           CL**2
00793      MOVE TIMESKW TO C-TO-TIMES.                                     CL**2
00794      GO TO 5450-CBL15.                                               CL**2
00795  5400-CBL15.                                                         CL**2
00796      IF SAVE-GRP-STC-OCC-TO EQUAL TO SPACES                          CL**2
00797          GO TO 6000-CBL15.                                           CL**2
00798      MOVE OCCURKW1 TO C-OCCUR-DEF.                                   CL**2
00799      MOVE TIMESKW TO C-TIMES.                                        CL**2
00800      MOVE SAVE-GRP-STC-OCC-TO TO C-OCCUR-VAL.                        CL**2
00801  5450-CBL15.                                                         CL**2
           PERFORM CBL-OUT THRU CBL-OUT-XIT.
00802      MOVE CARD-IMAGE-OCC TO HOLD-CARD-IMAGE.                         CL**2
00803 **********                                                           CL**2
00804 *     CHECK FOR DEPENDING ON CLAUSE                                  CL**2
00805 **********                                                           CL**2
00806  5500-CBL15.                                                         CL**2
00807      IF SAVE-GRP-STC-DEPEND EQUAL SPACES                             CL**2
00808          GO TO 5600-CBL15.                                           CL**2
00809      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00810      MOVE SPACES TO CARD-IMAGE-DEP.                                  CL**2
00811      MOVE DEPENDKW TO C-DEP-DEF.                                     CL**2
           MOVE SAVE-GRP-STC-DEPEND TO ITEM-CATNAME.
           MOVE SAVE-GRP-STC-DEP-ALIAS TO ITEM-ALIAS. 
           MOVE "Y" TO DATANAME-OK. 
           PERFORM FIND-DATANAME THRU FIND-DATANAME-XIT.
00814      MOVE WORK-DATA-NAME TO C-DEP-NAME.                              CL**2
00815      MOVE CARD-IMAGE-DEP TO HOLD-CARD-IMAGE.                         CL**2
00816 **********                                                           CL**2
00817 *     CHECK FOR INDEX CLAUSE                                         CL**2
00818 ***********                                                          CL**2
00819  5600-CBL15.                                                         CL**2
           PERFORM RESTORE-STRUCTURE THRU RESTORE-STRUCTURE-XIT.
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.
           PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.
           MOVE "Y" TO FIRST-INDEX. 
  
       5610-CBL15.
           IF CAT-LINE-TYPE = "I" 
             AND DATA-RETURN-CODE = ZERO
           THEN 
             MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
             MOVE MINUS-ASTER TO SAVE-GRP-STC-INDEX 
             PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
             PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
           END-IF 
  
00820      IF SAVE-GRP-STC-INDEX EQUAL SPACES                              CL**2
               GO TO 5620-CBL15.
00825      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00826      MOVE SPACES TO CARD-IMAGE-IND.                                  CL**2
           IF FIRST-INDEX = "Y" 
           THEN 
             MOVE INDEXKW TO C-IND-DEF
             MOVE "N" TO FIRST-INDEX
           END-IF 
00828      MOVE SAVE-GRP-STC-INDEX TO WS-DATA-NAME.                        CL**2
00829      PERFORM INSERT-PREFIX THRU INSERT-PREFIX-XIT.                   CL**2
00830      MOVE WORK-DATA-NAME TO C-IND-VAL.                               CL**2
           MOVE CARD-IMAGE-IND TO HOLD-CARD-IMAGE.
           MOVE SPACES TO SAVE-GRP-STC-INDEX. 
           GO TO 5610-CBL15.
  
      ******************************************************************
      *    CHECK FOR KEY IS CLAUSE. 
      ******************************************************************
       5620-CBL15.
           IF CAT-LINE-TYPE = "K" 
             AND DATA-RETURN-CODE = ZERO
           THEN 
             MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
             MOVE MINUS-ASTER TO SAVE-GRP-STC-K 
             PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
             PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
           END-IF 
  
      * KEY AND INDEX MAY BE GIVEN IN EITHER ORDER. 
           IF SAVE-GRP-STC-OCC-KEY = SPACES 
           THEN 
             IF CAT-LINE-TYPE = "I" 
               AND DATA-RETURN-CODE = ZERO
             THEN 
               GO TO 5600-CBL15 
             ELSE 
               GO TO 6000-CBL15 
             END-IF 
           END-IF 
  
           MOVE SPACES TO CARD-IMAGE-KEY. 
           IF SAVE-GRP-STC-OCC-KORDER NOT = SPACE 
           THEN 
             MOVE KWKEYIS TO C-KEY-IS 
             IF SAVE-GRP-STC-OCC-KORDER = "A" 
             THEN 
               MOVE KWASCEND TO C-KEY-ORDER 
             END-IF 
             IF SAVE-GRP-STC-OCC-KORDER = "D" 
             THEN 
               MOVE KWDESCEND TO C-KEY-ORDER
             END-IF 
           END-IF 
  
           MOVE SAVE-GRP-STC-OCC-KEY TO ITEM-CATNAME. 
           MOVE SAVE-GRP-STC-OCC-KALIAS TO ITEM-ALIAS.
           PERFORM FIND-DATANAME THRU FIND-DATANAME-XIT.
           MOVE WORK-DATA-NAME TO C-KEY-NAME. 
           PERFORM CBL-OUT THRU CBL-OUT-XIT.
           MOVE CARD-IMAGE-KEY TO HOLD-CARD-IMAGE.
           MOVE SPACES TO SAVE-GRP-STC-K. 
           GO TO 5620-CBL15.
00833                                                                    DCCBL31
00834 ****************************************************************     CL**2
00835 *                                                                    CL**2
00836 *    PROCESS STRUCTURE OF GROUP ENTRY                                CL**2
00837 *                                                                    CL**2
00838 ****************************************************************     CL**2
00839  6000-CBL15.                                                         CL**2
           MOVE HOLD-CARD-IMAGE TO SCAN-AREA. 
           PERFORM PRINT-AREA-PICTURE THRU PRINT-AREA-PICTURE.
  
           IF LEVEL-IDX > 10
           THEN 
             PERFORM 9060-GROUP-LIMIT THRU 9060-GROUP-LIMIT-XIT 
             GO TO 0500-CBL15 
           ELSE 
             ADD 1 TO LEVEL-IDX 
             ADD 1 TO GROUP-SUB 
           END-IF 
  
           MOVE SAVE-GRP-STC-CNAME TO DATA-ENTRY-NAME.
00840      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00841      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
           PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.
  
      * LOOK FOR FIRST INCLUDED STRUCTURE LINE OF STANDARD TYPE.
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             IF (CAT-LINE-TYPE = "A" OR SPACE)
               AND STC-DBD-INC NOT = "N"
             THEN 
               IF STC-SR-CNAME = SPACES 
               THEN 
                 PERFORM 9080-BLANK-STC THRU 9080-BLANK-STC-XIT 
               ELSE 
                 MOVE DATA-ENTRY-NAME TO GROUP-ENTRY-NAME (LEVEL-IDX) 
                 MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
                 MOVE SPACES TO SAVE-ELE-STC-CAT
                 MOVE MINUS-ASTER TO SAVE-ELE-STC-A 
  
      * CHECK FOR OCCURS STRUCTURE LINE.
                 PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
                 PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
                 IF CAT-LINE-TYPE = "O" 
                   AND DATA-RETURN-CODE = ZERO
                 THEN 
                   MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
                   MOVE MINUS-ASTER TO SAVE-ELE-STC-O 
                 END-IF 
                 GO TO 6300-CBL15 
               END-IF 
             END-IF 
  
      * IF NOT AN INCLUDED STANDARD LINE, READ NEXT LINE INTO "CAT-WORK"
             PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
             PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
           END-PERFORM
  
      * ERROR IF NO INCLUDED STRUCTURE LINE FOUND.
           PERFORM 9010-NO-STC-MSSG THRU 9010-NO-STC-MSSG-XIT.
           GO TO 6700-CBL15.
00865 *                                                                    CL**2
00866 *     PROCESS FIRST COMPONENT OF GROUP                               CL**2
00867 *        SAVE GROUP ATTRIBUTES                                       CL**2
00868 *        SAVE POSITION IN STRUCTURE LINE                             CL**2
00869 *                                                                    CL**2
00870  6300-CBL15.                                                         CL**2
           MOVE SAVE-GRP-ATTR-LENGTH  TO GROUP-LENGTH (LEVEL-IDX).
           MOVE SAVE-GRP-ATTR-FORMAT  TO GROUP-FORMAT (LEVEL-IDX).
           MOVE SAVE-GRP-ATTR-PICTURE TO GROUP-PICTURE (LEVEL-IDX). 
           MOVE SAVE-GRP-ATTR-JUST    TO GROUP-JUST (LEVEL-IDX).
           MOVE SAVE-GRP-ATTR-SYNC    TO GROUP-SYNC (LEVEL-IDX).
  
       6350-CBL15.
           IF SAVE-ELE-STC-CNAME = FILLERKW 
           THEN 
             PERFORM PROC-FILLER THRU PROC-FILLER-XIT 
             GO TO 6400-CBL15 
           END-IF 
  
00890 ******************************************************************   CL**2
00891 *     RETRIEVE COMPONENT ENTRY- DETERMINE TYPE                       CL**2
00892 *****************************************************************    CL**2
           MOVE SAVE-ELE-STC-CNAME TO DATA-ENTRY-NAME.
00894      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00895      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00896          PERFORM 9030-NO-DATA-MSSG THRU 9030-NO-DATA-MSSG-XIT        CL**2
00897      GO TO 6400-CBL15.                                               CL**2
00898 ******************************************************************   CL**2
00899 *     CHECK FOR GROUP COMPONENT AND PROCESS                          CL**2
00900 *****************************************************************    CL**2
00901      IF DATA-HDR-ENT-ID EQUAL TO "09" OR "10"                        CL**2
               MOVE SAVE-ELE-STC-CAT TO SAVE-GRP-STC-CAT
               MOVE SPACES TO SAVE-ELE-STC-CAT
00903          GO TO 5100-CBL15.                                           CL**2
00904 *****************************************************************    CL**2
00905 *     CHECK FOR ELEMENT COMPONENT AND PROCESS                        CL**2
00906 *****************************************************************    CL**2
00907      IF DATA-HDR-ENT-ID NOT EQUAL "05"                               CL**2
00908          PERFORM 9020-BAD-ENTITY THRU 9020-BAD-ENTITY-XIT            CL**2
               GO TO 6400-CBL15.
  
           MOVE GROUP-LENGTH (LEVEL-IDX)  TO SAVE-GRP-ATTR-LENGTH.
           MOVE GROUP-FORMAT (LEVEL-IDX)  TO SAVE-GRP-ATTR-FORMAT.
           MOVE GROUP-PICTURE (LEVEL-IDX) TO SAVE-GRP-ATTR-PICTURE. 
           MOVE GROUP-JUST (LEVEL-IDX)    TO SAVE-GRP-ATTR-JUST.
           MOVE GROUP-SYNC (LEVEL-IDX)    TO SAVE-GRP-ATTR-SYNC.
00916      MOVE "Y" TO IN-GROUP-SW.                                        CL**2
00917      GO TO 1000-CBL15.                                               CL**2
00918 *****************************************************************    CL**2
00919 *     AFTER ELEMENT GENERATED - CONTROL RETURNS HERE                 CL**2
00920 *****************************************************************    CL**2
00921  6390-CBL15.                                                         CL**2
00922      MOVE "N" TO IN-GROUP-SW.                                        CL**2
00923 *****************************************************************    CL**2
00924 *     RETURN FOR NEXT STRUCTURE LINE OF GROUP                        CL**2
00925 *****************************************************************    CL**2
00926  6400-CBL15.                                                         CL**2
           PERFORM RESTORE-STRUCTURE THRU RESTORE-STRUCTURE-XIT.
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.
           PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.
00932 *****************************************************************    CL**2
00933 *     HAVE RETRIEVED ANOTHER STRUCTURE LINE                          CL**2
00934 *     DETERMINE IF COMPONENT                                         CL**2
00935 ****************************************************************     CL**2
00936  6500-CBL15.                                                         CL**2
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             IF (CAT-LINE-TYPE = "A" OR SPACE)
               AND STC-DBD-INC NOT = "N"
             THEN 
               IF STC-GRP-CNAME = SPACES
               THEN 
                 PERFORM 9080-BLANK-STC THRU 9080-BLANK-STC-XIT 
               ELSE 
                 MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
                 MOVE SPACES TO SAVE-ELE-STC-CAT
                 MOVE MINUS-ASTER TO SAVE-ELE-STC-A 
  
      * CHECK FOR OCCURS STRUCTURE LINE.
                 PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
                 PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
                 IF CAT-LINE-TYPE = "O" 
                   AND DATA-RETURN-CODE = ZERO
                 THEN 
                   MOVE CAT-LINE TO GROUP-STC-LINE (LEVEL-IDX)
                   MOVE MINUS-ASTER TO SAVE-ELE-STC-O 
                 END-IF 
                 GO TO 6350-CBL15 
               END-IF 
             END-IF 
  
      * IF NOT AN INCLUDED STANDARD LINE, READ NEXT LINE INTO "CAT-WORK"
             PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
             PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
           END-PERFORM
  
00961 *****************************************************************    CL**2
00962 *     NO MORE COMPONENTS FOR GROUP                                   CL**2
00963 *     RETURN TO PREVIOUS GROUP - IF ANY                              CL**2
00964 *****************************************************************    CL**2
00965  6700-CBL15.                                                         CL**2
           SUBTRACT 1 FROM LEVEL-IDX. 
           SUBTRACT 1 FROM GROUP-SUB. 
           IF LEVEL-IDX = 1 
           THEN 
             GO TO 0500-CBL15 
           ELSE 
             GO TO 6400-CBL15 
           END-IF 
  
00972 ******************************************************************   CL**2
00973 *     CLOSE FILES AND GO BACK                                        CL**2
00974 ******************************************************************   CL**2
00975  8000-CBL15-END.                                                     CL**2
00976      MOVE "9" TO GTBL-MOD-REQ.                                       CL**2
           EXIT PROGRAM.
00978 ******************************************************************   CL**2
00979 *     ERROR MESSAGES                                                 CL**2
00980 ******************************************************************   CL**2
00981  9010-NO-STC-MSSG.                                                   CL**2
00982      MOVE "Y" TO MSG-SWITCH.                                         CL**2
00983      MOVE " 600-S" TO ERROR-MSSG-NUM.                                CL**2
00984      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
00985      MOVE DATA-ENTRY-NAME TO ERROR-CAT-NAME.                         CL**2
00986      MOVE NO-STC-MSSG TO MSSG-TYPE.                                  CL**2
00987      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00988  9010-NO-STC-MSSG-XIT.                                               CL**2
00989      EXIT.                                                           CL**2
00990  9020-BAD-ENTITY.                                                    CL**2
00991      MOVE "Y" TO MSG-SWITCH.                                         CL**2
00992      MOVE " 525-S" TO ERROR-MSSG-NUM.                                CL**2
00993      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
00994      MOVE DATA-ENTRY-NAME TO ERROR-CAT-NAME.                         CL**2
00995      MOVE BAD-ENTITY-MSSG TO MSSG-TYPE.                              CL**2
00996      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
00997  9020-BAD-ENTITY-XIT.                                                CL**2
00998      EXIT.                                                           CL**2
00999  9030-NO-DATA-MSSG.                                                  CL**2
01000      MOVE "Y" TO MSG-SWITCH.                                         CL**2
01001      MOVE " 500-S" TO ERROR-MSSG-NUM.                                CL**2
01002      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01003      MOVE DATA-ENTRY-NAME TO ERROR-CAT-NAME.                         CL**2
01004      MOVE NO-DATA-MSSG TO MSSG-TYPE.                                 CL**2
01005      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
01006  9030-NO-DATA-MSSG-XIT.                                              CL**2
01007      EXIT.                                                           CL**2
01008  9040-BAD-DATA-MSSG.                                                 CL**2
01009      MOVE "Y" TO MSG-SWITCH.                                         CL**2
01010      MOVE " 530-S" TO ERROR-MSSG-NUM.                                CL**2
01011      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01012      MOVE DATA-ENTRY-NAME TO ERROR-CAT-NAME.                         CL**2
01013      MOVE BAD-DATA-MSSG TO MSSG-TYPE.                                CL**2
01014      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
01015  9040-BAD-DATA-MSSG-XIT.                                             CL**2
01016      EXIT.                                                           CL**2
01017  9050-PIC-DEFAULT.                                                   CL**2
01018      MOVE "Y" TO MSG-SWITCH.                                         CL**2
01019      MOVE " 540-I" TO ERROR-MSSG-NUM.                                CL**2
01020      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01021      MOVE PICTURE-DEFAULT-MSSG TO DEFAULT-MSSG.                      CL**2
01022      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
01023  9050-PIC-DEFAULT-XIT.                                               CL**2
01024      EXIT.                                                           CL**2
01025  9060-GROUP-LIMIT.                                                   CL**2
01026      MOVE "Y" TO MSG-SWITCH.                                         CL**2
01027      MOVE " 550-S" TO ERROR-MSSG-NUM.                                CL**2
01028      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01029      MOVE GROUP-LIMIT-MSSG TO DEFAULT-MSSG.                          CL**2
01030      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
01031  9060-GROUP-LIMIT-XIT.                                               CL**2
01032      EXIT.                                                           CL**2
01034  9080-REDEFINE-MSSG.                                                 CL**2
           MOVE "Y" TO MSG-SWITCH.
01036      MOVE " 560-S" TO ERROR-MSSG-NUM.                                CL**2
01037      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01038      MOVE REDEFINE-MSSG TO DEFAULT-MSSG.                             CL**2
01039      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
01040  9080-REDEFINE-MSSG-XIT.                                             CL**2
01041      EXIT.                                                           CL**2
       9070-BAD-88. 
01042      MOVE "Y" TO MSG-SWITCH.                                         CL**2
01043      MOVE " 555-S" TO ERROR-MSSG-NUM.                                CL**2
01044      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01045      MOVE BAD-88-MSSG TO DEFAULT-MSSG.                               CL**2
01046      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
01047  9070-BAD-88-XIT.                                                    CL**2
01048      EXIT.                                                           CL**2
       9080-BLANK-STC.
           MOVE "Y" TO MSG-SWITCH.
           MOVE CAT-LINE TO BLANK-LINE. 
           MOVE DATA-ENTRY-NAME TO BLANK-CAT. 
           MOVE " 700-I" TO ERROR-MSSG-NUM. 
           MOVE SPACES TO ERROR-MSSG-TYPE.
           MOVE BLANK-STC TO DEFAULT-MSSG.
           PERFORM CBL-OUT THRU CBL-OUT-XIT.
       9080-BLANK-STC-XIT.
           EXIT.
01049 ******************************************************************   CL**2
01050 *                                                                    CL**2
01051 *          GENERATE 88 LEVELS                                        CL**2
01052 *     IDENTIFIED BY 88L=   OR 88LEVEL=                               CL**2
01053 *     REMAINDER OF ENTRY IS FREEFORM AND UNEDITED                    CL**2
01054 *                                                                    CL**2
01055 ******************************************************************   CL**2
01056  88-GEN.                                                             CL**2
01057      IF GTBL-OPT-88 EQUAL TO "N"                                     CL**2
01058          GO TO 88-GEN-XIT.                                           CL**2
01059      MOVE GEN-ELEMENT-NAME TO DATA-ENTRY-NAME.                       CL**2
01060      MOVE OTHER-CAT-NO TO DATA-ENTRY-CAT.                            CL**2
01061      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
01062      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
01063          GO TO 88-GEN-XIT.                                           CL**2
01064  88-EXTRACT.                                                         CL**2
01065      IF CAT-COMMENT EQUAL "*"                                        CL**2
01066          GO TO READ-88.                                              CL**2
01067      MOVE KEY-WORDS TO HOLD-88-LINE.                                 CL**2
01068 *                                                                    CL**2
01069 *     EXTRACT 88 IDENTIFICATION                                      CL**2
01070 *                                                                    CL**2
01071      MOVE "N" TO QUOTE-FOUND.                                        CL**2
01072      MOVE SPACES TO CONDITION-NAME.                                  CL**2
01073      MOVE SPACES TO 88-VALUE.                                        CL**2
01074      MOVE SPACES TO 88-IDENTIFIER.                                   CL**2
01075      MOVE 1 TO 88-SUB.                                               CL**2
01076  MOVE-88-IDEN.                                                       CL**2
01077      MOVE HOLD-88 (88-SUB) TO 88-IDEN (88-SUB).                      CL**2
01078      ADD 1 TO 88-SUB.                                                CL**2
01079      IF 88-SUB GREATER THAN 3                                        CL**2
01080          GO TO EQUAL-SIGN-SEARCH.                                    CL**2
01081      GO TO MOVE-88-IDEN.                                             CL**2
01082  EQUAL-SIGN-SEARCH.                                                  CL**2
01083      IF 88-IDENTIFIER NOT EQUAL "88L"                                CL**2
01084          GO TO READ-88.                                              CL**2
01085      IF HOLD-88 (88-SUB) EQUAL "="                                   CL**2
01086          ADD 1 TO 88-SUB                                             CL**2
01087          MOVE 1 TO SUB-4                                             CL**2
01088          GO TO FIND-NAME.                                            CL**2
01089      ADD 1 TO 88-SUB.                                                CL**2
01090      IF 88-SUB GREATER THAN 67 GO TO NO-88-GEN.                      CL**2
01091      GO TO EQUAL-SIGN-SEARCH.                                        CL**2
01092  FIND-NAME.                                                          CL**2
01093      IF HOLD-88 (88-SUB) EQUAL SPACES                                CL**2
01094          ADD 1 TO 88-SUB                                             CL**2
01095      ELSE                                                            CL**2
01096          GO TO MOVE-NAME.                                            CL**2
01097      IF 88-SUB GREATER THAN 67 GO TO NO-88-GEN.                      CL**2
01098      GO TO FIND-NAME.                                                CL**2
01099  MOVE-NAME.                                                          CL**2
01100      MOVE HOLD-88 (88-SUB) TO COND-NAME (SUB-4).                     CL**2
01101      ADD 1 TO 88-SUB  SUB-4.                                         CL**2
01102      IF 88-SUB GREATER THAN 67 GO TO NO-88-GEN.                      CL**2
           IF SUB-4 GREATER THAN 31 GO TO NO-88-GEN.
01104      IF HOLD-88 (88-SUB) NOT EQUAL SPACES                            CL**2
01105          GO TO MOVE-NAME.                                            CL**2
01106      ADD 1 TO 88-SUB.                                                CL**2
01107  FIND-VALUE.                                                         CL**2
01108      IF HOLD-88 (88-SUB) EQUAL SPACES                                CL**2
01109          ADD 1 TO 88-SUB                                             CL**2
01110      ELSE                                                            CL**2
01111          GO TO FIND-QUOTE.                                           CL**2
01112      IF 88-SUB GREATER THAN 67                                       CL**2
01113          GO TO NO-88-GEN.                                            CL**2
01114      GO TO FIND-VALUE.                                               CL**2
  
       FIND-QUOTE.
  
      * MAKE SURE TO HANDLE BOTH NEW AND OLD FORMAT (WITH OR WITHOUT
      * KEYWORD "VALUE" GIVEN). 
           IF HOLD-88-LINE (88-SUB : 6) = "VALUE "
           THEN 
             ADD 6 TO 88-SUB
             GO TO FIND-VALUE 
           END-IF 
  
      * FIND LAST NON-BLANK CHARACTER IN VALUE AND MOVE WHOLE VALUE TO
      * "88-VAL". 
           PERFORM VARYING END-88 FROM 67 BY -1 
             UNTIL HOLD-88 (END-88) NOT = SPACES
             CONTINUE 
           END-PERFORM
           MOVE 1 TO SUB-5. 
           PERFORM UNTIL 88-SUB > END-88
             MOVE HOLD-88 (88-SUB) TO 88-VAL (SUB-5)
             ADD 1 TO 88-SUB, SUB-5 
           END-PERFORM
           MOVE "." TO 88-VAL (SUB-5).
  
01144  FORMAT-LINE.                                                        CL**2
01145 *                                                                    CL**2
01146 *     CHECK FOR PREFIX-OPTION                                        CL**2
01147 *                                                                    CL**2
01148      IF GTBL-OPT-PREFIX88 EQUAL "Y"                                  CL**2
01149          MOVE CONDITION-NAME TO WS-DATA-NAME                         CL**2
01150          PERFORM INSERT-PREFIX THRU INSERT-PREFIX-XIT                CL**2
01151      ELSE                                                            CL**2
01152          MOVE CONDITION-NAME TO WORK-DATA-NAME.                      CL**2
01153      MOVE SPACES TO CARD-IMAGE-88.                                   CL**2
01154      MOVE LEVEL-88 TO CBL-88.                                        CL**2
01155      MOVE WORK-DATA-NAME TO CBL-NAME-88.                             CL**2
01156 *                                                                    CL**2
01157 *     CHECK LENGTH OF NAME AND VALUE                                 CL**2
01158      IF SUB-4 GREATER THAN 19                                        CL**2
01159          GO TO PRINT-2-LINES.                                        CL**2
01160      IF SUB-5 GREATER THAN 19                                        CL**2
01161          GO TO PRINT-2-LINES.                                        CL**2
01162 *                                                                    CL**2
01163 *     88 ENTRY FITS ON A SINGLE LINE                                 CL**2
01164 *                                                                    CL**2
01165      MOVE VALUEKW TO 88-VAL-DEF.                                     CL**2
01166      MOVE 88-VALUE TO 88-VAL-VAL.                                    CL**2
01167      MOVE CARD-IMAGE-88 TO HOLD-CARD-IMAGE.                          CL**2
01168      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
01169      GO TO READ-88.                                                  CL**2
01170 *                                                                    CL**2
01171 *     88 ENTRY REQUIRES TWO LINES                                    CL**2
01172 *                                                                    CL**2
01173  PRINT-2-LINES.                                                      CL**2
01174      MOVE CARD-IMAGE-88 TO HOLD-CARD-IMAGE.                          CL**2
01175      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
01176      MOVE SPACES TO CARD-IMAGE-88.                                   CL**2
01177      MOVE VALUEKW TO 88-VAL-DEF2.                                    CL**2
01178      MOVE 34 TO 88-SUB.                                              CL**2
01179 *                                                                    CL**2
01180 *     DETERMINE IF VALUE WILL NEED A CONTINUATION CARD               CL**2
01181 *                                                                    CL**2
01182      IF SUB-5 GREATER THAN 38                                        CL**2
01183          GO TO PRINT-3-LINES.                                        CL**2
01184      MOVE 1 TO SUB-5.                                                CL**2
01185  MOVE-LINE-2.                                                        CL**2
01186      MOVE 88-VAL (SUB-5) TO 88-CONT (88-SUB).                        CL**2
01187      ADD 1 TO SUB-5 88-SUB.                                          CL**2
01188      IF 88-SUB GREATER THAN 72                                       CL**2
01189          GO TO PRINT-88.                                             CL**2
01190      GO TO MOVE-LINE-2.                                              CL**2
01191  PRINT-3-LINES.                                                      CL**2
01192      MOVE 1 TO SUB-5.                                                CL**2
01193  MOVE-LINE-3.                                                        CL**2
01194      MOVE 88-VAL (SUB-5) TO 88-CONT (88-SUB).                        CL**2
01195      ADD 1 TO 88-SUB SUB-5.                                          CL**2
01196      IF 88-SUB GREATER THAN 72                                       CL**2
01197          MOVE CARD-IMAGE-88 TO HOLD-CARD-IMAGE                       CL**2
01198          PERFORM CBL-OUT THRU CBL-OUT-XIT                            CL**2
01199          GO TO SETUP-CONT-LINE.                                      CL**2
01200      GO TO MOVE-LINE-3.                                              CL**2
01201  SETUP-CONT-LINE.                                                    CL**2
01202      MOVE SPACES TO CARD-IMAGE-88.                                   CL**2
01203      MOVE "-" TO 88-CONT (7).                                        CL**2
01204      IF QUOTE-FOUND EQUAL "Y"                                        CL**2
01205          MOVE QUOTE TO 88-CONT (28).                                 CL**2
01206      MOVE 29 TO 88-SUB.                                              CL**2
01207  MOVE-CONT.                                                          CL**2
01208      MOVE 88-VAL (SUB-5) TO 88-CONT (88-SUB).                        CL**2
01209      ADD 1 TO 88-SUB SUB-5.                                          CL**2
01210      IF SUB-5 GREATER THAN 67                                        CL**2
01211          GO TO PRINT-88.                                             CL**2
01212      IF 88-SUB GREATER THAN 72                                       CL**2
01213          GO TO PRINT-88.                                             CL**2
01214      GO TO MOVE-CONT.                                                CL**2
01215  PRINT-88.                                                           CL**2
01216      MOVE CARD-IMAGE-88 TO HOLD-CARD-IMAGE.                          CL**2
01217      PERFORM CBL-OUT THRU CBL-OUT-XIT.                               CL**2
01218  READ-88.                                                            CL**2
01219      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
01220      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
01221          GO TO 88-GEN-XIT.                                           CL**2
01222      IF CAT-COMMENT EQUAL "*"                                        CL**2
01223          GO TO READ-88.                                              CL**2
01224      GO TO 88-EXTRACT.                                               CL**2
01225  NO-88-GEN.                                                          CL**2
01226      PERFORM 9070-BAD-88 THRU 9070-BAD-88-XIT.                       CL**2
01227      GO TO READ-88.                                                  CL**2
01228  88-GEN-XIT.                                                         CL**2
01229      EXIT.                                                           CL**2
01230  FIND-REDEFINE.                                                      CL**2
           MOVE SPACES TO SCAN-AREA2. 
01231      MOVE "N" TO LITERAL-SW.                                         CL**2
01232      MOVE 1 TO SUB-M.                                                CL**2
01233      ADD 1 TO LEN-P.                                                 CL**2
01234      IF SCAN-FIELD (LEN-P) EQUAL TO SPACES                           CL**2
01235          GO TO FIND-REDEFINE.                                        CL**2
01236  MOVE-REDEFINE-FIELD.                                                CL**2
01237      MOVE SCAN-FIELD (LEN-P) TO SCAN-FIELD (SUB-M).                  CL**2
01238      ADD 1 TO LEN-P, SUB-M.                                          CL**2
01239      IF SCAN-FIELD (LEN-P) NOT EQUAL TO SPACE                        CL**2
01240          GO TO MOVE-REDEFINE-FIELD.                                  CL**2
01241      IF SCAN-AREA2 EQUAL TO LITERAL-2                                CL**2
01242          MOVE "Y" TO LITERAL-SW                                      CL**2
01243          GO TO FIND-REDEFINE-XIT.                                    CL**2
01244      IF SCAN-AREA2 EQUAL TO LITERAL-3                                CL**2
01245          MOVE "X" TO LITERAL-SW.                                     CL**2
01246  FIND-REDEFINE-XIT.                                                  CL**2
01247      EXIT.                                                           CL**2
  
  
      ******************************************************************
      *    FIND DATANAME OF GIVEN GROUP/ELEMENT.
      * 
      *    INPUT:  ITEM-CATNAME   - CATNAME OF GIVEN GROUP/ELEMENT
      *            ITEM-ALIAS     - ALIAS NUMBER OF ELEMENT IF ONE GIVEN
      * 
      *    OUTPUT: WORK-DATA-NAME - PREFERRED DATANAME OF GROUP/ELEMENT 
      *                             WITH PREFIX IF REQUESTED
      ******************************************************************
  
       FIND-DATANAME. 
  
      * DIAGNOSE AND GIVE UP IF BLANK CATNAME.
           MOVE SPACES TO WORK-DATA-NAME. 
           IF ITEM-CATNAME = SPACES 
           THEN 
             PERFORM 9080-BLANK-STC THRU 9080-BLANK-STC-XIT 
             GO TO FIND-DATANAME-XIT
           END-IF 
  
      * SAVE ENTERING STRUCTURE LINE. 
           MOVE DATA-SEARCH TO TEMP-SAVE-SEARCH.
           MOVE CAT-LINE TO TEMP-DATA-ENTRY-LINE. 
           MOVE ITEM-CATNAME TO DATA-ENTRY-NAME.
  
      * IF NO ALIAS, GET DATANAME FROM NAMES CATEGORY.
           IF ITEM-ALIAS = SPACES OR ZERO 
           THEN 
             MOVE NAME-CAT-NO TO DATA-ENTRY-CAT 
             PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT 
             PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT 
  
             IF DATA-RETURN-CODE = ZERO 
               AND DATANAME-OK NOT = "F"
               AND NAME-DATA-NAME NOT = SPACES
             THEN 
               MOVE NAME-DATA-NAME TO WS-DATA-NAME
             ELSE 
               MOVE ITEM-CATNAME TO WS-DATA-NAME
             END-IF 
  
      * IF ALIAS GIVEN, GET DATANAME FROM ALIAS CATEGORY. 
           ELSE 
             MOVE ALIAS-CAT-NO TO DATA-ENTRY-CAT
             PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT 
             PERFORM UNTIL ITEM-ALIAS = CAT-LINE
               OR DATA-RETURN-CODE NOT = ZERO 
               PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
             END-PERFORM
  
             IF DATA-RETURN-CODE = ZERO 
               AND DATANAME-OK NOT = "F"
               AND CAT-COMMENT NOT = "*"
               AND ALY-DATA-NAME NOT = SPACES 
             THEN 
               MOVE ALY-DATA-NAME TO WS-DATA-NAME 
             ELSE 
               MOVE ITEM-CATNAME TO WS-DATA-NAME
             END-IF 
           END-IF 
  
      * INSERT PREFIX INTO DATANAME IF REQUESTED. 
           PERFORM INSERT-PREFIX THRU INSERT-PREFIX-XIT.
  
      * RESTORE ENTERING STRUCTURE LINE.
           MOVE TEMP-SAVE-SEARCH TO DATA-SEARCH.
           PERFORM RETURN-KEY THRU RETURN-KEY-XIT.
           MOVE "N" TO DATANAME-OK. 
  
       FIND-DATANAME-XIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      * RESTORE-STRUCTURE.
      * 
      * RESTORE THE STRUCTURE LINE WHICH WAS LAST PROCESSED AT THE
      * RECORD/GROUP LEVEL GIVEN BY "LEVEL-IDX".
      * 
      ******************************************************************
  
       RESTORE-STRUCTURE. 
           MOVE GROUP-ENTRY-NAME (LEVEL-IDX) TO DATA-ENTRY-NAME.
           MOVE GROUP-STC-LINE (LEVEL-IDX) TO DATA-ENTRY-LINE.
           MOVE STC-CAT-NO TO DATA-ENTRY-CAT. 
           PERFORM RETURN-KEY THRU RETURN-KEY-XIT.
  
       RESTORE-STRUCTURE-XIT. 
           EXIT.
  
  
*CALL     CBLOUT                                                           CL**5
*CALL     CBLSUB                                                           CL**5
*CALL     MAST1RFC                                                         CL**5
*CALL     MAST1RNL                                                         CL**5
*CALL     MAST1RK                                                          CL**5
*CALL     MAST1RFL                                                         CL**5
*CALL     MAST1EXT                                                         CL**5
*CALL     MAST1RDI                                                         CL**5
*CALL     MAST1ALG                                                         CL**5
