*DECK     DCTOT315
00001  IDENTIFICATION DIVISION.                                         08/09/78
       PROGRAM-ID. TOT315.
00003  ENVIRONMENT DIVISION.                                               LV002
00004  CONFIGURATION SECTION.                                              CL**2
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00007  DATA DIVISION.                                                      CL**2
*CALL GENCS 
*CALL     WRKSTG77
*CALL     MAST1WS 
*CALL     TESTWACOM 
*CALL     TOTWA32 
*CALL     DCDWA19 
*CALL     DCDWA13 
*CALL     DCDWA10 
*CALL     DCDWA05 
*CALL     ENTSAVE 
*CALL     GEN20BAL
*CALL     BAL15DAT
*CALL     GEN15DAT
*CALL     CBL10DAT
*CALL     GEN10BAL
*CALL     CBL05DAT
*CALL     GEN05BAL
*CALL     BALDEF2 
00034                                                                    DCTOT31
*CALL CURDATE 
00035  PROCEDURE DIVISION.                                                 CL**2
00039 *************************************************                    CL**2
00040 *************************************************                    CL**2
00041 *                                                                    CL**2
00042 *    CHECK CALLING MODULES RETURNS FROM GO TO I/O REQUESTS           CL**2
00043 *                                                                    CL**2
00044 *************************************************                    CL**2
00045 *************************************************                    CL**2
00046  0000-BEGIN.                                                         CL**2
00047      IF GTBL-MOD-REQ EQUAL "1"                                       CL**2
00048          GO TO DATA-READ-RETURN.                                     CL**2
00049      IF GTBL-MOD-REQ EQUAL "4"                                       CL**2
00050          GO TO BAL-OUT-RETURN.                                       CL**2
00051 *****************************************************                CL**2
00052 *****************************************************                CL**2
00053 *                                                                    CL**2
00054 *      INITIALIZATION                                                CL**2
00055 *                                                                    CL**2
00056 ****************************************************                 CL**2
00057 ****************************************************                 CL**2
00058      MOVE SPACES TO FILLER-AREA.                                     CL**2
00059      MOVE ZERO TO GTBL-COUNT, SUB-4, SUB-5, SUB-A.                   CL**2
00060      MOVE SPACES TO DATA-ARG-LIST.                                   CL**2
00061      MOVE SPACES TO DATA-LAST-ENTRY-NAME.                            CL**2
00062      MOVE "N" TO GROUP-OCCUR-SW MSG-SW GROUP-SW ZERO-SW.             CL**2
00063      MOVE "N" TO INITIAL-SW, IN-GROUP-SW, REDEFINES-SW.              CL**2
00065      MOVE SPACES TO IOAREA-TABLE.                                    CL**2
00066 *                                                                    CL**2
00067 *    PRINT COMMENTS AT BEGINNING OF EACH SELECT                      CL**2
00068 *                                                                    CL**2
00069      MOVE GTBL-SEL-CNAME TO DSNAME-COMMENT.                          CL**2
00070      MOVE SPACES TO HOLD-COMMENT-IMAGE.                              CL**2
00071      MOVE COMMENT1 TO COMMENT-SAVE.                                  CL**2
00072      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
*CALL ACCEPTDT
00073      MOVE CURRENT-DATE TO DATE-TODAY.                                CL**2
00074      MOVE SPACES TO HOLD-COMMENT-IMAGE.                              CL**2
00075      MOVE COMMENT2 TO COMMENT-SAVE.                                  CL**2
00076      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00077      MOVE NUM-REV-SAVE TO REV-TODAY.                                 CL**2
00078      MOVE SPACES TO HOLD-COMMENT-IMAGE.                              CL**2
00079      MOVE COMMENT3 TO COMMENT-SAVE.                                  CL**2
00080      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00081      MOVE DATE-SAVE TO REV-NO-LAST.                                  CL**2
00082      MOVE SPACES TO HOLD-COMMENT-IMAGE.                              CL**2
00083      MOVE COMMENT4 TO COMMENT-SAVE.                                  CL**2
00084      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00085      MOVE SPACES TO HOLD-COMMENT-IMAGE.                              CL**2
00086      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00087                                                                    DCTOT31
00088 ******************************************************************   CL**2
00089 *                                                                    CL**2
00090 *    PROCESSING OF A TOTAL DATABASE ENTRY BEGINS HERE                CL**2
00091 *                                                                    CL**2
00092 ******************************************************************   CL**2
00093      MOVE GTBL-SEL-CNAME TO DATA-ENTRY-NAME.                         CL**2
00094 *                                                                    CL**2
00095 *    MOVE BEGIN GENERATION STATEMENT TO OUTPUT LINE                  CL**2
00096 *                                                                    CL**2
00097      MOVE COMMENT5 TO HOLD-CARD-IMAGE.                               CL**2
00098      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00110 *                                                                    CL**2
00111 *    RETRIEVE DATABASE NAME FIELD FOR SECOND OUTPUT LINE             CL**2
00112 *                                                                    CL**2
00113      MOVE SPACES TO WS-DATA-NAME.                                    CL**2
00114      IF GTBL-OPT-NEWNAME NOT EQUAL TO SPACES                         CL**2
00115          MOVE GTBL-OPT-NEWNAME TO WS-DATA-NAME                       CL**2
00116          GO TO 0100-SET-LINE2.                                       CL**2
00117      MOVE NAME-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00118      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00119      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00120      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00121          GO TO 0050-MAKEUP-MSSG.                                     CL**2
00122      IF NAME-TOT-DBNAME EQUAL TO SPACES                              CL**2
00123          GO TO 0050-MAKEUP-MSSG.                                     CL**2
00124      MOVE NAME-TOT-DBNAME TO WS-DATA-NAME.                           CL**2
00125      GO TO 0100-SET-LINE2.                                           CL**2
00126  0050-MAKEUP-MSSG.                                                   CL**2
00127      PERFORM 9000-MAKEUP-MSSG THRU 9000-MAKEUP-MSSG-XIT.             CL**2
00128      MOVE DATA-ENTRY-NAME TO WS-DATA-NAME.                           CL**2
00129 *                                                                    CL**2
00130 *    SET NAME ON OUTPUT LINE AND MOVE TO OUTPUT AREA                 CL**2
00131 *                                                                    CL**2
00132  0100-SET-LINE2.                                                     CL**2
00133      MOVE WS-DATA-NAME TO NAME1.                                     CL**2
00134      MOVE COMMENT6 TO HOLD-CARD-IMAGE.                               CL**2
00135      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
      * 
      *   CDC OPTION CLAUSE-DICTIONARY DOES NOT 
      *   HAVE DATA FIELDS STORED.  THIS SECTION
      *   SETS UP OPTIONS CLAUSE WITH RUN TIME PARAMETERS.
      * 
           MOVE LOG-OPT TO OPTION-LOG.
           MOVE LOG-OUT TO OPTION-OUT.
           MOVE COMMENT14 TO HOLD-CARD-IMAGE. 
           PERFORM BAL-OUT THRU BAL-OUT-XIT.
00136 ******************************************************************   CL**2
00137 *    CHECK IOAREA CATEGORY FOR IOAREA FIELD                          CL**2
00138 ******************************************************************   CL**2
00139  0200-SET-IOAREA.                                                    CL**2
00140      MOVE IO-CAT-NO TO DATA-ENTRY-CAT.                               CL**2
00141      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00142  0300-COMMENT.                                                       CL**2
00143      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00144      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00145          PERFORM 9090-INPUT-MSSG THRU 9090-INPUT-MSSG-XIT            CL**2
00146          GO TO 1000-MOVE-STRUCTURE.                                  CL**2
00147      IF IOA-TOT-IOAREA NOT EQUAL TO SPACES                           CL**2
               MOVE "SHARE-IO " TO HOLD-CARD-IMAGE
00149          PERFORM BAL-OUT THRU BAL-OUT-XIT                            CL**2
00150          GO TO 0500-MOVE-FIELDS.                                     CL**2
00151  0400-READ-IO.                                                       CL**2
00152      IF SUB-A GREATER THAN 0                                         CL**2
00153          GO TO 0800-IOAREA-AGAIN.                                    CL**2
00154      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00155      GO TO 0300-COMMENT.                                             CL**2
00156 *                                                                    CL**2
00157 *    IOAREA FIELD PRESENT---FIND OCCUR FIELD---MOVE TO PRINT LINE    CL**2
00158 *                                                                    CL**2
00159  0500-MOVE-FIELDS.                                                   CL**2
00160      MOVE IOA-TOT-IOAREA TO OCCUR-SAVEB.                             CL**2
00161      IF OCCUR-SAVEB EQUAL TO "PRI"                                   CL**2
00162          PERFORM 9095-PRI-MSSG THRU 9095-PRI-MSSG-XIT                CL**2
00163          MOVE SPACES TO OCCUR-SAVEB                                  CL**2
00164          GO TO 0400-READ-IO.                                         CL**2
00165      MOVE SPACES TO OCCUR-SAVEB.                                     CL**2
00166 *                                                                    CL**2
00167 *    SET TABLE OF IOAREA NAMES                                       CL**2
00168 *    VALIDATE THAT NO TWO NAMES ARE ALIKE                            CL**2
00169 *                                                                    CL**2
00170      MOVE 0 TO SUB-B.                                                CL**2
00171      ADD 1 TO SUB-A.                                                 CL**2
00172      IF SUB-A EQUAL TO 1                                             CL**2
00173          GO TO 0700-SET-IOLINE.                                      CL**2
00174  0600-IO-LOOP.                                                       CL**2
00175      ADD 1 TO SUB-B.                                                 CL**2
00176      IF SUB-B EQUAL TO SUB-A                                         CL**2
00177          GO TO 0700-SET-IOLINE.                                      CL**2
00178      IF IOA-TOT-IOAREA EQUAL TO IOAREA-TAB (SUB-B)                   CL**2
00179          SUBTRACT 1 FROM SUB-A                                       CL**2
00180          PERFORM 9085-DUPLICATE-MSSG THRU 9085-DUPLICATE-MSSG-XIT    CL**2
00181          GO TO 0800-IOAREA-AGAIN.                                    CL**2
00182      GO TO 0600-IO-LOOP.                                             CL**2
00183  0700-SET-IOLINE.                                                    CL**2
00184      MOVE IOA-TOT-IOAREA TO IOAREA-TAB (SUB-A).                      CL**2
00185      MOVE IOA-TOT-IOAREA TO IO-NAME.                                 CL**2
00186      MOVE SPACES TO SIGN-EQUAL.                                      CL**2
00187      MOVE SPACES TO IO-OCCUR.                                        CL**2
00188      IF IOA-TOT-OCCURS GREATER THAN 0                                CL**2
00189          MOVE "=" TO SIGN-EQUAL                                      CL**2
00190          MOVE IOA-TOT-OCCURS TO IO-OCCUR.                            CL**2
00191      MOVE COMMENT8 TO HOLD-CARD-IMAGE.                               CL**2
00192      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00193 *                                                                    CL**2
00194 *    TEST IOAERA CATEGORY FOR EXISTENCE OF MORE IOAREA FIELDS        CL**2
00195 *                                                                    CL**2
00196  0800-IOAREA-AGAIN.                                                  CL**2
00197      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00198      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00199      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
              MOVE "END-IO " TO HOLD-CARD-IMAGE 
              PERFORM BAL-OUT THRU BAL-OUT-XIT
00200          GO TO 1000-MOVE-STRUCTURE.                                  CL**2
00201      IF IOA-TOT-IOAREA EQUAL TO SPACES                               CL**2
00202          GO TO 0800-IOAREA-AGAIN.                                    CL**2
00203      GO TO 0500-MOVE-FIELDS.                                         CL**2
00204                                                                    DCTOT31
00205 ******************************************************************   CL**2
00206 *                                                                    CL**2
00207 *    CHECK DATABASE STRUCTURE CATEGORY                               CL**2
00208 *                                                                    CL**2
00209 ******************************************************************   CL**2
00210  1000-MOVE-STRUCTURE.                                                CL**2
00211      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00212      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00213  1100-DATABASE-COMMENT.                                              CL**2
00214      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00215      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00216          PERFORM 9010-NO-STC-MSSG THRU 9010-NO-STC-MSSG-XIT          CL**2
00217          GO TO 6500-BAL-END.                                         CL**2
00218      GO TO 1300-READ-EXCLUDE.                                        CL**2
00219 *                                                                    CL**2
00220 *    READ NEXT STRUCTURE OF DATABASE ENTRY                           CL**2
00221 *                                                                    CL**2
00222  1200-READ-STRUCTURE.                                                CL**2
00223      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00224      GO TO 1100-DATABASE-COMMENT.                                    CL**2
00225 *                                                                    CL**2
00226 *    TEST DATABASE STRUCTURE EXCLUSION FIELD                         CL**2
00227 *                                                                    CL**2
00228  1300-READ-EXCLUDE.                                                  CL**2
00229      IF DS-TOT-EXCLUDE EQUAL TO "Y"                                  CL**2
00230          GO TO 1200-READ-STRUCTURE.                                  CL**2
00231 *                                                                    CL**2
00232 *    CHECK DATABASE STRUCTURE TYPE FIELD FOR MASTER OR VARIABLE      CL**2
00233 *                                                                    CL**2
00234  1400-STRUCTURE-FIELDS.                                              CL**2
00235      MOVE ZERO TO SUB-A, SUB-B.                                      CL**2
00236      MOVE SPACES TO TYPE-SW.                                         CL**2
00237      IF DS-TOT-TYPE EQUAL TO "V"                                     CL**2
00238          MOVE "V" TO TYPE-SW                                         CL**2
00239          MOVE COMMENT12 TO HOLD-CARD-IMAGE                           CL**2
00240          PERFORM BAL-OUT THRU BAL-OUT-XIT                            CL**2
00241          GO TO 1700-CONTINUE-GENERATION.                             CL**2
00242 *                                                                    CL**2
00243 *    FOUND A MASTER FILE                                             CL**2
00244 *                                                                    CL**2
00245  1500-MASTER-BEGIN.                                                  CL**2
00246      MOVE COMMENT10 TO HOLD-CARD-IMAGE.                              CL**2
00247      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00248  1700-CONTINUE-GENERATION.                                           CL**2
00249      MOVE DATA-SEARCH TO GEN32-SAVE-SEARCH.                          CL**2
00250      MOVE CAT-LINE TO SAVE32-DATA-ENTRY-LINE.                        CL**2
           MOVE MINUS-ASTER TO SAVE-STC.
00252      IF DS-TOT-DSNAME EQUAL TO SPACES OR FILLERKW                    CL**2
00253          GO TO 1750-BAD-STRUCTURE.                                   CL**2
00254      MOVE DS-TOT-DSNAME TO DATA-ENTRY-NAME.                          CL**2
00255      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00256      IF DATA-HDR-ENT-ID EQUAL "19"                                   CL**2
00257          GO TO 2000-DATASET-NAME.                                    CL**2
00258  1750-BAD-STRUCTURE.                                                 CL**2
00259      PERFORM 9040-BAD-DATA-MSSG THRU 9040-BAD-DATA-MSSG-XIT.         CL**2
00260      MOVE GEN32-SAVE-SEARCH TO DATA-SEARCH.                          CL**2
00261      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
00262      GO TO 1200-READ-STRUCTURE.                                      CL**2
00263                                                                    DCTOT31
00264 ******************************************************************   CL**2
00265 *                                                                    CL**2
00266 *    BEGIN DATASET DBDL GENERATION                                   CL**2
00267 *                                                                    CL**2
00268 ******************************************************************   CL**2
00269 *                                                                    CL**2
00270 *    RETRIEVE FILE NAME FROM NAMES CATEGORY                          CL**2
00271 *                                                                    CL**2
00272  2000-DATASET-NAME.                                                  CL**2
00273      MOVE NAME-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00274      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00275      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00276      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00277          GO TO 2005-ENTRY-MAKEUP.                                    CL**2
00278      IF NAME-SET-TD EQUAL TO SPACES                                  CL**2
00279          GO TO 2005-ENTRY-MAKEUP.                                    CL**2
00280      MOVE NAME-SET-TD TO WS-DATA-NAME.                               CL**2
00281      GO TO 2010-SET-DSNAME.                                          CL**2
00282  2005-ENTRY-MAKEUP.                                                  CL**2
00283      PERFORM 9000-MAKEUP-MSSG THRU 9000-MAKEUP-MSSG-XIT.             CL**2
00284      MOVE DATA-ENTRY-NAME TO WS-DATA-NAME.                           CL**2
00285  2010-SET-DSNAME.                                                    CL**2
00286      MOVE WS-DATA-NAME TO NAME2.                                     CL**2
00287      MOVE COMMENT11 TO HOLD-CARD-IMAGE.                              CL**2
00288      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00289 *                                                                    CL**2
00290 *    TEST DATASET NAMES CATEGORY FOR EXISTENCE OF IOAREA FIELD       CL**2
00291 *        IF IOAREA FIELD EXISTS AND DATABASE IOAREAS EXIST           CL**2
00292 *        THEN IOAERA MUST BE ONE OF THE DATABASE IOAERA NAMES        CL**2
00293 *        IF NO DATABASE IOAREAS EXIST THEN USE DATASET IOAREA NAME   CL**2
00294 *        IF NO DATASET IOAREAS EXIST THEN A PRIVATE ONE IS SET UP    CL**2
00295 *                                                                    CL**2
00296      IF IOAREA-TABLE EQUAL TO SPACES                                 CL**2
00297          GO TO 2030-PRIVATE-IO.                                      CL**2
00298 *                                                                    CL**2
00299 *    DATABASE IOAREAS EXIST---DATASET IOAREA NAME MUST BE FOUND      CL**2
00300 *                                                                    CL**2
00301  2020-DATABASE-IO.                                                   CL**2
00302      ADD 1 TO SUB-A.                                                 CL**2
00303      IF SUB-A GREATER THAN 16                                        CL**2
00304          PERFORM 9055-MISS-MSSG THRU 9055-MISS-MSSG-XIT              CL**2
00305          GO TO 2040-MASTER-CONSTANT.                                 CL**2
00306      IF IOAREA-TAB (SUB-A) EQUAL TO SPACES                           CL**2
00307          PERFORM 9055-MISS-MSSG THRU 9055-MISS-MSSG-XIT              CL**2
00308          GO TO 2040-MASTER-CONSTANT.                                 CL**2
00309      IF IOAREA-TAB (SUB-A) EQUAL TO NAME-SET-IO                      CL**2
00310          MOVE ZERO TO SUB-A                                          CL**2
00311          GO TO 2035-PRINT-NAME.                                      CL**2
00312      GO TO 2020-DATABASE-IO.                                         CL**2
00313 *                                                                    CL**2
00314 *    NO DATABASE IOAREAS EXIST---TEST FOR DATASET IOAREA             CL**2
00315 *                                                                    CL**2
00316  2030-PRIVATE-IO.                                                    CL**2
00317      IF NAME-SET-IO EQUAL TO SPACES                                  CL**2
00318          PERFORM 9055-IOAREA-FORMED THRU 9055-IOAREA-FORMED-XIT      CL**2
00319          GO TO 2040-MASTER-CONSTANT.                                 CL**2
00320  2035-PRINT-NAME.                                                    CL**2
00321      MOVE NAME-SET-IO TO IO-NAME2.                                   CL**2
00322      MOVE COMMENT15 TO HOLD-CARD-IMAGE.                              CL**2
00323      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00324 *                                                                    CL**2
00325 *    DEPENDING ON TYPE-SW EITHER A MASTER OR VARIABLE FILE EXISTS    CL**2
00326 *                                                                    CL**2
00327  2040-MASTER-CONSTANT.                                               CL**2
00328      IF TYPE-SW EQUAL TO "V"                                         CL**2
               MOVE "BASE-DATA " TO HOLD-CARD-IMAGE 
00330          GO TO 2200-DATASET-ENVIRONMENT.                             CL**2
           MOVE "MASTER-DATA " TO HOLD-CARD-IMAGE.
00332      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00333      MOVE NAME2 TO IO-NAME3.                                         CL**2
00334      MOVE COMMENT16 TO HOLD-CARD-IMAGE.                              CL**2
00335                                                                    DCTOT31
00336 ***************************************************************      CL**2
00337 *                                                                    CL**2
00338 *    PROCESSING OF DATASET (FILE) BEGINS HERE                        CL**2
00339 *                                                                    CL**2
00340 ***************************************************************      CL**2
00341 *                                                                    CL**2
00342 *    EXTRACT DATASET ENVIRONMENT CAT AND SAVE FOR LATER REFERENCE    CL**2
00343 *                                                                    CL**2
00344  2200-DATASET-ENVIRONMENT.                                           CL**2
00345      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00346      MOVE ENV-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00347      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00348      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00349      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00350          MOVE SPACES TO SET-SAVE-ENVIRONMENT                         CL**2
00351          GO TO 2500-DATASET-STRUCTURE.                               CL**2
           MOVE MINUS-ASTER TO SET-SAVE-ENVIRONMENT.
00353 ******************************************************************   CL**2
00354 *                                                                    CL**2
00355 *    PROCESS DATASET STRUCTURE---LOOKING FOR A RECORD                CL**2
00356 *                                                                    CL**2
00357 ******************************************************************   CL**2
00358  2500-DATASET-STRUCTURE.                                             CL**2
00359      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00360      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00361  2510-CHECK-COMMENT.                                                 CL**2
00362      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00363      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00364          PERFORM 9010-NO-STC-MSSG THRU 9010-NO-STC-MSSG-XIT          CL**2
00365          GO TO 6000-END-DATA.                                        CL**2
           IF STC-SET-CNAME EQUAL SPACES
               PERFORM 9105-BLANK-MSSG THRU 9105-BLANK-MSSG-XIT 
               GO TO 2520-NEXT-LINE.
00366      GO TO 2550-TEST-FOR-RECORD.                                     CL**2
00367 *                                                                    CL**2
00368 *    TEST NEXT STRUCTURE FOR VALID ENTRY OR COMMENT                  CL**2
00369 *                                                                    CL**2
00370  2520-NEXT-LINE.                                                     CL**2
00371      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00372      GO TO 2510-CHECK-COMMENT.                                       CL**2
00373 *                                                                    CL**2
00374 *    CHECK FOR TYPE 13 (RECORD)                                      CL**2
00375 *        IF RECORD IS NOT FOUND THERE IS AN ERROR                    CL**2
00376 *        MUST PROCESS NEXT FILE STRUCTURE                            CL**2
00377 *                                                                    CL**2
00378  2550-TEST-FOR-RECORD.                                               CL**2
00379      MOVE DATA-SEARCH TO GEN20-SAVE-SEARCH.                          CL**2
00380      MOVE CAT-LINE TO SAVE-DATA-ENTRY-LINE.                          CL**2
           MOVE MINUS-ASTER TO SAVE-STC.
00382      MOVE STC-SET-CNAME TO DATA-ENTRY-NAME.                          CL**2
00383      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00384      IF DATA-HDR-ENT-ID EQUAL TO "13"                                CL**2
00385          GO TO 3000-PROCESS-RECORD.                                  CL**2
00386      PERFORM 9040-BAD-DATA-MSSG THRU 9040-BAD-DATA-MSSG-XIT.         CL**2
00387      MOVE GEN20-SAVE-SEARCH TO DATA-SEARCH.                          CL**2
00388      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
00389      GO TO 2520-NEXT-LINE.                                           CL**2
00390                                                                    DCTOT31
00391 ******************************************************************   CL**2
00392 *    CHECK FOR ENTRY TYPE 22 (DATASETS)                              CL**2
00393 *    GENERATION RETURNS TO RETRIEVE NEXT STRUCTURE OF DATASET        CL**2
00394 *    IF NO STRUCTURE THEN PRINT OUT ENVIRONMENT CATEGORY             CL**2
00395 ******************************************************************   CL**2
00396  2600-PROCESS-DATASETS.                                              CL**2
00398      MOVE GEN20-SAVE-SEARCH TO DATA-SEARCH.                          CL**2
00399      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
       2650-READ-NEXT.
00400      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00401      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00402      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00403          GO TO 6000-END-DATA.                                        CL**2
           IF STC-SET-CNAME EQUAL SPACES
               PERFORM 9105-BLANK-MSSG THRU 9105-BLANK-MSSG-XIT 
               GO TO 2650-READ-NEXT.
00404      GO TO 2550-TEST-FOR-RECORD.                                     CL**2
00405 ******************************************************************   CL**2
00406 *    CHECK FOR ENTRY TYPE 32 (DATABASE)                              CL**2
00407 *    GENERATION RETURNS TO RETRIEVE NEXT STRUCTURE OF DATABASE       CL**2
00408 *    IF NO STRUCTURE THEN PRINT END GENERATION MESSAGE AND END JOB   CL**2
00409 ******************************************************************   CL**2
00410  2700-PROCESS-DATABASE.                                              CL**2
00412      MOVE GEN32-SAVE-SEARCH TO DATA-SEARCH.                          CL**2
00413      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
00414  2750-DATABASE-READ.                                                 CL**2
00415      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00416      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00417      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00418          GO TO 6500-BAL-END.                                         CL**2
           IF DS-TOT-DSNAME EQUAL SPACES
               PERFORM 9105-BLANK-MSSG THRU 9105-BLANK-MSSG-XIT 
               GO TO 2750-DATABASE-READ.
00419      IF DS-TOT-EXCLUDE EQUAL TO "Y"                                  CL**2
00420          GO TO 2750-DATABASE-READ.                                   CL**2
00421      GO TO 1400-STRUCTURE-FIELDS.                                    CL**2
00422                                                                    DCTOT31
00423 ***************************************************************      CL**2
00424 *                                                                    CL**2
00425 *    PROCESS RECORD ENTRY                                            CL**2
00426 *                                                                    CL**2
00427 ***************************************************************      CL**2
00428 *                                                                    CL**2
00429 *    CHECK RECORD STRUCTURE TO FIND THE KEY FIELD                    CL**2
00430 *                                                                    CL**2
00431  3000-PROCESS-RECORD.                                                CL**2
00432      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00433      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00434      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00435      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00436          PERFORM 9010-NO-STC-MSSG THRU 9010-NO-STC-MSSG-XIT          CL**2
00437          GO TO 2600-PROCESS-DATASETS.                                CL**2
00438 *                                                                    CL**2
00439 *    IF TYPE-SW IS EQUAL TO "V" THEN MUST PROCESS ENTIRE             CL**2
00440 *        RECORD STRUCTURE UNTIL FINDING IF A RECORD-CODE FIELD       CL**2
00441 *        EXISTS---IF ONE EXISTS THEN PRINT OUT "XXXXCODE=2"          CL**2
00442 *                                                                    CL**2
00443      IF TYPE-SW NOT EQUAL TO "V"                                     CL**2
00444          GO TO 3120-CHECK-LINETYPES.                                 CL**2
00445  3050-CHECK-RECORD-CODE.                                             CL**2
00446      IF STC-LINE-TYPE NOT EQUAL TO STD-CLINE-TYPE                    CL**2
00447          GO TO 3075-RECORD-READ.                                     CL**2
00448      IF STC-TOT-RCCODE EQUAL TO SPACES                               CL**2
00449          GO TO 3075-RECORD-READ.                                     CL**2
00450      MOVE NAME2 TO NAME4.                                            CL**2
00451      MOVE COMMENT19 TO HOLD-CARD-IMAGE.                              CL**2
00452      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00453      GO TO 3100-GENERATE-STRUCTURE.                                  CL**2
00454 *                                                                    CL**2
00455 *    READ NEXT RECORD STRUCTURE TO FIND IF RECORD-CODES EXIST        CL**2
00456 *                                                                    CL**2
00457  3075-RECORD-READ.                                                   CL**2
00458      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00459      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00460      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00461          GO TO 3100-GENERATE-STRUCTURE.                              CL**2
00462      GO TO 3050-CHECK-RECORD-CODE.                                   CL**2
00463                                                                    DCTOT31
00464 ***************************************************************      CL**2
00465 *                                                                    CL**2
00466 *    GET STRUCTURE LINE FROM RECORD AND PROCESS DOWN                 CL**2
00467 *        THROUGH ITS ENTIRE MAKEUP                                   CL**2
00468 *                                                                    CL**2
00469 ***********************************************************          CL**2
00470  3100-GENERATE-STRUCTURE.                                            CL**2
00471      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00472      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00473  3110-RECORD-COMMENT.                                                CL**2
00474      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00475      IF DATA-RETURN-CODE NOT EQUAL ZERO                              CL**2
00476          PERFORM 9010-NO-STC-MSSG THRU 9010-NO-STC-MSSG-XIT          CL**2
00477          GO TO 2600-PROCESS-DATASETS.                                CL**2
00478  3120-CHECK-LINETYPES.                                               CL**2
00479      IF STC-LINE-TYPE EQUAL TO STD-CLINE-TYPE                        CL**2
00480          GO TO 3200-RECORD-CODE.                                     CL**2
00481      IF STC-LINE-TYPE EQUAL TO STD-BLINE-TYPE                        CL**2
00482          GO TO 3300-LINKPATH.                                        CL**2
00483 *                                                                    CL**2
00484 *    FOUND AN "A" OR SPACE LINETYPE--TEST INCLUSION FIELD            CL**2
00485 *                                                                    CL**2
           IF STC-TOT-CNAME EQUAL SPACES
               PERFORM 9105-BLANK-MSSG THRU 9105-BLANK-MSSG-XIT 
               GO TO 3130-RECORD-STRUCTURE. 
00486      IF STC-TOT-DBD-INC NOT EQUAL TO "N"                             CL**2
00487          GO TO 3140-TEST-KEY.                                        CL**2
00488  3130-RECORD-STRUCTURE.                                              CL**2
00489      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00490      GO TO 3110-RECORD-COMMENT.                                      CL**2
00491 *                                                                    CL**2
00492 *    TEST KEY=Y FIELD TO FIND IF STRUCTURE IS A CONTROL STRUCTURE    CL**2
00493 *                                                                    CL**2
00494  3140-TEST-KEY.                                                      CL**2
00495      IF TYPE-SW EQUAL TO "V"                                         CL**2
00496          GO TO 3150-FILLER.                                          CL**2
00497      IF STC-TOT-KEY NOT EQUAL TO "U"                                 CL**2
00498          GO TO 3150-FILLER.                                          CL**2
00499      MOVE "Y" TO HOLD-SW.                                            CL**2
00500 *                                                                    CL**2
00501 *    FOUND A CONTROL STRUCTURE LINE---CATNAME=FILLER OR SPACES       CL**2
00502 *                                                                    CL**2
00503      IF STC-TOT-CNAME EQUAL TO SPACES OR FILLERKW                    CL**2
00504          MOVE "N" TO HOLD-SW                                         CL**2
00505          PERFORM 9005-KEY-MSSG THRU 9005-KEY-MSSG-XIT                CL**2
00506          GO TO 3450-GET-NEXT-STRUCTURE.                              CL**2
00507      GO TO 3160-CONTINUE-STRUCTURE.                                  CL**2
00508  3150-FILLER.                                                        CL**2
00509      IF STC-TOT-CNAME EQUAL TO FILLERKW                              CL**2
00510          PERFORM 9100-FILLER-MSSG THRU 9100-FILLER-MSSG-XIT          CL**2
00511          GO TO 3450-GET-NEXT-STRUCTURE.                              CL**2
00512 *                                                                    CL**2
00513 *    SAVE PLACE IN RECORD STRUCTURE FOR LATER REFERENCE              CL**2
00514 *                                                                    CL**2
00515  3160-CONTINUE-STRUCTURE.                                            CL**2
00516      MOVE DATA-SEARCH TO GEN15-SAVE-SEARCH.                          CL**2
00517      MOVE CAT-LINE TO GEN15-DATA-ENTRY-LINE.                         CL**2
           MOVE SPACES TO SAVE-ELE-STC-CAT. 
           MOVE MINUS-ASTER TO SAVE-ELE-STC-A.
  
      * LOOK FOR OCCURS STRUCTURE LINE BELONGING TO STANDARD 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 GEN15-DATA-ENTRY-LINE 
             MOVE MINUS-ASTER TO SAVE-ELE-STC-O 
           END-IF 
  
           MOVE SAVE-ELE-STC-CNAME TO DATA-ENTRY-NAME.
00520 *                                                                    CL**2
00521 *    VALIDATE THAT ENTRY EXISTS ON FILE                              CL**2
00522 *                                                                    CL**2
00523      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00524      IF DATA-RETURN-CODE NOT EQUAL ZERO                              CL**2
00525          PERFORM 9030-NO-DATA-MSSG THRU 9030-NO-DATA-MSSG-XIT        CL**2
00526          MOVE "N" TO HOLD-SW                                         CL**2
00527          GO TO 3400-FIND-SAVE-AREA.                                  CL**2
00528 *                                                                    CL**2
00529 *    EXTRACTED STRUCTURE LINE OF A RECORD                            CL**2
00530 *        DECIDE WHETHER STRUCTURE IS A GROUP OR ELEMENT              CL**2
00531 *                                                                    CL**2
00532      IF DATA-HDR-ENT-ID EQUAL TO "10"                                CL**2
               MOVE SAVE-ELE-STC-CAT TO SAVE-GRP-STC-CAT
               MOVE SPACES TO SAVE-ELE-STC-CAT
00534          GO TO 3175-TEST-REDEFINES.                                  CL**2
00535      IF DATA-HDR-ENT-ID NOT EQUAL TO "05"                            CL**2
00536          PERFORM 9020-BAD-ENTITY THRU 9020-BAD-ENTITY-XIT            CL**2
00537          MOVE "N" TO HOLD-SW                                         CL**2
00538          GO TO 3400-FIND-SAVE-AREA.                                  CL**2
           IF COMP-SWITCH = "Y" 
               MOVE SAVE-ELE-STC-CPA-CLINE TO HOLD-CPALIAS
               MOVE HOLD-CPALIAS TO SAVE-ELE-STC-ALY-NO.
00540      IF SAVE-ELE-STC-REDEFINES NOT EQUAL TO SPACES                   CL**2
00541          MOVE "N" TO HOLD-SW                                         CL**2
00542          GO TO 3400-FIND-SAVE-AREA.                                  CL**2
00543      MOVE SPACES TO SAVE-GRP-ATTR-CAT.                               CL**2
00544      MOVE 0 TO GROUP-SUB.                                            CL**2
00545      GO TO 3700-ELEMENT-PROCESS.                                     CL**2
00546  3175-TEST-REDEFINES.                                                CL**2
00547      IF SAVE-GRP-STC-REDEFINES EQUAL TO SPACES                       CL**2
00548          GO TO 3600-GROUP-PROCESS.                                   CL**2
00549      MOVE "N" TO HOLD-SW.                                            CL**2
00550      GO TO 3400-FIND-SAVE-AREA.                                      CL**2
00551 *                                                                    CL**2
00552 *    FOUND A "C" LINETYPE---PUT OUT RECORD-CODE LINE                 CL**2
00553 *                                                                    CL**2
00554  3200-RECORD-CODE.                                                   CL**2
00555      IF TYPE-SW NOT EQUAL TO "V"                                     CL**2
00556          GO TO 3450-GET-NEXT-STRUCTURE.                              CL**2
00557      IF STC-TOT-RCCODE EQUAL TO SPACES                               CL**2
00558          GO TO 3250-TEST-COMPNAME.                                   CL**2
00559      IF STC-TOT-RCCODE EQUAL TO PREVIOUS-CODE                        CL**2
00560          GO TO 3250-TEST-COMPNAME.                                   CL**2
00561      MOVE STC-TOT-RCCODE TO NAME10, PREVIOUS-CODE.                   CL**2
00562      MOVE COMMENT25 TO HOLD-CARD-IMAGE.                              CL**2
00563      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
           GO TO 3250-TEST-COMPNAME.
00565 *                                                                    CL**2
00566 *    FOUND A C-LINETYPE MUST TEST EXISTENCE OF COMPONENT NAME        CL**2
00567 *        FIELD---IF PRESENT PROCESS ITS STRUCTURE                    CL**2
00568 *            IF EQUAL TO SPACES OR FILLER IGNORE                     CL**2
00569 *                                                                    CL**2
00570  3250-TEST-COMPNAME.                                                 CL**2
00571      IF STC-TOT-COMPNAME EQUAL TO SPACES OR FILLERKW                 CL**2
00572          GO TO 3450-GET-NEXT-STRUCTURE.                              CL**2
00573      MOVE "Y" TO COMP-SWITCH.                                        CL**2
00574      GO TO 3160-CONTINUE-STRUCTURE.                                  CL**2
00575 *                                                                    CL**2
00576 *    FOUND A "B" LINETYPE---PUT OUT LINKPATH LINE                    CL**2
00577 *                                                                    CL**2
00578  3300-LINKPATH.                                                      CL**2
00579      IF STC-TOT-LINKPATH EQUAL TO SPACES                             CL**2
00580          GO TO 3450-GET-NEXT-STRUCTURE.                              CL**2
00581      MOVE STC-TOT-LINKPATH TO LINK-PATH-HOLD.                        CL**2
00582      MOVE HOLD-LINK-PATH TO M-NAME.                                  CL**2
00583      MOVE HOLD-LINK-PATH2 TO X-NAME.                                 CL**2
           IF TYPE-SW = "V" 
               MOVE "=" TO EQ2
               PERFORM 3303-LINKPATH THRU 3305-LINKPATH-XIT 
               IF ERROR-FLG = "Y" 
                   GO TO 3450-GET-NEXT-STRUCTURE
               ELSE 
                   NEXT SENTENCE
           ELSE 
               MOVE SPACE TO EQ2
               MOVE SPACES TO K-NAME. 
00584      MOVE COMMENT20 TO HOLD-CARD-IMAGE.                              CL**2
00585      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00586      GO TO 3450-GET-NEXT-STRUCTURE.                                  CL**2
       3303-LINKPATH. 
           MOVE "N" TO ERROR-FLG. 
           IF STC-TOT-LKFIELD = SPACES
               PERFORM 9110-BLANK-LKFIELD 
                  THRU 9110-BLANK-LKFIELD-XIT 
               MOVE "Y" TO ERROR-FLG
               GO TO 3305-LINKPATH-XIT. 
      * 
      *   SAVE PLACE IN RECORD STRUCTURE FOR LATER REFERENCE
      * 
           MOVE DATA-SEARCH TO GEN15-SAVE-SEARCH. 
           MOVE CAT-LINE TO GEN15-DATA-ENTRY-LINE.
           MOVE CAT-DETAIL TO SAVE-STC. 
           MOVE STC-TOT-LKFIELD TO DATA-ENTRY-NAME. 
           PERFORM READ-FIRST-DATA THRU 
                   READ-FIRST-DATA-XIT. 
           PERFORM TEST-RETURN-CODE THRU
                   TEST-RETURN-CODE-XIT.
           IF DATA-RETURN-CODE NOT EQUAL 0
               PERFORM 9030-NO-DATA-MSSG THRU 
                       9030-NO-DATA-MSSG-XIT
               MOVE "N" TO HOLD-SW
               MOVE "Y" TO ERROR-FLG
               GO TO 3302-FIND-SAVE-AREA. 
  
           IF DATA-HDR-ENT-ID = "10"
               MOVE SAVE-STC TO SAVE-GRP-STC-CAT
               PERFORM 3310-FIND-GRP-NAME THRU
                       3310-FIND-GRP-NAME-XIT 
           ELSE 
               IF DATA-HDR-ENT-ID = "05"
                   MOVE SAVE-STC TO SAVE-ELE-STC-CAT
                   PERFORM 3320-FIND-ELE-NAME THRU
                           3320-FIND-ELE-NAME-XIT 
                   PERFORM 3330-FIND-ALIAS THRU 
                           3360-FIND-ALIAS-XIT
           ELSE 
               PERFORM 9020-BAD-ENTITY THRU 
                       9020-BAD-ENTITY-XIT
               MOVE "Y" TO ERROR-FLG. 
      * 
      *   AFTER PROCESSING LINKPATH --- REPOSITION
      *                                 LINK PATH LINE
      * 
       3302-FIND-SAVE-AREA. 
           MOVE GEN15-SAVE-SEARCH TO DATA-SEARCH. 
           PERFORM RETURN-KEY THRU RETURN-KEY-XIT.
           MOVE "N" TO COMP-SWITCH. 
      * 
       3305-LINKPATH-XIT. 
           EXIT.
      * 
       3310-FIND-GRP-NAME.
           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 NAME-GRP-DBMS = SPACES OR 
              DATA-RETURN-CODE NOT = 0
               MOVE SAVE-GRP-STC-LKFIELD-BLINE TO K-NAME
               PERFORM 9000-MAKEUP-MSSG THRU
                       9000-MAKEUP-MSSG-XIT 
           ELSE 
               MOVE NAME-GRP-DBMS TO K-NAME.
      * 
       3310-FIND-GRP-NAME-XIT.
           EXIT.
      * 
       3320-FIND-ELE-NAME.
           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 NOT = 0 OR 
              NAME-DBMS = SPACES
               PERFORM 9000-MAKEUP-MSSG THRU 9000-MAKEUP-MSSG-XIT 
               MOVE SAVE-ELE-STC-LKFIELD-BLINE TO K-NAME
           ELSE 
               MOVE NAME-DBMS TO K-NAME.
      * 
       3320-FIND-ELE-NAME-XIT.
           EXIT.
      * 
       3330-FIND-ALIAS. 
           IF SAVE-ELE-STC-LKALIAS-BLINE = SPACES 
               GO TO 3360-FIND-ALIAS-XIT. 
           MOVE ALIAS-CAT-NO TO DATA-ENTRY-CAT. 
           PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.
       3340-CHECK-CODE. 
           PERFORM TEST-RETURN-CODE THRU
                   TEST-RETURN-CODE-XIT.
           IF DATA-RETURN-CODE NOT = 0
               GO TO 3360-FIND-ALIAS-XIT. 
           IF CAT-LINE = SAVE-ELE-STC-LKALIAS-BLINE 
               GO TO 3350-FOUND-ALIAS.
           PERFORM READ-NEXT-DATA THRU
                   READ-NEXT-DATA-XIT.
           GO TO 3340-CHECK-CODE. 
       3350-FOUND-ALIAS.
           IF ALY-DBMS NOT = SPACES 
               MOVE ALY-DBMS TO K-NAME. 
       3360-FIND-ALIAS-XIT. 
           EXIT.
00587 *                                                                    CL**2
00588 *    AFTER PROCESSING STRUCTURE---GENERATION COMES TO THIS POINT     CL**2
00589 *                                                                    CL**2
00590  3400-FIND-SAVE-AREA.                                                CL**2
00591      MOVE "N" TO COMP-SWITCH.                                        CL**2
00592      MOVE GEN15-SAVE-SEARCH TO DATA-SEARCH.                          CL**2
00593      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
00594  3450-GET-NEXT-STRUCTURE.                                            CL**2
00595      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00596      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00597      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00598          GO TO 2600-PROCESS-DATASETS.                                CL**2
00599      IF STC-LINE-TYPE EQUAL TO STD-CLINE-TYPE                        CL**2
00600          GO TO 3200-RECORD-CODE.                                     CL**2
00601      IF STC-LINE-TYPE EQUAL TO STD-BLINE-TYPE                        CL**2
00602          GO TO 3300-LINKPATH.                                        CL**2
           IF STC-TOT-CNAME EQUAL SPACES
               PERFORM 9105-BLANK-MSSG THRU 9105-BLANK-MSSG-XIT 
               GO TO 3450-GET-NEXT-STRUCTURE. 
00603      IF STC-TOT-DBD-INC NOT EQUAL TO "N"                             CL**2
00604          GO TO 3140-TEST-KEY.                                        CL**2
00605      GO TO 3450-GET-NEXT-STRUCTURE.                                  CL**2
00606                                                                    DCTOT31
00607 ******************************************************               CL**2
00608 *                                                                    CL**2
00609 *    THIS CODING WILL CHECK IF ENTRY IS A KEY FIELD                  CL**2
00610 *        CALCULATE THE LENGTH OF THE KEY FIELD AND MOVE TO PRINT     CL**2
00611 *                                                                    CL**2
00612 ******************************************************               CL**2
00613 *                                                                    CL**2
00614 *    FOUND A GROUP---MUST CHECK TO SEE IF IT IS A KEY FIELD          CL**2
00615 *                                                                    CL**2
00616  3600-GROUP-PROCESS.                                                 CL**2
00617      IF HOLD-SW NOT EQUAL TO "Y"                                     CL**2
00618          GO TO 4000-PROCESS-GROUPS.                                  CL**2
00619      MOVE ZERO TO GROUP-SUB, GROUP-SUBB, GROUP-SUBC.                 CL**2
00620      MOVE ZERO TO SAVE-LENGTH, TOTAL-LENGTH.                         CL**2
00621      MOVE SAVE-GRP-STC-CNAME TO DATA-ENTRY-NAME, GEN-GROUP-NAME.     CL**2
00622      MOVE NAME-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00623      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00624  3605-SET-LINE.                                                      CL**2
00625      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00626      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00627          GO TO 3610-MOVE-CTRL.                                       CL**2
00628      IF NAME-TOT-DBMS EQUAL TO SPACES                                CL**2
00629          GO TO 3610-MOVE-CTRL.                                       CL**2
00630      MOVE NAME-TOT-DBMS TO SUBNAME1.                                 CL**2
00631      MOVE "CTRL" TO SUBNAME2.                                        CL**2
00632      MOVE "=" TO EQUAL-SIGN.                                         CL**2
00633      GO TO 3615-CLEAR-ATTR.                                          CL**2
00634  3610-MOVE-CTRL.                                                     CL**2
00635      PERFORM 9000-MAKEUP-MSSG THRU 9000-MAKEUP-MSSG-XIT.             CL**2
00636      MOVE GEN-GROUP-NAME TO SUBNAME1.                                CL**2
00637      MOVE "CTRL" TO SUBNAME2.                                        CL**2
00638      MOVE "=" TO EQUAL-SIGN.                                         CL**2
00639 *                                                                    CL**2
00640 *    MOVE GROUP ATTRIBUTES TO SAVE AEEA---THEY TAKE PREFERENCE       CL**2
00641 *                                                                    CL**2
00642  3615-CLEAR-ATTR.                                                    CL**2
00643      MOVE SPACES TO SAVE-GRP-ATTR-CAT.                               CL**2
00644      MOVE ATTR-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00645      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00646  3620-ATTR-LOOP.                                                     CL**2
00647      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00648      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00649          GO TO 3625-FIND-LENGTH.                                     CL**2
           MOVE MINUS-ASTER TO SAVE-GRP-ATTR-CAT. 
00651 *                                                                    CL**2
00652 *    SET OCCUR FIELD TO NUMERIC VALUE FOR USE IN CALCULATION         CL**2
00653 *                                                                    CL**2
00654  3625-FIND-LENGTH.                                                   CL**2
00655      MOVE ZERO TO NUM-A.                                             CL**2
00656      IF SAVE-GRP-STC-OCC-TO EQUAL TO SPACES OR ZERO                  CL**2
00657          MOVE 1 TO SAVE-GRP-ATTR-OCCUR, OCCUR-SAVE                   CL**2
00658          GO TO 3650-CALCULATE.                                       CL**2
00659      MOVE SAVE-GRP-STC-OCC-TO TO SAVE-GRP-ATTR-OCCURB OCCUR-SAVEB.   CL**2
00660 *                                                                    CL**2
00661 *    CALCULATE GROUP LENGTH AND MOVE VALUE TO PRINT LINE             CL**2
00662 *                                                                    CL**2
00663  3650-CALCULATE.                                                     CL**2
           MOVE GROUP-SUB TO GROUP-SUBD 
           IF SAVE-GRP-ATTR-LENGTH EQUAL SPACES OR ZERO 
               PERFORM 7000-CALCULATE-LENGTH THRU 
                       7900-CALCULATE-LENGTH-XIT
           ELSE 
               MOVE SAVE-GRP-ATTR-LENGTH TO SAVE-LENGTH.
00665      IF SAVE-LENGTH EQUAL TO 0                                       CL**2
               MOVE "000000" TO SUBLENGTH 
00667          GO TO 3675-MOVE-LINE.                                       CL**2
00668      MOVE SAVE-LENGTH TO NINE-LENGTH.                                CL**2
00669      MOVE NINE-LENGTH TO SCAN-AREA.                                  CL**2
00670      MOVE ZERO TO SUB-A, SUB-B.                                      CL**2
00671      PERFORM MOVE-VALID-LENGTH THRU MOVE-VALID-LENGTH-XIT.           CL**2
00672      MOVE SCAN-AREA TO SUBLENGTH.                                    CL**2
00673  3675-MOVE-LINE.                                                     CL**2
00674      MOVE COMM-CONTINUE TO HOLD-CARD-IMAGE.                          CL**2
00675      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00676      IF GROUP-SUBC GREATER THAN 1                                    CL**2
00677          MOVE GROUP-ENTRY-NAME (1) TO DATA-ENTRY-NAME.               CL**2
00678      GO TO 4000-PROCESS-GROUPS.                                      CL**2
00679 ******************************************************************   CL**2
00680 *                                                                    CL**2
00681 *    FOUND AN ELEMENT---MUST CHECK TO SEE IF IT IS A KEY FIELD       CL**2
00682 *                                                                    CL**2
00683 ******************************************************************   CL**2
00684  3700-ELEMENT-PROCESS.                                               CL**2
00685      IF HOLD-SW NOT EQUAL TO "Y"                                     CL**2
00686          GO TO 5000-PROCESS-ELEMENTS.                                CL**2
00687      MOVE "N" TO HOLD-SW.                                            CL**2
00688      MOVE SAVE-ELE-STC-CNAME TO DATA-ENTRY-NAME.                     CL**2
00689      MOVE NAME-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00690      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00691      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00692      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00693          GO TO 3710-MOVE-CTRL.                                       CL**2
00694      IF NAME-DBMS EQUAL TO SPACES                                    CL**2
00695          GO TO 3710-MOVE-CTRL.                                       CL**2
00696      MOVE NAME-DBMS TO SUBNAME1.                                     CL**2
00697      MOVE "CTRL" TO SUBNAME2.                                        CL**2
00698      MOVE "=" TO EQUAL-SIGN.                                         CL**2
00699      GO TO 3715-CHECK-ATTR.                                          CL**2
00700  3710-MOVE-CTRL.                                                     CL**2
00701      MOVE GEN-GROUP-NAME TO SUBNAME1.                                CL**2
00702      MOVE "CTRL" TO SUBNAME2.                                        CL**2
00703      PERFORM 9000-MAKEUP-MSSG THRU 9000-MAKEUP-MSSG-XIT.             CL**2
00704      MOVE "=" TO EQUAL-SIGN.                                         CL**2
00705 *                                                                    CL**2
00706 *    CHECK ELEMENT LENGTH AND MOVE TO OUTPUT LINE.                   CL**2
00707 *                                                                    CL**2
00708  3715-CHECK-ATTR.                                                    CL**2
00709      MOVE ATTR-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00710      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
           PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.
           IF DATA-RETURN-CODE NOT EQUAL 0
               MOVE "1" TO ATTR-LENGTH
               GO TO 3720-FORMAT-ATTR.
00711      IF ATTR-LENGTH EQUAL TO SPACES OR ZERO                          CL**2
00712          MOVE "1" TO ATTR-LENGTH.                                    CL**2
       3720-FORMAT-ATTR.
00713      MOVE ATTR-LENGTH TO SCAN-AREA.                                  CL**2
00714      MOVE ZERO TO SUB-A, SUB-B.                                      CL**2
00715      PERFORM MOVE-VALID-LENGTH THRU MOVE-VALID-LENGTH-XIT.           CL**2
00716      MOVE SCAN-AREA TO SUBLENGTH.                                    CL**2
00717      MOVE COMM-CONTINUE TO HOLD-CARD-IMAGE.                          CL**2
00718      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00719      GO TO 3400-FIND-SAVE-AREA.                                      CL**2
00720                                                                    DCTOT31
00721 *****************************************************************    CL**2
00722 *****************************************************************    CL**2
00723 *                                                                    CL**2
00724 *    PROCESS GROUP ENTRY                                             CL**2
00725 *                                                                    CL**2
00726 ****************************************************************     CL**2
00727 ****************************************************************     CL**2
00728  4000-PROCESS-GROUPS.                                                CL**2
00729      MOVE ZERO TO GROUP-SUB, GROUP-SUBB, GROUP-SUBC.                 CL**2
           MOVE ZERO TO SAVE-LENGTH.
00730      IF HOLD-SW EQUAL TO "Y"                                         CL**2
00731          MOVE "N" TO HOLD-SW                                         CL**2
00732          GO TO 4600-STRUCTURE-PROCESSING.                            CL**2
00733 ******************************************************               CL**2
00734 *    RETRIEVE CHARACTERISTICS OF GROUP                               CL**2
00735 ******************************************************               CL**2
00736  4005-RETRIEVE-SAVE.                                                 CL**2
00737      MOVE SAVE-GRP-STC-CNAME TO DATA-ENTRY-NAME.                     CL**2
00738      MOVE SAVE-GRP-STC-CNAME TO GEN-GROUP-NAME.                      CL**2
00739  4010-GET-NAME.                                                      CL**2
00740 *                                                                    CL**2
00741 *    RETRIEVE DBMS NAME TO BE USED IN GENERATION                     CL**2
00742 *                                                                    CL**2
00743      MOVE NAME-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00744      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00745      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00746      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00747          PERFORM 9000-MAKEUP-MSSG THRU 9000-MAKEUP-MSSG-XIT          CL**2
00748          MOVE GEN-GROUP-NAME TO GROUP-DATA-NAME                      CL**2
00749          GO TO 4015-CHECK-ATTRIBUTES.                                CL**2
00750      IF NAME-GRP-DBMS EQUAL TO SPACES                                CL**2
00751          PERFORM 9000-MAKEUP-MSSG THRU 9000-MAKEUP-MSSG-XIT          CL**2
00752          MOVE GEN-GROUP-NAME TO GROUP-DATA-NAME                      CL**2
00753      ELSE                                                            CL**2
00754          MOVE NAME-GRP-DBMS TO GROUP-DATA-NAME.                      CL**2
00755 *                                                                    CL**2
00756 *    RETRIEVE GROUP ATTRIBUTES                                       CL**2
00757 *                                                                    CL**2
00758  4015-CHECK-ATTRIBUTES.                                              CL**2
00759      MOVE SPACES TO SAVE-GRP-ATTR-CAT.                               CL**2
00760      MOVE ATTR-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00761      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00762  4016-COMMENT-LOOP.                                                  CL**2
00763      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00764      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00765          GO TO 4020-LAYOUT-START.                                    CL**2
           MOVE MINUS-ASTER TO SAVE-GRP-ATTR-CAT. 
00767 *                                                                    CL**2
00768 *    FORM NAME USING PREFIX--IF FIRST STRUCTURE MOVE TO OUTPUT       CL**2
00769 *                                                                    CL**2
00770  4020-LAYOUT-START.                                                  CL**2
           IF SAVE-GRP-STC-OCC-TO EQUAL TO SPACES OR ZERO 
               MOVE 1 TO SAVE-GRP-ATTR-OCCUR, OCCUR-SAVE
           ELSE 
               MOVE SAVE-GRP-STC-OCC-TO TO SAVE-GRP-ATTR-OCCURB,
               OCCUR-SAVEB. 
           MOVE GROUP-SUB TO GROUP-SUBD.
           IF SAVE-GRP-ATTR-LENGTH EQUAL TO SPACES OR ZERO
               PERFORM 7000-CALCULATE-LENGTH THRU 
                       7900-CALCULATE-LENGTH-XIT
             ELSE 
               MOVE SAVE-GRP-ATTR-LENGTH TO SAVE-LENGTH.
00771      MOVE GROUP-DATA-NAME TO WS-DATA-NAME.                           CL**2
00772      MOVE SPACES TO COMM-CONTINUE, COMM-CONTINUE2.                   CL**2
00773      MOVE WS-DATA-NAME TO REC-SUBNAME.                               CL**2
00774      IF COMP-SWITCH EQUAL TO "Y"                                     CL**2
00775          ADD 1 TO GROUP-SUB.                                         CL**2
           MOVE "=" TO EQUAL-SIGN, EQUAL-SIGN2. 
           MOVE ZERO TO SUB-A, SUB-B. 
           MOVE SPACES TO SCAN-AREA.
           MOVE SAVE-LENGTH TO SCAN-AREA. 
           MOVE ZERO TO SAVE-LENGTH.
           PERFORM MOVE-VALID-LENGTH THRU MOVE-VALID-LENGTH-XIT.
           IF GROUP-SUB EQUAL TO ZERO 
               MOVE SCAN-AREA TO SUBLENGTH
               MOVE COMM-CONTINUE TO HOLD-CARD-IMAGE
               PERFORM BAL-OUT THRU BAL-OUT-XIT 
               GO TO 4600-STRUCTURE-PROCESSING. 
           IF GROUP-SUB GREATER THAN 9
               MOVE GROUP-SUB TO LEVEL-REC2 
               MOVE REC-SUBNAME TO REC-SUBNAME2 
               MOVE SCAN-AREA TO SUBLENGTH2 
               MOVE COMMENT18 TO HOLD-CARD-IMAGE
               PERFORM BAL-OUT THRU BAL-OUT-XIT 
               GO TO 4600-STRUCTURE-PROCESSING. 
           MOVE GROUP-SUB TO LEVEL-REC. 
           MOVE SCAN-AREA TO SUBLENGTH. 
           MOVE COMMENT17 TO HOLD-CARD-IMAGE. 
00788      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00789 ****************************************************************     CL**2
00790 *                                                                    CL**2
00791 *    PROCESS STRUCTURE OF GROUP ENTRY                                CL**2
00792 *                                                                    CL**2
00793 ****************************************************************     CL**2
00794  4600-STRUCTURE-PROCESSING.                                          CL**2
00795      IF COMP-SWITCH EQUAL TO "Y"                                     CL**2
00796          SUBTRACT 1 FROM GROUP-SUB.                                  CL**2
00797      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
00798      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00799  4650-COMMENT-PROCESS.                                               CL**2
00800      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00801      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00802          PERFORM 9010-NO-STC-MSSG THRU 9010-NO-STC-MSSG-XIT          CL**2
00803          GO TO 5900-TEST-MORE-STRUCTURE.                             CL**2
00804      IF STC-LINE-TYPE EQUAL TO SPACE OR STD-LINE-TYPE                CL**2
00805          NEXT SENTENCE                                               CL**2
00806      ELSE                                                            CL**2
00807          GO TO 4675-READ-STRUCTURE.                                  CL**2
           IF STC-GRP-CNAME EQUAL SPACES
               PERFORM 9105-BLANK-MSSG THRU 9105-BLANK-MSSG-XIT 
               GO TO 4675-READ-STRUCTURE. 
00808      IF STC-DBD-INC NOT EQUAL "N"                                    CL**2
00809          GO TO 4700-CHECK-FILLER.                                    CL**2
00810  4675-READ-STRUCTURE.                                                CL**2
00811      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00812      GO TO 4650-COMMENT-PROCESS.                                     CL**2
00813 *                                                                    CL**2
00814 *     CHECK FOR FILLER                                               CL**2
00815 *                                                                    CL**2
00816  4700-CHECK-FILLER.                                                  CL**2
00817      IF STC-GRP-CNAME NOT EQUAL TO FILLERKW                          CL**2
00818          GO TO 4750-SAVE-ALL.                                        CL**2
00819      PERFORM 9100-FILLER-MSSG THRU 9100-FILLER-MSSG-XIT.             CL**2
00820      GO TO 4675-READ-STRUCTURE.                                      CL**2
00821 *                                                                    CL**2
00822 *    PROCESSING OF COMPONENT OF GROUP ENTITY BEGINS HERE             CL**2
00823 *    SAVE STRUCTURE LINE INFORMATION                                 CL**2
00824 *                                                                    CL**2
00825  4750-SAVE-ALL.                                                      CL**2
00826      ADD 1 TO GROUP-SUB.                                             CL**2
00828      IF GROUP-SUB GREATER THAN 15                                    CL**2
00829          PERFORM 9060-GROUP-LIMIT THRU 9060-GROUP-LIMIT-XIT          CL**2
00830          MOVE GROUP-ENTRY-NAME (1) TO DATA-ENTRY-NAME                CL**2
00831          PERFORM 9025-INFORM-ERROR THRU 9025-INFORM-ERROR-XIT        CL**2
00832          GO TO 3400-FIND-SAVE-AREA.                                  CL**2
           MOVE DATA-ENTRY-NAME TO GROUP-ENTRY-NAME (GROUP-SUB).
00833      MOVE CAT-LINE TO GROUP-STC-LINE (GROUP-SUB).                    CL**2
00834      MOVE SAVE-GRP-ATTR-LENGTH TO GROUP-LENGTH (GROUP-SUB).          CL**2
00835      MOVE SAVE-GRP-ATTR-FORMAT TO GROUP-FORMAT (GROUP-SUB).          CL**2
00836      MOVE SAVE-GRP-ATTR-PICTURE TO GROUP-PICTURE (GROUP-SUB).        CL**2
00837      MOVE SAVE-GRP-ATTR-JUST TO GROUP-JUST (GROUP-SUB).              CL**2
00838      MOVE SAVE-GRP-ATTR-SYNC TO GROUP-SYNC (GROUP-SUB).              CL**2
00839  4775-SAVE-STRUCTURE.                                                CL**2
           MOVE SPACES TO SAVE-ELE-STC-CAT. 
           MOVE MINUS-ASTER TO SAVE-ELE-STC-A.
  
      * LOOK FOR OCCURS STRUCTURE LINE BELONGING TO STANDARD 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 (GROUP-SUB)
             MOVE MINUS-ASTER TO SAVE-ELE-STC-O 
           END-IF 
  
00841 ******************************************************************   CL**2
00842 *     RETRIEVE COMPONENT ENTRY- DETERMINE TYPE                       CL**2
00843 *****************************************************************    CL**2
           MOVE SAVE-ELE-STC-CNAME TO DATA-ENTRY-NAME.
00845      MOVE DATA-ENTRY-NAME TO GEN-GROUP-NAME.                         CL**2
00846      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00847      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00848          PERFORM 9030-NO-DATA-MSSG THRU 9030-NO-DATA-MSSG-XIT        CL**2
00849          GO TO 5800-RETURN-FOR-STRUCTURE.                            CL**2
00850 ******************************************************************   CL**2
00851 *     CHECK FOR GROUP COMPONENT AND PROCESS                          CL**2
00852 *****************************************************************    CL**2
00853      IF DATA-HDR-ENT-ID EQUAL TO "10"                                CL**2
               MOVE SAVE-ELE-STC-CAT TO SAVE-GRP-STC-CAT
               MOVE SPACES TO SAVE-ELE-STC-CAT
00855          GO TO 4900-GRP-REDEFINES.                                   CL**2
00856 *****************************************************************    CL**2
00857 *     CHECK FOR ELEMENT COMPONENT AND PROCESS                        CL**2
00858 ******************************************************************   CL**2
00859  4800-TEST-ELEMENT.                                                  CL**2
00860      IF DATA-HDR-ENT-ID NOT EQUAL "05"                               CL**2
00861          PERFORM 9020-BAD-ENTITY THRU 9020-BAD-ENTITY-XIT            CL**2
00862          GO TO 5800-RETURN-FOR-STRUCTURE.                            CL**2
00864      IF SAVE-ELE-STC-REDEFINES NOT EQUAL TO SPACES                   CL**2
00865          SUBTRACT 1 FROM GROUP-SUB                                   CL**2
00866          GO TO 5800-RETURN-FOR-STRUCTURE.                            CL**2
00867      MOVE GROUP-LENGTH (GROUP-SUB) TO SAVE-GRP-ATTR-LENGTH.          CL**2
00868      MOVE GROUP-FORMAT (GROUP-SUB) TO SAVE-GRP-ATTR-FORMAT.          CL**2
00869      MOVE "Y" TO IN-GROUP-SW.                                        CL**2
00870      GO TO 5000-PROCESS-ELEMENTS.                                    CL**2
00871  4900-GRP-REDEFINES.                                                 CL**2
00872      IF SAVE-GRP-STC-REDEFINES EQUAL TO SPACES                       CL**2
00873          GO TO 4005-RETRIEVE-SAVE.                                   CL**2
00874      SUBTRACT 1 FROM GROUP-SUB.                                      CL**2
00875      GO TO 5800-RETURN-FOR-STRUCTURE.                                CL**2
00876                                                                    DCTOT31
00877 *****************************************************************    CL**2
00878 *****************************************************************    CL**2
00879 *                                                                *   CL**2
00880 *     PROCESS ELEMENT                                            *   CL**2
00881 *                                                                *   CL**2
00882 *****************************************************************    CL**2
00883 *****************************************************************    CL**2
00884  5000-PROCESS-ELEMENTS.                                              CL**2
00885      MOVE SAVE-ELE-STC-CNAME TO GEN-ELEMENT-NAME.                    CL**2
00886 *****************************************************************    CL**2
00887 *     RETREIVE DATA NAME (PREFERRED)                                 CL**2
00888 *****************************************************************    CL**2
00889  5005-FIND-NAME.                                                     CL**2
00890      MOVE NAME-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00891      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00892      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00893      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
00894          PERFORM 9000-MAKEUP-MSSG THRU 9000-MAKEUP-MSSG-XIT          CL**2
00895          MOVE GEN-ELEMENT-NAME TO ELE-DATA-NAME                      CL**2
00896          GO TO 5010-ELEMENT-ATTRIBUTES.                              CL**2
00897      IF NAME-DBMS EQUAL TO SPACES                                    CL**2
00898          PERFORM 9000-MAKEUP-MSSG THRU 9000-MAKEUP-MSSG-XIT          CL**2
00899          MOVE GEN-ELEMENT-NAME TO ELE-DATA-NAME                      CL**2
00900      ELSE                                                            CL**2
00901          MOVE NAME-DBMS TO ELE-DATA-NAME.                            CL**2
00902 *****************************************************************    CL**2
00903 *     RETREIVE ATTRIBUTES CATEGORY PLACE IN ATTRIUBUTES WORK AREA*   CL**2
00904 *****************************************************************    CL**2
00905  5010-ELEMENT-ATTRIBUTES.                                            CL**2
00906      MOVE ATTR-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
00907      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00908      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00909      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
00910          MOVE SPACES TO ELEMENT-ATTRIBUTES                           CL**2
00911          GO TO 5015-PROCESS-ALIAS.                                   CL**2
           MOVE MINUS-ASTER TO ELEMENT-ATTRIBUTES.
00913 *****************************************************************    CL**2
00914 *     CHECK FOR ALIAS CATEGORY REFERENCE IN STRUCTURE LINE           CL**2
00915 *     USE ALIAS CATEGORY ATTRIBUTES IF SO                            CL**2
00916 ******************************************************************   CL**2
00917  5015-PROCESS-ALIAS.                                                 CL**2
00918      IF SAVE-ELE-STC-ALY-NO EQUAL TO SPACES                          CL**2
00919          GO TO 5100-TEST-GROUP-ATTRIBUTES.                           CL**2
00920      MOVE ALIAS-CAT-NO TO DATA-ENTRY-CAT.                            CL**2
00921      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00922  5025-CHECK-CODE.                                                    CL**2
00923      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
00924      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
00925          GO TO 5100-TEST-GROUP-ATTRIBUTES.                           CL**2
00926      IF CAT-LINE EQUAL SAVE-ELE-STC-ALY-NO                           CL**2
00927          GO TO 5050-FOUND-ALIAS.                                     CL**2
00928      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00929      GO TO 5025-CHECK-CODE.                                          CL**2
00930 *                                                                    CL**2
00931 *    FOUND STRUCTURE OF ALIAS MUST USE IT                            CL**2
00932 *                                                                    CL**2
00933  5050-FOUND-ALIAS.                                                   CL**2
00934      IF ALY-DBMS NOT EQUAL TO SPACES                                 CL**2
00935          MOVE ALY-DBMS TO ELE-DATA-NAME                              CL**2
00936      ELSE                                                            CL**2
00937          MOVE DATA-ENTRY-NAME TO ELE-DATA-NAME.                      CL**2
00938      IF ELE-DATA-NAME EQUAL TO SPACES                                CL**2
00939          MOVE DATA-ENTRY-NAME TO ELE-DATA-NAME.                      CL**2
00940      IF ALY-LENGTH NOT EQUAL TO SPACES                               CL**2
00941          MOVE ALY-LENGTH TO ELE-LENGTH.                              CL**2
00942      IF ALY-FORMAT NOT EQUAL TO SPACES                               CL**2
00943          MOVE ALY-FORMAT TO ELE-FORMAT.                              CL**2
00944 *****************************************************************    CL**2
      *     GROUP LENGTH IS NO LONGER USED TO OVERRIDE
      *     ELEMENT LENGTH IN CALCULATIONS
00947 *****************************************************************    CL**2
00948  5100-TEST-GROUP-ATTRIBUTES.                                         CL**2
00951      IF SAVE-GRP-ATTR-FORMAT NOT EQUAL TO SPACES                     CL**2
00952          MOVE SAVE-GRP-ATTR-FORMAT TO ELE-FORMAT.                    CL**2
00953      IF ELE-LENGTHC EQUAL TO SPACES                                  CL**2
00954          MOVE 1 TO ELE-LENGTH                                        CL**2
00955          PERFORM 9050-PIC-DEFAULT THRU 9050-PIC-DEFAULT-XIT.         CL**2
00956 ******************************************************************   CL**2
00957 *                                                                    CL**2
00958 *    GENERATE PREFERED DBMS NAME TO OUTPUT LINE                      CL**2
00959 *                                                                    CL**2
00960 *****************************************************************    CL**2
00961      MOVE ELE-DATA-NAME TO WS-DATA-NAME.                             CL**2
00962      MOVE SPACES TO COMM-CONTINUE, COMM-CONTINUE2.                   CL**2
00963      MOVE WS-DATA-NAME TO REC-SUBNAME.                               CL**2
00964 ******************************************************************   CL**2
00965 *     IF FORMAT OR LENGTH MISSING SET TO DEFAULT                     CL**2
00966 ******************************************************************   CL**2
00967  5150-TEST-LENGTH.                                                   CL**2
00968      MOVE ELE-LENGTH TO SCAN-AREA.                                   CL**2
00969      MOVE ZERO TO SUB-B, SUB-A.                                      CL**2
00970      PERFORM MOVE-VALID-LENGTH THRU MOVE-VALID-LENGTH-XIT.           CL**2
00971      MOVE SCAN-AREA TO ELE-LENGTH.                                   CL**2
00972 *                                                                    CL**2
00973 *    SET PRINT LINE WITH ELEMENT NAME AND ELEMENT LENGTH ON IT       CL**2
00974 *                                                                    CL**2
00975      IF COMP-SWITCH EQUAL TO "Y"                                     CL**2
00976          ADD 1 TO GROUP-SUB.                                         CL**2
00977      IF GROUP-SUB EQUAL TO ZERO                                      CL**2
00978          MOVE "=" TO EQUAL-SIGN                                      CL**2
00979          MOVE ELE-LENGTH TO SUBLENGTH                                CL**2
00980          MOVE COMM-CONTINUE TO HOLD-CARD-IMAGE                       CL**2
00981          PERFORM BAL-OUT THRU BAL-OUT-XIT                            CL**2
00982          GO TO 5600-RETURN.                                          CL**2
00983      IF GROUP-SUB GREATER THAN 9                                     CL**2
00984          MOVE GROUP-SUB TO LEVEL-REC2                                CL**2
00985          MOVE "=" TO EQUAL-SIGN2                                     CL**2
00986          MOVE ELE-LENGTH TO SUBLENGTH2                               CL**2
00987          MOVE REC-SUBNAME TO REC-SUBNAME2                            CL**2
00988          MOVE COMMENT18 TO HOLD-CARD-IMAGE                           CL**2
00989          PERFORM BAL-OUT THRU BAL-OUT-XIT                            CL**2
00990          GO TO 5600-RETURN.                                          CL**2
00991      MOVE GROUP-SUB TO LEVEL-REC.                                    CL**2
00992      MOVE "=" TO EQUAL-SIGN.                                         CL**2
00993      MOVE ELE-LENGTH TO SUBLENGTH.                                   CL**2
00994      MOVE COMMENT17 TO HOLD-CARD-IMAGE.                              CL**2
00995      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
00996 *                                                                    CL**2
00997 *    PROCESSING OF ELEMENT ENDS--CHECK IN GROUP SWITCH               CL**2
00998 *                                                                    CL**2
00999  5600-RETURN.                                                        CL**2
01000      IF COMP-SWITCH EQUAL TO "Y"                                     CL**2
01001          SUBTRACT 1 FROM GROUP-SUB.                                  CL**2
01002      IF IN-GROUP-SW EQUAL "Y"                                        CL**2
01003          GO TO 5700-RETURN-CONTROL.                                  CL**2
01004      GO TO 3400-FIND-SAVE-AREA.                                      CL**2
01005 *****************************************************************    CL**2
01006 *     AFTER ELEMENT GENERATED - CONTROL RETURNS HERE                 CL**2
01007 *****************************************************************    CL**2
01008  5700-RETURN-CONTROL.                                                CL**2
01009      MOVE "N" TO IN-GROUP-SW.                                        CL**2
01010 *****************************************************************    CL**2
01011 *     RETURN FOR NEXT STRUCTURE LINE OF GROUP                        CL**2
01012 *****************************************************************    CL**2
01013  5800-RETURN-FOR-STRUCTURE.                                          CL**2
01014      MOVE GROUP-ENTRY-NAME (GROUP-SUB) TO DATA-ENTRY-NAME.           CL**2
01015      MOVE DATA-ENTRY-NAME TO GEN-GROUP-NAME.                         CL**2
01016      MOVE GROUP-STC-LINE (GROUP-SUB) TO DATA-ENTRY-LINE.             CL**2
01017      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
01018      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
01019      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
01020      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
01021          GO TO 5900-TEST-MORE-STRUCTURE.                             CL**2
01022 *****************************************************************    CL**2
01023 *     HAVE RETRIEVED ANOTHER STRUCTURE LINE                          CL**2
01024 *     DETERMINE IF COMPONENT                                         CL**2
01025 ****************************************************************     CL**2
01026  5825-FOUND-MORE-STRUCTURE.                                          CL**2
01027      PERFORM CHECK-COMMENT THRU CHECK-COMMENT-XIT.                   CL**2
01028      IF DATA-RETURN-CODE NOT EQUAL 0                                 CL**2
01029          GO TO 5900-TEST-MORE-STRUCTURE.                             CL**2
01030      IF STC-LINE-TYPE EQUAL TO SPACE OR STD-LINE-TYPE                CL**2
01031          NEXT SENTENCE                                               CL**2
01032      ELSE                                                            CL**2
01033          GO TO 5850-READ-AGAIN.                                      CL**2
           IF STC-GRP-CNAME EQUAL SPACES
               PERFORM 9105-BLANK-MSSG THRU 9105-BLANK-MSSG-XIT 
               GO TO 5850-READ-AGAIN. 
01034      IF STC-DBD-INC NOT EQUAL "N"                                    CL**2
01035          GO TO 5875-LOOK-FOR-FILLER.                                 CL**2
01036  5850-READ-AGAIN.                                                    CL**2
01037      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
01038      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
01039          GO TO 5900-TEST-MORE-STRUCTURE.                             CL**2
01040      GO TO 5825-FOUND-MORE-STRUCTURE.                                CL**2
01041  5875-LOOK-FOR-FILLER.                                               CL**2
01042      IF STC-GRP-CNAME NOT EQUAL TO FILLERKW                          CL**2
01043          GO TO 5890-SAVE-LINE.                                       CL**2
01044      PERFORM 9100-FILLER-MSSG THRU 9100-FILLER-MSSG-XIT.             CL**2
01045      GO TO 5850-READ-AGAIN.                                          CL**2
01046 *****************************************************************    CL**2
01047 *     HAVE NEXT COMPONENT OF GROUP                                   CL**2
01048 *     UPDATE LINE NUMBER IN GROUP TABLE                              CL**2
01049 *****************************************************************    CL**2
01050  5890-SAVE-LINE.                                                     CL**2
01051      MOVE CAT-LINE TO GROUP-STC-LINE (GROUP-SUB).                    CL**2
01052      GO TO 4775-SAVE-STRUCTURE.                                      CL**2
01053 *****************************************************************    CL**2
01054 *     NO MORE COMPONENTS FOR GROUP                                   CL**2
01055 *     RETURN TO PREVIOUS GROUP - IF ANY                              CL**2
01056 *****************************************************************    CL**2
01057  5900-TEST-MORE-STRUCTURE.                                           CL**2
01058      IF GROUP-SUB EQUAL TO 0                                         CL**2
01059          GO TO 3400-FIND-SAVE-AREA.                                  CL**2
01060      SUBTRACT 1 FROM GROUP-SUB.                                      CL**2
01061      IF GROUP-SUB NOT EQUAL TO 0                                     CL**2
01062          GO TO 5800-RETURN-FOR-STRUCTURE.                            CL**2
01063      GO TO 3400-FIND-SAVE-AREA.                                      CL**2
01064                                                                    DCTOT31
01065 ******************************************************************   CL**2
01066 *                                                                    CL**2
01067 *    PROCESS ENVIRONMENT OF DATASET PRINTING ITS CHARACTERISTICS     CL**2
01068 *                                                                    CL**2
01069 ******************************************************************   CL**2
01070  6000-END-DATA.                                                      CL**2
           MOVE "END-DATA" TO HOLD-CARD-IMAGE.
01072      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01073 *                                                                    CL**2
01074 *    TEST TO MAKE SURE ENVIRONMENT CATEGORY EXISTS                   CL**2
01075 *                                                                    CL**2
01076      IF SET-SAVE-ENVIRONMENT EQUAL TO SPACES                         CL**2
01077          PERFORM 9045-ENVIRON-MSSG THRU 9045-ENVIRON-MSSG-XIT        CL**2
01078          GO TO 2700-PROCESS-DATABASE.                                CL**2
01079 *                                                                    CL**2
01080 *    MOVE DEVICE FIELD TO PRINT LINE                                 CL**2
01081 *                                                                    CL**2
01082      IF SET-DEVICE NOT EQUAL TO SPACES                               CL**2
01083          MOVE SET-DEVICE TO DEVICE-TYPE                              CL**2
01084          MOVE COMMENT7 TO HOLD-CARD-IMAGE                            CL**2
01085          PERFORM BAL-OUT THRU BAL-OUT-XIT.                           CL**2
01086 *                                                                    CL**2
01087 *    MOVE TOTAL LOGICAL RECORDS TO PRINT LINE                        CL**2
01088 *                                                                    CL**2
01089      IF SET-TRECS NOT EQUAL TO SPACES                                CL**2
01090          MOVE SET-TRECS TO TOT-RECORDL                               CL**2
01091          MOVE COMMENT9 TO HOLD-COMMENT-IMAGE                         CL**2
01092          PERFORM BAL-OUT THRU BAL-OUT-XIT.                           CL**2
01093 *                                                                    CL**2
01094 *    MOVE TOTAL TRACKS TO PRINT LINE                                 CL**2
01095 *                                                                    CL**2
01096      IF SET-TRACK NOT EQUAL TO SPACES                                CL**2
01097          MOVE SET-TRACK TO TRACK-TOTAL                               CL**2
01098          MOVE COMMENT21 TO HOLD-CARD-IMAGE                           CL**2
01099          PERFORM BAL-OUT THRU BAL-OUT-XIT.                           CL**2
01100 *                                                                    CL**2
01101 *    MOVE LOGICAL RECORD LENGTH TO PRINT LINE                        CL**2
01102 *                                                                    CL**2
01103      IF SET-LENGTH NOT EQUAL TO SPACES                               CL**2
01104          MOVE SET-LENGTH TO LENGTH-RECORD                            CL**2
01105          MOVE COMMENT22 TO HOLD-CARD-IMAGE                           CL**2
01106          PERFORM BAL-OUT THRU BAL-OUT-XIT.                           CL**2
01107 *                                                                    CL**2
01108 *    MOVE BLOCKS PER TRACK TO PRINT LINE                             CL**2
01109 *                                                                    CL**2
01110      IF SET-BLOCK NOT EQUAL TO SPACES                                CL**2
01111          MOVE SET-BLOCK TO TRACK-BLOCKS                              CL**2
01112          MOVE COMMENT23 TO HOLD-CARD-IMAGE                           CL**2
01113          PERFORM BAL-OUT THRU BAL-OUT-XIT.                           CL**2
01114 *                                                                    CL**2
01115 *    MOVE DISK EXTENTS TO PRINT LINE                                 CL**2
01116 *                                                                    CL**2
01117      IF SET-DISK NOT EQUAL TO SPACES                                 CL**2
01118          MOVE SET-DISK TO EXTENT-DISK                                CL**2
01119          MOVE COMMENT24 TO HOLD-CARD-IMAGE                           CL**2
01120          PERFORM BAL-OUT THRU BAL-OUT-XIT.                           CL**2
01121 *                                                                    CL**2
01122 *    MOVE CYLINDER LOAD LIMIT TO PRINT LINE                          CL**2
01123 *                                                                    CL**2
01124      IF TYPE-SW NOT EQUAL TO "V"                                     CL**2
01125          GO TO 6050-OLD-FILE.                                        CL**2
01126      IF SET-LOAD NOT EQUAL TO SPACES                                 CL**2
01127          MOVE SET-LOAD TO LOAD-SET-ENV                               CL**2
01128          MOVE COMMENT26 TO HOLD-CARD-IMAGE                           CL**2
01129          PERFORM BAL-OUT THRU BAL-OUT-XIT.                           CL**2
01130 *                                                                    CL**2
01131 *    MOVE OLD FILE IF IT EXISTS TO PRINT LINE                        CL**2
01132 *                                                                    CL**2
01133  6050-OLD-FILE.                                                      CL**2
01134      IF SET-FILE NOT EQUAL TO "Y"                                    CL**2
01135          GO TO 6100-END-MESSAGE.                                     CL**2
01136      MOVE "OLD-FILE=YES" TO HOLD-CARD-IMAGE.                         CL**2
01137      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01138 *                                                                    CL**2
01139 *    PRINT LAST MESSAGE FOR DATASET PART OF GENERATION               CL**2
01140 *                                                                    CL**2
01141  6100-END-MESSAGE.                                                   CL**2
01142      IF TYPE-SW EQUAL TO "V"                                         CL**2
01143          MOVE COMMENT27 TO HOLD-CARD-IMAGE                           CL**2
01144          PERFORM BAL-OUT THRU BAL-OUT-XIT                            CL**2
01145          GO TO 2700-PROCESS-DATABASE.                                CL**2
            MOVE "END-MASTER-DATA-SET " TO HOLD-CARD-IMAGE. 
01147      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01148 *                                                                    CL**2
01149 *    GET NEXT STRUCTURE LINE (DATASET) FROM DATABASE ENTRY           CL**2
01150 *                                                                    CL**2
01151      GO TO 2700-PROCESS-DATABASE.                                    CL**2
01152 ******************************************************************   CL**2
01153 *     CLOSE FILES AND GO BACK                                        CL**2
01154 ******************************************************************   CL**2
01155  6500-BAL-END.                                                       CL**2
           MOVE "END-DATA-BASE-GENERATION " TO HOLD-CARD-IMAGE. 
01157      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01158      MOVE "9" TO GTBL-MOD-REQ.                                       CL**2
           EXIT PROGRAM.
01160                                                                    DCTOT31
01161 ******************************************************************   CL**2
01162 *                                                                    CL**2
01163 *    LOOK AT STRUCTURE MAKEUP TO CALCULATE LENGTH                    CL**2
01164 ******************************************************************   CL**2
01165  7000-CALCULATE-LENGTH.                                              CL**2
01166      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
01167      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
01168  7025-COMMENT.                                                       CL**2
01169      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
01170      IF DATA-RETURN-CODE NOT EQUAL TO 0                              CL**2
01171          PERFORM 9015-LENGTH-MSSG THRU 9015-LENGTH-MSSG-XIT          CL**2
01172          MOVE 0 TO SAVE-LENGTH                                       CL**2
01173          GO TO 7900-CALCULATE-LENGTH-XIT.                            CL**2
           IF (STC-LINE-TYPE = SPACES 
             OR STC-LINE-TYPE = STD-LINE-TYPE)
             AND (STC-GRP-CNAME NOT = FILLERKW) 
01175          NEXT SENTENCE                                               CL**2
01176      ELSE                                                            CL**2
01177          GO TO 7050-READ-AGAIN.                                      CL**2
           IF STC-GRP-CNAME EQUAL SPACES
               GO TO 7050-READ-AGAIN. 
01178      IF STC-DBD-INC NOT EQUAL TO "N"                                 CL**2
               GO TO 7077-MOVE-ATTRIBUTES.
01180  7050-READ-AGAIN.                                                    CL**2
01181      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
01182      GO TO 7025-COMMENT.                                             CL**2
01218 *                                                                    CL**2
01219 *    MOVE GROUP ATTRIBUTES TO TABLE                                  CL**2
01220 *                                                                    CL**2
01221  7077-MOVE-ATTRIBUTES.                                               CL**2
01222      ADD 1 TO GROUP-SUB, GROUP-SUBB, GROUP-SUBC.                     CL**2
01223      IF GROUP-SUB GREATER THAN 15                                    CL**2
01224          PERFORM 9015-LENGTH-MSSG THRU 9015-LENGTH-MSSG-XIT          CL**2
01225          PERFORM 9060-GROUP-LIMIT THRU 9060-GROUP-LIMIT-XIT          CL**2
01226          MOVE GROUP-ENTRY-NAME (1) TO DATA-ENTRY-NAME                CL**2
01227          PERFORM 9025-INFORM-ERROR THRU 9025-INFORM-ERROR-XIT        CL**2
01228          MOVE 0 TO SAVE-LENGTH                                       CL**2
01229          GO TO 7900-CALCULATE-LENGTH-XIT.                            CL**2
01230      MOVE DATA-ENTRY-NAME TO GROUP-ENTRY-NAME (GROUP-SUB).           CL**2
01231      MOVE CAT-LINE TO GROUP-STC-LINE (GROUP-SUB).                    CL**2
01232      MOVE SAVE-GRP-ATTR-LENGTH TO GROUP-LENGTH (GROUP-SUB).          CL**2
01233      MOVE SAVE-GRP-ATTR-FORMAT TO GROUP-FORMAT (GROUP-SUB).          CL**2
01234      MOVE SAVE-GRP-ATTR-REDEFINES TO GROUP-REDEFINES (GROUP-SUB).    CL**2
01235      MOVE SAVE-GRP-ATTR-OCCUR TO GROUP-OCCUR (GROUP-SUB).            CL**2
01236      IF GROUP-OCCUR (GROUP-SUB) NOT GREATER THAN 0                   CL**2
01237          MOVE 1 TO GROUP-OCCUR (GROUP-SUB).                          CL**2
01238 *                                                                    CL**2
01239 *    SAVE STRUCTURE LINE LOCATION                                    CL**2
01240 *                                                                    CL**2
01241  7080-SAVE-STRUCTURE.                                                CL**2
01242      MOVE CAT-LINE TO GROUP-STC-LINE (GROUP-SUB).                    CL**2
           MOVE SPACES TO SAVE-ELE-STC-CAT. 
           MOVE MINUS-ASTER TO SAVE-ELE-STC-A.
  
      * LOOK FOR OCCURS STRUCTURE LINE BELONGING TO STANDARD 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 (GROUP-SUB)
             MOVE MINUS-ASTER TO SAVE-ELE-STC-O 
           END-IF 
01244 *                                                                    CL**2
01245 *    RETRIEVE ENTRY FROM STRUCTURE LINE AND VALIDATE EXISTENCE       CL**2
01246 *                                                                    CL**2
01247  7087-RETRIEVE-ENTRY.                                                CL**2
           MOVE SAVE-ELE-STC-CNAME TO DATA-ENTRY-NAME.
01249      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
01250      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
01251          PERFORM 9015-LENGTH-MSSG THRU 9015-LENGTH-MSSG-XIT          CL**2
01252          MOVE 0 TO SAVE-LENGTH                                       CL**2
01253          GO TO 7900-CALCULATE-LENGTH-XIT.                            CL**2
01254 *                                                                    CL**2
01255 *    TEST IF STRUCTURE FOUND IS A GROUP OR AN ELEMENT                CL**2
01256 *                                                                    CL**2
01257      IF DATA-HDR-ENT-ID EQUAL TO "09" OR "10"                        CL**2
01258          NEXT SENTENCE                                               CL**2
01259      ELSE                                                            CL**2
01260          GO TO 7090-TEST-ELEMENTS.                                   CL**2
           MOVE SAVE-ELE-STC-CAT TO SAVE-GRP-STC-CAT. 
           MOVE SPACES TO SAVE-ELE-STC-CAT. 
01262      MOVE SPACES TO SAVE-GRP-ATTR-CAT.                               CL**2
01263      MOVE ATTR-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
01264      MOVE SAVE-GRP-STC-CNAME TO DATA-ENTRY-NAME.                     CL**2
01265      MOVE DATA-ENTRY-NAME TO GEN-GROUP-NAME.                         CL**2
01266      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
01267  7087-ATTRIBUTE-LOOP.                                                CL**2
01268      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
01269          GO TO 7089-CHECK-SAVE.                                      CL**2
01270      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
01271          PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT              CL**2
01272          GO TO 7087-ATTRIBUTE-LOOP.                                  CL**2
           MOVE MINUS-ASTER TO SAVE-GRP-ATTR-CAT. 
01274  7089-CHECK-SAVE.                                                    CL**2
01275      IF SAVE-GRP-STC-OCC-TO EQUAL TO SPACES OR ZERO                  CL**2
01276          MOVE 1 TO OCCUR-SAVE, SAVE-GRP-ATTR-OCCUR                   CL**2
01277      ELSE                                                            CL**2
01278          MOVE SAVE-GRP-STC-OCC-TO TO SAVE-GRP-ATTR-OCCURB            CL**2
01279          OCCUR-SAVEB.                                                CL**2
01280      IF SAVE-GRP-STC-REDEFINES NOT EQUAL TO SPACES                   CL**2
01281          GO TO 7370-READ-STRUCTURE.                                  CL**2
           IF SAVE-GRP-ATTR-LENGTH EQUAL SPACES OR ZERO 
               GO TO 7000-CALCULATE-LENGTH
             ELSE 
               PERFORM 7089-ADD-GRP THRU 7089-ADD-GRP-XIT.
           GO TO 7370-READ-STRUCTURE. 
       7089-ADD-GRP.
      *     WHEN AN IMBEDDED GROUP HAS LENGTH SPECIFIED 
      *     IT IS USED IN CALCULATING THE INITIAL 
      *     GROUP'S LENGTH. 
           MOVE SAVE-GRP-ATTR-LENGTH TO ELE-LENGTHC.
           IF ELE-LENGTHC EQUAL TO SPACES OR ZERO 
               MOVE 1 TO ELE-LENGTHB. 
           MOVE ELE-LENGTHB TO CALC-NUM.
           MULTIPLY OCCUR-SAVE BY CALC-NUM
               GIVING TOTAL-LENGTH. 
       7089-ADD-GRP-LOOP. 
           IF GROUP-SUBB NOT GREATER THAN 0 
               MOVE GROUP-SUB TO GROUP-SUBB 
               GO TO 7089-ADD-GRP-LENGTH. 
           MULTIPLY TOTAL-LENGTH BY GROUP-OCCUR (GROUP-SUBB)
               GIVING TOTAL-LENGTH. 
           SUBTRACT 1 FROM GROUP-SUBB.
           GO TO 7089-ADD-GRP-LOOP. 
       7089-ADD-GRP-LENGTH. 
           ADD TOTAL-LENGTH TO SAVE-LENGTH. 
           MOVE ZERO TO TOTAL-LENGTH ELE-LENGTHC. 
       7089-ADD-GRP-XIT.
           EXIT.
01283                                                                    DCTOT31
01284 *                                                                    CL**2
01285 *    STRUTURE LINE FOUND IS AN ELEMENT---CALCULATE ITS LENGTH        CL**2
01286 *                                                                    CL**2
01287  7090-TEST-ELEMENTS.                                                 CL**2
01288      IF DATA-HDR-ENT-ID NOT EQUAL TO "05"                            CL**2
01289          PERFORM 9015-LENGTH-MSSG THRU 9015-LENGTH-MSSG-XIT          CL**2
01290          MOVE 0 TO SAVE-LENGTH                                       CL**2
01291          GO TO 7900-CALCULATE-LENGTH-XIT.                            CL**2
01293      MOVE GROUP-LENGTH (GROUP-SUB) TO SAVE-GRP-ATTR-LENGTH.          CL**2
01294      MOVE GROUP-FORMAT (GROUP-SUB) TO SAVE-GRP-ATTR-FORMAT.          CL**2
01295      MOVE GROUP-REDEFINES (GROUP-SUB) TO SAVE-GRP-ATTR-REDEFINES.    CL**2
01296      MOVE GROUP-OCCUR (GROUP-SUB) TO SAVE-GRP-ATTR-OCCUR.            CL**2
01297      IF SAVE-ELE-STC-REDEFINES NOT EQUAL TO SPACES                   CL**2
01298          GO TO 7370-READ-STRUCTURE.                                  CL**2
01299 *                                                                    CL**2
01300 *    STRUCTURE LINE IS AN ELEMENT  MUST FIND ITS LENGTH              CL**2
01301 *                                                                    CL**2
01302      MOVE SAVE-ELE-STC-CNAME TO GEN-ELEMENT-NAME.                    CL**2
01303  7100-ELEMENT-ATTRIBUTES.                                            CL**2
01304      MOVE ATTR-CAT-NO TO DATA-ENTRY-CAT.                             CL**2
01305      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
01306  7170-ATTRIBUTE-COMMENT.                                             CL**2
01307      PERFORM TEST-RETURN-CODE THRU TEST-RETURN-CODE-XIT.             CL**2
01308      IF DATA-RETURN-CODE EQUAL TO 0                                  CL**2
               MOVE MINUS-ASTER TO ELEMENT-ATTRIBUTES 
01310          GO TO 7177-CHECK-ALIAS.                                     CL**2
           MOVE SPACES TO ELEMENT-ATTRIBUTES. 
01313 *                                                                    CL**2
01314 *    CHECK FOR ALIAS CATEGORY REFERENCE                              CL**2
01315 *                                                                    CL**2
01316  7177-CHECK-ALIAS.                                                   CL**2
01317      IF SAVE-ELE-STC-ALY-NO EQUAL TO SPACES                          CL**2
01318          GO TO 7200-OVERRIDE-GROUPS.                                 CL**2
01319      MOVE ALIAS-CAT-NO TO DATA-ENTRY-CAT.                            CL**2
01320      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
01321  7180-ALIAS-EXIST.                                                   CL**2
01322      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
01323          GO TO 7200-OVERRIDE-GROUPS.                                 CL**2
01324      IF CAT-LINE EQUAL TO SAVE-ELE-STC-ALY-NO                        CL**2
01325          GO TO 7187-FOUND-ALIAS.                                     CL**2
01326      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
01327      GO TO 7180-ALIAS-EXIST.                                         CL**2
01328  7187-FOUND-ALIAS.                                                   CL**2
01329      IF ALY-LENGTH NOT EQUAL TO SPACES                               CL**2
01330          MOVE ALY-LENGTH TO ELE-LENGTH.                              CL**2
01331 *                                                                    CL**2
      *     IF ELEMENT ATTRIBUTES EXIST USE THEM IN CALCULATIONS
01333 *                                                                    CL**2
01334  7200-OVERRIDE-GROUPS.                                               CL**2
01337      IF ELE-LENGTHC EQUAL TO SPACES OR ZERO                          CL**2
01338          MOVE 1 TO ELE-LENGTHB.                                      CL**2
01339 *                                                                    CL**2
01340 *    TEST ELEMENT ATTRIBUTES FOR AN OCCURS CLAUSE                    CL**2
01341 *                                                                    CL**2
01342      IF SAVE-ELE-STC-OCC-TO EQUAL TO SPACES OR ZERO                  CL**2
01343          MOVE "001" TO SAVE-ELE-STC-OCC-TO.                          CL**2
01344      MOVE SAVE-ELE-STC-OCC-TO TO OCCUR-COUNTB.                       CL**2
01345      MOVE ELE-LENGTHB TO CALC-NUM.                                   CL**2
01346      MULTIPLY OCCUR-COUNT BY CALC-NUM                                CL**2
01347          GIVING TOTAL-LENGTH.                                        CL**2
01348  7270-LENGTH-LOOP.                                                   CL**2
01349      IF GROUP-SUBB NOT GREATER THAN 0                                CL**2
01350          MOVE GROUP-SUB TO GROUP-SUBB                                CL**2
01351          GO TO 7300-ADD-LENGTH.                                      CL**2
01352      MULTIPLY TOTAL-LENGTH BY GROUP-OCCUR (GROUP-SUBB)               CL**2
01353          GIVING TOTAL-LENGTH.                                        CL**2
01354      SUBTRACT 1 FROM GROUP-SUBB.                                     CL**2
01355      GO TO 7270-LENGTH-LOOP.                                         CL**2
01356                                                                    DCTOT31
01357 *                                                                    CL**2
01358 *    FOUND ELEMENT LENGTH ADD TO THE STORED LENGTH                   CL**2
01359 *                                                                    CL**2
01360  7300-ADD-LENGTH.                                                    CL**2
01361      ADD TOTAL-LENGTH TO SAVE-LENGTH.                                CL**2
01362      MOVE ZERO TO TOTAL-LENGTH.                                      CL**2
01363  7370-READ-STRUCTURE.                                                CL**2
01364      MOVE GROUP-ENTRY-NAME (GROUP-SUB) TO DATA-ENTRY-NAME.           CL**2
01365      MOVE GROUP-ENTRY-NAME (GROUP-SUB) TO GEN-GROUP-NAME.            CL**2
01366      MOVE GROUP-STC-LINE (GROUP-SUB) TO DATA-ENTRY-LINE.             CL**2
01367      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
01368      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
01369  7400-READ-NEXT.                                                     CL**2
01370      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
01371      IF DATA-RETURN-CODE NOT EQUAL TO ZERO                           CL**2
01372          GO TO 7600-CHECK-MORE-STRUCTURE.                            CL**2
01390  7700-CHECK-COMMENT.                                                 CL**2
01391      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
01392          GO TO 7400-READ-NEXT.                                       CL**2
           IF (STC-LINE-TYPE = SPACES 
             OR STC-LINE-TYPE = STD-LINE-TYPE)
             AND (STC-GRP-CNAME NOT = FILLERKW) 
               NEXT SENTENCE
             ELSE 
               GO TO 7400-READ-NEXT.
           IF STC-GRP-CNAME EQUAL SPACES
               GO TO 7400-READ-NEXT.
           GO TO 7080-SAVE-STRUCTURE. 
01396 *                                                                    CL**2
01397 *    PROCESSING OF STRUCTURE--CHECK IF MORE LINE EXIST               CL**2
      *     ON PREVIOUS GROUP.
      *     THE FIELD - GROUP-SUBD CONTAINS THE GROUP 
      *     LEVEL (GROUP-SUB) AT WHICH 700-CALCULATE-LENGTH 
      *     WAS FIRST ENTERED.
01398 *                                                                    CL**2
01399  7600-CHECK-MORE-STRUCTURE.                                          CL**2
           IF GROUP-SUB EQUAL GROUP-SUBD
01401          GO TO 7900-CALCULATE-LENGTH-XIT.                            CL**2
01402      SUBTRACT 1 FROM GROUP-SUB.                                      CL**2
01403      SUBTRACT 1 FROM GROUP-SUBB.                                     CL**2
           IF GROUP-SUB NOT EQUAL TO GROUP-SUBD 
01405          GO TO 7670-RETURN-FOR-STRUCTURE.                            CL**2
01406      GO TO 7900-CALCULATE-LENGTH-XIT.                                CL**2
01407 *                                                                    CL**2
01408 *    CHECK IF MORE STRUCTURE EXISTS                                  CL**2
01409 *                                                                    CL**2
01410  7670-RETURN-FOR-STRUCTURE.                                          CL**2
01411      MOVE GROUP-ENTRY-NAME (GROUP-SUB) TO DATA-ENTRY-NAME.           CL**2
01412      MOVE GROUP-ENTRY-NAME (GROUP-SUB) TO GEN-GROUP-NAME.            CL**2
01413      MOVE GROUP-STC-LINE (GROUP-SUB) TO DATA-ENTRY-LINE.             CL**2
01414      MOVE STC-CAT-NO TO DATA-ENTRY-CAT.                              CL**2
01415      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
01416      GO TO 7400-READ-NEXT.                                           CL**2
01417 *                                                                    CL**2
01418 *    END OF CALCULATION---GO BACK AND GET GROUP STRUCTURE            CL**2
01419 *                                                                    CL**2
01420  7900-CALCULATE-LENGTH-XIT.                                          CL**2
01421      EXIT.                                                           CL**2
01422                                                                    DCTOT31
01423 ***************************************************************      CL**2
01424 *     ERROR MESSAGES                                                 CL**2
01425 ******************************************************************   CL**2
01426  9000-MAKEUP-MSSG.                                                   CL**2
01427      MOVE "Y" TO MSG-SW.                                             CL**2
01428      MOVE " 655-I" TO ERROR-MSSG-NUM.                                CL**2
01429      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01430      MOVE NAME-MASK TO DEFAULT-MSSG.                                 CL**2
01431      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01432  9000-MAKEUP-MSSG-XIT.                                               CL**2
01433      EXIT.                                                           CL**2
01434  9005-KEY-MSSG.                                                      CL**2
01435      MOVE "Y" TO MSG-SW.                                             CL**2
01436      MOVE " 620-F" TO ERROR-MSSG-TYPE.                               CL**2
01437      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01438      MOVE DATA-ENTRY-NAME TO ERROR-CAT-NAME.                         CL**2
01439      MOVE KEY-CODE-MSSG TO MSSG-TYPE.                                CL**2
01440      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01441  9005-KEY-MSSG-XIT.                                                  CL**2
01442      EXIT.                                                           CL**2
01443  9010-NO-STC-MSSG.                                                   CL**2
01444      MOVE "Y" TO MSG-SW.                                             CL**2
01445      MOVE " 600-S" TO ERROR-MSSG-NUM.                                CL**2
01446      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01447      MOVE DATA-ENTRY-NAME TO ERROR-CAT-NAME.                         CL**2
01448      MOVE NO-STC-MSSG TO MSSG-TYPE.                                  CL**2
01449      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01450  9010-NO-STC-MSSG-XIT.                                               CL**2
01451      EXIT.                                                           CL**2
01452  9015-LENGTH-MSSG.                                                   CL**2
01453      MOVE "Y" TO MSG-SW.                                             CL**2
01454      MOVE " 545-S" TO ERROR-MSSG-NUM.                                CL**2
01455      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01456      MOVE NO-LENGTH-MSSG TO DEFAULT-MSSG.                            CL**2
01457      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01458  9015-LENGTH-MSSG-XIT.                                               CL**2
01459      EXIT.                                                           CL**2
01460  9020-BAD-ENTITY.                                                    CL**2
01461      MOVE "Y" TO MSG-SW.                                             CL**2
01462      MOVE " 525-S" TO ERROR-MSSG-NUM.                                CL**2
01463      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01464      MOVE DATA-ENTRY-NAME TO ERROR-CAT-NAME.                         CL**2
01465      MOVE BAD-ENTITY-MSSG TO MSSG-TYPE.                              CL**2
01466      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01467  9020-BAD-ENTITY-XIT.                                                CL**2
01468      EXIT.                                                           CL**2
01469  9025-INFORM-ERROR.                                                  CL**2
01470      MOVE "Y" TO MSG-SW.                                             CL**2
01471      MOVE DATA-ENTRY-NAME TO ERROR-NAMED.                            CL**2
01472      MOVE " 580-I" TO ERROR-MSSG-NUM.                                CL**2
01473      MOVE FORMAT-INFORM TO INFORM-MSSG.                              CL**2
01474      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01475  9025-INFORM-ERROR-XIT.                                              CL**2
01476      EXIT.                                                           CL**2
01477  9030-NO-DATA-MSSG.                                                  CL**2
01478      MOVE "Y" TO MSG-SW.                                             CL**2
01479      MOVE " 500-S" TO ERROR-MSSG-NUM.                                CL**2
01480      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01481      MOVE DATA-ENTRY-NAME TO ERROR-CAT-NAME.                         CL**2
01482      MOVE NO-DATA-MSSG TO MSSG-TYPE.                                 CL**2
01483      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01484  9030-NO-DATA-MSSG-XIT.                                              CL**2
01485      EXIT.                                                           CL**2
01486  9035-LINKAGE-MSSG.                                                  CL**2
01487      MOVE "Y" TO MSG-SW.                                             CL**2
01488      MOVE " 665-F" TO ERROR-MSSG-TYPE.                               CL**2
01489      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01490      MOVE LINKAGE-MSSG TO DEFAULT-MSSG.                              CL**2
01491      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01492  9035-LINKAGE-MSSG-XIT.                                              CL**2
01493      EXIT.                                                           CL**2
01494  9040-BAD-DATA-MSSG.                                                 CL**2
01495      MOVE "Y" TO MSG-SW.                                             CL**2
01496      MOVE " 530-S" TO ERROR-MSSG-NUM.                                CL**2
01497      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01498      MOVE DATA-ENTRY-NAME TO ERROR-CAT-NAME.                         CL**2
01499      MOVE BAD-DATA-MSSG TO MSSG-TYPE.                                CL**2
01500      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01501  9040-BAD-DATA-MSSG-XIT.                                             CL**2
01502      EXIT.                                                           CL**2
01503  9045-ENVIRON-MSSG.                                                  CL**2
01504      MOVE "Y" TO MSG-SW.                                             CL**2
           MOVE "660-I" TO ERROR-MSSG-NUM.
01506      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01507      MOVE ENVIRON-MSSG TO DEFAULT-MSSG.                              CL**2
01508      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01509  9045-ENVIRON-MSSG-XIT.                                              CL**2
01510      EXIT.                                                           CL**2
01511  9050-PIC-DEFAULT.                                                   CL**2
01512      MOVE "Y" TO MSG-SW.                                             CL**2
01513      MOVE " 540-I" TO ERROR-MSSG-NUM.                                CL**2
01514      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01515      MOVE PICTURE-DEFAULT-MSSG TO DEFAULT-MSSG.                      CL**2
01516      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01517  9050-PIC-DEFAULT-XIT.                                               CL**2
01518      EXIT.                                                           CL**2
01519  9055-MISS-MSSG.                                                     CL**2
01520      MOVE "Y" TO MSG-SW.                                             CL**2
01521      MOVE " 605-F" TO ERROR-MSSG-NUM.                                CL**2
01522      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01523      MOVE MISS-MSSG TO DEFAULT-MSSG.                                 CL**2
01524      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01525  9055-MISS-MSSG-XIT.                                                 CL**2
01526      EXIT.                                                           CL**2
01527  9060-GROUP-LIMIT.                                                   CL**2
01528      MOVE "Y" TO MSG-SW.                                             CL**2
01529      MOVE " 550-S" TO ERROR-MSSG-NUM.                                CL**2
01530      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01531      MOVE GROUP-LIMIT-MSSG TO DEFAULT-MSSG.                          CL**2
01532      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01533  9060-GROUP-LIMIT-XIT.                                               CL**2
01534      EXIT.                                                           CL**2
01535  9065-INITIAL-FORMAT.                                                CL**2
01536      MOVE "Y" TO MSG-SW.                                             CL**2
01537      MOVE " 595-S" TO ERROR-MSSG-NUM.                                CL**2
01538      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01539      MOVE INITIAL-DEFAULT-MSSG TO DEFAULT-MSSG.                      CL**2
01540      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01541  9065-INITIAL-FORMAT-XIT.                                            CL**2
01542      EXIT.                                                           CL**2
01543  9050-LENGTH-MSSG-ERR.                                               CL**2
01544      MOVE "Y" TO MSG-SW.                                             CL**2
01545      MOVE " 590-S" TO ERROR-MSSG-NUM.                                CL**2
01546      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01547      MOVE LENGTH-MSSG2 TO DEFAULT-MSSG.                              CL**2
01548      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01549  9050-LENGTH-MSSG-ERR-XIT.                                           CL**2
01550      EXIT.                                                           CL**2
01551  9055-IOAREA-FORMED.                                                 CL**2
01552      MOVE "Y" TO MSG-SW.                                             CL**2
01553      MOVE " 635-I" TO ERROR-MSSG-NUM.                                CL**2
01554      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01555      MOVE PRIVATE-MSSG TO DEFAULT-MSSG.                              CL**2
01556      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01557  9055-IOAREA-FORMED-XIT.                                             CL**2
01558      EXIT.                                                           CL**2
01559  9080-FORMAT-MSSG.                                                   CL**2
01560      MOVE "Y" TO MSG-SW.                                             CL**2
01561      MOVE " 585-I" TO ERROR-MSSG-NUM.                                CL**2
01562      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01563      MOVE FORMAT-MSSG2 TO DEFAULT-MSSG.                              CL**2
01564      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01565  9080-FORMAT-MSSG-XIT.                                               CL**2
01566      EXIT.                                                           CL**2
01567  9085-DUPLICATE-MSSG.                                                CL**2
01568      MOVE "Y" TO MSG-SW.                                             CL**2
01569      MOVE " 615-F" TO ERROR-MSSG-NUM.                                CL**2
01570      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01571      MOVE COPY-MSSG TO DEFAULT-MSSG.                                 CL**2
01572      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01573  9085-DUPLICATE-MSSG-XIT.                                            CL**2
01574      EXIT.                                                           CL**2
01575  9090-INPUT-MSSG.                                                    CL**2
01576      MOVE "Y" TO MSG-SW.                                             CL**2
01577      MOVE " 625-I" TO ERROR-MSSG-NUM.                                CL**2
01578      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01579      MOVE IO-MESSAGE TO DEFAULT-MSSG.                                CL**2
01580      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01581  9090-INPUT-MSSG-XIT.                                                CL**2
01582      EXIT.                                                           CL**2
01583  9095-PRI-MSSG.                                                      CL**2
01584      MOVE "Y" TO MSG-SW.                                             CL**2
01585      MOVE " 640-F" TO ERROR-MSSG-NUM.                                CL**2
01586      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01587      MOVE PRI-MESSAGE TO DEFAULT-MSSG.                               CL**2
01588      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01589  9095-PRI-MSSG-XIT.                                                  CL**2
01590      EXIT.                                                           CL**2
01591  9100-FILLER-MSSG.                                                   CL**2
01592      MOVE "Y" TO MSG-SW.                                             CL**2
01593      MOVE " 650-I" TO ERROR-MSSG-NUM.                                CL**2
01594      MOVE SPACES TO ERROR-MSSG-TYPE.                                 CL**2
01595      MOVE FILLERKW TO ERROR-CAT-NAME.                                CL**2
01596      MOVE BAD-ENTITY-MSSG TO MSSG-TYPE.                              CL**2
01597      PERFORM BAL-OUT THRU BAL-OUT-XIT.                               CL**2
01598  9100-FILLER-MSSG-XIT.                                               CL**2
01599      EXIT.                                                           CL**2
01600                                                                    DCTOT31
       9105-BLANK-MSSG. 
           MOVE "Y" TO MSG-SW.
           MOVE CAT-LINE TO BLANK-LINE. 
           MOVE DATA-ENTRY-NAME TO BLANK-CAT. 
           MOVE " 700-I" TO ERROR-MSSG-NUM. 
           MOVE BLANK-CATNAME-MSSG TO DEFAULT-MSSG. 
           PERFORM BAL-OUT THRU BAL-OUT-XIT.
       9105-BLANK-MSSG-XIT. 
           EXIT.
  
       9110-BLANK-LKFIELD.
           MOVE "Y" TO MSG-SW.
           MOVE CAT-LINE TO BLANK-LINE-NO.
           MOVE DATA-ENTRY-NAME TO BLANK-CATNAME. 
           MOVE " 670-W" TO ERROR-MSSG-NUM. 
           MOVE SPACES TO ERROR-MSSG-TYPE.
           MOVE BLANK-LKFIELD-MSSG TO DEFAULT-MSSG. 
           PERFORM BAL-OUT THRU BAL-OUT-XIT.
  
       9110-BLANK-LKFIELD-XIT.
           EXIT.
*CALL     BALOUT
*CALL     BALSUB2 
*CALL     MAST1RFC
*CALL     MAST1RNL
*CALL     MAST1RK 
*CALL     MAST1RFL
*CALL     MAST1EXT
*CALL     MAST1RDI
*CALL     MAST1ALG
