*DECK     DCCONEDT
00001  IDENTIFICATION DIVISION.                                         09/13/78
       PROGRAM-ID. CONEDT.
*CALL COPYRIGHT 
      * THIS MODULE READS AND EDITS CONVERSION CONTROL CARDS
      * BUILD CONVERSION TABLES 
      * PRINTS CONVERSION CONTROL CARDS AND THEIR ERRORS
00010  ENVIRONMENT DIVISION.                                            DCCONEDT
00011  CONFIGURATION SECTION.                                           DCCONEDT
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
       SPECIAL-NAMES. 
           SWITCH-2 IS SW2
           SWITCH-3 IS SW3
           SWITCH-4 IS SW4. 
00014  INPUT-OUTPUT SECTION.                                            DCCONEDT
00015  FILE-CONTROL.                                                    DCCONEDT
*CALL     MAST3SS1                                                         CL**2
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
           SELECT CTL-CARD ASSIGN TO "INPUT". 
00019  DATA DIVISION.                                                   DCCONEDT
00020  FILE SECTION.                                                    DCCONEDT
*CALL     MAST3FD                                                       DCCONEDT
*CALL     SYSPRTFD                                                      DCCONEDT
00023  FD  CTL-CARD                                                     DCCONEDT
00025      LABEL RECORDS ARE OMITTED                                    DCCONEDT
00028      DATA RECORDS ARE CONV-REC.                                   DCCONEDT
00029  01  CONV-REC.                                                    DCCONEDT
00030      03  FILLER                  PICTURE X(6).                       CL**2
00031      03  CVT-COMMENT             PICTURE X.                          CL**2
00032      03  FILLER                       PICTURE X(73).                 CL**2
       COMMON-STORAGE SECTION.
       77  RETURN-CODE                 PICTURE XX.
*CALL     CVTBL                                                         DCCONEDT
00167  01  PRINT-CTL-TBL.                                                  CL**2
*CALL     WKPRINT                                                          CL**2
       01  WRKF-FUNCTION-CODE              PICTURE X. 
*CALL WRKFHDR 
00033                                                                    DCCONED
*CALL     WRKSTG77                                                      DCCONEDT
*CALL     MAST3DD1                                                      DCCONEDT
00036 ***************************************************************** DCCONEDT
00037 *     WORK AREA USED FOR EXTRACTING A FIELD                       DCCONEDT
00038 ****************************************************************  DCCONEDT
00039  01  EXTRACT-WORKAREA.                                            DCCONEDT
00040      03  HOLD-VALUE.                                              DCCONEDT
00041          05  WORK-VALUE          PICTURE X OCCURS 80 TIMES.       DCCONEDT
00042      03  WORK-30.                                                 DCCONEDT
00043          05  WORK-30-A           PICTURE X OCCURS 80 TIMES.       DCCONEDT
00044      03  SUB1                    PICTURE 99 COMP.                 DCCONEDT
00045      03  SUB2                    PICTURE 99 COMP.                 DCCONEDT
00046      03  SUB3                    PICTURE 9.                       DCCONEDT
00047      03  EXTRACT-SWITCH          PICTURE X.                       DCCONEDT
00048      03  QUOTE-FOUND             PICTURE X VALUE SPACES.          DCCONEDT
00049      03  COMMA-FOUND             PICTURE X VALUE SPACES.          DCCONEDT
00050      03  LINE-ERR-SW             PICTURE X.                       DCCONEDT
00051      03  LEVEL-ERR-SW            PICTURE X.                          CL**2
00052      03  MOD-READ                PICTURE 999 VALUE ZERO.          DCCONEDT
00053      03  SEL-READ                PICTURE 999 VALUE ZERO.          DCCONEDT
00054      03  MOD-BYPASS              PICTURE 999 VALUE ZERO.             CL**2
00055      03  SEL-BYPASS              PICTURE 999 VALUE ZERO.             CL**2
00056      03  CONT-COUNT              PICTURE 9.                          CL**2
00057      03  CK-LINE-NO              PICTURE X(4).                    DCCONEDT
00058      03  CK-LINE REDEFINES CK-LINE-NO.                            DCCONEDT
00059          05  LINE-NO             PICTURE X OCCURS 4 TIMES.        DCCONEDT
00060      03  CK-LEVEL                PICTURE XX.                      DCCONEDT
00061      03  CK-LEVEL-NO REDEFINES CK-LEVEL.                             CL**2
00062          05  CK-LEV              PICTURE X OCCURS 2 TIMES.           CL**2
00063      03  SAVE-CREATE-OPTIONS.                                        CL**2
00064          05  MOD-OPTION          PICTURE X.                          CL**2
00065          05  SEL-OPTION          PICTURE X(6).                       CL**2
00066                                                                    DCCONED
00067 ***************************************************************** DCCONEDT
00068 *                                                                 DCCONEDT
00069 *     ERROR MESSAGES                                              DCCONEDT
00070 *                                                                 DCCONEDT
00071 ***************************************************************** DCCONEDT
00072  01  ERROR-TABLE.                                                 DCCONEDT
00073      03  ERROR-HOLD.                                              DCCONEDT
00074          05  MSSG-1              PICTURE X(55) VALUE              DCCONEDT
00075         "  DCCVT-400-S ERROR * NO COMMANDS SPECIFIED            ".   CL**2
00076          05  MSSG-2              PICTURE X(55) VALUE              DCCONEDT
00077         "  DCCVT-405-S ERROR * ILLEGAL BLANK CARD               ".DCCONEDT
00078          05  MSSG-3              PICTURE X(55) VALUE              DCCONEDT
00079         "  DCCVT-410-S ERROR * CARD OUT OF SEQUENCE             ".DCCONEDT
00080          05  MSSG-4              PICTURE X(55) VALUE              DCCONEDT
00081         "  DCCVT-415-S ERROR * INCOMPLETE $CONVERT CARD         ".DCCONEDT
00082          05  MSSG-5.                                              DCCONEDT
00083              07  FILLER          PICTURE X(22) VALUE              DCCONEDT
00084             "  DCCVT-420-S ERROR * ".                             DCCONEDT
00085              07  LANG-ERROR      PICTURE X(6).                    DCCONEDT
00086              07  FILLER          PICTURE X(27) VALUE              DCCONEDT
00087             "IS AN INVALID LANGUAGE NAME".                        DCCONEDT
00088          05  MSSG-6              PICTURE X(55) VALUE              DCCONEDT
00089         "  DCCVT-425-S ERROR * NO PROGRAM NAME FOR MODULE CARD  ".DCCONEDT
00090          05  MSSG-7              PICTURE X(55) VALUE              DCCONEDT
00091         "  DCCVT-430-S ERROR * SELECT CARD INCOMPLETE/INCORRECT ".DCCONEDT
00092          05  MSSG-8              PICTURE X(55) VALUE              DCCONEDT
00093         "  DCCVT-435-S ERROR * PROGRAM TABLE EXCEEDS LIMIT      ".DCCONEDT
00094          05  MSSG-9              PICTURE X(55) VALUE              DCCONEDT
00095         "  DCCVT-440-S ERROR * SELECT TABLE EXCEEDS LIMIT       ".DCCONEDT
00096          05  MSSG-10             PICTURE X(55) VALUE              DCCONEDT
00097         "  DCCVT-445-S ERROR * MODULE CARD INCOMPLETE/INCORRECT ".DCCONEDT
00098          05  MSSG-11             PICTURE X(55) VALUE              DCCONEDT
00099         "  DCCVT-450-S ERROR * NO DATANAME FOR SELECT CARD      ".DCCONEDT
00100          05  MSSG-12             PICTURE X(55) VALUE              DCCONEDT
00101         " DCCVT-455-S ERROR * RENAMES TABLE EXCEEDS LIMIT       ".DCCONEDT
00102          05  MSSG-13             PICTURE X(55) VALUE              DCCONEDT
00103         "  DCCVT-460-S ERROR * ILLEGAL LEVEL NUMBER             ".DCCONEDT
00104          05  MSSG-14             PICTURE X(55) VALUE              DCCONEDT
00105         "  DCCVT-465-S ERROR * INPUT IGNORED UNTIL NEXT FUNCTION".DCCONEDT
00106          05  MSSG-15             PICTURE X(55) VALUE              DCCONEDT
00107         "  DCCVT-470-S ERROR * TOO MANY CONTINUATION STATEMENTS ".   CL**2
00108          05  MSSG-16             PICTURE X(55) VALUE              DCCONEDT
00109         "  DCCVT-475-S ERROR * RENAME CARD INCOMPLETE/INCORRECT ".DCCONEDT
00110          05  MSSG-17             PICTURE X(55) VALUE              DCCONEDT
00111         "  DCCVT-480-S ERROR * ILLEGAL LINE NUMBER              ".DCCONEDT
00112          05  MSSG-18             PICTURE X(55) VALUE              DCCONEDT
00113         "  DCCVT-485-S ERROR * CREATE CARD INCOMPLETE/INCORRECT ".DCCONEDT
00114          05  MSSG-19             PICTURE X(55) VALUE              DCCONEDT
00115         "  DCCVT-950-F ERROR * MAST3 READ CLIENT RECORD         ".DCCONEDT
               05  MSSG-20             PICTURE X(55) VALUE
              "  DCCVT-505-S ERROR * INCLUDE CARD INCOMPLETE/INCORRECT".
00116      03  ERROR-PRINT REDEFINES ERROR-HOLD.                        DCCONEDT
               05  ERROR-MSSG          PICTURE X(55) OCCURS 20 TIMES. 
00118      03  ERROR-CODE              PICTURE 99.                         CL**2
00119                                                                    DCCONED
00120 ***************************************************************   DCCONEDT
00121 *                                                                 DCCONEDT
00122 *     HEADING LITERALS                                            DCCONEDT
00123 *                                                                 DCCONEDT
00124 ***************************************************************** DCCONEDT
00125      03  LITERAL-1               PICTURE X(24) VALUE              DCCONEDT
00126         "REPORT DATE-".                                           DCCONEDT
00127      03  LITERAL-2               PICTURE X(24) VALUE              DCCONEDT
00128         "DATE OF LAST REVISION-".                                 DCCONEDT
00129      03  LITERAL-3               PICTURE X(5) VALUE               DCCONEDT
00130         "PAGE".                                                   DCCONEDT
00131      03  LITERAL-4               PICTURE X(31) VALUE              DCCONEDT
00132         "D A T A   C A T A L O G U E   2".                        DCCONEDT
00133      03  LITERAL-5               PICTURE X(25) VALUE              DCCONEDT
00134         "REVISION NUMBER-".                                       DCCONEDT
00135      03  PROP-MSG.                                                DCCONEDT
00136          05  FILLER              PICTURE X(44) VALUE              DCCONEDT
               "DATA CATALOGUE 2                        V2.0".
00138          05  FILLER              PICTURE X(30) VALUE                 CL**2
*CALL LEVEL 
00140      03  CONV-TITLE-1            PICTURE X(50) VALUE              DCCONEDT
00141     "  C O N V E R S I O N   E D I T   R E P O R T   ".           DCCONEDT
00142      03  CONV-TITLE-2            PICTURE X(42) VALUE              DCCONEDT
00143     "       *CONVERSION CONTROL CARDS*        ".                     CL**2
00144      03  ACCEPT-LINE.                                                CL**2
00145          05  FILLER              PICTURE X(5) VALUE SPACES.          CL**2
00146          05  NO-ACCEPT           PICTURE ZZ9.                        CL**2
00147          05  FILLER              PICTURE XX VALUE SPACES.            CL**2
00148          05  TYPE-ACCEPT         PICTURE X(7).                       CL**2
00149          05  FILLER              PICTURE X(24) VALUE                 CL**2
00150         " ACCEPTED FOR CONVERSION".                                  CL**2
00151      03  REJECT-LINE.                                                CL**2
00152          05  FILLER              PICTURE X(5) VALUE SPACES.          CL**2
00153          05  NO-REJECT           PICTURE ZZ9.                        CL**2
00154          05  FILLER              PICTURE XX VALUE SPACES.            CL**2
00155          05  TYPE-REJECT         PICTURE X(7).                       CL**2
00156          05  FILLER              PICTURE X(9) VALUE                  CL**2
00157         " REJECTED".                                                 CL**2
00158      03  TOT-READ-LINE.                                              CL**2
00159          05  FILLER              PICTURE X(5) VALUE SPACES.          CL**2
00160          05  NO-READ             PICTURE ZZ9.                        CL**2
00161          05  FILLER              PICTURE XX VALUE SPACES.            CL**2
00162          05  TYPE-READ           PICTURE X(7).                       CL**2
00163          05  FILLER              PICTURE X(5) VALUE                  CL**2
00164         " READ".                                                     CL**2
*CALL CURDATE 
00169  PROCEDURE DIVISION.                                              DCCONEDT
00172 ***************************************************************** DCCONEDT
00173 *                                                                 DCCONEDT
00174 *     INITIALIZATION                                              DCCONEDT
00175 *                                                                 DCCONEDT
00176 ****************************************************************  DCCONEDT
00177  0000-BEGIN.                                                      DCCONEDT
00178      OPEN INPUT MAST3.                                            DCCONEDT
00179      OPEN INPUT CTL-CARD.                                         DCCONEDT
00180      OPEN OUTPUT SYSPRINT.                                        DCCONEDT
00181 ****************************************************************  DCCONEDT
00182 *     RETRIEVE HEADING DATA FROM CONTROL FILE                     DCCONEDT
00183 ****************************************************************  DCCONEDT
00184      MOVE "1" TO CON-ENTRY-FUNCTION.                              DCCONEDT
00185      PERFORM CON-READ THRU CON-READ-XIT.                          DCCONEDT
00186      IF CON-RETURN-CODE EQUAL "9"                                 DCCONEDT
00187          GO TO 8090-MAST3-READ-ERROR.                             DCCONEDT
00188      MOVE CTL-DATE-UPD TO DATE-LAST-REVISION                         CL**2
00189          SAVE-CTL-DATE-UPD.                                          CL**2
00190      MOVE CTL-REV-NUM TO REVISION-NUMBER SAVE-CTL-REV-NUM.           CL**2
00191      MOVE SPACES TO EOP-MSG.                                      DCCONEDT
00192      MOVE CTL-LINES TO MAX-LINES SAVE-CTL-LINES.                     CL**2
00193      SUBTRACT 1 FROM MAX-LINES.                                   DCCONEDT
00194      MOVE CTL-LINES TO LINE-CT.                                   DCCONEDT
00195      MOVE CTL-NAME TO CON-USER SAVE-CTL-NAME.                        CL**2
00196      MOVE PROP-MSG TO CON-TITLE.                                  DCCONEDT
00197      CLOSE MAST3.                                                 DCCONEDT
00198 ***************************************************************** DCCONEDT
00199 *     INITIALIZE OTHER PRINT CONTROL TABLE FIELDS                 DCCONEDT
00200 ***************************************************************** DCCONEDT
00201  0100-INIT-MISC.                                                  DCCONEDT
*CALL ACCEPTDT
           MOVE ZERO TO RETURN-CODE.
00202      MOVE CURRENT-DATE TO PRT-CURRENT-DATE.                       DCCONEDT
00203      MOVE ZERO TO PAGE-NO.                                           CL**2
00204      MOVE SPACES TO USER-TITLE.                                   DCCONEDT
00205      MOVE SPACES TO STD-REPORT-REC.                               DCCONEDT
00206      MOVE ZERO TO PRT-CTL.                                        DCCONEDT
00207      MOVE "N" TO 8BY11-FLAG.                                      DCCONEDT
00208      MOVE ZERO TO HOF-IND.                                        DCCONEDT
00209      MOVE 1 TO SPACE-1.                                           DCCONEDT
00210      MOVE LITERAL-1 TO PRT-DATE1-HCON.                            DCCONEDT
00211      MOVE LITERAL-2 TO PRT-DATE2-HCON.                            DCCONEDT
00212      MOVE LITERAL-3 TO PRT-PAGE-HCON.                             DCCONEDT
00213      MOVE LITERAL-4 TO CON-DC.                                    DCCONEDT
00214      MOVE LITERAL-5 TO PRT-REV-NO-HCON.                           DCCONEDT
00215      MOVE CONV-TITLE-1 TO REPORT-TITLE-LONG.                      DCCONEDT
00216                                                                    DCCONED
00217 ****************************************************************  DCCONEDT
00218 *                                                                 DCCONEDT
00219 *     INITIALIZE CONVERSION REQUEST TABLES AND SUBSCRIPTS         DCCONEDT
00220 *                                                                 DCCONEDT
00221 ***************************************************************** DCCONEDT
00222  0200-INIT-TABLE.                                                 DCCONEDT
00223      PERFORM CLEAR-TABLES THRU CLEAR-TABLES-XIT.                     CL**2
00224      MOVE ZERO TO PROG-SUB.                                       DCCONEDT
00225      MOVE ZERO TO SEL-SUB.                                        DCCONEDT
00226      MOVE ZERO TO RN-SUB.                                         DCCONEDT
00227      MOVE ZERO TO MOD-BYPASS.                                        CL**2
00228      MOVE ZERO TO SEL-BYPASS.                                        CL**2
00229      MOVE ZERO TO MOD-READ.                                          CL**2
00230      MOVE ZERO TO SEL-READ.                                          CL**2
00231      MOVE ZERO TO CONT-COUNT.                                        CL**2
           MOVE ZERO TO STRUCT-COUNT. 
00232 ****************************************************************  DCCONEDT
00233 *     READ - EDIT AND PRINT $CONVERT CARD INFORMATION             DCCONEDT
00234 ***************************************************************** DCCONEDT
00235      MOVE 99 TO LINE-CT.                                          DCCONEDT
00236      MOVE 1 TO PRT-CTL.                                           DCCONEDT
00237      MOVE SPACES TO STD-REPORT-REC.                               DCCONEDT
00238      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCCONEDT
00239      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00240  0300-READ-FIRST.                                                    CL**2
00241      READ CTL-CARD AT END                                            CL**2
00242          GO TO 8080-NO-INPUT.                                        CL**2
00243      MOVE CONV-REC TO STD-REPORT-REC.                             DCCONEDT
00244      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCCONEDT
00245 *                                                                 DCCONEDT
00246 *     CHECK FOR COMMENT CARD                                      DCCONEDT
00247 *                                                                 DCCONEDT
00248      IF CVT-COMMENT EQUAL "*"                                     DCCONEDT
00249          GO TO 0300-READ-FIRST.                                   DCCONEDT
00250      MOVE CONV-REC TO HOLD-VALUE.                                 DCCONEDT
00251      MOVE ZERO TO SUB1.                                           DCCONEDT
00252      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00253      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00254          MOVE "02" TO ERROR-CODE                                  DCCONEDT
00255          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT              CL**2
00256          GO TO CLOSE-FILES.                                          CL**2
00257  1000-CONVERT-CARD.                                               DCCONEDT
00258      IF WORK-30 NOT EQUAL "$CONVERT"                              DCCONEDT
00259          MOVE "03" TO ERROR-CODE                                  DCCONEDT
00260          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00261          GO TO CLOSE-FILES.                                          CL**2
00262      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00263      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00264          MOVE "04" TO ERROR-CODE                                  DCCONEDT
00265          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00266          GO TO CLOSE-FILES.                                          CL**2
00267 ***************************************************************** DCCONEDT
00268 *                                                                 DCCONEDT
00269 *     SET UP LANGUAGE CODE                                        DCCONEDT
00270 *                                                                 DCCONEDT
00271 ***************************************************************** DCCONEDT
00272      IF WORK-30 EQUAL "COBOL"                                     DCCONEDT
00273          MOVE "C" TO LANG-CODE                                    DCCONEDT
00274          GO TO 2000-MODULE-CARD.                                     CL**2
00275      IF WORK-30 EQUAL "BAL"                                       DCCONEDT
00276          MOVE "B" TO LANG-CODE                                    DCCONEDT
00277          GO TO 2000-MODULE-CARD.                                  DCCONEDT
00278      IF WORK-30 EQUAL "PSB"                                       DCCONEDT
00279          MOVE "P" TO LANG-CODE                                    DCCONEDT
00280          GO TO 1500-SKIP-MODULE.                                  DCCONEDT
00281      IF WORK-30 EQUAL "DBD"                                       DCCONEDT
00282          MOVE "D" TO LANG-CODE                                    DCCONEDT
00283          GO TO 1500-SKIP-MODULE.                                  DCCONEDT
00284      IF WORK-30 EQUAL "DBDL"                                      DCCONEDT
00285          MOVE "T" TO LANG-CODE                                    DCCONEDT
00286          GO TO 1500-SKIP-MODULE.                                  DCCONEDT
           IF WORK-30 EQUAL "CDCS"
               MOVE SPACE TO INCLUDE-NOTES
               MOVE "S" TO LANG-CODE
               MOVE "9" TO CVTBL-MOD-REQUEST
               GO TO 1200-CDCS-STATEMENT. 
00287 *                                                                 DCCONEDT
00288 *     INVALID LANGUAGE CODE                                       DCCONEDT
00289 *                                                                 DCCONEDT
00290      MOVE WORK-30 TO LANG-ERROR.                                  DCCONEDT
00291      MOVE "05" TO ERROR-CODE.                                     DCCONEDT
00292      PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT.              DCCONEDT
00293      GO TO CLOSE-FILES.                                              CL**2
      ******************************************************************
      * 
      *        NEXT STATEMENT MUST BE INCLUDE NOTES 
      * 
      ******************************************************************
       1200-CDCS-STATEMENT. 
           PERFORM READ-CARD THRU READ-CARD-XIT.
           IF WORK-30 NOT EQUAL "INCLUDE" 
               MOVE "03" TO ERROR-CODE
               PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT 
               GO TO 8000-BYPASS. 
      ******************************************************************
      * 
      *        EDIT AND TABLE INCLUDE NOTES 
      * 
      ******************************************************************
       1300-INCLUDE-NOTES.
           PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.
           IF EXTRACT-SWITCH EQUAL "Y"
               MOVE "20" TO ERROR-CODE
               PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT 
               GO TO 8000-BYPASS. 
           IF WORK-30 NOT EQUAL "NOTES" 
               MOVE "20" TO ERROR-CODE
               PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT 
               GO TO 8000-BYPASS. 
           MOVE "Y" TO INCLUDE-NOTES. 
           GO TO 1200-CDCS-STATEMENT. 
00294  1500-SKIP-MODULE.                                                DCCONEDT
00295      PERFORM READ-CARD THRU READ-CARD-XIT.                        DCCONEDT
00296      GO TO 3000-SELECT-CARD.                                      DCCONEDT
00297                                                                    DCCONED
00298 ****************************************************************  DCCONEDT
00299 *                                                                 DCCONEDT
00300 *     READ - EDIT AND PRINT MODULE CARD INFORMATION               DCCONEDT
00301 *                                                                 DCCONEDT
00302 ***************************************************************** DCCONEDT
00303  2000-MODULE-CARD.                                                DCCONEDT
00304      PERFORM READ-CARD THRU READ-CARD-XIT.                        DCCONEDT
00305      IF WORK-30 NOT EQUAL "MODULE"                                DCCONEDT
00306          MOVE "03" TO ERROR-CODE                                  DCCONEDT
00307          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00308          GO TO 8000-BYPASS.                                       DCCONEDT
00309  2020-MOD-DATANAME.                                               DCCONEDT
00310      ADD 1 TO MOD-READ.                                           DCCONEDT
00311      ADD 1 TO PROG-SUB.                                              CL**2
00312      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00313      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00314          MOVE "06" TO ERROR-CODE                                  DCCONEDT
00315          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00316          GO TO 8000-BYPASS.                                       DCCONEDT
00317      MOVE SPACE TO QUOTE-FOUND.                                   DCCONEDT
00318 ***************************************************************   DCCONEDT
00319 *     TABLE PROGRAM NAME                                          DCCONEDT
00320 ***************************************************************** DCCONEDT
00321      IF PROG-SUB GREATER THAN 100                                 DCCONEDT
00322          MOVE "08" TO ERROR-CODE                                  DCCONEDT
00323          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00324          SUBTRACT 1 FROM PROG-SUB                                 DCCONEDT
00325          GO TO 9000-EDIT-END.                                     DCCONEDT
00326      MOVE WORK-30 TO CVT-PROG-NAME (PROG-SUB).                    DCCONEDT
00327 *                                                                 DCCONEDT
00328 *     CHECK FOR CONTINUATION CARD                                 DCCONEDT
00329 *                                                                 DCCONEDT
00330      IF COMMA-FOUND EQUAL ","                                     DCCONEDT
00331          MOVE SPACE TO COMMA-FOUND                                DCCONEDT
00332          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00333          GO TO 2050-CK-MOD-OPTIONS.                               DCCONEDT
00334      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00335      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00336          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00337          GO TO 3000-SELECT-CARD.                                  DCCONEDT
00338 *                                                                 DCCONEDT
00339 *     EXTRACT ALL OPTIONS FOR MODULE CARD                         DCCONEDT
00340 *                                                                 DCCONEDT
00341  2050-CK-MOD-OPTIONS.                                             DCCONEDT
00342      IF WORK-30 NOT EQUAL "INCLUDE"                               DCCONEDT
00343          GO TO 2070-CK-CATNAME.                                   DCCONEDT
00344      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00345      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00346          GO TO 2090-MOD-OPT-ERROR.                                DCCONEDT
00347      IF WORK-30 NOT EQUAL "NOTES"                                 DCCONEDT
00348          GO TO 2090-MOD-OPT-ERROR.                                DCCONEDT
00349 ***************************************************************** DCCONEDT
00350 *     TABLE NOTES OPTION                                          DCCONEDT
00351 ******************************************************************DCCONEDT
00352      MOVE "Y" TO CVT-NOTES-OPT (PROG-SUB).                        DCCONEDT
00353 *                                                                 DCCONEDT
00354 *     CHECK FOR CONTINUATION CARD                                 DCCONEDT
00355 *                                                                 DCCONEDT
00356      IF COMMA-FOUND EQUAL ","                                     DCCONEDT
00357          MOVE SPACES TO COMMA-FOUND                               DCCONEDT
00358          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00359          GO TO 2070-CK-CATNAME.                                   DCCONEDT
00360      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00361      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00362          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00363          GO TO 3000-SELECT-CARD.                                  DCCONEDT
00364  2070-CK-CATNAME.                                                 DCCONEDT
00365      IF WORK-30 NOT EQUAL "CATNAME"                               DCCONEDT
00366          GO TO 2090-MOD-OPT-ERROR.                                DCCONEDT
00367      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00368      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00369          GO TO 2090-MOD-OPT-ERROR.                                DCCONEDT
00370      IF WORK-30 NOT EQUAL "IS"                                    DCCONEDT
00371          GO TO 2090-MOD-OPT-ERROR.                                DCCONEDT
00372      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00373      IF EXTRACT-SWITCH EQUAL "Y"                                     CL**2
00374          GO TO 2090-MOD-OPT-ERROR.                                DCCONEDT
00375 ***************************************************************** DCCONEDT
00376 *     TABLE NEW CATALOGUE NAME FOR PROGRAM                        DCCONEDT
00377 **************************************************************    DCCONEDT
00378      MOVE WORK-30 TO CVT-NEWNAME (PROG-SUB).                         CL**2
00379      PERFORM READ-CARD THRU READ-CARD-XIT.                        DCCONEDT
00380      GO TO 3000-SELECT-CARD.                                      DCCONEDT
00381 *                                                                 DCCONEDT
00382 *     MODULE OPTIONS WERE INCOMPLETE OR INCORRECT                 DCCONEDT
00383 *                                                                 DCCONEDT
00384  2090-MOD-OPT-ERROR.                                              DCCONEDT
00385          MOVE "10" TO ERROR-CODE.                                 DCCONEDT
00386      PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT.              DCCONEDT
00387      GO TO 8000-BYPASS.                                           DCCONEDT
00388                                                                    DCCONED
00389 ***************************************************************** DCCONEDT
00390 *                                                                 DCCONEDT
00391 *     READ - EDIT AND TABLE SELECT CARD INFORMATION               DCCONEDT
00392 *                                                                 DCCONEDT
00393 ***************************************************************** DCCONEDT
00394  3000-SELECT-CARD.                                                DCCONEDT
00395      IF WORK-30 NOT EQUAL "SELECT"                                DCCONEDT
00396          MOVE "03" TO ERROR-CODE                                  DCCONEDT
00397          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00398          GO TO 8000-BYPASS.                                       DCCONEDT
00399      MOVE SPACES TO SAVE-CREATE-OPTIONS.                             CL**2
00400 *                                                                 DCCONEDT
00401 *     EXTRACT OPTIONS FOR SELECT CARD                             DCCONEDT
00402 *                                                                 DCCONEDT
00403  3050-CK-SELECT-OPT.                                              DCCONEDT
00404      ADD 1 TO SEL-READ.                                              CL**2
00405      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00406      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00407          MOVE "11" TO ERROR-CODE                                  DCCONEDT
00408          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00409          GO TO 8000-BYPASS.                                       DCCONEDT
00410      ADD 1 TO SEL-SUB.                                            DCCONEDT
00411      IF SEL-SUB GREATER THAN 200                                  DCCONEDT
00412          SUBTRACT 1 FROM SEL-SUB                                  DCCONEDT
00413          MOVE "09" TO ERROR-CODE                                  DCCONEDT
00414          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT              CL**2
00415          GO TO 9000-EDIT-END.                                     DCCONEDT
00416 ***************************************************************** DCCONEDT
00417 *     USE PROGRAM TABLE SUBSCRIPT AS AN INDEX CODE FOR SELECT TABLDCCONEDT
00418 ***************************************************************** DCCONEDT
00419      MOVE PROG-SUB TO SELECT-ID (SEL-SUB).                        DCCONEDT
00420 ***************************************************************** DCCONEDT
00421 *     TABLE SELECT DATANAME                                       DCCONEDT
00422 ***************************************************************** DCCONEDT
00423      MOVE WORK-30 TO CVT-DATANAME (SEL-SUB).                      DCCONEDT
00424 *                                                                 DCCONEDT
00425 *     FOR TOTAL AND IMS CONVERSION, THE SELECT CARD IS            DCCONEDT
00426 *          COMPLETE AT THIS POINT                                 DCCONEDT
00427 *                                                                 DCCONEDT
00428      IF LANG-CODE EQUAL "T" OR "P" OR "D"                         DCCONEDT
00429          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00430          GO TO 4000-RENAME-CARD.                                  DCCONEDT
00431 *                                                                 DCCONEDT
00432 *     CHECK FOR CONTINUATION CARD                                 DCCONEDT
00433 *                                                                 DCCONEDT
00434      IF COMMA-FOUND EQUAL ","                                     DCCONEDT
00435          MOVE SPACES TO COMMA-FOUND                               DCCONEDT
00436          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00437          GO TO 3065-CK-ATLEVEL.                                   DCCONEDT
00438  3060-CK-LEVEL-OPTION.                                            DCCONEDT
00439      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00440      IF EXTRACT-SWITCH NOT EQUAL "Y"                              DCCONEDT
00441          GO TO 3065-CK-ATLEVEL.                                   DCCONEDT
00442 *                                                                 DCCONEDT
00443 *     NO LEVEL WAS FOUND - USE DEFAULT VALUE OF "01" FOR COBOL    DCCONEDT
00444 *          "DS" FOR BAL                                           DCCONEDT
00445 *                                                                 DCCONEDT
00446      IF LANG-CODE EQUAL "C"                                       DCCONEDT
00447          MOVE "01" TO CVT-LEVEL (SEL-SUB)                            CL**2
00448      ELSE                                                         DCCONEDT
00449          MOVE "DS" TO CVT-LEVEL (SEL-SUB).                        DCCONEDT
00450      PERFORM READ-CARD THRU READ-CARD-XIT.                           CL**2
00451      GO TO 4000-RENAME-CARD.                                      DCCONEDT
00452  3065-CK-ATLEVEL.                                                 DCCONEDT
00453      IF LANG-CODE EQUAL "B"                                       DCCONEDT
00454          GO TO 3095-CK-DSECT.                                     DCCONEDT
00455      IF WORK-30 NOT EQUAL "AT"                                    DCCONEDT
00456          GO TO 3080-USE-DEFAULT.                                  DCCONEDT
00457      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00458      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00459          GO TO 3080-USE-DEFAULT.                                  DCCONEDT
00460      IF WORK-30 NOT EQUAL "LEVEL"                                 DCCONEDT
00461          GO TO 3080-USE-DEFAULT.                                  DCCONEDT
00462      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00463      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00464          GO TO 3080-USE-DEFAULT.                                  DCCONEDT
00465      IF WORK-30 EQUAL "FD"                                        DCCONEDT
00466          MOVE "FD" TO CK-LEVEL                                       CL**2
00467          GO TO 3070-TABLE-LEVEL.                                  DCCONEDT
00468 *                                                                 DCCONEDT
00469 *     CHECK FOR VALID LEVEL NUMBER                                DCCONEDT
00470 *                                                                 DCCONEDT
00471      PERFORM TEST-LEVEL-NO THRU TEST-LEVEL-NO-XIT.                   CL**2
00472      IF LEVEL-ERR-SW EQUAL "Y"                                       CL**2
00473          MOVE "13" TO ERROR-CODE                                     CL**2
00474          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00475          GO TO 3080-USE-DEFAULT.                                  DCCONEDT
00476 ***************************************************************** DCCONEDT
00477 *     TABLE LEVEL NUMBER                                          DCCONEDT
00478 ***************************************************************** DCCONEDT
00479  3070-TABLE-LEVEL.                                                DCCONEDT
00480      MOVE CK-LEVEL TO CVT-LEVEL (SEL-SUB).                           CL**2
00481 *                                                                 DCCONEDT
00482 *     CHECK FOR CONTINUATION CARD                                 DCCONEDT
00483 *                                                                 DCCONEDT
00484      IF COMMA-FOUND EQUAL ","                                     DCCONEDT
00485          MOVE SPACES TO COMMA-FOUND                               DCCONEDT
00486          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00487          GO TO 3075-CK-PREFIX.                                    DCCONEDT
00488      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00489      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00490          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00491          GO TO 4000-RENAME-CARD.                                  DCCONEDT
00492  3075-CK-PREFIX.                                                  DCCONEDT
00493      IF WORK-30 NOT EQUAL "STRIP"                                 DCCONEDT
00494          GO TO 3090-SEL-OPT-ERROR.                                DCCONEDT
00495      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00496      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00497          GO TO 3090-SEL-OPT-ERROR.                                DCCONEDT
00498      IF WORK-30 NOT EQUAL "PREFIX"                                DCCONEDT
00499          GO TO 3090-SEL-OPT-ERROR.                                DCCONEDT
00500      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00501      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00502          GO TO 3090-SEL-OPT-ERROR.                                DCCONEDT
00503 ***************************************************************** DCCONEDT
00504 *     TABLE PREFIX                                                DCCONEDT
00505 ***************************************************************   DCCONEDT
00506      MOVE WORK-30 TO CVT-PREFIX (SEL-SUB).                        DCCONEDT
00507      PERFORM READ-CARD THRU READ-CARD-XIT.                        DCCONEDT
00508      GO TO 4000-RENAME-CARD.                                      DCCONEDT
00509 *                                                                 DCCONEDT
00510 *     USE 01 DEFAULT VALUE FOR COBOL CONVERSION LEVEL             DCCONEDT
00511 *                                                                 DCCONEDT
00512  3080-USE-DEFAULT.                                                DCCONEDT
00513      IF CVT-LEVEL (SEL-SUB) EQUAL SPACES                          DCCONEDT
00514          MOVE "01" TO CVT-LEVEL (SEL-SUB).                        DCCONEDT
00515 *                                                                 DCCONEDT
00516 *     CHECK FOR CONTINUATION CARD                                 DCCONEDT
00517 *                                                                 DCCONEDT
00518      IF COMMA-FOUND EQUAL ","                                     DCCONEDT
00519          MOVE SPACES TO COMMA-FOUND                               DCCONEDT
00520          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00521          GO TO 3075-CK-PREFIX.                                    DCCONEDT
00522      IF EXTRACT-SWITCH NOT EQUAL "Y"                              DCCONEDT
00523          GO TO 3075-CK-PREFIX.                                    DCCONEDT
00524      PERFORM READ-CARD THRU READ-CARD-XIT.                        DCCONEDT
00525      GO TO 4000-RENAME-CARD.                                      DCCONEDT
00526 *                                                                 DCCONEDT
00527 *     OPTIONS FOR SELECT CARD WERE INCOMPLETE OR INCORRECT        DCCONEDT
00528 *                                                                 DCCONEDT
00529  3090-SEL-OPT-ERROR.                                              DCCONEDT
00530      MOVE "07" TO ERROR-CODE.                                     DCCONEDT
00531      PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT.              DCCONEDT
00532      GO TO 8000-BYPASS.                                           DCCONEDT
00533 *                                                                 DCCONEDT
00534 *     SET UP LEVEL FOR BAL CONVERSION                             DCCONEDT
00535 *                                                                 DCCONEDT
00536  3095-CK-DSECT.                                                   DCCONEDT
00537      IF WORK-30 EQUAL "EQU"                                       DCCONEDT
00538          MOVE "EQ" TO CVT-LEVEL (SEL-SUB)                         DCCONEDT
00539      ELSE                                                         DCCONEDT
00540          MOVE "DS" TO CVT-LEVEL (SEL-SUB).                           CL**2
00541      IF WORK-30 EQUAL "EQU" OR "DSECT"                               CL**2
00542          NEXT SENTENCE                                               CL**2
00543      ELSE                                                            CL**2
00544          GO TO 3075-CK-PREFIX.                                       CL**2
00545      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                   CL**2
00546      IF EXTRACT-SWITCH EQUAL "Y"                                     CL**2
00547          PERFORM READ-CARD THRU READ-CARD-XIT                        CL**2
00548          GO TO 4000-RENAME-CARD.                                     CL**2
00549      GO TO 3075-CK-PREFIX.                                           CL**2
00550                                                                    DCCONED
00551 ***************************************************************** DCCONEDT
00552 *                                                                 DCCONEDT
00553 *     NEXT CONTROL CARD COULD BE RENAME, CREATE                   DCCONEDT
00554 *          SELECT OR A NEW MODULE                                 DCCONEDT
00555 *                                                                 DCCONEDT
00556 ******************************************************************DCCONEDT
00557  4000-RENAME-CARD.                                                DCCONEDT
00558      IF WORK-30 EQUAL "RENAME"                                    DCCONEDT
00559          GO TO 4500-CK-RENAME-OPT.                                DCCONEDT
00560 ***************************************************************** DCCONEDT
00561 *     CHECK FOR A CREATE CARD                                     DCCONEDT
00562 ***************************************************************   DCCONEDT
00563  4010-CREATE-CARD.                                                DCCONEDT
00564      IF WORK-30 EQUAL "CREATE"                                    DCCONEDT
00565          GO TO 5500-CK-CREATE-OPT.                                DCCONEDT
00566 *                                                                 DCCONEDT
00567 *     USE CREATE OPTIONS FOR PREVIOUS SELECT                      DCCONEDT
00568 *          IF NONE, ALL ENTRY TYPES WILL BE CREATED               DCCONEDT
00569 *                                                                 DCCONEDT
00570      IF SAVE-CREATE-OPTIONS NOT EQUAL SPACES                         CL**2
00571          GO TO 4015-USE-PREVIOUS.                                    CL**2
00572      IF LANG-CODE EQUAL "C" OR "B"                                   CL**2
00573          MOVE "Y" TO CVT-PROGRAM (PROG-SUB).                         CL**2
00574      MOVE ALL "Y" TO CVT-CREATE-OPTS (SEL-SUB).                      CL**2
00575      GO TO 4020-SELECT-CARD.                                         CL**2
00576  4015-USE-PREVIOUS.                                                  CL**2
00577      IF LANG-CODE EQUAL "B" OR "C"                                   CL**2
00578          MOVE MOD-OPTION TO CVT-PROGRAM (PROG-SUB).                  CL**2
00579      MOVE SEL-OPTION TO CVT-CREATE-OPTS (SEL-SUB).                   CL**2
00580 ******************************************************************DCCONEDT
00581 *     CHECK FOR SELECT CARD                                       DCCONEDT
00582 ***************************************************************** DCCONEDT
00583  4020-SELECT-CARD.                                                   CL**2
00584      IF WORK-30 EQUAL "SELECT"                                    DCCONEDT
00585          GO TO 3050-CK-SELECT-OPT.                                DCCONEDT
00586 ***************************************************************** DCCONEDT
00587 *     CHECK FOR MODULE CARD                                       DCCONEDT
00588 ******************************************************************DCCONEDT
00589  4030-MODULE-CARD.                                                DCCONEDT
00590      IF WORK-30 EQUAL "MODULE"                                    DCCONEDT
00591          GO TO 2020-MOD-DATANAME.                                 DCCONEDT
00592 *                                                                 DCCONEDT
00593 *     CARD OUT OF SEQUENCE                                        DCCONEDT
00594 *                                                                 DCCONEDT
00595  4040-SEQ-ERROR.                                                  DCCONEDT
00596      MOVE "03" TO ERROR-CODE.                                     DCCONEDT
00597      PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT.              DCCONEDT
00598      GO TO 8000-BYPASS.                                           DCCONEDT
00599                                                                    DCCONED
00600 ***************************************************************   DCCONEDT
00601 *     EXTRACT AND TABLE OPTIONS FOR RENAME CARD                   DCCONEDT
00602 ******************************************************************DCCONEDT
00603  4500-CK-RENAME-OPT.                                                 CL**2
00604      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00605      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00606          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00607      ADD 1 TO RN-SUB.                                             DCCONEDT
00608      IF RN-SUB GREATER THAN 200                                   DCCONEDT
00609          SUBTRACT 1 FROM RN-SUB                                   DCCONEDT
00610          MOVE "12" TO ERROR-CODE                                  DCCONEDT
00611          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00612          GO TO 9000-EDIT-END.                                     DCCONEDT
00613 *                                                                 DCCONEDT
00614 *     USE SELECT TABLE SUBSCRIPT FOR INDEX FOR RENAME TABLE       DCCONEDT
00615 *                                                                 DCCONEDT
00616      MOVE SEL-SUB TO RENAME-ID (RN-SUB).                          DCCONEDT
00617 ***************************************************************** DCCONEDT
00618 *     TABLE DATANAME                                              DCCONEDT
00619 ******************************************************************DCCONEDT
00620      MOVE WORK-30 TO CVT-RENAME (RN-SUB).                         DCCONEDT
00621      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00622      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00623          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00624      IF WORK-30 NOT EQUAL "TO"                                    DCCONEDT
00625          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00626      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00627      IF EXTRACT-SWITCH EQUAL TO "Y"                               DCCONEDT
00628          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00629 *                                                                 DCCONEDT
00630 *     DETERMINE IF NEXT WORD IS ALIAS, VERSION OR CATALOGUE       DCCONEDT
00631 *                                                                 DCCONEDT
           IF WORK-30 IS EQUAL TO "ALIAS" 
             OR WORK-30 IS EQUAL TO "VERSION" 
00636          MOVE "A" TO CVT-ALIAS (RN-SUB)                           DCCONEDT
00637          GO TO 4550-CK-OF.                                           CL**2
00638      IF WORK-30 NOT EQUAL "CATNAME"                                  CL**2
00639          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00640  4550-CK-OF.                                                      DCCONEDT
00641      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00642      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00643          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00644      IF WORK-30 NOT EQUAL "OF"                                    DCCONEDT
00645          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00646      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00647      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00648          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00649 ***************************************************************** DCCONEDT
00650 *     TABLE CATALOGUE NAME                                        DCCONEDT
00651 ******************************************************************DCCONEDT
00652      MOVE WORK-30 TO CVT-CATNAME (RN-SUB).                        DCCONEDT
00653 *                                                                 DCCONEDT
00654 *     CHECK FOR CONTINUATION CARD                                 DCCONEDT
00655 *                                                                 DCCONEDT
00656      IF COMMA-FOUND EQUAL ","                                     DCCONEDT
00657          MOVE SPACES TO COMMA-FOUND                               DCCONEDT
00658          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00659          GO TO 4600-CK-BEGIN.                                     DCCONEDT
00660      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00661      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00662          PERFORM READ-CARD THRU READ-CARD-XIT                        CL**2
00663          GO TO 4000-RENAME-CARD.                                  DCCONEDT
00664  4600-CK-BEGIN.                                                   DCCONEDT
00665      IF WORK-30 NOT EQUAL "BEGIN"                                 DCCONEDT
00666          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00667      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00668      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00669          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00670      IF WORK-30 NOT EQUAL "NUMBER"                                DCCONEDT
00671          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00672      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00673      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00674          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00675      IF WORK-30 NOT EQUAL "AT"                                    DCCONEDT
00676          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00677      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00678      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00679          GO TO 4900-RENAME-OPT-ERR.                               DCCONEDT
00680 *                                                                 DCCONEDT
00681 *     CHECK FOR VALID LINE NUMBER                                 DCCONEDT
00682 *                                                                 DCCONEDT
00683  4700-CK-LINE.                                                    DCCONEDT
00684      PERFORM TEST-LINE-NO THRU TEST-LINE-NO-XIT.                  DCCONEDT
00685      IF LINE-ERR-SW EQUAL "Y"                                     DCCONEDT
00686          MOVE "17" TO ERROR-CODE                                  DCCONEDT
00687          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00688          GO TO 8000-BYPASS.                                       DCCONEDT
00689 ***************************************************************** DCCONEDT
00690 *     TABLE BEGINNING LINE NUMBER FOR ELE ALIAS ENTRY             DCCONEDT
00691 ****************************************************************  DCCONEDT
00692      MOVE CK-LINE-NO TO CVT-BEGIN (RN-SUB).                       DCCONEDT
00693      PERFORM READ-CARD THRU READ-CARD-XIT.                        DCCONEDT
00694      GO TO 4000-RENAME-CARD.                                      DCCONEDT
00695 *                                                                 DCCONEDT
00696 *     RENAME CARD WAS INCOMPLETE OR INCORRECT                     DCCONEDT
00697 *                                                                 DCCONEDT
00698  4900-RENAME-OPT-ERR.                                             DCCONEDT
00699      MOVE "16" TO ERROR-CODE.                                     DCCONEDT
00700      PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT.              DCCONEDT
00701      GO TO 8000-BYPASS.                                           DCCONEDT
00702                                                                    DCCONED
00703 ***************************************************************** DCCONEDT
00704 *     EDIT AND TABLE OPTIONS FOR CREATE CARD                      DCCONEDT
00705 ***************************************************************** DCCONEDT
00706  5500-CK-CREATE-OPT.                                              DCCONEDT
00707      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00708      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00709          GO TO 5900-CREATE-ERROR.                                    CL**2
00710      GO TO 5700-CK-TYPE.                                          DCCONEDT
00711  5600-GET-NEXT.                                                   DCCONEDT
00712 *                                                                 DCCONEDT
00713 *     CHECK FOR CONTINUATION CARD                                 DCCONEDT
00714 *                                                                    CL**2
00715      IF COMMA-FOUND EQUAL ","                                     DCCONEDT
00716          ADD 1 TO CONT-COUNT                                         CL**2
00717          MOVE SPACES TO COMMA-FOUND                               DCCONEDT
00718          PERFORM READ-CARD THRU READ-CARD-XIT                     DCCONEDT
00719          GO TO 5700-CK-TYPE.                                      DCCONEDT
00720      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00721      IF EXTRACT-SWITCH NOT EQUAL "Y"                                 CL**2
00722          GO TO 5700-CK-TYPE.                                         CL**2
00723 *                                                                 DCCONEDT
00724 *     SAVE CREATE OPTIONS                                         DCCONEDT
00725 *                                                                 DCCONEDT
00726      IF LANG-CODE EQUAL "C" OR "B"                                   CL**2
00727          MOVE CVT-PROGRAM (PROG-SUB) TO MOD-OPTION.                  CL**2
00728      MOVE CVT-CREATE-OPTS (SEL-SUB) TO SEL-OPTION.                   CL**2
00729      PERFORM READ-CARD THRU READ-CARD-XIT.                           CL**2
00730      GO TO 4020-SELECT-CARD.                                         CL**2
00731  5700-CK-TYPE.                                                    DCCONEDT
00732      IF CONT-COUNT GREATER 3                                         CL**2
00733          MOVE 0 TO CONT-COUNT                                        CL**2
00734          MOVE "15" TO ERROR-CODE                                     CL**2
00735          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT              CL**2
00736          GO TO 8000-BYPASS.                                          CL**2
00737      IF WORK-30 EQUAL "PROGRAM" OR "PRO"                             CL**2
00738          MOVE "Y" TO CVT-PROGRAM (PROG-SUB)                          CL**2
00739          GO TO 5600-GET-NEXT.                                     DCCONEDT
00740      IF WORK-30 EQUAL "FILE" OR "FIL" OR "DATASET"                DCCONEDT
00741          MOVE "Y" TO CVT-FILE (SEL-SUB)                           DCCONEDT
00742          GO TO 5600-GET-NEXT.                                     DCCONEDT
00743      IF WORK-30 EQUAL "RECORD" OR "REC"                           DCCONEDT
00744          MOVE "Y" TO CVT-RECORD (SEL-SUB)                         DCCONEDT
00745          GO TO 5600-GET-NEXT.                                     DCCONEDT
00746      IF WORK-30 EQUAL "GROUP" OR "GRO"                            DCCONEDT
00747          MOVE "Y" TO CVT-GROUP (SEL-SUB)                          DCCONEDT
00748          GO TO 5600-GET-NEXT.                                     DCCONEDT
00749      IF WORK-30 EQUAL "ELEMENTS" OR "ELE"                            CL**2
00750              MOVE "Y" TO CVT-ELEMENT (SEL-SUB)                    DCCONEDT
00751          GO TO 5600-GET-NEXT.                                     DCCONEDT
00752      IF WORK-30 EQUAL "DATABASE"                                  DCCONEDT
00753          MOVE "Y" TO CVT-DATABASE (SEL-SUB)                       DCCONEDT
00754          GO TO 5600-GET-NEXT.                                     DCCONEDT
00755      IF WORK-30 EQUAL "PSB"                                       DCCONEDT
00756          MOVE "Y" TO CVT-PSB (SEL-SUB)                            DCCONEDT
00757          GO TO 5600-GET-NEXT.                                     DCCONEDT
00758  5900-CREATE-ERROR.                                               DCCONEDT
00759      MOVE "18" TO ERROR-CODE.                                     DCCONEDT
00760      PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT.              DCCONEDT
00761      GO TO 8000-BYPASS.                                           DCCONEDT
00762                                                                    DCCONED
00763 ***************************************************************   DCCONEDT
00764 *     PRINTS ERROR MESSAGE AND BYPASS MESSAGE                     DCCONEDT
00765 *     CLEARS TABLES AFFECTED BY ERROR                             DCCONEDT
00766 *     LISTS REMAINING CONTROL CARDS UNTIL NEXT MODULE CARD FOR    DCCONEDT
00767 *     BAL OR COBOL/NEXT SELECT CARD FOR IMS OR TOTAL IS FOUND     DCCONEDT
00768 ***************************************************************   DCCONEDT
00769  8000-BYPASS.                                                     DCCONEDT
00770      IF LANG-CODE EQUAL "B" OR "C"                                DCCONEDT
00771          ADD 1 TO MOD-BYPASS                                         CL**2
00772          GO TO CLEAR-PROG-TABLE.                                  DCCONEDT
           IF LANG-CODE EQUAL "S" 
               MOVE "8" TO CVTBL-MOD-REQUEST
               GO TO PRINT-BYPASS.
00773      ADD 1 TO SEL-BYPASS.                                            CL**2
00774 *                                                                 DCCONEDT
00775 *     CLEAR SELECT AND RENAME TABLES FOR IMS AND TOTAL            DCCONEDT
00776 *                                                                 DCCONEDT
00777  CLEAR-SEL-TABLES.                                                   CL**2
00778      IF SEL-SUB NOT EQUAL 0                                       DCCONEDT
00779          MOVE SPACES TO CVT-SELECT-TABLE (SEL-SUB)                DCCONEDT
00780          GO TO CLEAR-SEL-RENAMES.                                 DCCONEDT
00781      GO TO PRINT-BYPASS.                                          DCCONEDT
00782  CLEAR-SEL-RENAMES.                                               DCCONEDT
00783      IF RN-SUB EQUAL 0                                               CL**2
00784          SUBTRACT 1 FROM SEL-SUB                                     CL**2
00785          GO TO PRINT-BYPASS.                                         CL**2
00786      IF RENAME-ID (RN-SUB) EQUAL SEL-SUB                          DCCONEDT
00787          MOVE SPACES TO CVT-RENAME-TABLE (RN-SUB)                 DCCONEDT
00788          SUBTRACT 1 FROM RN-SUB                                   DCCONEDT
00789          GO TO CLEAR-SEL-RENAMES.                                 DCCONEDT
00790      SUBTRACT 1 FROM SEL-SUB.                                     DCCONEDT
00791      GO TO PRINT-BYPASS.                                          DCCONEDT
00792 *                                                                 DCCONEDT
00793 *     CLEAR MODULE, SELECT AND RENAME TABLE FOR COBOL/BAL         DCCONEDT
00794 *                                                                 DCCONEDT
00795  CLEAR-PROG-TABLE.                                                DCCONEDT
00796       IF PROG-SUB NOT EQUAL 0                                     DCCONEDT
00797      MOVE SPACES TO CVT-PROG-TABLE (PROG-SUB)                     DCCONEDT
00798          GO TO CLEAR-PROG-SEL.                                    DCCONEDT
00799      GO TO PRINT-BYPASS.                                          DCCONEDT
00800  CLEAR-PROG-SEL.                                                  DCCONEDT
00801      IF SEL-SUB EQUAL 0                                              CL**2
00802          SUBTRACT 1 FROM PROG-SUB                                    CL**2
00803          GO TO PRINT-BYPASS.                                         CL**2
00804      IF SELECT-ID (SEL-SUB) EQUAL PROG-SUB                        DCCONEDT
00805          MOVE SPACES TO CVT-SELECT-TABLE (SEL-SUB)                DCCONEDT
00806          GO TO CLEAR-PROG-RENAMES.                                DCCONEDT
00807      SUBTRACT 1 FROM PROG-SUB.                                    DCCONEDT
00808      GO TO PRINT-BYPASS.                                          DCCONEDT
00809  CLEAR-PROG-RENAMES.                                              DCCONEDT
00810      IF RN-SUB EQUAL 0                                               CL**2
00811          SUBTRACT 1 FROM SEL-SUB                                     CL**2
00812          GO TO CLEAR-PROG-SEL.                                       CL**2
00813      IF RENAME-ID (RN-SUB) EQUAL SEL-SUB                          DCCONEDT
00814          MOVE SPACES TO CVT-RENAME-TABLE (RN-SUB)                 DCCONEDT
00815          SUBTRACT 1 FROM RN-SUB                                   DCCONEDT
00816          GO TO CLEAR-PROG-RENAMES.                                DCCONEDT
00817      SUBTRACT 1 FROM SEL-SUB.                                     DCCONEDT
00818      GO TO CLEAR-PROG-SEL.                                        DCCONEDT
00819  PRINT-BYPASS.                                                    DCCONEDT
00820      MOVE "14" TO ERROR-CODE.                                     DCCONEDT
00821      PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT.              DCCONEDT
00822  NEXT-CARD.                                                       DCCONEDT
00823      READ CTL-CARD AT END                                         DCCONEDT
00824          GO TO 9000-EDIT-END.                                     DCCONEDT
00825      IF CVT-COMMENT EQUAL "*"                                     DCCONEDT
00826          GO TO PRINT-CARD.                                        DCCONEDT
00827      MOVE CONV-REC TO HOLD-VALUE.                                 DCCONEDT
00828      MOVE ZERO TO SUB1.                                           DCCONEDT
00829      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00830      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00831          MOVE "02" TO ERROR-CODE                                  DCCONEDT
00832          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00833          GO TO NEXT-CARD.                                         DCCONEDT
00834      IF LANG-CODE EQUAL "T" OR "P" OR "D"                            CL**2
00835          GO TO TEST-SELECT.                                       DCCONEDT
           IF LANG-CODE EQUAL "S" 
               GO TO TEST-CDCS. 
00836      IF WORK-30 EQUAL "MODULE"                                    DCCONEDT
00837          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCCONEDT
00838          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCCONEDT
00839          MOVE CONV-REC TO STD-REPORT-REC                          DCCONEDT
00840          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCCONEDT
00841          MOVE SPACES TO COMMA-FOUND                                  CL**2
00842          GO TO 2020-MOD-DATANAME.                                 DCCONEDT
00843      GO TO PRINT-CARD.                                            DCCONEDT
       TEST-CDCS. 
           IF WORK-30 EQUAL "INCLUDE" 
               MOVE CONV-REC TO STD-REPORT-REC
               PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT 
               MOVE SPACES TO COMMA-FOUND 
               GO TO 1300-INCLUDE-NOTES.
           GO TO PRINT-CARD.
00844  TEST-SELECT.                                                     DCCONEDT
00845      IF WORK-30 EQUAL "SELECT"                                    DCCONEDT
00846          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCCONEDT
00847          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCCONEDT
00848          MOVE CONV-REC TO STD-REPORT-REC                          DCCONEDT
00849          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT               DCCONEDT
00850          MOVE SPACES TO SAVE-CREATE-OPTIONS                          CL**2
00851          MOVE SPACES TO COMMA-FOUND                                  CL**2
00852          GO TO 3050-CK-SELECT-OPT.                                DCCONEDT
00853  PRINT-CARD.                                                      DCCONEDT
00854      MOVE CONV-REC TO STD-REPORT-REC.                             DCCONEDT
00855      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCCONEDT
00856      GO TO NEXT-CARD.                                             DCCONEDT
00857                                                                    DCCONED
00858  8080-NO-INPUT.                                                   DCCONEDT
00859      MOVE SPACES TO STD-REPORT-REC.                               DCCONEDT
00860      MOVE ERROR-MSSG (1) TO STD-REPORT-REC.                       DCCONEDT
00861      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCCONEDT
00862      MOVE "8" TO CVTBL-MOD-REQUEST.                               DCCONEDT
00863      GO TO CLOSE-FILES.                                           DCCONEDT
00864  8090-MAST3-READ-ERROR.                                           DCCONEDT
00865      MOVE SPACES TO PRINT-DATA.                                   DCCONEDT
00866      MOVE ERROR-MSSG (19) TO PRINT-DATA.                          DCCONEDT
00867      MOVE 1 TO PRT-CTL.                                           DCCONEDT
00868      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                      DCCONEDT
00869      MOVE "8" TO CVTBL-MOD-REQUEST.                               DCCONEDT
00870      MOVE 12 TO RETURN-CODE.                                         CL**2
00871      GO TO CLOSE-FILES.                                           DCCONEDT
00872 ***************************************************************** DCCONEDT
00873 *     PRINTS APPROPRIATE MESSAGE FRO ERROR MESSAGE TABLE          DCCONEDT
00874 ***************************************************************** DCCONEDT
00875  PROCESS-ERRORS.                                                  DCCONEDT
00876      MOVE ERROR-MSSG (ERROR-CODE) TO STD-REPORT-REC.              DCCONEDT
00877      MOVE 8 TO RETURN-CODE.                                          CL**2
00878      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                  DCCONEDT
00879  PROCESS-ERRORS-XIT.                                              DCCONEDT
00880 *                                                                 DCCONEDT
00881 *     READS CARD FILE AND PRINTS CARD IMAGE                       DCCONEDT
00882 *          CHECKS FOR BLANK CARDS AND COMMENT CARDS               DCCONEDT
00883 *         EXTRACTS FIRST WORD                                     DCCONEDT
00884 *                                                                 DCCONEDT
00885  READ-CARD.                                                       DCCONEDT
00886      READ CTL-CARD AT END                                         DCCONEDT
00887          GO TO 9000-EDIT-END.                                     DCCONEDT
00888      IF CVT-COMMENT EQUAL "*"                                     DCCONEDT
00889          MOVE CONV-REC TO STD-REPORT-REC                             CL**2
00890          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00891          GO TO READ-CARD.                                         DCCONEDT
00892      MOVE CONV-REC TO HOLD-VALUE.                                 DCCONEDT
00893      MOVE ZERO TO SUB1.                                           DCCONEDT
00894      PERFORM EXTRACT-FIELD THRU EXTRACT-FIELD-XIT.                DCCONEDT
00895      IF EXTRACT-SWITCH EQUAL "Y"                                  DCCONEDT
00896          MOVE "02" TO ERROR-CODE                                  DCCONEDT
00897          PERFORM PROCESS-ERRORS THRU PROCESS-ERRORS-XIT           DCCONEDT
00898          GO TO READ-CARD.                                         DCCONEDT
00899      IF LANG-CODE EQUAL "T" OR "P" OR "D"                            CL**2
00900          GO TO SELECT-SPACE.                                         CL**2
00901      IF WORK-30 EQUAL "MODULE"                                       CL**2
00902          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00903          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00904      GO TO PRINT-IT.                                                 CL**2
00905  SELECT-SPACE.                                                       CL**2
00906      IF WORK-30 EQUAL "SELECT"                                       CL**2
00907          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT                  CL**2
00908          PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                 CL**2
00909  PRINT-IT.                                                           CL**2
00910      MOVE CONV-REC TO STD-REPORT-REC.                                CL**2
00911      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00912  READ-CARD-XIT.                                                      CL**2
00913 *                                                                 DCCONEDT
00914 *     EXTRACT A FIELD FROM HOLD AREA                              DCCONEDT
00915 *                                                                 DCCONEDT
00916  EXTRACT-FIELD.                                                   DCCONEDT
00917      MOVE ZERO TO SUB2.                                           DCCONEDT
00918      MOVE SPACES TO WORK-30.                                      DCCONEDT
00919      MOVE "N" TO EXTRACT-SWITCH.                                  DCCONEDT
00920      MOVE SPACE TO COMMA-FOUND.                                      CL**2
00921  START-TO-FIND.                                                   DCCONEDT
00922      ADD 1 TO SUB1.                                               DCCONEDT
00923      IF SUB1 GREATER 73                                              CL**2
00924          GO TO END-FIELD-SEARCH.                                  DCCONEDT
00925      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCCONEDT
00926          GO TO START-TO-FIND.                                     DCCONEDT
00927 *                                                                 DCCONEDT
00928 *     CHECK FOR FIELD IN QUOTES                                   DCCONEDT
00929 *                                                                 DCCONEDT
00930  MOVE-FIELD.                                                      DCCONEDT
00931      IF WORK-VALUE (SUB1) EQUAL TO QUOTES                         DCCONEDT
00932          ADD 1 TO SUB1.                                              CL**2
00933      ADD 1 TO SUB2.                                               DCCONEDT
00934      MOVE WORK-VALUE (SUB1) TO WORK-30-A (SUB2).                  DCCONEDT
00935      ADD 1 TO SUB1.                                               DCCONEDT
00936      IF SUB1 GREATER 73                                              CL**2
00937          GO TO END-FIELD-SEARCH.                                  DCCONEDT
00938      IF WORK-VALUE (SUB1) EQUAL TO SPACES                         DCCONEDT
00939          GO TO CK-COMMA.                                          DCCONEDT
00940      GO TO MOVE-FIELD.                                            DCCONEDT
00941  CK-COMMA.                                                        DCCONEDT
00942      IF WORK-30-A (SUB2) EQUAL TO ","                             DCCONEDT
00943          MOVE SPACE TO WORK-30-A (SUB2)                           DCCONEDT
00944          SUBTRACT 1 FROM SUB2                                     DCCONEDT
00945          MOVE "," TO COMMA-FOUND.                                 DCCONEDT
00946      IF WORK-30-A (SUB2) EQUAL QUOTES                                CL**2
00947          MOVE SPACE TO WORK-30-A (SUB2)                              CL**2
00948          SUBTRACT 1 FROM SUB2.                                       CL**2
00949      GO TO EXTRACT-FIELD-XIT.                                     DCCONEDT
00950  END-FIELD-SEARCH.                                                DCCONEDT
00951      MOVE "Y" TO EXTRACT-SWITCH.                                  DCCONEDT
00952      MOVE ZERO TO SUB1.                                           DCCONEDT
00953  EXTRACT-FIELD-XIT.                                                  CL**2
00954      EXIT.                                                           CL**2
00955                                                                    DCCONED
00956  9000-EDIT-END.                                                   DCCONEDT
00957      IF LANG-CODE EQUAL "C" OR "B"                                DCCONEDT
00958          GO TO 9020-COB-BAL-END.                                  DCCONEDT
           IF LANG-CODE NOT EQUAL "S" 
               GO TO 9010-IMS-TOT-END.
           GO TO CLOSE-FILES. 
00959  9010-IMS-TOT-END.                                                DCCONEDT
00960      IF SEL-SUB EQUAL 0                                           DCCONEDT
00961          MOVE "8" TO CVTBL-MOD-REQUEST                            DCCONEDT
00962      ELSE                                                         DCCONEDT
00963          MOVE "9" TO CVTBL-MOD-REQUEST                            DCCONEDT
00964      GO TO 9040-PRINT-TOTALS.                                     DCCONEDT
00965  9020-COB-BAL-END.                                                DCCONEDT
00966      IF PROG-SUB EQUAL 0                                          DCCONEDT
00967          MOVE "8" TO CVTBL-MOD-REQUEST                            DCCONEDT
00968          GO TO 9040-PRINT-TOTALS.                                 DCCONEDT
00969      IF PROG-SUB GREATER SELECT-ID (SEL-SUB)                         CL**2
00970          MOVE SPACES TO CVT-PROG-TABLE (PROG-SUB)                 DCCONEDT
00971          ADD 1 TO MOD-BYPASS                                         CL**2
00972          SUBTRACT 1 FROM PROG-SUB.                                   CL**2
00973      IF PROG-SUB NOT EQUAL 0                                         CL**2
00974          MOVE "9" TO CVTBL-MOD-REQUEST                               CL**2
00975      ELSE                                                            CL**2
00976          MOVE "8" TO CVTBL-MOD-REQUEST.                              CL**2
00977  9040-PRINT-TOTALS.                                               DCCONEDT
00978      MOVE PROG-SUB TO PROG-SUB-HI.                                   CL**2
00979      MOVE SEL-SUB TO SEL-SUB-HI.                                     CL**2
00980      MOVE RN-SUB TO RN-SUB-HI.                                       CL**2
00981      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00982      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00983      IF LANG-CODE EQUAL "C" OR "B"                                   CL**2
00984      MOVE PROG-SUB TO NO-ACCEPT                                      CL**2
00985          MOVE "MODULES" TO TYPE-ACCEPT                               CL**2
00986      ELSE                                                            CL**2
00987          MOVE SEL-SUB TO NO-ACCEPT                                   CL**2
00988          MOVE "SELECTS" TO TYPE-ACCEPT.                              CL**2
00989      MOVE ACCEPT-LINE TO STD-REPORT-REC.                             CL**2
00990      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00991      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00992      IF LANG-CODE EQUAL "C" OR "B"                                   CL**2
00993          MOVE MOD-BYPASS TO NO-REJECT                                CL**2
00994          MOVE "MODULES" TO TYPE-REJECT                               CL**2
00995      ELSE                                                            CL**2
00996          MOVE SEL-BYPASS TO NO-REJECT                                CL**2
00997          MOVE "SELECTS" TO TYPE-REJECT.                              CL**2
00998      MOVE REJECT-LINE TO STD-REPORT-REC.                             CL**2
00999      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01000      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01001      IF LANG-CODE EQUAL "C" OR "B"                                   CL**2
01002          MOVE MOD-READ TO NO-READ                                    CL**2
01003          MOVE "MODULE" TO TYPE-READ                                  CL**2
01004      ELSE                                                            CL**2
01005          MOVE SEL-READ TO NO-READ                                    CL**2
01006          MOVE "SELECTS" TO TYPE-READ.                                CL**2
01007      MOVE TOT-READ-LINE TO STD-REPORT-REC.                           CL**2
01008      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01009 *                                                                    CL**2
01010 *     IF LAST SELECT HAS NO OPTIONS - USE PREVIOUS                   CL**2
01011 *                                                                    CL**2
01012      IF CVT-CREATE-OPTS (SEL-SUB) EQUAL SPACES                       CL**2
01013              NEXT SENTENCE                                           CL**2
01014      ELSE                                                            CL**2
01015              GO TO CLOSE-FILES.                                      CL**2
01016      IF SAVE-CREATE-OPTIONS NOT EQUAL SPACES                         CL**2
01017          GO TO USE-PREV-OPTS.                                        CL**2
01018      IF LANG-CODE EQUAL "B" OR "C"                                   CL**2
01019          MOVE "Y" TO CVT-PROGRAM (PROG-SUB).                         CL**2
01020      MOVE ALL "Y" TO CVT-CREATE-OPTS (SEL-SUB).                      CL**2
01021      GO TO CLOSE-FILES.                                              CL**2
01022  USE-PREV-OPTS.                                                      CL**2
01023      IF LANG-CODE EQUAL "B" OR "C"                                   CL**2
01024          MOVE MOD-OPTION TO CVT-PROGRAM (PROG-SUB).                  CL**2
01025      MOVE SEL-OPTION TO CVT-CREATE-OPTS (SEL-SUB).                   CL**2
01026  CLOSE-FILES.                                                     DCCONEDT
01027      CLOSE CTL-CARD.                                              DCCONEDT
01028      CLOSE SYSPRINT.                                              DCCONEDT
           EXIT PROGRAM.
*CALL     MAST3IO1                                                      DCCONEDT
*CALL     DISPLAYLN                                                     DCCONEDT
*CALL     WRITELN                                                       DCCONEDT
01033  TEST-LINE-NO.                                                    DCCONEDT
01034      MOVE "N" TO LINE-ERR-SW.                                     DCCONEDT
01035      MOVE ZERO TO CK-LINE-NO.                                     DCCONEDT
01036      MOVE 4 TO SUB3.                                              DCCONEDT
01037  MOVE-LINE-NO.                                                    DCCONEDT
01038      MOVE WORK-30-A (SUB2) TO LINE-NO (SUB3).                        CL**2
01039      SUBTRACT 1 FROM SUB2 SUB3.                                   DCCONEDT
01040      IF SUB2 NOT EQUAL 0                                             CL**2
01041          GO TO MOVE-LINE-NO.                                      DCCONEDT
01042      IF CK-LINE-NO LESS THAN "0001" OR GREATER THAN "9999"           CL**2
01043          MOVE "Y" TO LINE-ERR-SW.                                 DCCONEDT
01044  TEST-LINE-NO-XIT.                                                DCCONEDT
01045  TEST-LEVEL-NO.                                                      CL**2
01046      MOVE ZERO TO CK-LEVEL.                                          CL**2
01047      MOVE "N" TO LEVEL-ERR-SW.                                       CL**2
01048      MOVE 2 TO SUB3.                                                 CL**2
01049  MOVE-LEVEL-NO.                                                      CL**2
01050      MOVE WORK-30-A (SUB2) TO CK-LEV (SUB3).                         CL**2
01051      SUBTRACT 1 FROM SUB2 SUB3.                                      CL**2
01052      IF SUB2 NOT EQUAL 0                                             CL**2
01053          GO TO MOVE-LEVEL-NO.                                        CL**2
01054      IF CK-LEVEL LESS THAN "01" OR GREATER THAN "99"                 CL**2
01055          MOVE "Y" TO LEVEL-ERR-SW.                                   CL**2
01056  TEST-LEVEL-NO-XIT.                                                  CL**2
01057  USER-ROUTINE.                                                       CL**2
01058      MOVE CONV-TITLE-2 TO PRINT-DATA.                                CL**2
01059      PERFORM WRITE-LINE THRU WRITE-LINE-XIT.                         CL**2
01060      ADD 2 TO LINE-CT.                                               CL**2
01061  USER-ROUTINE-XIT.                                                   CL**2
01062      EXIT.                                                           CL**2
01063  CLEAR-TABLES.                                                       CL**2
01064      MOVE 1 TO PROG-SUB.                                             CL**2
01065      IF LANG-CODE EQUAL "T" OR "P" OR "D"                            CL**2
01066          GO TO SELECT-TBL.                                           CL**2
01067  PROG-LOOP.                                                          CL**2
01068      MOVE SPACES TO CVT-PROG-TABLE (PROG-SUB).                       CL**2
01069      ADD 1 TO PROG-SUB.                                              CL**2
01070      IF PROG-SUB NOT GREATER 100                                     CL**2
01071          GO TO PROG-LOOP.                                            CL**2
01072      MOVE 1 TO PROG-SUB.                                             CL**2
01073  SELECT-TBL.                                                         CL**2
01074      MOVE SPACES TO CVT-SELECT-TABLE (PROG-SUB).                     CL**2
01075      ADD 1 TO PROG-SUB.                                              CL**2
01076      IF PROG-SUB NOT GREATER THAN 200                                CL**2
01077          GO TO SELECT-TBL.                                           CL**2
01078      MOVE 1 TO PROG-SUB.                                             CL**2
01079  RENAME-TBL.                                                         CL**2
01080      MOVE SPACES TO CVT-RENAME-TABLE (PROG-SUB).                     CL**2
01081      ADD 1 TO PROG-SUB.                                              CL**2
01082      IF PROG-SUB NOT GREATER THAN 200                                CL**2
01083          GO TO RENAME-TBL.                                           CL**2
01084  CLEAR-TABLES-XIT.                                                   CL**2
01085      EXIT.                                                           CL**2
