*DECK     DCCBL010
00001  IDENTIFICATION DIVISION.                                         09/28/78
       PROGRAM-ID. CBL010.
*CALL COPYRIGHT 
      *    VALIDATE GENERATION STATEMENT
      *    BUILD GENERATION TABLE 
      *    PRINT GENERATION ERRORS
00010  ENVIRONMENT DIVISION.                                            DCCBL010
00011  CONFIGURATION SECTION.                                           DCCBL010
       SOURCE-COMPUTER.  CYBER. 
       OBJECT-COMPUTER.  CYBER. 
*CALL OTHSN 
00014  INPUT-OUTPUT SECTION.                                            DCCBL010
00015  FILE-CONTROL.                                                    DCCBL010
           SELECT MAST2 ASSIGN TO "MAST2" 
               ACCESS MODE IS RANDOM
                ORGANIZATION IS DIRECT
               RECORD KEY IS REL-KEY. 
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
00021  DATA DIVISION.                                                   DCCBL010
00022  FILE SECTION.                                                    DCCBL010
00023 ********************************************************          DCCBL010
00024 *    PRINT A LINE FROM HERE                                       DCCBL010
00025 ********************************************************          DCCBL010
*CALL     SYSPRTFD                                                      DCCBL010
*CALL     MAST2FD                                                       DCCBL010
*CALL GENCS 
*CALL     WRKSTG77                                                      DCCBL010
00031  77  ERROR-CODE                  PICTURE XX.                      DCCBL010
*CALL     WRKSTG01                                                      DCCBL010
00036  01  WORK-STORE.                                                  DCCBL010
00037 ******************************************************************DCCBL010
00038 *    HOLDS PLACE IN QRY-WORK                                     *DCCBL010
00039 ******************************************************************DCCBL010
00040      03  SUB3                    PICTURE 99      COMP.            DCCBL010
00041 ******************************************************************DCCBL010
00042 *    USED TO EXTRACT A FIELD FROM QRY-WORK                       *DCCBL010
00043 ******************************************************************DCCBL010
00044      03  SUB2                    PICTURE 99      COMP.            DCCBL010
00045      03  SUB1                    PICTURE 99      COMP.            DCCBL010
00046      03  SUB4                    PICTURE 99      COMP.            DCCBL010
00047 ******************************************************************DCCBL010
00048 *    REQUEST EXTRACTION END SW                                   *DCCBL010
00049 *    Y = EXTRACT SUCCESSFUL - N = NOT SUCCESSFUL                 *DCCBL010
00050 ******************************************************************DCCBL010
00051      03  EXTRACT-SWITCH          PICTURE X.                       DCCBL010
00052      03  EDIT-SW                 PICTURE X.                       DCCBL010
00053      03  HAVE-SW                 PICTURE X.                       DCCBL010
00054      03  ROUTINE-SW              PICTURE X.                       DCCBL010
00055      03  PREFIX-A                PICTURE X.                       DCCBL010
00056      03  PREFIX-B                PICTURE X.                       DCCBL010
00057      03  SUFFIX-A                PICTURE X   VALUE "N".           DCCBL010
00058      03  SUFFIX-B                PICTURE X   VALUE "N".           DCCBL010
00059 ******************************************************************DCCBL010
00060 *    HOLD AN EXTRACTED FIELD                                     *DCCBL010
00061 ******************************************************************DCCBL010
00062      03  HOLD-VALUE.                                              DCCBL010
00063          05  WORK-VALUE          PICTURE X OCCURS 72 TIMES.       DCCBL010
00065      03  INCREMENT-HOLD          PICTURE 9(6).                    DCCBL010
00066 ******************************************************************DCCBL010
00067 *    HOLD SHORT WORK AREAS                                       *DCCBL010
00068 ******************************************************************DCCBL010
00069      03  WORK-AREAS.                                              DCCBL010
00070          05  WORK-1              PICTURE X.                       DCCBL010
00071          05  WORK-5              PICTURE X(5).                    DCCBL010
00072          05  WORK-9              PICTURE X(9).                    DCCBL010
00073          05  WORK-32.                                             DCCBL010
00074              07  WORK-32-A       PICTURE X OCCURS 32 TIMES.       DCCBL010
00075          05  WORK-30.                                             DCCBL010
00076              07  WORK-30-A       PICTURE X OCCURS 30 TIMES.       DCCBL010
00077          05  WORK-15.                                             DCCBL010
00078              07  WORK-15-A       PICTURE X OCCURS 15 TIMES.       DCCBL010
00079          05  WORK-6.                                              DCCBL010
00080              07  FILLER          PICTURE 99.                      DCCBL010
00081              07  WORK-4.                                          DCCBL010
00082                  09  FILLER      PICTURE 9.                       DCCBL010
00083                  09  WORK-3.                                      DCCBL010
00084                      11  FILLER  PICTURE 9.                       DCCBL010
00085                      11  WORK-2  PICTURE 99.                      DCCBL010
00086          05  WORK-6Z  REDEFINES  WORK-6.                          DCCBL010
00087              07  WORK-6A         PICTURE X OCCURS 6 TIMES.        DCCBL010
00091 ******************************************************************DCCBL010
00092 *    STORE LITERALS USED IN PROGRAM                              *DCCBL010
00093 ******************************************************************DCCBL010
00094  01  LITERAL-TABLE.                                               DCCBL010
00095          05  LITERAL-1           PICTURE X(04)   VALUE            DCCBL010
00096             "LIST".                                               DCCBL010
00097          05  LITERAL-2           PICTURE X(07)   VALUE            DCCBL010
00098             "DATASET".                                            DCCBL010
00099          05  LITERAL-3           PICTURE X(04)   VALUE            DCCBL010
00100             "IDEN".                                               DCCBL010
00101          05  LITERAL-4           PICTURE X(08)   VALUE            DCCBL010
00102             "STARTSEQ".                                           DCCBL010
00103          05  LITERAL-5           PICTURE X(06)   VALUE            DCCBL010
00104             "INCSEQ".                                             DCCBL010
00105          05  LITERAL-6           PICTURE X(07)   VALUE            DCCBL010
00106             "PREFIX1".                                            DCCBL010
00107          05  LITERAL-7           PICTURE X(07)   VALUE            DCCBL010
00108             "PREFIX2".                                            DCCBL010
               05  LITERAL-8           PICTURE X(30) VALUE
                  "PREFIX88                      ". 
00111          05  LITERAL-9           PICTURE X(07)   VALUE            DCCBL010
00112             "BALTYPE".                                            DCCBL010
00113          05  LITERAL-10          PICTURE X(09)   VALUE            DCCBL010
00114             "START-LEV".                                          DCCBL010
00115          05  LITERAL-11          PICTURE X(07)   VALUE            DCCBL010
00116             "LEV-INC".                                            DCCBL010
00117          05  LITERAL-12          PICTURE X(05)   VALUE            DCCBL010
00118             "NOTES".                                              DCCBL010
00119          05  LITERAL-13          PICTURE X(07)   VALUE            DCCBL010
00120             "COPYLIB".                                            DCCBL010
00121          05  LITERAL-14          PICTURE X(01)   VALUE            DCCBL010
00122             "=".                                                  DCCBL010
00123          05  LITERAL-15          PICTURE X(01)   VALUE            DCCBL010
00124             ",".                                                  DCCBL010
00125          05  LITERAL-16          PICTURE X(06)   VALUE            DCCBL010
00126             "SELECT".                                             DCCBL010
00127          05  LITERAL-17          PICTURE X(09)   VALUE            DCCBL010
00128             "$GENERATE".                                          DCCBL010
00129          05  LITERAL-18          PICTURE X(04) VALUE              DCCBL010
00130             "OPT ".                                               DCCBL010
00131          05  LITERAL-19          PICTURE X(05)   VALUE            DCCBL010
00132             "COBOL".                                              DCCBL010
00135          05  LITERAL-21          PICTURE X(04)   VALUE            DCCBL010
00136             "PL/1".                                               DCCBL010
00137          05  LITERAL-22          PICTURE X(06)   VALUE            DCCBL010
00138             "*ERROR".                                             DCCBL010
00139          05  LITERAL-23          PICTURE X(07) VALUE              DCCBL010
00140             "OPTIONS".                                            DCCBL010
00143          05  LITERAL-25          PICTURE X(07)   VALUE            DCCBL010
00144             "NEWNAME".                                            DCCBL010
00147          05  LITERAL-27          PICTURE X(04) VALUE              DCCBL010
00148             "SEL ".                                               DCCBL010
00149          05  LITERAL-28          PICTURE X(05)   VALUE            DCCBL010
00150             "TOTAL".                                              DCCBL010
00151          05  LITERAL-29          PICTURE X(05)   VALUE            DCCBL010
                  "LOG".
00153          05  LITERAL-30          PICTURE X(07)   VALUE            DCCBL010
                  "OUTPUT". 
00155          05  LITERAL-31          PICTURE X(07)   VALUE            DCCBL010
00156             "LEVEL88".                                            DCCBL010
00157          05  LITERAL-32          PICTURE X(05)   VALUE            DCCBL010
00158             "QUOTE".                                              DCCBL010
00159          05  LITERAL-33          PICTURE X(04)   VALUE            DCCBL010
00160             "FROM".                                               DCCBL010
00161          05  LITERAL-34          PICTURE X(02)   VALUE            DCCBL010
00162             "TO".                                                 DCCBL010
00163          05  LITERAL-35          PICTURE X(03)   VALUE            DCCBL010
00164             "FOR".                                                DCCBL010
00165          05  LITERAL-36          PICTURE X(07)   VALUE            DCCBL010
00166             "SUFFIX1".                                            DCCBL010
00167          05  LITERAL-37          PICTURE X(07)   VALUE            DCCBL010
00168             "SUFFIX2".                                            DCCBL010
00169          05  LITERAL-38          PICTURE X(06)   VALUE            DCCBL010
00170             "SEQCOL".                                             DCCBL010
00171          05  LITERAL-39          PICTURE X(06)   VALUE            DCCBL010
00172             "FDNAME".                                             DCCBL010
               05  LITERAL-40          PICTURE X(04)   VALUE
                  "CDCS". 
               05  LITERAL-41          PICTURE X(08)   VALUE
                  "COMMENTS". 
00173 ******************************************************************DCCBL010
00174 *    ERROR-MESSAGES                                               DCCBL010
00175 ******************************************************************DCCBL010
00176  01  ERROR-TABLE.                                                 DCCBL010
00177      03  ERROR-HOLD.                                              DCCBL010
00178          05  ERROR-1             PICTURE X(35)   VALUE            DCCBL010
00179             "INVALID OPTIONS CONTINUATION".                       DCCBL010
00180          05  MESSAGE-NUMBER-1  PICTURE X(12) VALUE "DCGEN-440-S". DCCBL010
00181          05  ERROR-2             PICTURE X(35)   VALUE            DCCBL010
00182             "MAST3 READ CLIENT RECORD".                           DCCBL010
00183          05  MESSAGE-NUMBER-2  PICTURE X(12) VALUE "DCGEN-950-F". DCCBL010
00184          05  ERROR-3             PICTURE X(35)   VALUE            DCCBL010
00185             "GENERATE LANGUAGE MISSING".                          DCCBL010
00186          05  MESSAGE-NUMBER-3  PICTURE X(12) VALUE "DCGEN-400-S". DCCBL010
00187          05  ERROR-4.                                             DCCBL010
00188              07  LAN-NAME        PICTURE X(06).                   DCCBL010
00189              07  FILLER          PICTURE X(29)   VALUE            DCCBL010
00190                 "IS AN INVALID LANGUAGE NAME".                    DCCBL010
00191          05  MESSAGE-NUMBER-4  PICTURE X(12) VALUE "DCGEN-405-S". DCCBL010
00192          05  ERROR-5             PICTURE X(35)   VALUE            DCCBL010
00193              "LAST OPTION FOLLOWED BY COMMA".                     DCCBL010
00194          05  MESSAGE-NUMBER-5  PICTURE X(12) VALUE "DCGEN-435-S". DCCBL010
00195          05  ERROR-6             PICTURE X(35)   VALUE            DCCBL010
00196             "INVALID OPTION SYNTAX".                              DCCBL010
00197          05  MESSAGE-NUMBER-6  PICTURE X(12) VALUE "DCGEN-415-S". DCCBL010
00198          05  ERROR-7.                                             DCCBL010
00199              07  FILLER          PICTURE X(7)   VALUE             DCCBL010
00200                 "OPTION ".                                        DCCBL010
00201              07  SYNTAX-WORD      PICTURE X(10).                  DCCBL010
00202              07  FILLER          PICTURE X(18)   VALUE            DCCBL010
00203                 " HAS ILLEGAL VALUE".                             DCCBL010
00204          05  MESSAGE-NUMBER-7  PICTURE X(12) VALUE "DCGEN-420-S". DCCBL010
00205          05  ERROR-8.                                             DCCBL010
00206              07  OPT-NAME        PICTURE X(10).                   DCCBL010
00207              07  FILLER          PICTURE X(25)   VALUE            DCCBL010
00208                 "VALUE MUST BE NUMERIC".                          DCCBL010
00209          05  MESSAGE-NUMBER-8  PICTURE X(12) VALUE "DCGEN-425-S". DCCBL010
00210          05  ERROR-9.                                             DCCBL010
00211              07  OPT-NAME-A      PICTURE X(10).                   DCCBL010
00212              07  FILLER          PICTURE X(25)   VALUE            DCCBL010
00213                 "INVALID FOR LANGUAGE USED".                      DCCBL010
00214          05  MESSAGE-NUMBER-9  PICTURE X(12) VALUE "DCGEN-430-S". DCCBL010
00215          05  ERROR-10            PICTURE X(35)   VALUE            DCCBL010
00216             "NO RECORD OR FILE NAMED FOR SELECT".                 DCCBL010
00217          05  MESSAGE-NUMBER-10 PICTURE X(12) VALUE "DCGEN-460-S". DCCBL010
00218          05  ERROR-11.                                            DCCBL010
00219              07  PROCESS-REC     PICTURE X(23).                   DCCBL010
00220              07  FILLER          PICTURE X(12)   VALUE            DCCBL010
00221                 " NOT ON FILE".                                   DCCBL010
00222          05  MESSAGE-NUMBER-11 PICTURE X(12) VALUE "DCGEN-465-S". DCCBL010
00223          05  ERROR-12            PICTURE X(35)   VALUE            DCCBL010
00224             "RECORD OR FILE MUST BE SELECTED".                    DCCBL010
00225          05  MESSAGE-NUMBER-12 PICTURE X(12) VALUE "DCGEN-470-S". DCCBL010
00226          05  ERROR-13        PICTURE X(35)   VALUE                DCCBL010
00227             "STATEMENT SEQUENCE ERROR".                           DCCBL010
00228          05  MESSAGE-NUMBER-13 PICTURE X(12) VALUE "DCGEN-410-S". DCCBL010
00229          05  ERROR-14          PICTURE X(35) VALUE                DCCBL010
                  "INPUT IGNORED UNTIL $GENERATE".
00231          05  MESSAGE-NUMBER-14 PICTURE X(12) VALUE "DCGEN-495-S". DCCBL010
00232          05  ERROR-15          PICTURE X(35) VALUE                DCCBL010
00233             "TOO MANY CONTINUATION STATEMENTS".                   DCCBL010
00234          05  MESSAGE-NUMBER-15 PICTURE X(12) VALUE "DCGEN-445-S". DCCBL010
00235          05  ERROR-16          PICTURE X(35) VALUE                DCCBL010
00236             "NO COMMAND SPECIFIED".                               DCCBL010
00237          05  MESSAGE-NUMBER-16 PICTURE X(12) VALUE "DCGEN-455-S". DCCBL010
00238          05  ERROR-17          PICTURE X(35) VALUE                DCCBL010
00239             "INVALID IMS/TOTAL SELECT COMMAND".                   DCCBL010
00240          05  MESSAGE-NUMBER-17 PICTURE X(12) VALUE "DCGEN-480-S". DCCBL010
00241          05  ERROR-18          PICTURE X(35) VALUE                DCCBL010
00242             "SELECT MUST BE PSB SSA OR DATABASE".                 DCCBL010
00243          05  MESSAGE-NUMBER-18 PICTURE X(12) VALUE "DCGEN-485-S". DCCBL010
00244          05  ERROR-19.                                            DCCBL010
00245              07  IMS-RECORD-A  PICTURE X(12).                     DCCBL010
00246              07  FILLER        PICTURE X(12) VALUE                DCCBL010
00247                 "INVALID FOR ".                                   DCCBL010
00248              07  IMS-RECORD-B  PICTURE X(11).                     DCCBL010
00249          05  MESSAGE-NUMBER-19 PICTURE X(12) VALUE "DCGEN-490-S". DCCBL010
00250          05  ERROR-20.                                            DCCBL010
00251              07  NUM-RECORD    PICTURE X(12).                     DCCBL010
00252              07  FILLER        PICTURE X(23)   VALUE              DCCBL010
00253             "NUMERIC VALUE TOO LARGE".                            DCCBL010
00254          05  MESSAGE-NUMBER-20 PICTURE X(12) VALUE "DCGEN-450-S". DCCBL010
00255          05  ERROR-21            PICTURE X(35) VALUE              DCCBL010
00256             "SELECT MUST BE A TOTAL DATABASE".                    DCCBL010
00257          05  MESSAGE-NUMBER-21  PICTURE X(12) VALUE "DCGEN-485-S".DCCBL010
               05  ERROR-22            PICTURE X(35) VALUE
                  "FIRST STATEMENT NOT $GENERATE ". 
               05  MESSAGE-NUMBER-22  PICTURE X(12) VALUE "DCGEN-475-S".
00258      03  ERROR-PRINT  REDEFINES  ERROR-HOLD.                      DCCBL010
               05  ERROR-MOVE OCCURS 22 TIMES.
00260              07  ERROR-MESSAGE   PICTURE X(35).                   DCCBL010
00261              07  ERROR-NUMBER    PICTURE X(12).                   DCCBL010
00287  PROCEDURE DIVISION.                                              DCCBL010
       BEGIN-PARA.
00290 **************************************************                DCCBL010
00291 *************************************************                 DCCBL010
00292 *                                                                 DCCBL010
00293 *     INITIALIZATION                                              DCCBL010
00294 *                                                                 DCCBL010
00295 ***************************************************               DCCBL010
00296 **************************************************                DCCBL010
00297      PERFORM REL-OPEN THRU REL-OPEN-XIT.                          DCCBL010
00299      MOVE ZERO TO SUB1.                                           DCCBL010
00306      MOVE SPACES TO ROUTINE-SW.                                   DCCBL010
00307      MOVE ZERO TO SUB2.                                           DCCBL010
00308      MOVE ZERO TO SUB3.                                           DCCBL010
00309      MOVE ZERO TO SUB4.                                           DCCBL010
00310      MOVE "N" TO HAVE-SW.                                         DCCBL010
00311      IF ERROR-COUNT NOT EQUAL TO ZEROS                            DCCBL010
00312          GO TO PROCESS-ERRORS.                                    DCCBL010
00313 *                                                                 DCCBL010
00314 *    EXTRACT FIRST FIELD FROM LINKAGE HOLD AREA                   DCCBL010
00315 *                                                                 DCCBL010
00316  LINKAGE-HOLD.                                                    DCCBL010
00317      ADD 1 TO SUB3.                                               DCCBL010
00318      MOVE QRY-WORK (SUB3) TO HOLD-VALUE.                          DCCBL010
00319      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCBL010
00320 *                                                                 DCCBL010
00321 *    HAVE A $GENERATE OR A SELECT QUERY                           DCCBL010
00322 *                                                                 DCCBL010
00323      IF WORK-30 EQUAL TO LITERAL-17                               DCCBL010
00324          MOVE SPACES TO GEN-TABLE                                 DCCBL010
00325          PERFORM DEFAULT-CODE THRU DEFAULT-CODE-XIT               DCCBL010
00326          GO TO FIND-LANGUAGE.                                     DCCBL010
00327      IF WORK-30 EQUAL TO LITERAL-16 OR LITERAL-27                 DCCBL010
00328          MOVE INCREMENT-HOLD TO GTBL-OPT-STARTSEQNO               DCCBL010
00329          GO TO PROCESS-SELECT.                                    DCCBL010
00330      MOVE "13" TO ERROR-CODE.                                     DCCBL010
00331      GO TO BAD-ERROR-Y.                                           DCCBL010
00332 *                                                                 DCCBL010
00333 *    EXTRACT LANGUAGE FROM GENERATE QUERY                         DCCBL010
00334 *                                                                 DCCBL010
00335  FIND-LANGUAGE.                                                   DCCBL010
00336      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCBL010
00337      IF EXTRACT-SWITCH EQUAL TO "N"                               DCCBL010
00338          MOVE "03" TO ERROR-CODE                                  DCCBL010
00339          GO TO BAD-ERROR-Y.                                       DCCBL010
      * 
      *    LANGUAGE FOUND = CDCS
      * 
           IF WORK-30 = LITERAL-40
           THEN 
             MOVE "GD" TO GTBL-HDR-REQTYPE
             MOVE LITERAL-40 TO WORK-5
             GO TO PROCESS-OPTION 
           END-IF 
00348 *                                                                 DCCBL010
00349 *    LANGUAGE FOUND = TOTAL                                       DCCBL010
00350 *                                                                 DCCBL010
00351      IF WORK-30 EQUAL TO LITERAL-28                               DCCBL010
00353          MOVE "IT" TO GTBL-HDR-REQTYPE                            DCCBL010
00354          MOVE LITERAL-28 TO WORK-5                                DCCBL010
00355          GO TO PROCESS-OPTION.                                    DCCBL010
00356 *                                                                 DCCBL010
00357 *    LANGUAGE FOUND = COBOL                                       DCCBL010
00358 *                                                                 DCCBL010
00359      IF WORK-30 EQUAL TO LITERAL-19                               DCCBL010
00360          MOVE LITERAL-19 TO WORK-5                                DCCBL010
00361          MOVE "GA" TO GTBL-HDR-REQTYPE                            DCCBL010
00362          GO TO PROCESS-OPTION.                                    DCCBL010
00371 *                                                                 DCCBL010
00372 *    LANGUAGE FOUND = PL/1                                        DCCBL010
00373 *                                                                 DCCBL010
00374      IF WORK-30 EQUAL TO LITERAL-21                               DCCBL010
00375          MOVE LITERAL-21 TO WORK-5                                DCCBL010
00377          MOVE "GB" TO GTBL-HDR-REQTYPE                            DCCBL010
00378          GO TO PROCESS-OPTION.                                    DCCBL010
00379 *                                                                 DCCBL010
00380 *    GENERATION LANGUAGE ERROR                                    DCCBL010
00381 *                                                                 DCCBL010
00382      MOVE WORK-30 TO LAN-NAME.                                    DCCBL010
00383      MOVE "04" TO ERROR-CODE.                                     DCCBL010
00384      GO TO BAD-ERROR-Y.                                           DCCBL010
00386 ******************************************************************DCCBL010
00387 *    CHECK IF AN OPTION CARD EXISTS                               DCCBL010
00388 ******************************************************************DCCBL010
00389  PROCESS-OPTION.                                                  DCCBL010
00390      ADD 1 TO SUB3.                                               DCCBL010
00391      MOVE ZERO TO SUB1.                                           DCCBL010
00392      MOVE QRY-WORK (SUB3) TO HOLD-VALUE.                          DCCBL010
00393      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCBL010
00394 *                                                                 DCCBL010
00395 *    CHECK IF AN OPTION OR SELECT ENTRY HAS BEEN FOUND            DCCBL010
00396 *                                                                 DCCBL010
00397      IF WORK-30 EQUAL TO LITERAL-16 OR LITERAL-27                 DCCBL010
00398          GO TO PROCESS-SELECT.                                    DCCBL010
00399      IF WORK-30 EQUAL TO LITERAL-18 OR LITERAL-23                 DCCBL010
00400          GO TO EXTRACT-OPTIONS.                                   DCCBL010
00401      MOVE "13" TO ERROR-CODE.                                     DCCBL010
00402      GO TO BAD-ERROR-Y.                                           DCCBL010
00403 *                                                                 DCCBL010
00404 *    PROCESS OPTIONS FROM OPTIONS QUERY                           DCCBL010
00405 *                                                                 DCCBL010
00406  EXTRACT-OPTIONS.                                                 DCCBL010
00407      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCBL010
00408      IF EDIT-SW NOT EQUAL TO "M"                                  DCCBL010
00409          GO TO CHECK-SWITCHES.                                    DCCBL010
00410      ADD 1 TO SUB3.                                               DCCBL010
00411      IF SUB3 GREATER THAN 5                                       DCCBL010
00412          MOVE "05" TO ERROR-CODE                                  DCCBL010
00413          GO TO BAD-ERROR-Y.                                       DCCBL010
00414      MOVE ZERO TO SUB1.                                           DCCBL010
00415      MOVE QRY-WORK (SUB3) TO HOLD-VALUE.                          DCCBL010
00416      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCBL010
00417  CHECK-SWITCHES.                                                  DCCBL010
00418      IF EXTRACT-SWITCH EQUAL TO "N"                               DCCBL010
00419          MOVE "06" TO ERROR-CODE                                  DCCBL010
00420          GO TO BAD-ERROR-Y.                                       DCCBL010
00421      IF WORK-30 EQUAL TO LITERAL-16 OR LITERAL-27                 DCCBL010
00422          MOVE "06" TO ERROR-CODE                                  DCCBL010
00423          GO TO BAD-ERROR-Y.                                       DCCBL010
00424      IF HAVE-SW EQUAL TO "N"                                      DCCBL010
00425          MOVE WORK-30 TO SYNTAX-WORD                              DCCBL010
00426          MOVE "07" TO ERROR-CODE                                  DCCBL010
00427          GO TO BAD-ERROR-Y.                                       DCCBL010
00428 *                                                                 DCCBL010
00429 *    VALIDATE IF OPTION LEGAL FOR EACH LANGUAGE                   DCCBL010
00430 *                                                                 DCCBL010
00431      IF WORK-5 EQUAL TO LITERAL-28                                DCCBL010
00432          GO TO LANGUAGE-TOTAL-OPTIONS.                            DCCBL010
           IF WORK-5 = LITERAL-40 
               GO TO LANGUAGE-CDCS. 
00435      IF WORK-5 EQUAL TO LITERAL-19                                DCCBL010
00436          GO TO LANGUAGE-COBOL.                                    DCCBL010
00439      IF WORK-5 EQUAL TO LITERAL-21                                DCCBL010
00440          GO TO LANGUAGE-COMMON.                                   DCCBL010
00441 *                                                                 DCCBL010
00442 *    OPTIONS COMMON ONLY TO TOTAL DBDL GENERATION                 DCCBL010
00443 *                                                                 DCCBL010
00444  LANGUAGE-TOTAL-OPTIONS.                                          DCCBL010
00445      IF WORK-30 NOT EQUAL TO LITERAL-29                           DCCBL010
00446          GO TO TEST-LOGSIZE.                                      DCCBL010
00447      MOVE WORK-15 TO LOG-OPT.                                     DCCBL010
00448      GO TO END-OPTION-TEST.                                       DCCBL010
00449  TEST-LOGSIZE.                                                    DCCBL010
00450      IF WORK-30 NOT EQUAL TO LITERAL-30                           DCCBL010
00451          GO TO LANGUAGE-IMS.                                      DCCBL010
           MOVE WORK-15 TO LOG-OUT. 
00453      GO TO END-OPTION-TEST.                                       DCCBL010
00454 *                                                                 DCCBL010
      *    TEST FOR NEWNAME FIELD   COMMON ONLY TO TOTAL
00456 *                                                                 DCCBL010
00457  LANGUAGE-IMS.                                                    DCCBL010
00458      IF WORK-30 NOT EQUAL TO LITERAL-25                           DCCBL010
               GO TO LANGUAGE-COMMON-IMS. 
00460      MOVE WORK-15 TO GTBL-OPT-NEWNAME.                            DCCBL010
00461      GO TO END-OPTION-TEST.                                       DCCBL010
      * 
      *    TEST FOR COMMENT FIELD   COMMON ONLY TO CDCS 
      * 
       LANGUAGE-CDCS. 
           IF WORK-30 NOT = LITERAL-41
           THEN 
             GO TO TRY-OPT-10 
           END-IF 
  
           PERFORM YES-NO THRU YES-NO-XIT 
           IF HAVE-SW = "N" 
           THEN 
             MOVE "N" TO GTBL-OPT-COMMENT 
           END-IF 
  
           GO TO END-OPTION-TEST. 
  
00483 ******************************************************************DCCBL010
00484 *                                                                 DCCBL010
00485 *    FIELDS COMMON ONLY TO COBOL                                  DCCBL010
00486 *                                                                 DCCBL010
00487 ******************************************************************DCCBL010
00488  LANGUAGE-COBOL.                                                  DCCBL010
00489 *                                                                 DCCBL010
00490 *    TEST FOR PREFIX88  FIELD IS COMMON ONLY TO COBOL             DCCBL010
00491 *                                                                 DCCBL010
00492      IF WORK-30 NOT EQUAL TO LITERAL-8                            DCCBL010
00493          GO TO CHECK-88LEVEL.                                     DCCBL010
00494      PERFORM YES-NO THRU YES-NO-XIT.                              DCCBL010
00495      IF HAVE-SW EQUAL TO "Y"                                      DCCBL010
00496          GO TO END-OPTION-TEST.                                   DCCBL010
00497      MOVE "N" TO GTBL-OPT-PREFIX88.                               DCCBL010
00498      GO TO END-OPTION-TEST.                                       DCCBL010
00499 *                                                                 DCCBL010
00500 *    TEST FOR 88LEVEL                                             DCCBL010
00501 *                                                                 DCCBL010
00502  CHECK-88LEVEL.                                                   DCCBL010
00503      IF WORK-30 NOT EQUAL TO LITERAL-31                           DCCBL010
00504          GO TO TRY-OPT-SEQCOL.                                    DCCBL010
00505      PERFORM YES-NO THRU YES-NO-XIT.                              DCCBL010
00506      IF HAVE-SW EQUAL TO "Y"                                      DCCBL010
00507          GO TO END-OPTION-TEST.                                   DCCBL010
00508      MOVE "N" TO GTBL-OPT-88.                                     DCCBL010
00509      GO TO END-OPTION-TEST.                                       DCCBL010
00510 *                                                                 DCCBL010
00511 *    TEST FOR SEQCOL FIELD                                        DCCBL010
00512 *                                                                 DCCBL010
00513  TRY-OPT-SEQCOL.                                                  DCCBL010
00514      IF WORK-30 NOT EQUAL TO LITERAL-38                           DCCBL010
00515          GO TO TRY-OPT-FDNAME.                                    DCCBL010
00516      MOVE WORK-15 TO GTBL-OPT-SEQCOL.                             DCCBL010
00517      IF GTBL-OPT-SEQCOL EQUAL TO "01" OR "1 " OR " 1" OR "73"        CL**2
00518          GO TO END-OPTION-TEST.                                   DCCBL010
00519      MOVE WORK-30 TO SYNTAX-WORD.                                 DCCBL010
00520      MOVE "A" TO ROUTINE-SW.                                      DCCBL010
00521      MOVE "07" TO ERROR-CODE.                                     DCCBL010
00522      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
00523 *                                                                 DCCBL010
00524 *    TEST FOR FDNAME FIELD                                        DCCBL010
00525 *                                                                 DCCBL010
00526  TRY-OPT-FDNAME.                                                  DCCBL010
00527      IF WORK-30 NOT EQUAL TO LITERAL-39                           DCCBL010
00528          GO TO TRY-OPT-QUOTE.                                     DCCBL010
00529      MOVE WORK-32 TO GTBL-OPT-FDNAME.                             DCCBL010
00530      GO TO END-OPTION-TEST.                                       DCCBL010
00531 *                                                                 DCCBL010
00532 *    TEST FOR DOUBLE QUOTE FIELD                                  DCCBL010
00533 *                                                                 DCCBL010
00534  TRY-OPT-QUOTE.                                                   DCCBL010
00535      IF WORK-30 NOT EQUAL TO LITERAL-32                           DCCBL010
00536          GO TO TRY-OPT-NOTESFROM.                                 DCCBL010
00537      IF WORK-15 EQUAL TO "YES" OR "Y"                             DCCBL010
00538          MOVE "Y" TO GTBL-OPT-QUOTE.                              DCCBL010
00539      GO TO END-OPTION-TEST.                                       DCCBL010
00540 *                                                                 DCCBL010
00541 *    TEST FOR NOTESFROM FIELD                                     DCCBL010
00542 *                                                                 DCCBL010
00543  TRY-OPT-NOTESFROM.                                               DCCBL010
00544      IF WORK-30 NOT EQUAL TO LITERAL-33                           DCCBL010
00545          GO TO TRY-OPT-NOTESTO.                                   DCCBL010
00546      PERFORM MOVE-NUMERIC THRU MOVE-NUMERIC-XIT.                  DCCBL010
00547      IF WORK-4 NUMERIC                                            DCCBL010
00548          MOVE WORK-4 TO GTBL-OPT-NOTESFROM                        DCCBL010
00549          GO TO END-OPTION-TEST.                                   DCCBL010
00550      GO TO COMMON-ERROR-NOTES.                                    DCCBL010
00551 *                                                                 DCCBL010
00552 *    TEST NOTESTO FIELD                                           DCCBL010
00553 *                                                                 DCCBL010
00554  TRY-OPT-NOTESTO.                                                 DCCBL010
00555      IF WORK-30 NOT EQUAL TO LITERAL-34                           DCCBL010
00556          GO TO TRY-OPT-NOTESFOR.                                  DCCBL010
00557      PERFORM MOVE-NUMERIC THRU MOVE-NUMERIC-XIT.                  DCCBL010
00558      IF WORK-4 NUMERIC                                            DCCBL010
00559          MOVE WORK-4 TO GTBL-OPT-NOTESTO                          DCCBL010
00560          GO TO END-OPTION-TEST.                                   DCCBL010
00561      GO TO COMMON-ERROR-NOTES.                                    DCCBL010
00562 *                                                                 DCCBL010
00563 *    TEST FOR NOTESFOR FIELD                                      DCCBL010
00564 *                                                                 DCCBL010
00565  TRY-OPT-NOTESFOR.                                                DCCBL010
00566      IF WORK-30 NOT EQUAL TO LITERAL-35                           DCCBL010
00567          GO TO TRY-OPT-10.                                        DCCBL010
00568      PERFORM MOVE-NUMERIC THRU MOVE-NUMERIC-XIT.                  DCCBL010
00569      IF WORK-4 NUMERIC                                            DCCBL010
00570          MOVE WORK-4 TO GTBL-OPT-NOTESFOR                         DCCBL010
00571          GO TO END-OPTION-TEST.                                   DCCBL010
00572  COMMON-ERROR-NOTES.                                              DCCBL010
00573      MOVE WORK-30 TO OPT-NAME.                                    DCCBL010
00574      MOVE "A" TO ROUTINE-SW.                                      DCCBL010
00575      MOVE "08" TO ERROR-CODE.                                     DCCBL010
00576      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
00577 *                                                                 DCCBL010
      *    TEST FOR START-LEV   COMMON ONLY TO CDCS AND COBOL 
00579 *                                                                 DCCBL010
00580  TRY-OPT-10.                                                      DCCBL010
00581      IF WORK-30 NOT EQUAL TO LITERAL-10                           DCCBL010
00582          GO TO TRY-OPT-11.                                        DCCBL010
00583      PERFORM MOVE-NUMERIC THRU MOVE-NUMERIC-XIT.                  DCCBL010
00584      IF WORK-2 NUMERIC                                            DCCBL010
00585          MOVE WORK-2 TO GTBL-OPT-LEVEL                            DCCBL010
00586          GO TO END-OPTION-TEST.                                   DCCBL010
00587      MOVE WORK-30 TO OPT-NAME.                                    DCCBL010
00588      MOVE "A" TO ROUTINE-SW.                                      DCCBL010
00589      MOVE "08" TO ERROR-CODE.                                     DCCBL010
00590      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
00591 *                                                                 DCCBL010
      *    TEST FOR LEV-INC   COMMON ONLY TO CDCS AND COBOL 
00593 *                                                                 DCCBL010
00594  TRY-OPT-11.                                                      DCCBL010
00595      IF WORK-30 NOT EQUAL TO LITERAL-11                           DCCBL010
           THEN 
  
      *    CDCS SKIPS OVER SOME COBOL OPTIONS.
             IF GTBL-HDR-REQTYPE = "GD" 
             THEN 
               GO TO LANGUAGE-COMMON-IMS
             ELSE 
               GO TO LANGUAGE-COMMON
             END-IF 
           END-IF 
  
00597      PERFORM MOVE-NUMERIC THRU MOVE-NUMERIC-XIT.                  DCCBL010
00598      IF WORK-2 NUMERIC                                            DCCBL010
00599          MOVE WORK-2 TO GTBL-OPT-INCLEV                           DCCBL010
00600          GO TO END-OPTION-TEST.                                   DCCBL010
00601      MOVE WORK-30 TO OPT-NAME.                                    DCCBL010
00602      MOVE "A" TO ROUTINE-SW.                                      DCCBL010
00603      MOVE "08" TO ERROR-CODE.                                     DCCBL010
00604      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
00617 ******************************************************************DCCBL010
00618 *                                                                 DCCBL010
      *    VALID OPTIONS COMMON TO COBOL AND PL/1 
00620 *                                                                 DCCBL010
00621 ******************************************************************DCCBL010
00622 *                                                                 DCCBL010
00623 *    TEST FOR PREFIX1                                             DCCBL010
00624 *                                                                 DCCBL010
00625  LANGUAGE-COMMON.                                                 DCCBL010
00626      IF WORK-30 NOT EQUAL TO LITERAL-6                            DCCBL010
00627          GO TO TRY-OPT-7.                                         DCCBL010
00628      MOVE WORK-15 TO GTBL-OPT-PREFIX1.                            DCCBL010
           MOVE "N" TO FIRST-PREFIX-SW. 
00629      MOVE "Y" TO PREFIX-A.                                        DCCBL010
00630      GO TO END-OPTION-TEST.                                       DCCBL010
00631 *                                                                 DCCBL010
00632 *    TEST FOR PREFIX2                                             DCCBL010
00633 *                                                                 DCCBL010
00634  TRY-OPT-7.                                                       DCCBL010
00635      IF WORK-30 NOT EQUAL TO LITERAL-7                            DCCBL010
00636          GO TO TRY-OPT-SUFFIX1.                                   DCCBL010
00637      MOVE WORK-15 TO GTBL-OPT-PREFIX2.                            DCCBL010
00638      MOVE "Y" TO PREFIX-B.                                        DCCBL010
00639      GO TO END-OPTION-TEST.                                       DCCBL010
00640 *                                                                 DCCBL010
00641 *    TEST FOR SUFFIX1                                             DCCBL010
00642 *                                                                 DCCBL010
00643  TRY-OPT-SUFFIX1.                                                 DCCBL010
00644      IF WORK-30 NOT EQUAL TO LITERAL-36                           DCCBL010
00645          GO TO TRY-OPT-SUFFIX2.                                   DCCBL010
00646      MOVE WORK-15 TO GTBL-OPT-SUFFIX1.                            DCCBL010
           MOVE "N" TO FIRST-PREFIX-SW. 
00647      MOVE "Y" TO SUFFIX-A.                                        DCCBL010
00648      GO TO END-OPTION-TEST.                                       DCCBL010
00649 *                                                                 DCCBL010
00650 *    TEST FOR SUFFIX2                                             DCCBL010
00651 *                                                                 DCCBL010
00652  TRY-OPT-SUFFIX2.                                                 DCCBL010
00653      IF WORK-30 NOT EQUAL TO LITERAL-37                           DCCBL010
00654          GO TO TRY-OPT-12.                                        DCCBL010
00655      MOVE WORK-15 TO GTBL-OPT-SUFFIX2.                            DCCBL010
00656      MOVE "Y" TO SUFFIX-B.                                        DCCBL010
00657      GO TO END-OPTION-TEST.                                       DCCBL010
00658 *                                                                 DCCBL010
00659 *    TEST FOR NOTES                                               DCCBL010
00660 *                                                                 DCCBL010
00661  TRY-OPT-12.                                                      DCCBL010
00662      IF WORK-30 NOT EQUAL TO LITERAL-12                           DCCBL010
00663          GO TO LANGUAGE-COMMON-IMS.                               DCCBL010
00664      PERFORM YES-NO THRU YES-NO-XIT.                              DCCBL010
00665      IF HAVE-SW EQUAL TO "Y"                                      DCCBL010
00666          GO TO END-OPTION-TEST.                                   DCCBL010
00667      MOVE "N" TO GTBL-OPT-COMMENT.                                DCCBL010
00668      GO TO END-OPTION-TEST.                                       DCCBL010
00669 ******************************************************************DCCBL010
00670 *                                                                 DCCBL010
      *    VALID OPTIONS COMMON TO CDCS, COBOL, AND PL/1
00672 *                                                                 DCCBL010
00673 ******************************************************************DCCBL010
00674 *                                                                 DCCBL010
00675 *    TEST FOR LIST=                                               DCCBL010
00676 *                                                                 DCCBL010
00677  LANGUAGE-COMMON-IMS.                                             DCCBL010
00678      IF WORK-30 NOT EQUAL TO LITERAL-1                            DCCBL010
00679          GO TO TRY-OPT-2.                                         DCCBL010
00680      PERFORM YES-NO THRU YES-NO-XIT.                              DCCBL010
00681      IF HAVE-SW EQUAL TO "Y"                                      DCCBL010
00682          GO TO END-OPTION-TEST.                                   DCCBL010
00683      MOVE "N" TO GTBL-OPT-LIST.                                   DCCBL010
00684      GO TO END-OPTION-TEST.                                       DCCBL010
00685 *                                                                 DCCBL010
00686 *    TEST FOR DATASET=                                            DCCBL010
00687 *                                                                 DCCBL010
00688  TRY-OPT-2.                                                       DCCBL010
00689      IF WORK-30 NOT EQUAL TO LITERAL-2                            DCCBL010
00690          GO TO TRY-OPT-3.                                         DCCBL010
00691      PERFORM YES-NO THRU YES-NO-XIT.                              DCCBL010
00692      IF HAVE-SW EQUAL TO "Y"                                      DCCBL010
00693          GO TO END-OPTION-TEST.                                   DCCBL010
00694      MOVE "N" TO GTBL-OPT-PUNCH.                                  DCCBL010
00695      GO TO END-OPTION-TEST.                                       DCCBL010
00696 *                                                                 DCCBL010
      *    TEST FOR IDEN=     VALID ONLY FOR COBOL
00698 *                                                                 DCCBL010
00699  TRY-OPT-3.                                                       DCCBL010
           IF GTBL-HDR-REQTYPE NOT = "GA" 
           THEN 
             GO TO TRY-OPT-4
           END-IF 
  
00702      IF WORK-30 NOT EQUAL TO LITERAL-3                            DCCBL010
00703          GO TO TRY-OPT-4.                                         DCCBL010
00704      MOVE WORK-15 TO GTBL-OPT-IDEN.                               DCCBL010
00705      GO TO END-OPTION-TEST.                                       DCCBL010
00706 *                                                                 DCCBL010
00707 *    TEST FOR STARTSEQ=                                           DCCBL010
00708 *                                                                 DCCBL010
00709  TRY-OPT-4.                                                       DCCBL010
00710      IF WORK-30 NOT EQUAL TO LITERAL-4                            DCCBL010
00711          GO TO TRY-OPT-5.                                         DCCBL010
00712      PERFORM MOVE-NUMERIC THRU MOVE-NUMERIC-XIT.                  DCCBL010
00713      IF WORK-6 NUMERIC                                            DCCBL010
00714          MOVE WORK-6 TO INCREMENT-HOLD                            DCCBL010
00715          MOVE WORK-6 TO GTBL-OPT-STARTSEQNO                       DCCBL010
00716          GO TO END-OPTION-TEST.                                   DCCBL010
00717      MOVE WORK-30 TO OPT-NAME.                                    DCCBL010
00718      MOVE "A" TO ROUTINE-SW.                                      DCCBL010
00719      MOVE "08" TO ERROR-CODE.                                     DCCBL010
00720      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
00721 *                                                                 DCCBL010
00722 *    TEST FOR INCSEQ=                                             DCCBL010
00723 *                                                                 DCCBL010
00724  TRY-OPT-5.                                                       DCCBL010
00725      IF WORK-30 NOT EQUAL TO LITERAL-5                            DCCBL010
00726          GO TO NO-OPTIONS-EXIST.                                  DCCBL010
00727      PERFORM MOVE-NUMERIC THRU MOVE-NUMERIC-XIT.                  DCCBL010
00728      IF WORK-3 NUMERIC                                            DCCBL010
00729          MOVE WORK-3 TO GTBL-OPT-INCSEQNO                         DCCBL010
00730          GO TO END-OPTION-TEST.                                   DCCBL010
00731      MOVE WORK-30 TO OPT-NAME.                                    DCCBL010
00732      MOVE "A" TO ROUTINE-SW.                                      DCCBL010
00733      MOVE "08" TO ERROR-CODE.                                     DCCBL010
00734      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
00735 *                                                                 DCCBL010
00736 *    THE OPTION DOESN"T EXIST                                     DCCBL010
00737 *                                                                 DCCBL010
00738  NO-OPTIONS-EXIST.                                                DCCBL010
00739      MOVE WORK-30 TO OPT-NAME-A.                                  DCCBL010
00740      MOVE "A" TO ROUTINE-SW.                                      DCCBL010
00741      MOVE "09" TO ERROR-CODE.                                     DCCBL010
00742      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
00743  MOVE-YES.                                                        DCCBL010
00744      MOVE SPACES TO ERROR-CODES.                                  DCCBL010
00745      MOVE "Y" TO ERROR-CHECK.                                     DCCBL010
00746      MOVE ZERO TO ERROR-COUNT.                                    DCCBL010
00747 *                                                                 DCCBL010
00748 *    IF A SPACE FOUND AT END OF OPTION CLAUSE INSTEAD OF COMMA    DCCBL010
00749 *    THE EDIT-SW WILL EQUAL "Y" AND NO MORE OPTIONS WILL EXIST    DCCBL010
00750 *                                                                 DCCBL010
00751  END-OPTION-TEST.                                                 DCCBL010
00752      IF EDIT-SW EQUAL TO "Y"                                      DCCBL010
00753          MOVE "N" TO EDIT-SW, HAVE-SW, EXTRACT-SWITCH             DCCBL010
00754          GO TO CHECK-PREFIX.                                      DCCBL010
00755 *                                                                 DCCBL010
00756 *    IF EDIT-SW EQUAL "N" THEN MORE OPTIONS WILL BE FOUND AND A   DCCBL010
00757 *       TEST FOR END OF CARD CONTINUATION MUST OCCUR              DCCBL010
00758 *                                                                 DCCBL010
00759      IF SUB1 GREATER THAN 71                                      DCCBL010
00760          NEXT SENTENCE ELSE                                       DCCBL010
00761          GO TO EXTRACT-OPTIONS.                                   DCCBL010
00762      ADD 1 TO SUB3.                                               DCCBL010
00763      IF SUB3 GREATER THAN 5                                       DCCBL010
00764          MOVE "13" TO ERROR-CODE                                  DCCBL010
00765          GO TO BAD-ERROR-Y.                                       DCCBL010
00766      MOVE ZERO TO SUB1.                                           DCCBL010
00767      MOVE QRY-WORK (SUB3) TO HOLD-VALUE.                          DCCBL010
00768      GO TO EXTRACT-OPTIONS.                                       DCCBL010
00769 *                                                                 DCCBL010
00770 *    TEST TO MAKE SURE PREFIX2 ISN"T USED WITHOUT PREFIX1         DCCBL010
00771 *                                                                 DCCBL010
00772  CHECK-PREFIX.                                                    DCCBL010
00773      IF PREFIX-B EQUAL TO PREFIX-A                                DCCBL010
00774          GO TO CHANGE-SIGNS.                                      DCCBL010
00775      MOVE SPACES TO GTBL-OPT-PREFIX2.                             DCCBL010
00776  CHANGE-SIGNS.                                                    DCCBL010
00777      MOVE "N" TO PREFIX-A, PREFIX-B.                              DCCBL010
00778 *                                                                 DCCBL010
00779 *    TEST TO MAKE SURE SUFFIX2 ISN"T USED WITHOUT SUFFIX1         DCCBL010
00780 *                                                                 DCCBL010
00781  CHECK-SUFFIX.                                                    DCCBL010
00782      IF SUFFIX-B EQUAL TO SUFFIX-A                                DCCBL010
00783          GO TO CHANGE-SUFFIX-SW.                                  DCCBL010
00784      MOVE SPACES TO GTBL-OPT-SUFFIX2.                             DCCBL010
00785  CHANGE-SUFFIX-SW.                                                DCCBL010
00786      MOVE "N" TO SUFFIX-A, SUFFIX-B.                              DCCBL010
00787      IF ERROR-CHECK EQUAL TO "Y"                                  DCCBL010
00788          GO TO BAD-ERROR-CONT.                                    DCCBL010
00789 *                                                                 DCCBL010
00790 *    GET SELECT FROM HOLD AREA                                    DCCBL010
00791 *                                                                 DCCBL010
00792  PROCESS-SELECTIONS.                                              DCCBL010
00793      ADD 1 TO SUB3.                                               DCCBL010
00794      IF SUB3 GREATER THAN 5                                       DCCBL010
00795          MOVE "13" TO ERROR-CODE                                  DCCBL010
00796          GO TO BAD-ERROR.                                         DCCBL010
00797      MOVE ZERO TO SUB1.                                           DCCBL010
00798      MOVE QRY-WORK (SUB3) TO HOLD-VALUE.                          DCCBL010
00799      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCBL010
00800      IF WORK-30 EQUAL TO LITERAL-16 OR LITERAL-27                 DCCBL010
00801          GO TO PROCESS-SELECT.                                    DCCBL010
00802      MOVE "01" TO ERROR-CODE.                                     DCCBL010
00803      GO TO BAD-ERROR.                                             DCCBL010
00804 *                                                                 DCCBL010
00805 *    BEGIN PROCESSING THE $SELECT GENERATION                      DCCBL010
00806 *                                                                 DCCBL010
00807  PROCESS-SELECT.                                                  DCCBL010
00808      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCBL010
           IF EXTRACT-SWITCH = "N" AND
00814          GTBL-HDR-REQTYPE EQUAL TO "IT"                           DCCBL010
00815          MOVE "21" TO ERROR-CODE                                  DCCBL010
00816          GO TO BAD-ERROR.                                         DCCBL010
00817      IF EXTRACT-SWITCH EQUAL TO "N"                               DCCBL010
00818          MOVE "10" TO ERROR-CODE                                  DCCBL010
00819          GO TO BAD-ERROR.                                         DCCBL010
00820      MOVE WORK-30 TO REL-ENTRY-NAME.                              DCCBL010
00821      MOVE SPACES TO REL-ENTRY-FUNCTION.                           DCCBL010
00822      PERFORM REL-READ THRU REL-READ-XIT.                          DCCBL010
00823      IF REL-RETURN-CODE EQUAL TO ZERO                             DCCBL010
00824          GO TO LEGAL-ENTRY-NAME.                                  DCCBL010
00825      MOVE WORK-30 TO PROCESS-REC.                                 DCCBL010
00826      MOVE "11" TO ERROR-CODE.                                     DCCBL010
00827      GO TO BAD-ERROR.                                             DCCBL010
  
       LEGAL-ENTRY-NAME.
  
      * CDCS MAY SELECT ONLY A SCHEMA OR SUBSCHEMA. 
           IF GTBL-HDR-REQTYPE = "GD" 
           THEN 
             IF REL-ENTRY-TYPE = "24" OR "26" 
             THEN 
               MOVE REL-ENTRY-NAME TO GTBL-SEL-CNAME
               MOVE REL-ENTRY-TYPE TO GTBL-SEL-TYPE 
  
      * ONLY A SCHEMA IS ALLOWED FURTHER OPTIONS ON THE SELECT -- EITHER
      * "ALL" OR "MD".
               PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT 
               IF EXTRACT-SWITCH = "Y"
               THEN 
                 IF REL-ENTRY-TYPE = "26" 
                 THEN 
                   IF WORK-30 = "ALL" 
                   THEN 
                     MOVE "Y" TO GTBL-SEL-ALL 
                     GO TO EDIT-END 
                   END-IF 
  
                   IF WORK-30 = "MD"
                   THEN 
                     MOVE "Y" TO GTBL-SEL-MD
                     GO TO EDIT-END 
                   END-IF 
                 END-IF 
  
                 MOVE GTBL-SEL-CNAME TO IMS-RECORD-A
                 MOVE WORK-30 TO IMS-RECORD-B 
                 MOVE "19" TO ERROR-CODE
                 GO TO BAD-ERROR
               END-IF 
  
      * IF THE ENTRY IS A SUBSCHEMA, SAVE ITS SCHEMA'S CATNAME. 
               IF REL-ENTRY-TYPE = "24" 
               THEN 
                 MOVE REL-DTL-CATNAME (1) TO SCHEMA-CATNAME 
               END-IF 
               GO TO EDIT-END 
  
      * ERROR IF DISALLOWED ENTITY SELECTED.
             ELSE 
               MOVE "12" TO ERROR-CODE
               GO TO BAD-ERROR
             END-IF 
           END-IF 
  
      * TOTAL MAY SELECT A TOTAL DATABASE OR A PROCEDURAL ENTITY. 
           IF GTBL-HDR-REQTYPE = "IT" 
           THEN 
             IF REL-ENTRY-TYPE < "32" 
             THEN 
               MOVE "21" TO ERROR-CODE
               GO TO BAD-ERROR
             END-IF 
  
             MOVE REL-ENTRY-NAME TO GTBL-SEL-CNAME
             PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT 
  
             IF REL-ENTRY-TYPE = "32" 
             THEN 
               MOVE SPACES TO GTBL-SEL-REQTYPE
               MOVE REL-ENTRY-TYPE TO GTBL-SEL-TYPE 
  
               IF EXTRACT-SWITCH = "Y"
               THEN 
                 MOVE GTBL-SEL-CNAME TO IMS-RECORD-A
                 MOVE WORK-30 TO IMS-RECORD-B 
                 MOVE "19" TO ERROR-CODE
                 GO TO BAD-ERROR
               END-IF 
  
      * "DBDL" MUST BE SPECIFIED IF PROCEDURAL ENTITY.
             ELSE 
               MOVE REL-ENTRY-TYPE TO GTBL-SEL-REQTYPE
               IF EXTRACT-SWITCH = "Y"
                 AND WORK-30 = "DBDL" 
               THEN 
                 MOVE "32" TO GTBL-SEL-TYPE 
               ELSE 
                 MOVE "17" TO ERROR-CODE
                 GO TO BAD-ERROR
               END-IF 
             END-IF 
  
             GO TO EDIT-END 
           END-IF 
  
      * COBOL AND PL/1 ALLOWED TO SELECT RECORD, DATASET, FILE, OR TOTAL
      * DATABASE. 
           IF REL-ENTRY-TYPE = "13" OR "19" OR "20" OR "32" 
           THEN 
             MOVE REL-ENTRY-NAME TO GTBL-SEL-CNAME
             MOVE REL-ENTRY-TYPE TO GTBL-SEL-TYPE 
  
             IF REL-ENTRY-TYPE = "32" 
             THEN 
               MOVE SPACES TO GTBL-SEL-REQTYPE
             END-IF 
  
      * FURTHER OPTIONS NOT ALLOWED ON SELECT.
             PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT 
             IF EXTRACT-SWITCH = "Y"
             THEN 
               MOVE GTBL-SEL-CNAME TO IMS-RECORD-A
               MOVE WORK-30 TO IMS-RECORD-B 
               MOVE "19" TO ERROR-CODE
               GO TO BAD-ERROR
             END-IF 
  
      * ERROR IF DISALLOWED ENTITY SELECTED.
           ELSE 
             MOVE "12" TO ERROR-CODE
             GO TO BAD-ERROR
           END-IF 
  
      * 
      * END OF SELECT STATEMENT PROCESSING. 
      * 
00895  EDIT-END.                                                        DCCBL010
00897      CLOSE MAST2.                                                 DCCBL010
00898  CK-ERROR-COUNT.                                                  DCCBL010
00899      IF ERROR-COUNT EQUAL TO ZERO                                 DCCBL010
00900          GO TO CALL-NEXT-PROGRAM.                                 DCCBL010
           EXIT PROGRAM.
00902  CALL-NEXT-PROGRAM.                                               DCCBL010
           IF GTBL-HDR-REQTYPE = "GD" 
           THEN 
             CALL "DMS300"
             EXIT PROGRAM 
           END-IF 
  
00909      IF GTBL-HDR-REQTYPE EQUAL TO "IT"                            DCCBL010
               CALL "TOT300"
               EXIT PROGRAM.
           IF GTBL-HDR-REQTYPE EQUAL TO "GB"
               CALL "PLC300"
               EXIT PROGRAM.
           CALL "CBL300". 
           EXIT PROGRAM.
00916 ******************************************************************DCCBL010
00917 ******************************************************************DCCBL010
00918 *                                                                 DCCBL010
00919 *    SUBROUTINES FOR PROGRAM GENERATION                           DCCBL010
00920 *                                                                 DCCBL010
00921 ******************************************************************DCCBL010
00922 ******************************************************************DCCBL010
00923 *                                                                 DCCBL010
00924 *      EXTRACT A FIELD FROM HOLD AREA                             DCCBL010
00925 *                                                                 DCCBL010
00926  EXTRACT-FIELD.                                                   DCCBL010
00927      MOVE ZERO TO SUB2.                                           DCCBL010
00928      MOVE SPACES TO WORK-30.                                      DCCBL010
00929      MOVE "N" TO EXTRACT-SWITCH.                                  DCCBL010
00930      MOVE "N" TO EDIT-SW.                                         DCCBL010
00931  START-TO-FIND.                                                   DCCBL010
00932      ADD 1 TO SUB1.                                               DCCBL010
00933      IF SUB1 GREATER THAN 72                                      DCCBL010
00934          MOVE "M" TO EDIT-SW                                      DCCBL010
00935          GO TO EXTRACT-FIELD-XIT.                                 DCCBL010
00936      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCCBL010
00937          GO TO START-TO-FIND.                                     DCCBL010
00938 *                                                                 DCCBL010
00939 *    CHECK FOR = SIGN IN OPTION QUERY                             DCCBL010
00940 *                                                                 DCCBL010
00941  MOVE-FIELD.                                                      DCCBL010
00942      IF WORK-VALUE (SUB1) EQUAL TO LITERAL-14                     DCCBL010
00943          GO TO EXTRACT-SECOND.                                    DCCBL010
00944      ADD 1 TO SUB2.                                               DCCBL010
00945      MOVE WORK-VALUE (SUB1) TO WORK-30-A (SUB2).                  DCCBL010
00946      ADD 1 TO SUB1.                                               DCCBL010
00947      IF SUB1 GREATER THAN 72                                      DCCBL010
00948          GO TO END-FIELD-SEARCH.                                  DCCBL010
00949      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCCBL010
00950          GO TO END-FIELD-SEARCH.                                  DCCBL010
00951      GO TO MOVE-FIELD.                                            DCCBL010
00952 *                                                                 DCCBL010
00953 *    FOUND A FIELD TO RIGHT OF = SIGN IN OPTION QUERY             DCCBL010
00954 *                                                                 DCCBL010
00955  EXTRACT-SECOND.                                                  DCCBL010
00956      MOVE SPACES TO WORK-32.                                      DCCBL010
00957      MOVE SPACES TO WORK-15.                                      DCCBL010
00958      MOVE ZERO TO SUB2.                                           DCCBL010
00959      MOVE "N" TO HAVE-SW.                                         DCCBL010
00960      MOVE "N" TO EDIT-SW.                                         DCCBL010
00961  START-SECOND.                                                    DCCBL010
00962      ADD 1 TO SUB1.                                               DCCBL010
00963      IF SUB1 GREATER THAN 72                                      DCCBL010
00964          GO TO END-FIELD-SEARCH.                                  DCCBL010
00965      IF WORK-VALUE (SUB1) EQUAL TO QUOTES                         DCCBL010
00966          GO TO QUOTE-FIELD.                                       DCCBL010
00967      IF WORK-VALUE (SUB1) EQUAL TO LITERAL-15                     DCCBL010
00968          GO TO END-FIELD-SEARCH.                                  DCCBL010
00969      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCCBL010
00970          GO TO START-SECOND.                                      DCCBL010
00971 *                                                                 DCCBL010
00972 *    MOVE SECOND FIELD TO WORK-15                                 DCCBL010
00973 *                                                                 DCCBL010
00974  MOVE-SECOND.                                                     DCCBL010
00975      ADD 1 TO SUB2.                                               DCCBL010
00976      IF WORK-30 EQUAL TO LITERAL-39                                  CL**2
00977          GO TO MOVE-32LENGTH.                                     DCCBL010
00978      IF SUB2 GREATER THAN 15                                      DCCBL010
00979          GO TO END-FIELD-SEARCH.                                  DCCBL010
00980      MOVE WORK-VALUE (SUB1) TO WORK-15-A (SUB2).                  DCCBL010
00981      GO TO CHECK-FOR-COMMA.                                       DCCBL010
00982  MOVE-32LENGTH.                                                   DCCBL010
00983      IF SUB2 GREATER THAN 32                                      DCCBL010
00984          GO TO END-FIELD-SEARCH.                                  DCCBL010
00985      MOVE WORK-VALUE (SUB1) TO WORK-32-A (SUB2).                  DCCBL010
00986  CHECK-FOR-COMMA.                                                 DCCBL010
00987      ADD 1 TO SUB1.                                               DCCBL010
00988      IF SUB1 GREATER THAN 72                                      DCCBL010
00989          MOVE "Y" TO EDIT-SW                                      DCCBL010
00990          GO TO END-SECOND-SEARCH.                                 DCCBL010
00991      IF WORK-VALUE (SUB1) EQUAL TO LITERAL-15                     DCCBL010
00992          GO TO END-SECOND-SEARCH.                                 DCCBL010
00993      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCCBL010
00994          MOVE "Y" TO EDIT-SW                                      DCCBL010
00995          GO TO END-SECOND-SEARCH.                                 DCCBL010
00996      GO TO MOVE-SECOND.                                           DCCBL010
00997 *                                                                 DCCBL010
00998 *    EXTRACT A FIELD IN QUOTES                                    DCCBL010
00999 *                                                                 DCCBL010
01000  QUOTE-FIELD.                                                     DCCBL010
01001      ADD 1 TO SUB1.                                               DCCBL010
01002      IF SUB1 GREATER THAN 72                                      DCCBL010
01003          GO TO END-FIELD-SEARCH.                                  DCCBL010
01004      IF WORK-VALUE (SUB1) EQUAL TO QUOTES                         DCCBL010
01005          GO TO CHECK-FOR-COMMA.                                   DCCBL010
01006      ADD 1 TO SUB2.                                               DCCBL010
01007      MOVE WORK-VALUE (SUB1) TO WORK-15-A (SUB2).                  DCCBL010
01008      GO TO QUOTE-FIELD.                                           DCCBL010
01009  END-SECOND-SEARCH.                                               DCCBL010
01010      MOVE "Y" TO HAVE-SW.                                         DCCBL010
01011  END-FIELD-SEARCH.                                                DCCBL010
01012      MOVE "Y" TO EXTRACT-SWITCH.                                  DCCBL010
01013  EXTRACT-FIELD-XIT.                                               DCCBL010
01014      EXIT.                                                        DCCBL010
01016 *                                                                 DCCBL010
01017 *    PROCESS ERROR MESSAGES                                       DCCBL010
01018 *                                                                 DCCBL010
01019  BAD-ERROR.                                                       DCCBL010
01020      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
01021      GO TO PROCESS-ERRORS.                                        DCCBL010
01022  BAD-ERROR-Y.                                                     DCCBL010
01023      MOVE "Y" TO ERROR-CHECK.                                     DCCBL010
01024      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
01025  BAD-ERROR-CONT.                                                  DCCBL010
01026      MOVE "14" TO ERROR-CODE.                                     DCCBL010
01027      PERFORM ERROR-RTN THRU ERROR-RTN-XIT.                        DCCBL010
01028      GO TO PROCESS-ERRORS.                                        DCCBL010
01029  ERROR-RTN.                                                       DCCBL010
01030      ADD 1 TO ERROR-COUNT.                                        DCCBL010
01031      IF ERROR-COUNT GREATER THAN 20                               DCCBL010
01032          GO TO ERROR-RTN-XIT.                                     DCCBL010
01033      MOVE ERROR-CODE TO ERROR-BUILD (ERROR-COUNT).                DCCBL010
01034      IF ROUTINE-SW EQUAL TO "A"                                   DCCBL010
01035          GO TO PROCESS-ERRORS.                                    DCCBL010
01036  ERROR-RTN-XIT.                                                   DCCBL010
01037      EXIT.                                                        DCCBL010
01039  PROCESS-ERRORS.                                                  DCCBL010
01040      OPEN OUTPUT SYSPRINT.                                        DCCBL010
01041 *                                                                 DCCBL010
01042 *    PRINT ERROR MESSAGES                                         DCCBL010
01043 *                                                                 DCCBL010
01044      MOVE "01" TO SUB2.                                           DCCBL010
01045  PRINT-ERROR-LOOP.                                                DCCBL010
01046      MOVE SPACES TO PRINT-LINE.                                   DCCBL010
01047      MOVE SPACES TO STD-REPORT-REC.                               DCCBL010
01048      MOVE ERROR-BUILD (SUB2) TO SUB4.                             DCCBL010
01049      MOVE ERROR-NUMBER (SUB4) TO PRINT-MESSAGE-NUMBER.            DCCBL010
01050      MOVE LITERAL-22 TO PRINT-ERROR-LITERAL.                      DCCBL010
01051      MOVE ERROR-MESSAGE (SUB4) TO PRINT-ERROR-MESSAGE.            DCCBL010
01052      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCCBL010
01053      IF ROUTINE-SW EQUAL TO "A"                                   DCCBL010
01054          MOVE SPACES TO ROUTINE-SW                                DCCBL010
01055          CLOSE SYSPRINT                                           DCCBL010
01056          GO TO MOVE-YES.                                          DCCBL010
01057      ADD 1 TO SUB2.                                               DCCBL010
01058      IF SUB2 NOT GREATER THAN ERROR-COUNT                         DCCBL010
01059          GO TO PRINT-ERROR-LOOP.                                  DCCBL010
01060      CLOSE SYSPRINT.                                              DCCBL010
01061      GO TO EDIT-END.                                              DCCBL010
01063 ******************************************************************DCCBL010
01064 *                                                                 DCCBL010
01065 *    SET GENERATION TABLE VALUES TO THEIR DEFAULT CODES           DCCBL010
01066 *                                                                 DCCBL010
01067 ******************************************************************DCCBL010
01068  DEFAULT-CODE.                                                    DCCBL010
01069      MOVE "Y" TO GTBL-OPT-LIST.                                   DCCBL010
01070      MOVE "Y" TO GTBL-OPT-PUNCH.                                  DCCBL010
01071      MOVE SPACES TO GTBL-OPT-IDEN.                                DCCBL010
01072      MOVE ZEROES TO GTBL-OPT-STARTSEQNO.                          DCCBL010
01073      MOVE ZEROS TO INCREMENT-HOLD.                                DCCBL010
01074      MOVE "000010" TO GTBL-OPT-INCSEQNO.                          DCCBL010
01079      MOVE SPACES TO GTBL-OPT-NEWNAME.                             DCCBL010
01081      MOVE SPACES TO GTBL-OPT-PREFIX1.                             DCCBL010
01082      MOVE SPACES TO GTBL-OPT-PREFIX2.                             DCCBL010
01083      MOVE SPACES TO GTBL-OPT-SUFFIX1.                             DCCBL010
01084      MOVE SPACES TO GTBL-OPT-SUFFIX2.                             DCCBL010
01085      MOVE SPACES TO GTBL-OPT-SEQCOL.                              DCCBL010
01086      MOVE SPACES TO GTBL-OPT-FDNAME.                              DCCBL010
01087      MOVE "Y" TO GTBL-OPT-PREFIX88.                               DCCBL010
01089      MOVE "01" TO GTBL-OPT-LEVEL.                                 DCCBL010
01090      MOVE "02" TO GTBL-OPT-INCLEV.                                DCCBL010
01092      MOVE "Y" TO GTBL-OPT-COMMENT.                                DCCBL010
01093      MOVE "Y" TO GTBL-OPT-88.                                     DCCBL010
01094      MOVE "N" TO GTBL-OPT-QUOTE.                                  DCCBL010
01095      MOVE ZEROES TO GTBL-OPT-NOTESFROM.                           DCCBL010
01096      MOVE ZEROES TO GTBL-OPT-NOTESTO.                             DCCBL010
01097      MOVE ZEROES TO GTBL-OPT-NOTESFOR.                            DCCBL010
           MOVE "N" TO GTBL-SEL-ALL.
           MOVE "N" TO GTBL-SEL-MD. 
           MOVE "Y" TO LOG-OPT. 
           MOVE "N" TO LOG-OUT. 
01100  DEFAULT-CODE-XIT.                                                DCCBL010
01101      EXIT.                                                        DCCBL010
01103 *                                                                 DCCBL010
01104 *    OPTIONS TAKEN FROM OPTION QUERY HAVING A CODE OF YES OR NO   DCCBL010
01105 *                                                                 DCCBL010
01106  YES-NO.                                                          DCCBL010
01107      IF WORK-15 EQUAL TO "Y" OR "YES"                             DCCBL010
01108          GO TO YES-NO-XIT.                                        DCCBL010
01109      IF WORK-15 EQUAL TO "N" OR "NO"                              DCCBL010
01110          MOVE "N" TO HAVE-SW                                      DCCBL010
01111          GO TO YES-NO-XIT.                                        DCCBL010
01112      MOVE WORK-15 TO IMS-RECORD-A.                                DCCBL010
01113      MOVE WORK-30 TO IMS-RECORD-B.                                DCCBL010
01114      MOVE "19" TO ERROR-CODE.                                     DCCBL010
01115      MOVE "A" TO ROUTINE-SW.                                      DCCBL010
01116      GO TO ERROR-RTN.                                             DCCBL010
01117  YES-NO-XIT.                                                      DCCBL010
01118      EXIT.                                                        DCCBL010
01119  MOVE-NUMERIC.                                                    DCCBL010
01120 *                                                                 DCCBL010
01121 *    TEST FOR AND RIGHT JUSTIFY A NUMERIC FIELD                   DCCBL010
01122 *                                                                 DCCBL010
01123      MOVE ZEROS TO WORK-6.                                        DCCBL010
01124      MOVE 1 TO SUB2.                                              DCCBL010
01125      IF WORK-15-A (SUB2) NUMERIC GO TO TEST-LENGTH.               DCCBL010
01126      MOVE SPACES TO WORK-6.                                       DCCBL010
01127      GO TO MOVE-NUMERIC-XIT.                                      DCCBL010
01128  TEST-LENGTH.                                                     DCCBL010
01129      ADD 1 TO SUB2.                                               DCCBL010
01130      IF SUB2 GREATER THAN 7                                       DCCBL010
01131          MOVE WORK-30 TO NUM-RECORD                               DCCBL010
01132          MOVE "A" TO ROUTINE-SW                                   DCCBL010
01133          MOVE "20" TO ERROR-CODE                                  DCCBL010
01134          GO TO BAD-ERROR.                                         DCCBL010
01135      IF WORK-15-A (SUB2) EQUAL TO SPACES                          DCCBL010
01136          MOVE 7 TO SUB4                                           DCCBL010
01137          GO TO EXTRACT-NUMERIC.                                   DCCBL010
01138      GO TO TEST-LENGTH.                                           DCCBL010
01139  EXTRACT-NUMERIC.                                                 DCCBL010
01140      SUBTRACT 1 FROM SUB4.                                        DCCBL010
01141      SUBTRACT 1 FROM SUB2.                                        DCCBL010
01142      IF SUB2 EQUAL TO ZERO                                        DCCBL010
01143          GO TO MOVE-NUMERIC-XIT.                                  DCCBL010
01144      MOVE WORK-15-A (SUB2) TO WORK-6A (SUB4).                     DCCBL010
01145      GO TO EXTRACT-NUMERIC.                                       DCCBL010
01146  MOVE-NUMERIC-XIT.                                                DCCBL010
01147      EXIT.                                                        DCCBL010
       USER-ROUTINE.
           GO TO USER-ROUTINE-XIT.
       USER-ROUTINE-XIT.
*CALL     DISPLAYLN                                                     DCCBL010
*CALL     WRITELN                                                       DCCBL010
01150 *                                                                 DCCBL010
01151 *    REL FILES FROM WHICH NAMED TYPE WILL BE VALIDATED            DCCBL010
01152 *                                                                 DCCBL010
*CALL     RELALG                                                        DCCBL010
*CALL     RELCOM                                                        DCCBL010
