*DECK     DCCONTOT
00001  IDENTIFICATION DIVISION.                                         10/24/78
       PROGRAM-ID. CONTOT.
*CALL COPYRIGHT 
      *    THIS PROGRAM EXPLODES TOTAL DBDL PROGRAM ENTRIES AS PART 
      *    OF THE DATA CATALOGUE CONVERSION.
00009  ENVIRONMENT DIVISION.                                               CL**2
00010  CONFIGURATION SECTION.                                              CL**2
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00013  INPUT-OUTPUT SECTION.                                               CL**2
00014  FILE-CONTROL.                                                       CL**2
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
           SELECT WORK-FILE ASSIGN TO WRKFILE 
               USE "RT=Z".
           SELECT TOTAL-FILE ASSIGN TO CONVFIL
               USE "RT=Z".
00018  DATA DIVISION.                                                      CL**2
00019  FILE SECTION.                                                       CL**2
00020  FD  TOTAL-FILE                                                      CL**2
00022      LABEL RECORDS ARE OMITTED                                       CL**2
00024      RECORD CONTAINS 80 CHARACTERS                                   CL**2
00025      DATA RECORDS ARE UNLABEL-COB.                                   CL**2
00026  01  UNLABEL-COB                 PICTURE X(80).                      CL**2
*CALL     CVTWKFD 
*CALL     SYSPRTFD
       COMMON-STORAGE SECTION.
       77  RETURN-CODE                 PICTURE XX.
*CALL     CVTBL 
00359  01  PRINT-CTL-TBL.                                                  CL**2
*CALL     WKPRINT 
00029  WORKING-STORAGE SECTION.                                            CL**2
00030  01  LINE1.                                                          CL**2
00031      03  FILLER                  PICTURE X.                          CL**2
00032      03  LINE1A                  PICTURE X(10).                      CL**2
00033      03  FILLER                  PICTURE X(9).                       CL**2
00034      03  LINE1B                  PICTURE X(32).                      CL**2
00035      03  FILLER                  PICTURE X(2).                       CL**2
00036      03  LINE1C                  PICTURE X(78).                      CL**2
00037                                                                    DCCONTO
00038  01  LEVEL-TABLE.                                                    CL**2
00039      02  LEV-TAB     OCCURS 10 TIMES.                                CL**2
00040          03  LEVT-LINE           PICTURE XX.                         CL**2
00041          03  LEVT-NAME           PICTURE X(32).                      CL**2
00042          03  LEVT-GNAM           PICTURE X(32).                      CL**2
00043          03  LEVT-HOLD.                                              CL**2
00044              05  LEVT-LGHT       PICTURE 9(4).                       CL**2
00045              05  LEVT-USE        PICTURE X.                          CL**2
00046              05  LEVT-PIC        PICTURE X(25).                      CL**2
00047              05  LEVT-VALUE      PICTURE X(25).                      CL**2
00048              05  LEVT-JUST       PICTURE X.                          CL**2
00049              05  LEVT-SYNC       PICTURE X.                          CL**2
00050  01  HOLD-RENAME-TABLE.                                              CL**2
00051      03  FILLER                  PICTURE XXX.                        CL**2
00052      03  CVT-RENAME-HOLD         PICTURE X(32).                      CL**2
00053      03  CVT-CATNAME-HOLD        PICTURE X(32).                      CL**2
00054      03  CVT-ALIAS-HOLD          PICTURE X.                          CL**2
00055      03  CVT-BEGIN-HOLD          PICTURE X(4).                       CL**2
00056  01  COMMENT-TABLE.                                                  CL**2
00057      03  COM-LINE                PICTURE X(80) OCCURS 50 TIMES.      CL**2
00058                                                                    DCCONTO
00059 *                                                                    CL**2
00060 *           W O R K   A R E A S                                      CL**2
00061 *                                                                    CL**2
00062  01  TOTAL-IN.                                                       CL**2
00063      03  TOTAL-SECTION           PICTURE X OCCURS 72 TIMES.          CL**2
00064      03  TOTAL-ID                PICTURE X(8).                       CL**2
00065  01  TOTAL-IN2  REDEFINES  TOTAL-IN.                                 CL**2
00066      03  TOTAL-SECTION2          PICTURE X(30).                      CL**2
00067      03  FILLER                  PICTURE X(50).                      CL**2
00068  01  TOTAL-IN3  REDEFINES  TOTAL-IN.                                 CL**2
00069      03  TOTAL-SECTION3          PICTURE X(15).                      CL**2
00070      03  TOTAL-DBNAME            PICTURE X(8).                       CL**2
00071      03  FILLER                  PICTURE X(57).                      CL**2
00072  01  TOTAL-IN4  REDEFINES  TOTAL-IN.                                 CL**2
00073      03  TOTAL-SECTION4          PICTURE X(7).                       CL**2
00074      03  TOTAL-IOAREA.                                               CL**2
00075          05  TOTAL-IONAME        PICTURE X(4).                       CL**2
00076          05  FILLER              PICTURE X.                          CL**2
00077          05  TOTAL-IOOCCUR       PICTURE XX.                         CL**2
00078      03  FILLER                  PICTURE X(66).                      CL**2
00079  01  TOTAL-IN5  REDEFINES  TOTAL-IN.                                 CL**2
00080      03  TOTAL-SECTION5.                                             CL**2
00081          05  TOTAL-REC-CODE      PICTURE X(12).                      CL**2
00082          05  TOTAL-REC-CODE2     PICTURE XX.                         CL**2
00083      03  TOTAL-DATASET-NAME      PICTURE XXXX.                       CL**2
00084      03  FILLER                  PICTURE X(62).                      CL**2
00085  01  TOTAL-IN6  REDEFINES  TOTAL-IN.                                 CL**2
00086      03  FILLER                  PICTURE XXXX.                       CL**2
           03  ROOTNAME                PICTURE X(7).
           03  FILLER                  PICTURE X(69). 
00089  01  TOTAL-IN7  REDEFINES  TOTAL-IN.                                 CL**2
00090      03  LINKA                   PICTURE XXXX.                       CL**2
00091      03  FILLER                  PICTURE XX.                         CL**2
00092      03  LINKB                   PICTURE XX.                         CL**2
00093      03  FILLER                  PICTURE X(72).                      CL**2
00094  01  TOTAL-IN8  REDEFINES  TOTAL-IN.                                 CL**2
           03  CTRL-NAMEC.
                05  FILLER-NAME     PICTURE X(4). 
                05  FILLER-CTRL     PICTURE X(4). 
00097      03  FILLER                  PICTURE X.                          CL**2
00098      03  FILLER-LEN              PICTURE X(4).                       CL**2
00099      03  FILLER                  PICTURE X(67).                      CL**2
00100  01  TOTAL-IN9  REDEFINES  TOTAL-IN.                                 CL**2
00101      03  FILLER                  PICTURE X.                          CL**2
00102      03  FILLER-NUM1             PICTURE X.                          CL**2
00103      03  FILLER                  PICTURE X.                          CL**2
           03  CTRL-NAMEA.
                05  FILLER-NAME1    PICTURE X(4). 
                05  FILLER-CTRL1    PICTURE X(4). 
00106      03  FILLER                  PICTURE X.                          CL**2
00107      03  FILLER-LEN1             PICTURE X(4).                       CL**2
00109  01  TOTAL-IN10  REDEFINES  TOTAL-IN.                                CL**2
00110      03  FILLER                  PICTURE X.                          CL**2
00111      03  FILLER-NUM2             PICTURE XX.                         CL**2
00112      03  FILLER                  PICTURE X.                          CL**2
           03  CTRL-NAMEB.
                05  FILLER-NAME2    PICTURE X(4). 
               05 FILLER-CTRL2  PICTURE X(4). 
00115      03  FILLER                  PICTURE X.                          CL**2
00116      03  FILLER-LEN2             PICTURE X(4).                       CL**2
00117      03  FILLER                  PICTURE X(63).                      CL**2
00118 *                                                                    CL**2
00119 *    WORK AREAS USED TO DETERMINE ELEMENT OR GROUP ENTRY             CL**2
00120 *                                                                    CL**2
00121  01  STRUCTURE-IN.                                                   CL**2
00122      03  FILLER                  PICTURE X.                          CL**2
00123      03  LEVEL-NO1               PICTURE X.                          CL**2
00124      03  FILLER                  PICTURE X.                          CL**2
00125      03  LEVEL-NAME              PICTURE X(8).                       CL**2
00126      03  FILLER                  PICTURE X.                          CL**2
00127      03  LEVEL-LENGTH            PICTURE XXXX.                       CL**2
00128      03  FILLER                  PICTURE X(64).                      CL**2
00129  01  STRUCTURE-IN2  REDEFINES  STRUCTURE-IN.                         CL**2
00130      03  FILLER                  PICTURE X.                          CL**2
00131      03  LEVEL-NO2               PICTURE XX.                         CL**2
00132      03  FILLER                  PICTURE X.                          CL**2
00133      03  LEVEL-NAME2             PICTURE X(8).                       CL**2
00134      03  FILLER                  PICTURE X.                          CL**2
00135      03  LEVEL-LENGTH2           PICTURE XXXX.                       CL**2
00136      03  FILLER                  PICTURE X(63).                      CL**2
00137  01  STRUCTURE-IN3  REDEFINES  STRUCTURE-IN.                         CL**2
00138      03  LEVEL-NAME3             PICTURE X(8).                       CL**2
00139      03  FILLER                  PICTURE X.                          CL**2
00140      03  LEVEL-LENGTH3           PICTURE XXXX.                       CL**2
00141      03  FILLER                  PICTURE X(67).                      CL**2
00142  01  STRUCTURE-IN4  REDEFINES  STRUCTURE-IN.                         CL**2
00143      03  LEVEL-IN                PICTURE X  OCCURS 72 TIMES.         CL**2
00144      03  LEVEL-ID                PICTURE X(8).                       CL**2
00145  01  STRUCTURE-IN5  REDEFINES  STRUCTURE-IN.                         CL**2
00146      03  FILLER                  PICTURE X.                          CL**2
00147      03  LEVEL-NAME4             PICTURE X(8).                       CL**2
00148      03  FILLER                  PICTURE X.                          CL**2
00149      03  LEVEL-LENGTH4           PICTURE XXXX.                       CL**2
00150      03  FILLER                  PICTURE X(66).                      CL**2
00151 *                                                                    CL**2
00152 *    WORK AREA TO HOLD DATASET ENVIRONMENT CATEGORY                  CL**2
00153 *                                                                    CL**2
00154  01  ENVIRONMENT-LINE.                                               CL**2
00155      03  DEVICE-LEN              PICTURE X(7).                       CL**2
00156      03  VALUE-LEN               PICTURE X(7).                       CL**2
00157      03  FILLER                  PICTURE X(66).                      CL**2
00158  01  ENVIRONMENT-LINE2  REDEFINES  ENVIRONMENT-LINE.                 CL**2
00159      03  LOG-REC                 PICTURE X(22).                      CL**2
00160      03  LOG-REC-VAL             PICTURE X(7).                       CL**2
00161      03  FILLER                  PICTURE X(51).                      CL**2
00162  01  ENVIRONMENT-LINE3  REDEFINES  ENVIRONMENT-LINE.                 CL**2
00163      03  LOG-TRACKS              PICTURE X(13).                      CL**2
00164      03  LOG-TRACKS-VAL          PICTURE X(5).                       CL**2
00165      03  FILLER                  PICTURE X(62).                      CL**2
00166  01  ENVIRONMENT-LINE4  REDEFINES  ENVIRONMENT-LINE.                 CL**2
00167      03  LOG-LENGTH              PICTURE X(22).                      CL**2
00168      03  LOG-LENGTH-VAL          PICTURE X(5).                       CL**2
00169      03  FILLER                  PICTURE X(53).                      CL**2
00170  01  ENVIRONMENT-LINE5  REDEFINES  ENVIRONMENT-LINE.                 CL**2
00171      03  LOG-BLOCKS              PICTURE X(25).                      CL**2
00172      03  LOG-BLOCKS-VAL          PICTURE X(5).                       CL**2
00173      03  FILLER                  PICTURE X(50).                      CL**2
00174  01  ENVIRONMENT-LINE6  REDEFINES  ENVIRONMENT-LINE.                 CL**2
00175      03  LOG-DISKS               PICTURE X(13).                      CL**2
00176      03  LOG-DISKS-VAL           PICTURE XX.                         CL**2
00177      03  FILLER                  PICTURE X(65).                      CL**2
00178  01  ENVIRONMENT-LINE7  REDEFINES  ENVIRONMENT-LINE.                 CL**2
00179      03  LOG-CYLINDER            PICTURE X(20).                      CL**2
00180      03  LOG-CYLINDER-VAL        PICTURE XX.                         CL**2
00181      03  FILLER                  PICTURE X(58).                      CL**2
00182  01  ENVIRONMENT-LINE8  REDEFINES  ENVIRONMENT-LINE.                 CL**2
00183      03  LOG-FILE                PICTURE X(9).                       CL**2
00184      03  LOG-FILE-VAL            PICTURE X.                          CL**2
00185      03  FILLER                  PICTURE X(70).                      CL**2
00186  01  WORK-AREA.                                                      CL**2
00187      02  WORKA   OCCURS 40       PICTURE X.                          CL**2
00188  01  NUM-WORK.                                                       CL**2
00189      02  NUM-1ST                 PICTURE 9.                          CL**2
00190      02  NUM-2ND                 PICTURE 9.                          CL**2
00191      02  NUM-3RD                 PICTURE 9.                          CL**2
00192      02  NUM-4TH                 PICTURE 9.                          CL**2
00193  01  NUM-WORK4 REDEFINES NUM-WORK PICTURE 9(4).                      CL**2
00194  01  NUM-WORK3 REDEFINES NUM-WORK4.                                  CL**2
00195      02  NUM3                    PICTURE 999.                        CL**2
00196      02  FILLER                  PICTURE X.                          CL**2
00197  01  NUM-WORK2 REDEFINES NUM-WORK3.                                  CL**2
00198      02  NUM2                    PICTURE 99.                         CL**2
00199      02  FILLER                  PICTURE XX.                         CL**2
00200  01  NUM-WORK1 REDEFINES NUM-WORK2.                                  CL**2
00201      02  NUM1                    PICTURE 9.                          CL**2
00202      02  FILLER                  PICTURE XXX.                        CL**2
00203  01  NEXT-LINE.                                                      CL**2
00204      02  FLD1                    PICTURE X.                          CL**2
00205      02  FLD2                    PICTURE X.                          CL**2
00206  01  HOLD-AREA.                                                      CL**2
00207      02  HOLD-ELM.                                                   CL**2
00208          03  HOLD-LGHT           PICTURE 9(4).                       CL**2
00209          03  HOLD-USE            PICTURE X.                          CL**2
00210          03  HOLD-PIC            PICTURE X(25).                      CL**2
00211          03  HOLD-VALUE          PICTURE X(25).                      CL**2
00212          03  HOLD-JUST           PICTURE X.                          CL**2
00213          03  HOLD-SYNC           PICTURE X.                          CL**2
00214      02  HOLD-GRP.                                                   CL**2
00215          03  HOLD-OFROM          PICTURE XXX.                        CL**2
00216          03  HOLD-OTO            PICTURE XXX.                        CL**2
00217          03  HOLD-REDEF          PICTURE X(32).                      CL**2
00218          03  HOLD-DEPEND         PICTURE X(32).                      CL**2
00219          03  HOLD-INDEX          PICTURE X(32).                      CL**2
00220  01  88-VAL-AREA.                                                    CL**2
00221      03  88-AREA OCCURS 65 TIMES PICTURE X.                          CL**2
00222  01  CATAL-REC-NAME.                                                 CL**2
00223      03  CATAL-NAME-1            PICTURE X OCCURS 32 TIMES.          CL**2
00224  01  LINKPATH-NAME.                                                  CL**2
00225      03  LINKC                   PICTURE XXXX.                       CL**2
00226      03  LINKD                   PICTURE XX.                         CL**2
00227  01  GROUP-NAME-HOLD-AREA.                                           CL**2
00228      03  GROUP-NAME-HOLD         PICTURE X(32) OCCURS 15 TIMES.      CL**2
00229  01  GROUP-LEVEL-HOLD-AREA.                                          CL**2
00230      03  GROUP-LEVEL-HOLD        PICTURE XX OCCURS 15 TIMES.         CL**2
00231 *                                                                    CL**2
00232 *    HOLD NAME WORK AREAS DEFINED                                    CL**2
00233 *                                                                    CL**2
00234  01  CATAL-NAME                  PICTURE X(32).                      CL**2
00235  01  DATA-NAME                   PICTURE X(32).                      CL**2
00236  01  RECORD-NAME-HOLD            PICTURE X(32).                      CL**2
00237  01  DATASET-NAME-HOLD           PICTURE X(32).                      CL**2
00238  01  DATABASE-NAME-HOLD          PICTURE X(32).                      CL**2
00239  01  CUR-NAME                    PICTURE X(32).                      CL**2
00240  01  SEG-NAME                    PICTURE X(32).                      CL**2
00241  01  GRP-DNAME                   PICTURE X(32).                      CL**2
00242  01  SEG-DNAME                   PICTURE X(32).                      CL**2
00243  01  DATA-NAME-2                 PICTURE X(4).                       CL**2
00244  01  HOLD-88-CATAL-NAME          PICTURE X(32).                      CL**2
00245  01  PROG-ID                     PICTURE X(10)   VALUE SPACE.        CL**2
00246  01  REC-SUB                     PICTURE 99      VALUE 0.            CL**2
00247  01  SUB-IO                      PICTURE 99      VALUE 0.            CL**2
00248  01  VAR-COUNT                   PICTURE 99      VALUE 0.            CL**2
00249  01  NUMBER-HOLD                 PICTURE 99.                         CL**2
00250  01  NUMBER-HOLD2                PICTURE 99.                         CL**2
00251  01  GROUP-COUNT                 PICTURE 99      VALUE 0.            CL**2
00252  01  REC-COUNT                   PICTURE 999     VALUE 0.            CL**2
00253  01  HOLD-LENGTH                 PICTURE XXXX.                       CL**2
00254  01  PREFIX-OUT                  PICTURE X(9).                       CL**2
00255  01  SAVE-CTRL-LEN               PICTURE X(4).                       CL**2
00256  01  WORK-USE                    PICTURE XXXX.                       CL**2
00257  01  CUR-LINE                    PICTURE XX      VALUE SPACE.        CL**2
00258  01  LEVEL-NO                    PICTURE XX.                         CL**2
00259  01  HIGH-LINE                   PICTURE XX      VALUE SPACE.        CL**2
00260  01  LINE-NO                     PICTURE XX.                         CL**2
00261  01  END-SW                      PICTURE X       VALUE "N".          CL**2
00262  01  FOUND-SW                    PICTURE X       VALUE "N".          CL**2
00263  01  LEVEL-SW                    PICTURE X.                          CL**2
00264  01  RESET-SW                    PICTURE X.                          CL**2
00265  01  READ-SW                     PICTURE X       VALUE "R".          CL**2
00266  01  SEG-FOUND                   PICTURE X.                          CL**2
00267  01  GROUP-SUB-SW                PICTURE X.                          CL**2
00268  01  FIRST-LEVEL                 PICTURE X.                          CL**2
00269  01  END-SELECT-SW               PICTURE X.                          CL**2
00270  01  SAVE-USE                    PICTURE X.                          CL**2
00271  01  COM-SW                      PICTURE X.                          CL**2
00272  01  CTL-SW                      PICTURE X       VALUE SPACE.        CL**2
00273  01  ELMGRP-SW                   PICTURE X       VALUE SPACE.        CL**2
00274  01  PER-FOUND                   PICTURE X       VALUE SPACE.        CL**2
00275  01  MV-TYPE                     PICTURE X.                          CL**2
00277  01  COM-SUB                     PICTURE S9999 COMP.                 CL**2
00278  01  WK-SUB                      PICTURE S9999 COMP.                 CL**2
00279  01  PX-SUB                      PICTURE S9999 COMP.                 CL**2
00280  01  LV-SUB                      PICTURE S9999 COMP.                 CL**2
00281  01  IN-SUB                      PICTURE S9999 COMP.                 CL**2
00282  01  HOLD-IN-SUB                 PICTURE S9999 COMP.                 CL**2
00283  01  HOLD-IN-SUB2                PICTURE S9999 COMP.                 CL**2
00284  01  IN-SUB-HI                   PICTURE S9999 COMP.                 CL**2
00285  01  LV-SUB-HI                   PICTURE S9999 COMP.                 CL**2
00286  01  PIC-COUNT                   PICTURE S9(5) .                   DCCONTO
00287  01  PIC-COUNTA                  PICTURE S9(6)  VALUE ZERO .       DCCONTO
00288  01  OCC-WORK                    PICTURE 999.                        CL**2
00289  01  LEN-S                       PICTURE XX      VALUE HIGH-VALUE.   CL**2
       01  88-COUNT                    PICTURE 9(5) VALUE ZEROS.
00293 ***************************************************************      CL**2
00294 *                                                                    CL**2
00295 *     HEADING LITERALS                                               CL**2
00296 *                                                                    CL**2
00297 *****************************************************************    CL**2
00298  01  HEADING-LITS.                                                   CL**2
00299      03  LITERAL-1               PICTURE X(24)   VALUE               CL**2
00300         "REPORT DATE-".                                              CL**2
00301      03  LITERAL-2               PICTURE X(24)   VALUE               CL**2
00302         "DATE OF LAST REVISION-".                                    CL**2
00303      03  LITERAL-3               PICTURE X(5)    VALUE               CL**2
00304         "PAGE".                                                      CL**2
00305      03  LITERAL-4               PICTURE X(31)   VALUE               CL**2
00306         "D A T A   C A T A L O G U E   2".                           CL**2
00307      03  LITERAL-5               PICTURE X(25)   VALUE               CL**2
00308         "REVISION NUMBER-".                                          CL**2
00309      03  LITERAL-6               PICTURE X(7)    VALUE               CL**2
00310         "OPTIONS".                                                   CL**2
00311      03  LITERAL-7               PICTURE X(24)   VALUE               CL**2
00312          "TOTAL DATANAME SELECTED".                                  CL**2
00313      03  LITERAL-8               PICTURE X(23)   VALUE               CL**2
00314         "IMAGE OF ITEM PROCESSED".                                   CL**2
00315      03  LITERAL-9               PICTURE X(27)   VALUE               CL**2
             "BEGIN-DATA-BASE-GENERATION ". 
00317      03  LITERAL-10              PICTURE X(22)   VALUE               CL**2
             "BEGIN-MASTER-DATA-SET ".
00319      03  LITERAL-11              PICTURE X(30)   VALUE               CL**2
             "BEGIN-VARIABLE-ENTRY-DATA-SET ".
00321      03  LITERAL-12              PICTURE X(14)   VALUE               CL**2
00322         "DATA-SET-NAME=".                                            CL**2
00323      03  LITERAL-13              PICTURE X(12)   VALUE               CL**2
             "MASTER-DATA ".
00325      03  LITERAL-14              PICTURE X(10)   VALUE               CL**2
             "BASE-DATA ".
00327      03  LITERAL-15              PICTURE X(9)    VALUE               CL**2
             "SHARE-IO ". 
00329      03  LITERAL-16              PICTURE X(9)    VALUE               CL**2
             "END-DATA ". 
00331      03  LITERAL-17              PICTURE X(20)   VALUE               CL**2
             "END-MASTER-DATA-SET ".
00333      03  LITERAL-18              PICTURE X(28)   VALUE               CL**2
             "END-VARIABLE-ENTRY-DATA-SET ".
00335      03  LITERAL-19              PICTURE X(25)   VALUE               CL**2
             "END-DATA-BASE-GENERATION ". 
00337      03  CONV-CBL-TITLE          PICTURE X(50)   VALUE               CL**2
00338         "  T O T A L   C O N V E R S I O N   R E P O R T  ".         CL**2
00339      03  TRUNCATION-MSG.                                             CL**2
00340          05  FILLER              PICTURE X(25)   VALUE               CL**2
00341          "     DCCVT-490-W ERROR * ".                                CL**2
00342          05  FILLER              PICTURE X(43)   VALUE               CL**2
00343             "TRUNCATION OCCURED IN PICTURE/VALUE ABOVE".             CL**2
00344      03  PROP-MSG.                                                   CL**2
00345          05  FILLER              PICTURE X(44)   VALUE               CL**2
               "DATA CATALOGUE 2                        V2.0".
00347          05  FILLER              PICTURE X(30)   VALUE               CL**2
*CALL LEVEL 
00349      03  NOT-FOUND-MSG.                                              CL**2
00350          05  FILLER              PICTURE X(25)   VALUE               CL**2
00351             "     DCCVT-495-S ERROR * ".                             CL**2
00352          05  PROG-NOT-FOUND      PICTURE X(8).                       CL**2
00353          05  FILLER              PICTURE X(13)   VALUE               CL**2
00354             "  NOT ON FILE".                                         CL**2
00355      03  END-REPORT-MSG          PICTURE X(33)   VALUE               CL**2
00356         "***END COBOL CONVERSION REPORT***".                         CL**2
00361                                                                    DCCONTO
00362  PROCEDURE DIVISION.                                                 CL**2
       BEGIN-PARA.
00366      OPEN INPUT TOTAL-FILE.                                          CL**2
00367      OPEN OUTPUT SYSPRINT.                                           CL**2
00368      OPEN OUTPUT WORK-FILE.                                          CL**2
00369      MOVE CONV-CBL-TITLE TO REPORT-TITLE-LONG.                       CL**2
00370      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00371 ******************************************************************   CL**2
00372 *                                                                *   CL**2
00373 *                R E S E T S  - NEW PROGRAM                      *   CL**2
00374 *                                                                *   CL**2
00375 ******************************************************************   CL**2
00376  RESET-NEW-PROG.                                                     CL**2
00377      MOVE SPACES TO PROG-ID.                                         CL**2
           MOVE "T" TO OUT-LANG-CODE. 
00378      MOVE "N" TO FIRST-LEVEL, READ-SW, RESET-SW, SEG-FOUND.          CL**2
00379      MOVE "N" TO GROUP-SUB-SW, FOUND-SW, SAVE-USE, LEVEL-SW.         CL**2
00380      MOVE 0 TO SUB-IO, REC-SUB.                                      CL**2
00381      MOVE 1 TO PROG-SUB, SEL-SUB.                                    CL**2
00382      MOVE SPACES TO COMMENT-TABLE.                                   CL**2
00383 ******************************************************************   CL**2
00384 *                                                                *   CL**2
00385 *            P R O G R A M   S E A R C H - FIND PROG-ID          *   CL**2
00386 *                                                                *   CL**2
00387 ******************************************************************   CL**2
00388  PROGRAM-READ.                                                       CL**2
00389      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00390      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
00391      IF RESET-SW NOT EQUAL TO "R"                                    CL**2
00392          GO TO PROGRAM-READ.                                         CL**2
00393  PROGRAM-READ-AGAIN.                                                 CL**2
00394      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00395      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
00396      IF TOTAL-SECTION3 NOT EQUAL TO "DATA-BASE-NAME="                CL**2
00397          GO TO PROGRAM-READ-AGAIN.                                   CL**2
00398 *                                                                    CL**2
00399 *    FIND IF SELECTED DATABASE DBDL FOUND                            CL**2
00400 *                                                                    CL**2
00401  PROGRAM-SEARCH.                                                     CL**2
00402      MOVE TOTAL-DBNAME TO PROG-ID.                                   CL**2
00403      MOVE 1 TO PROG-SUB, SEL-SUB.                                    CL**2
00404  PROG-LOOP.                                                          CL**2
00405      IF PROG-ID EQUAL TO CVT-DATANAME (PROG-SUB)                     CL**2
00406          GO TO TEST-PROG-CVT.                                        CL**2
00407      ADD 1 TO PROG-SUB, SEL-SUB.                                     CL**2
00408      IF PROG-SUB GREATER PROG-SUB-HI                                 CL**2
00409          GO TO RESET-NEW-PROG.                                       CL**2
00410      GO TO PROG-LOOP.                                                CL**2
00411  TEST-PROG-CVT.                                                      CL**2
00412      MOVE "N" TO RESET-SW.                                           CL**2
00413      MOVE "X" TO CVT-MOD-FND (PROG-SUB).                             CL**2
00414      IF CVT-DATABASE (PROG-SUB) NOT EQUAL TO "Y"                     CL**2
00415          GO TO READ-FIRST.                                           CL**2
00416 *                                                                    CL**2
00417 *    SET UP DATABASE RECORD FOR PRINT PURPOSES                       CL**2
00418 *                                                                    CL**2
00419      MOVE SPACES TO OUT-DATABASE-REC.                                CL**2
00420      MOVE ZERO TO OUT-STCR.                                          CL**2
00421      MOVE "32" TO OUT-ENTRY-TYPE.                                    CL**2
00422      MOVE "0" TO OUT-REC-TYPE.                                       CL**2
00423      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00424      MOVE PROG-ID TO DATA-NAME.                                      CL**2
00425      PERFORM RENAME THRU RENAME-XIT.                                 CL**2
00426      PERFORM PREFIX THRU PREFIX-XIT.                                 CL**2
00427      MOVE CATAL-NAME TO OUT-CATNAME.                                 CL**2
00428      PERFORM SET-RENAME-FIELD THRU SET-RENAME-FIELD-XIT.             CL**2
00429      MOVE OUT-CATNAME TO OUT-DATABASE-ID, DATABASE-NAME-HOLD.        CL**2
00430      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00431 *                                                                    CL**2
00432 *    TEST NEXT LINE FOR IOAREA IN DATABASE                           CL**2
00433 *                                                                    CL**2
00434  READ-AGAIN.                                                         CL**2
00435      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00436      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
00437      IF RESET-SW EQUAL TO "S"                                        CL**2
00438          GO TO READ-AGAIN.                                           CL**2
00439      IF TOTAL-SECTION4 NOT EQUAL TO "IOAREA="                        CL**2
00440          GO TO WRITE-DATABASE-ENTRY.                                 CL**2
00441      ADD 1 TO SUB-IO.                                                CL**2
00442      MOVE TOTAL-IONAME TO OUT-DB-IOA (SUB-IO).                       CL**2
00443      MOVE TOTAL-IOOCCUR TO OUT-DB-OCC (SUB-IO).                      CL**2
00444      GO TO READ-AGAIN.                                               CL**2
00445  WRITE-DATABASE-ENTRY.                                               CL**2
00451      WRITE OUT-DATABASE-REC.                                         CL**2
00452      ADD 1 TO STRUCT-COUNT.                                          CL**2
00453      MOVE SPACES TO OUT-DATABASE-REC.                                CL**2
00454      MOVE ZERO TO OUT-STCR.                                          CL**2
00455      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00456      MOVE "32" TO OUT-ENTRY-TYPE.                                    CL**2
00457      MOVE DATABASE-NAME-HOLD TO OUT-CATNAME.                         CL**2
00458      GO TO SKIP-READ.                                                CL**2
00459 *****************************************************************    CL**2
00460 *                                                                    CL**2
00461 *    READ TOTAL DBDL LOOKING FOR A MASTER OR VARIABLE DATASET        CL**2
00462 *                                                                    CL**2
00463 ****************************************************************     CL**2
00464  READ-FIRST.                                                         CL**2
00465      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00466      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
00467  SKIP-READ.                                                          CL**2
00468      IF RESET-SW EQUAL TO "M"                                        CL**2
00469          MOVE "M" TO MV-TYPE                                         CL**2
00470          GO TO RESET-READ.                                           CL**2
00471      IF RESET-SW EQUAL TO "V"                                        CL**2
00472          MOVE "V" TO MV-TYPE                                         CL**2
00473          GO TO RESET-READ.                                           CL**2
00474      GO TO READ-FIRST.                                               CL**2
00475  RESET-READ.                                                         CL**2
00476      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00477      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
00478      IF TOTAL-SECTION5 NOT EQUAL TO LITERAL-12                       CL**2
00479          GO TO RESET-READ.                                           CL**2
00480      MOVE TOTAL-DATASET-NAME TO DATA-NAME, DATA-NAME-2.              CL**2
00481 *                                                                    CL**2
00482 *    SETUP DATABASE STRUCTURE RECORD AND PRINT                       CL**2
00483 *                                                                    CL**2
00484  SET-OUTPUT-DATASET.                                                 CL**2
00485      MOVE 1 TO OUT-REC-TYPE.                                         CL**2
00486      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00487      PERFORM RENAME THRU RENAME-XIT.                                 CL**2
00488      PERFORM PREFIX THRU PREFIX-XIT.                                 CL**2
           IF CVT-DATABASE (PROG-SUB) NOT EQUAL "Y" 
                   GO TO SET-UP-FOR-DS. 
00489      MOVE CATAL-NAME TO OUT-DATASET-STCNAME.                         CL**2
00490      MOVE MV-TYPE TO OUT-DATE-TYPE.                                  CL**2
00496      WRITE OUT-DATABASE-STC-REC.                                     CL**2
00497      MOVE SPACES TO OUT-DATABASE-STC-REC.                            CL**2
00498      MOVE ZERO TO OUT-STCR.                                          CL**2
00499      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00500      ADD 1 TO STRUCT-COUNT.                                          CL**2
00501 *                                                                    CL**2
00502 *    SET UP DATASET HEADER INFORMATION FOR PRINT RECORD              CL**2
00503 *                                                                    CL**2
       SET-UP-FOR-DS. 
00504      IF CVT-FILE (PROG-SUB) NOT EQUAL TO "Y"                         CL**2
00505          GO TO PROCESS-DATA-RECORD.                                  CL**2
00506      MOVE "19" TO OUT-ENTRY-TYPE.                                    CL**2
00507      MOVE CATAL-NAME TO DATASET-NAME-HOLD, OUT-CATNAME.              CL**2
00508      MOVE 0 TO OUT-REC-TYPE.                                         CL**2
00509      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00510      MOVE DATA-NAME-2 TO SET-NAME.                                   CL**2
00511      PERFORM SET-RENAME-FIELD THRU SET-RENAME-FIELD-XIT.             CL**2
00512 *                                                                    CL**2
00513 *    READ NEXT LINE - DETERMINE DATASET IOAREA                       CL**2
00514 *                                                                    CL**2
00515      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00516      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
00517      IF TOTAL-SECTION4 EQUAL TO "IOAREA="                            CL**2
00518          MOVE TOTAL-IOAREA TO SET-IOAREA                             CL**2
00519          PERFORM READ-TOTAL THRU READ-TOTAL-XIT                      CL**2
00520          PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.             CL**2
00521 *                                                                    CL**2
00522 *    WRITE OUT DATASET RECORD---CONTAINS CHARACTERISTICS             CL**2
00523 *                                                                    CL**2
00524  WRITE-DATASET-ENTRY.                                                CL**2
00530      WRITE OUT-DATASET-REC.                                          CL**2
00531      MOVE SPACES TO OUT-DATASET-REC.                                 CL**2
00532      MOVE ZERO TO OUT-STCR.                                          CL**2
00533      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00534      MOVE "19" TO OUT-ENTRY-TYPE.                                    CL**2
00535      MOVE DATASET-NAME-HOLD TO OUT-CATNAME.                          CL**2
00536      ADD 1 TO STRUCT-COUNT.                                          CL**2
00537      GO TO BASE-MASTER-DATA.                                         CL**2
00538                                                                    DCCONTO
00539 *****************************************************************    CL**2
00540 *                                                                    CL**2
00541 *    PROCESSING OF DATASET STRUCTURE BEGINS                          CL**2
00542 *                                                                    CL**2
00543 *****************************************************************    CL**2
00544  PROCESS-DATA-RECORD.                                                CL**2
00545      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00546      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
00547  BASE-MASTER-DATA.                                                   CL**2
00548      IF RESET-SW EQUAL TO "M" AND MV-TYPE EQUAL TO "M"               CL**2
00549          GO TO READ-DBDL-RECORD.                                     CL**2
00550      IF RESET-SW EQUAL TO "V" AND MV-TYPE EQUAL TO "V"               CL**2
00551          GO TO PROCESS-VARIABLE-LINES.                               CL**2
00552      GO TO PROCESS-DATA-RECORD.                                      CL**2
00553  READ-DBDL-RECORD.                                                   CL**2
00554      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00555      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
           IF ROOTNAME EQUAL TO "ROOT=10" 
00557          GO TO PROCESS-DATASET-STRUCTURE.                            CL**2
00558      GO TO READ-DBDL-RECORD.                                         CL**2
00559  PROCESS-VARIABLE-LINES.                                             CL**2
00560      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00561      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
00562      IF ROOTNAME EQUAL TO "CODE=2"                                   CL**2
00563          GO TO PROCESS-DATASET-STRUCTURE.                            CL**2
00564      MOVE "Y" TO FIRST-LEVEL.                                        CL**2
00565  PROCESS-DATASET-STRUCTURE.                                          CL**2
00566 *                                                                    CL**2
00567 *    BEFORE PROCESSING CONTINUES MUST MAKE UP A RECORD NAME          CL**2
00568 *                                                                    CL**2
00569      MOVE CATAL-NAME TO CATAL-REC-NAME.                              CL**2
00570      MOVE 0 TO REC-SUB.                                              CL**2
00571  RECORD-NAME-LOOP.                                                   CL**2
00572      ADD 1 TO REC-SUB.                                               CL**2
00573      IF REC-SUB GREATER THAN 32                                      CL**2
00574          SUBTRACT 2 FROM REC-SUB                                     CL**2
00575          GO TO ADD-NAME.                                             CL**2
00576      IF CATAL-NAME-1 (REC-SUB) NOT EQUAL TO SPACE                    CL**2
00577          GO TO RECORD-NAME-LOOP.                                     CL**2
00578  ADD-NAME.                                                           CL**2
00579      MOVE "-" TO CATAL-NAME-1 (REC-SUB).                             CL**2
00580      ADD 1 TO REC-SUB.                                               CL**2
00581      IF REC-SUB GREATER THAN 32                                      CL**2
00582          SUBTRACT 2 FROM REC-SUB                                     CL**2
00583          GO TO ADD-NAME.                                             CL**2
00584      MOVE 1 TO CATAL-NAME-1 (REC-SUB).                               CL**2
00585 *                                                                    CL**2
00586 *    WRITE OUT DATASET STRUCTURE RECORD                              CL**2
00587 *                                                                    CL**2
00588      MOVE CATAL-REC-NAME TO DATA-NAME.                               CL**2
00589      PERFORM RENAME THRU RENAME-XIT.                                 CL**2
00590      PERFORM PREFIX THRU PREFIX-XIT.                                 CL**2
           IF CVT-FILE (PROG-SUB) NOT EQUAL "Y" 
                 MOVE CATAL-NAME TO RECORD-NAME-HOLD
                 GO TO SET-UP-FOR-REC.
00591      MOVE CATAL-NAME TO OUT-RECORD-ID, RECORD-NAME-HOLD.             CL**2
00592      MOVE 1 TO OUT-REC-TYPE.                                         CL**2
00593      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00599      WRITE OUT-DATASET-STC-REC.                                      CL**2
00600      MOVE SPACES TO OUT-DATASET-STC-REC.                             CL**2
00601      MOVE ZERO TO OUT-STCR.                                          CL**2
00602      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00603      ADD 1 TO STRUCT-COUNT.                                          CL**2
00604 *                                                                    CL**2
00605 *    WRITE RECORD HEADER RECORD                                      CL**2
00606 *                                                                    CL**2
       SET-UP-FOR-REC.
00607      IF CVT-RECORD (PROG-SUB) NOT EQUAL TO "Y"                       CL**2
00608          GO TO PROCESS-RECORD-ENTRY-STRUCTURE.                       CL**2
00609      MOVE "13" TO OUT-ENTRY-TYPE.                                    CL**2
00610      MOVE SPACES TO OUT-RECORD-ID.                                   CL**2
00611      MOVE 0 TO OUT-REC-TYPE.                                         CL**2
00612      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00613      PERFORM SET-RENAME-FIELD THRU SET-RENAME-FIELD-XIT.             CL**2
00614      MOVE RECORD-NAME-HOLD TO OUT-CATNAME.                           CL**2
00620      WRITE OUT-DATASET-STC-REC.                                      CL**2
00621      MOVE SPACES TO OUT-DATASET-STC-REC.                             CL**2
00622      MOVE ZERO TO OUT-STCR.                                          CL**2
00623      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00624      ADD 1 TO STRUCT-COUNT.                                          CL**2
00625 *****************************************************************    CL**2
00626 *    PROCESSING OF ENTRY STRUCTURES BEGIN HERE                       CL**2
00627 *        READ TWO LINES AT ONCE---BY EXAMINING FIRST CHARACTER       CL**2
00628 *            OF SECOND LINE DETERMINE ELEMENT OR GROUP ENTRY         CL**2
00629 ******************************************************************   CL**2
00630  PROCESS-RECORD-ENTRY-STRUCTURE.                                     CL**2
00631      IF FIRST-LEVEL EQUAL TO "Y"                                     CL**2
00632          MOVE "N" TO FIRST-LEVEL                                     CL**2
00633          GO TO TEST-RESET-SW.                                        CL**2
00634      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
           PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.
00635 *                                                                    CL**2
00636 *    IF RESET-SW EQUAL TO "Q"---FOUND "END-DATA:" STATEMENT          CL**2
00637 *                                                                    CL**2
00638  TEST-RESET-SW.                                                      CL**2
00639      IF RESET-SW EQUAL TO "Q"                                        CL**2
00640          MOVE SPACES TO OUT-ENV-REC                                  CL**2
00641          GO TO PROCESS-ENVIRONMENT.                                  CL**2
00642 *                                                                    CL**2
00643 *    IF RESET-SW EQUAL TO "X"---FOUND A LINKPATH LINE STATEMENT      CL**2
00644 *                                                                    CL**2
00645      IF RESET-SW EQUAL TO "X"                                        CL**2
00646          PERFORM FOUND-LINKAGE THRU FOUND-LINKAGE-XIT                CL**2
00647          GO TO PROCESS-RECORD-ENTRY-STRUCTURE.                       CL**2
00648 *                                                                    CL**2
00649 *    IF RESET-SW EQUAL TO "C"---FOUND A RECORD CODE STATEMENT        CL**2
00650 *                                                                    CL**2
00651      IF RESET-SW NOT EQUAL TO "G"                                    CL**2
00652          GO TO FOUND-CONTROL-LINE.                                   CL**2
00653      GO TO RECORD-CODE-LINE.                                         CL**2
00654 *                                                                    CL**2
00655 *    IF RESET-SW EQUAL TO "Y"---FOUND A CONTROL LINE STATEMENT       CL**2
00656 *                                                                    CL**2
00657  FOUND-CONTROL-LINE.                                                 CL**2
00658      IF RESET-SW EQUAL TO "Y"                                        CL**2
00659          PERFORM SET-UP-RECORD THRU SET-UP-RECORD-XIT                CL**2
00660          PERFORM WRITE-RECORD THRU WRITE-RECORD-XIT                  CL**2
00661          MOVE SPACE TO OUT-CTRL.                                     CL**2
00662  MOVE-RECORD-STRUCTURES.                                             CL**2
00663      MOVE TOTAL-IN TO STRUCTURE-IN.                                  CL**2
00664      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
           PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.
00665      IF RESET-SW EQUAL TO "Q"                                        CL**2
00666          PERFORM FOUND-ELEMENT THRU FOUND-ELEMENT-XIT                CL**2
00667          MOVE SPACES TO OUT-ENV-REC                                  CL**2
00668          GO TO PROCESS-ENVIRONMENT.                                  CL**2
00669      IF RESET-SW EQUAL TO "X"                                        CL**2
00670          PERFORM FOUND-ELEMENT THRU FOUND-ELEMENT-XIT                CL**2
00671          MOVE "N" TO FOUND-SW                                        CL**2
00672          PERFORM FOUND-LINKAGE THRU FOUND-LINKAGE-XIT                CL**2
00673          GO TO PROCESS-RECORD-ENTRY-STRUCTURE.                       CL**2
00674      IF RESET-SW NOT EQUAL TO "G"                                    CL**2
00675          GO TO TEST-CONTROL-LINEB.                                   CL**2
00676      PERFORM FOUND-ELEMENT THRU FOUND-ELEMENT-XIT.                   CL**2
00677  RECORD-CODE-LINE.                                                   CL**2
00678      MOVE "Y" TO LEVEL-SW.                                           CL**2
00679      MOVE "N" TO FOUND-SW.                                           CL**2
00680      MOVE 0 TO GROUP-COUNT.                                          CL**2
00681      MOVE "1" TO OUT-REC-CODE.                                       CL**2
00682      MOVE SPACES TO GROUP-NAME-HOLD-AREA.                            CL**2
00683      MOVE SPACES TO OUT-REC-STRUCTURE.                               CL**2
00684      MOVE TOTAL-REC-CODE2 TO OUT-RECORD-CODE.                        CL**2
00685      PERFORM WRITE-RECORD THRU WRITE-RECORD-XIT.                     CL**2
00686      GO TO PROCESS-RECORD-ENTRY-STRUCTURE.                           CL**2
00687  TEST-CONTROL-LINEB.                                                 CL**2
00688      IF RESET-SW NOT EQUAL TO "Y"                                    CL**2
00689          PERFORM ELEMENT-GROUP THRU ELEMENT-GROUP-XIT                CL**2
00690          GO TO MOVE-RECORD-STRUCTURES.                               CL**2
00691      MOVE "A" TO RESET-SW.                                           CL**2
00692      MOVE DATA-NAME TO CUR-NAME.                                     CL**2
00693      PERFORM ELEMENT-GROUP THRU ELEMENT-GROUP-XIT.                   CL**2
00694      MOVE CUR-NAME TO DATA-NAME.                                     CL**2
00695      MOVE "Y" TO RESET-SW.                                           CL**2
00696      GO TO FOUND-CONTROL-LINE.                                       CL**2
00697                                                                    DCCONTO
00698 ******************************************************************   CL**2
00699 *    READ DBDL AND SET UP ENVIRONMENT CATEGORY RECORD                CL**2
00700 ******************************************************************   CL**2
00701  PROCESS-ENVIRONMENT.                                                CL**2
00702      PERFORM READ-TOTAL THRU READ-TOTAL-XIT.                         CL**2
00703      PERFORM CHECK-SWITCHES THRU CHECK-SWITCHES-XIT.                 CL**2
00704      IF MV-TYPE EQUAL TO "M" AND                                     CL**2
00705          RESET-SW EQUAL TO "E"                                       CL**2
00706          GO TO WRITE-ENVIRONMENT-RECORD.                             CL**2
00707      IF MV-TYPE EQUAL TO "V" AND                                     CL**2
00708          RESET-SW EQUAL TO "F"                                       CL**2
00709          GO TO WRITE-ENVIRONMENT-RECORD.                             CL**2
00710      MOVE TOTAL-IN TO ENVIRONMENT-LINE.                              CL**2
00711      IF DEVICE-LEN EQUAL TO "DEVICE="                                CL**2
00712          MOVE VALUE-LEN TO OUT-DEVICE.                               CL**2
00713      IF LOG-REC EQUAL TO "TOTAL-LOGICAL-RECORDS="                    CL**2
00714          MOVE LOG-REC-VAL TO OUT-TOT-REC.                            CL**2
00715      IF LOG-TRACKS EQUAL TO "TOTAL-TRACKS="                          CL**2
00716          MOVE LOG-TRACKS-VAL TO OUT-TOTAL-TRACKS.                    CL**2
00717      IF LOG-LENGTH EQUAL TO "LOGICAL-RECORD-LENGTH="                 CL**2
00718          MOVE LOG-LENGTH-VAL TO OUT-RECORD-LENGTH.                   CL**2
00719      IF LOG-BLOCKS EQUAL TO "LOGICAL-BLOCKS-PER-TRACK="              CL**2
00720          MOVE LOG-BLOCKS-VAL TO OUT-BLOCKS.                          CL**2
00721      IF LOG-DISKS EQUAL TO "DISK-EXTENTS="                           CL**2
00722          MOVE LOG-DISKS-VAL TO OUT-DISK-EXTENTS.                     CL**2
00723      IF LOG-CYLINDER EQUAL TO "CYLINDER-LOAD-LIMIT="                 CL**2
00724          MOVE LOG-CYLINDER-VAL TO OUT-CYLINDER.                      CL**2
00725      IF LOG-FILE EQUAL TO "OLD-FILE="                                CL**2
00726          MOVE LOG-FILE-VAL TO OUT-OLD-FILE.                          CL**2
00727      GO TO PROCESS-ENVIRONMENT.                                      CL**2
00728  WRITE-ENVIRONMENT-RECORD.                                           CL**2
           IF CVT-FILE (PROG-SUB) NOT EQUAL "Y" 
                 GO TO SET-UP-FOR-DB. 
00729      MOVE "19" TO OUT-ENTRY-TYPE.                                    CL**2
00730      MOVE DATASET-NAME-HOLD TO OUT-CATNAME.                          CL**2
00731      MOVE 2 TO OUT-REC-TYPE.                                         CL**2
00732      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00733      MOVE SPACE TO OUT-REC-CODE.                                     CL**2
00740      WRITE OUT-DATASET-ENV-REC.                                      CL**2
00741      MOVE SPACES TO OUT-DATASET-ENV-REC.                             CL**2
00742      MOVE ZERO TO OUT-STCR.                                          CL**2
00743      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00744      ADD 1 TO STRUCT-COUNT.                                          CL**2
00745 *                                                                    CL**2
00746 *    SET-UP DATABASE STRUCTURE RECORD IN PREPARATION FOR DATASET     CL**2
00747 *                                                                    CL**2
       SET-UP-FOR-DB. 
00748      MOVE "32" TO OUT-ENTRY-TYPE.                                    CL**2
00749      MOVE DATABASE-NAME-HOLD TO OUT-CATNAME.                         CL**2
00750      MOVE "N" TO LEVEL-SW, FOUND-SW, GROUP-SUB-SW.                   CL**2
00751      MOVE SPACE TO OUT-REC-CODE.                                     CL**2
00752      MOVE 0 TO GROUP-COUNT.                                          CL**2
00753      MOVE SPACES TO GROUP-NAME-HOLD-AREA.                            CL**2
00754      GO TO READ-FIRST.                                               CL**2
00755                                                                    DCCONTO
00756 *                                                                    CL**2
00757 *    PROCESSING TO FIND IF FIRST LINE IS AN ELEMENT/GROUP            CL**2
00758 *                                                                    CL**2
00759  ELEMENT-GROUP.                                                      CL**2
00760      IF TOTAL-SECTION (1) EQUAL TO SPACE                             CL**2
00761          GO TO SPACE-PROCESSING.                                     CL**2
00762      IF TOTAL-SECTION (1) EQUAL TO "."                               CL**2
00763          GO TO LEVEL-PROCESSING.                                     CL**2
00764      PERFORM FOUND-ELEMENT THRU FOUND-ELEMENT-XIT.                   CL**2
00765      MOVE "N" TO FOUND-SW.                                           CL**2
00766      MOVE 0 TO GROUP-COUNT.                                          CL**2
00767      GO TO ELEMENT-GROUP-XIT.                                        CL**2
00768  SPACE-PROCESSING.                                                   CL**2
00769      IF LEVEL-IN (1) EQUAL TO SPACE                                  CL**2
00770          PERFORM FOUND-ELEMENT THRU FOUND-ELEMENT-XIT                CL**2
00771          GO TO ELEMENT-GROUP-XIT.                                    CL**2
00772      IF LEVEL-IN (1) NOT EQUAL TO "."                                CL**2
00773          MOVE 0 TO NUMBER-HOLD.                                      CL**2
00774      PERFORM FOUND-GROUP THRU FOUND-GROUP-XIT.                       CL**2
00775      GO TO ELEMENT-GROUP-XIT.                                        CL**2
00776  LEVEL-PROCESSING.                                                   CL**2
00777      IF LEVEL-IN (1) EQUAL TO SPACE                                  CL**2
00778          PERFORM FOUND-ELEMENT THRU FOUND-ELEMENT-XIT                CL**2
00779          SUBTRACT 1 FROM GROUP-COUNT                                 CL**2
00780          GO TO ELEMENT-GROUP-XIT.                                    CL**2
00781      IF LEVEL-IN (1) NOT EQUAL TO "."                                CL**2
00782          MOVE 0 TO NUMBER-HOLD                                       CL**2
00783          PERFORM FOUND-GROUP THRU FOUND-GROUP-XIT                    CL**2
00784          GO TO ELEMENT-GROUP-XIT.                                    CL**2
00785      IF LEVEL-IN (3) EQUAL TO "."                                    CL**2
00786          MOVE LEVEL-NO1 TO NUMBER-HOLD                               CL**2
00787      ELSE                                                            CL**2
00788          MOVE LEVEL-NO2 TO NUMBER-HOLD.                              CL**2
00789      IF TOTAL-SECTION (3) EQUAL TO "."                               CL**2
00790          MOVE FILLER-NUM1 TO NUMBER-HOLD2                            CL**2
00791      ELSE                                                            CL**2
00792          MOVE FILLER-NUM2 TO NUMBER-HOLD2.                           CL**2
00793      IF NUMBER-HOLD EQUAL TO NUMBER-HOLD2                            CL**2
00794          PERFORM FOUND-ELEMENT THRU FOUND-ELEMENT-XIT                CL**2
00795          GO TO ELEMENT-GROUP-XIT.                                    CL**2
00796      IF NUMBER-HOLD GREATER THAN NUMBER-HOLD2                        CL**2
00797          PERFORM FOUND-ELEMENT THRU FOUND-ELEMENT-XIT                CL**2
00798          GO TO REPEAT-EQUALITY.                                      CL**2
00799      PERFORM FOUND-GROUP THRU FOUND-GROUP-XIT.                       CL**2
00800      GO TO ELEMENT-GROUP-XIT.                                        CL**2
00801  REPEAT-EQUALITY.                                                    CL**2
00802      SUBTRACT 1 FROM GROUP-COUNT.                                    CL**2
00803      IF GROUP-COUNT LESS THAN 1                                      CL**2
00804          MOVE "N" TO FOUND-SW                                        CL**2
00805          GO TO ELEMENT-GROUP-XIT.                                    CL**2
00806      IF GROUP-LEVEL-HOLD (GROUP-COUNT) EQUAL TO NUMBER-HOLD2         CL**2
00807          GO TO REPEAT-EQUALITY.                                      CL**2
00808      IF GROUP-LEVEL-HOLD (GROUP-COUNT) GREATER THAN NUMBER-HOLD2     CL**2
00809          GO TO REPEAT-EQUALITY.                                      CL**2
00810  ELEMENT-GROUP-XIT.                                                  CL**2
00811      EXIT.                                                           CL**2
00812                                                                    DCCONTO
00813 *                                                                    CL**2
00814 *    PROCESSING FOUND A GROUP STRUCTURE LINE                         CL**2
00815 *                                                                    CL**2
00816  FOUND-GROUP.                                                        CL**2
00817      MOVE "G" TO ELMGRP-SW.                                          CL**2
00818      IF CVT-GROUP (PROG-SUB) NOT EQUAL TO "Y"                        CL**2
00819          MOVE "M" TO SAVE-USE                                        CL**2
00820      ELSE                                                            CL**2
00821          MOVE "Y" TO SAVE-USE.                                       CL**2
00822      PERFORM MOVE-LEVEL-FIELDS THRU MOVE-LEVEL-FIELDS-XIT.           CL**2
00823  FOUND-GROUP-XIT.                                                    CL**2
00824      EXIT.                                                           CL**2
00825 *                                                                    CL**2
00826 *    PROCESSING FOUND AN ELEMENT STRUCTURE LINE                      CL**2
00827 *                                                                    CL**2
00828  FOUND-ELEMENT.                                                      CL**2
00829      MOVE "E" TO ELMGRP-SW.                                          CL**2
00830      IF CVT-ELEMENT (PROG-SUB) NOT EQUAL TO "Y"                      CL**2
00831          MOVE "X" TO SAVE-USE                                        CL**2
00832      ELSE                                                            CL**2
00833          MOVE "Y" TO SAVE-USE.                                       CL**2
00834      PERFORM MOVE-LEVEL-FIELDS THRU MOVE-LEVEL-FIELDS-XIT.           CL**2
00835  FOUND-ELEMENT-XIT.                                                  CL**2
00836      EXIT.                                                           CL**2
00837 *                                                                    CL**2
00838 *    PROCESSING FOUND A LINKPATH STRUCTURE LINE                      CL**2
00839 *                                                                    CL**2
00840  FOUND-LINKAGE.                                                      CL**2
00841      MOVE LINKA TO LINKC.                                            CL**2
00842      MOVE LINKB TO LINKD.                                            CL**2
00843      MOVE SPACES TO OUT-REC-STRUCTURE.                               CL**2
00844      MOVE LINKPATH-NAME TO OUT-LINKPATH.                             CL**2
00845      MOVE "N" TO FOUND-SW.                                           CL**2
00846      PERFORM WRITE-RECORD THRU WRITE-RECORD-XIT.                     CL**2
00847  FOUND-LINKAGE-XIT.                                                  CL**2
00848      EXIT.                                                           CL**2
00849 *****************************************************************    CL**2
00850 *    THIS PROCESSING MOVE THE CORRECT FIELD TO RIGHTFUL PLACES       CL**2
00851 *        SETS UP THE RECORD STRUCTURE RECORD                         CL**2
00852 *        WRITE THE RECORD STRUCTURE RECORD                           CL**2
00853 *        WRITES THE ELEMENT/GROUP HEADER RECORD                      CL**2
00854 *****************************************************************    CL**2
00855  MOVE-LEVEL-FIELDS.                                                  CL**2
00856      IF SEG-FOUND EQUAL TO "Y"                                       CL**2
00857          MOVE "N" TO SEG-FOUND                                       CL**2
00858          MOVE SAVE-CTRL-LEN TO HOLD-LENGTH                           CL**2
00859          GO TO WRITE-HEADER-RECORD.                                  CL**2
00860      IF LEVEL-IN (1) EQUAL TO SPACE                                  CL**2
00861          MOVE LEVEL-NAME4 TO DATA-NAME                               CL**2
00862          MOVE LEVEL-LENGTH4 TO HOLD-LENGTH                           CL**2
00863          GO TO WRITE-STRUCTURE-RECORD.                               CL**2
00864      IF LEVEL-IN (3) EQUAL TO "."                                    CL**2
00865          MOVE LEVEL-NAME TO DATA-NAME                                CL**2
00866          MOVE LEVEL-LENGTH TO HOLD-LENGTH                            CL**2
00867          GO TO WRITE-STRUCTURE-RECORD.                               CL**2
00868      IF LEVEL-IN (1) EQUAL TO "."                                    CL**2
00869          MOVE LEVEL-NAME2 TO DATA-NAME                               CL**2
00870          MOVE LEVEL-LENGTH2 TO HOLD-LENGTH                           CL**2
00871          GO TO WRITE-STRUCTURE-RECORD.                               CL**2
00872      MOVE LEVEL-NAME3 TO DATA-NAME.                                  CL**2
00873      MOVE LEVEL-LENGTH3 TO HOLD-LENGTH.                              CL**2
00874  WRITE-STRUCTURE-RECORD.                                             CL**2
00875      PERFORM SET-UP-RECORD THRU SET-UP-RECORD-XIT.                   CL**2
00876      PERFORM WRITE-RECORD THRU WRITE-RECORD-XIT.                     CL**2
00877      IF ELMGRP-SW EQUAL TO "E" AND                                   CL**2
00878          SAVE-USE EQUAL TO "X"                                       CL**2
00879          GO TO MOVE-LEVEL-FIELDS-XIT.                                CL**2
00880      IF ELMGRP-SW EQUAL TO "G" AND                                   CL**2
00881          SAVE-USE EQUAL TO "M"                                       CL**2
00882          ADD 1 TO GROUP-COUNT                                        CL**2
00883          MOVE NUMBER-HOLD TO GROUP-LEVEL-HOLD (GROUP-COUNT)          CL**2
00884          MOVE CATAL-NAME TO GROUP-NAME-HOLD (GROUP-COUNT)            CL**2
00885          GO TO MOVE-LEVEL-FIELDS-XIT.                                CL**2
00886  WRITE-HEADER-RECORD.                                                CL**2
           IF (CVT-ELEMENT (PROG-SUB) EQUAL "Y" AND 
                     ELMGRP-SW EQUAL "E")   OR
              (CVT-GROUP (PROG-SUB) EQUAL "Y"  AND
                     ELMGRP-SW EQUAL "G") 
                 NEXT SENTENCE
             ELSE 
                 GO TO MOVE-LEVEL-FIELDS-XIT. 
00887      MOVE CATAL-NAME TO OUT-CATNAME.                                 CL**2
00888      IF ELMGRP-SW EQUAL TO "E"                                       CL**2
00889          MOVE "05" TO OUT-ENTRY-TYPE.                                CL**2
00890      IF ELMGRP-SW EQUAL TO "G"                                       CL**2
00891          MOVE "Y" TO FOUND-SW                                        CL**2
00892          ADD 1 TO GROUP-COUNT                                        CL**2
00893          MOVE NUMBER-HOLD TO GROUP-LEVEL-HOLD (GROUP-COUNT)          CL**2
00894          MOVE CATAL-NAME TO GROUP-NAME-HOLD (GROUP-COUNT)            CL**2
00895          MOVE "10" TO OUT-ENTRY-TYPE.                                CL**2
00896      MOVE 0 TO OUT-REC-TYPE.                                         CL**2
00897      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00898      MOVE HOLD-LENGTH TO OUT-LENGTH.                                 CL**2
00899      IF LEVEL-SW EQUAL TO "Y"                                        CL**2
00900          MOVE "1" TO OUT-REC-CODE.                                   CL**2
00901      PERFORM SET-RENAME-FIELD THRU SET-RENAME-FIELD-XIT.             CL**2
00907      WRITE OUT-BASIC-REC.                                            CL**2
00908      MOVE SPACES TO OUT-BASIC-REC.                                   CL**2
00909      MOVE ZERO TO OUT-STCR.                                          CL**2
00910      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00911      ADD 1 TO STRUCT-COUNT.                                          CL**2
00912  MOVE-LEVEL-FIELDS-XIT.                                              CL**2
00913      EXIT.                                                           CL**2
00914 *                                                                    CL**2
00915 *    ROUTINE RENAMES THE STRUCTURE ENTRY FOUND                       CL**2
00916 *        SETS UP CONTROL RECORD IF ONE EXISTS                        CL**2
00917 *        MOVE NEW NAME OF ENTRY TO OUTPUT RECORD                     CL**2
00918 *                                                                    CL**2
00919  SET-UP-RECORD.                                                      CL**2
00920      MOVE SPACES TO OUT-REC-STRUCTURE.                               CL**2
00921      PERFORM RENAME THRU RENAME-XIT.                                 CL**2
00922      PERFORM PREFIX THRU PREFIX-XIT.                                 CL**2
           IF CVT-RECORD (PROG-SUB) NOT EQUAL "Y" 
                 GO TO SET-UP-RECORD-XIT. 
00923      IF RESET-SW EQUAL TO "Y"                                        CL**2
00924          MOVE "Y" TO OUT-CTRL                                        CL**2
00925          MOVE "Y" TO SEG-FOUND.                                      CL**2
00926      MOVE CATAL-NAME TO OUT-ELEGRP-STC.                              CL**2
00927  SET-UP-RECORD-XIT.                                                  CL**2
00928      EXIT.                                                           CL**2
00929 *                                                                    CL**2
00930 *    ROUTINE SETS UP A RECORD STRUCTURE RECORD                       CL**2
00931 *                                                                    CL**2
00932  WRITE-RECORD.                                                       CL**2
           IF CVT-RECORD (PROG-SUB) NOT EQUAL TO "Y"
                 GO TO WRITE-RECORD-XIT.
00933      IF FOUND-SW EQUAL TO "Y"                                        CL**2
00934          PERFORM WRITE-GROUP THRU WRITE-GROUP-XIT                    CL**2
00935          GO TO WRITE-RECORD-XIT.                                     CL**2
00936      MOVE "N" TO GROUP-SUB-SW.                                       CL**2
00937      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00938      MOVE 1 TO OUT-REC-TYPE.                                         CL**2
00939      MOVE RECORD-NAME-HOLD TO OUT-CATNAME.                           CL**2
00940      MOVE "13" TO OUT-ENTRY-TYPE.                                    CL**2
00941      IF LEVEL-SW EQUAL TO "Y"                                        CL**2
00942          MOVE "1" TO OUT-REC-CODE.                                   CL**2
00949      WRITE OUT-RECORD-REC.                                           CL**2
00950      MOVE SPACES TO OUT-RECORD-REC.                                  CL**2
00951      MOVE ZERO TO OUT-STCR.                                          CL**2
00952      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00953      ADD 1 TO STRUCT-COUNT.                                          CL**2
00954      IF FOUND-SW EQUAL TO "B"                                        CL**2
00955          MOVE "Y" TO FOUND-SW.                                       CL**2
00956  WRITE-RECORD-XIT.                                                   CL**2
00957      EXIT.                                                           CL**2
00958 *                                                                    CL**2
00959 *    ROUTINE SETS UP GROUP STRUCTURE RECORD                          CL**2
00960 *                                                                    CL**2
00961  WRITE-GROUP.                                                        CL**2
           IF CVT-GROUP (PROG-SUB) NOT EQUAL "Y"
                 GO TO WRITE-GROUP-XIT. 
00962      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
00963      MOVE 1 TO OUT-REC-TYPE.                                         CL**2
00964      MOVE SPACES TO OUT-CTRL.                                        CL**2
00965      MOVE GROUP-NAME-HOLD (GROUP-COUNT) TO OUT-CATNAME.              CL**2
00966      MOVE "10" TO OUT-ENTRY-TYPE.                                    CL**2
00967      IF LEVEL-SW EQUAL TO "Y"                                        CL**2
00968          MOVE "1" TO OUT-REC-CODE.                                   CL**2
00975      WRITE OUT-RECORD-REC.                                           CL**2
00976      MOVE SPACES TO OUT-RECORD-REC.                                  CL**2
00977      MOVE ZERO TO OUT-STCR.                                          CL**2
00978      MOVE "T" TO OUT-LANG-CODE.                                      CL**2
00979      ADD 1 TO STRUCT-COUNT.                                          CL**2
00980  WRITE-GROUP-XIT.                                                    CL**2
00981      EXIT.                                                           CL**2
00982 ******************************************************************   CL**2
00983 *                                                                    CL**2
00984 *     RENAME  -  FIND CATALOGUE NAME                                 CL**2
00985 *                                                                    CL**2
00986 ******************************************************************   CL**2
00987  RENAME.                                                             CL**2
00988      MOVE SPACES TO HOLD-RENAME-TABLE.                               CL**2
00989      IF RN-SUB-HI EQUAL 0                                            CL**2
00990          GO TO RN-NOT-FOUND.                                         CL**2
00991      MOVE 1 TO RN-SUB.                                               CL**2
00992  FIND-RN.                                                            CL**2
00993      IF RN-SUB GREATER THAN RN-SUB-HI                                CL**2
00994          GO TO RN-NOT-FOUND.                                         CL**2
00995      IF RENAME-ID (RN-SUB) EQUAL TO SEL-SUB                          CL**2
00996          AND CVT-RENAME (RN-SUB) EQUAL TO DATA-NAME                  CL**2
00997              GO TO RN-FOUND.                                         CL**2
00998      ADD 1 TO RN-SUB.                                                CL**2
00999      GO TO FIND-RN.                                                  CL**2
01000  RN-FOUND.                                                           CL**2
01001      MOVE CVT-RENAME-TABLE (RN-SUB) TO HOLD-RENAME-TABLE.            CL**2
01002      IF CVT-ALIAS-HOLD EQUAL "A"                                     CL**2
01003          GO TO RN-NOT-FOUND.                                         CL**2
01004      MOVE SPACES TO CATAL-NAME.                                      CL**2
01005      MOVE CVT-CATNAME-HOLD TO CATAL-NAME.                            CL**2
01006      GO TO RENAME-XIT.                                               CL**2
01007  RN-NOT-FOUND.                                                       CL**2
01008      MOVE DATA-NAME TO CATAL-NAME.                                   CL**2
01009  RENAME-XIT.                                                         CL**2
01010      EXIT.                                                           CL**2
01011 ******************************************************************   CL**2
01012 *                                                                    CL**2
01013 *         PREFIX TEST  - DROP IF REQUESTED                           CL**2
01014 *                                                                    CL**2
01015 ******************************************************************   CL**2
01016  PREFIX.                                                             CL**2
01017      MOVE SPACES TO PREFIX-OUT.                                      CL**2
01018      IF CVT-PREFIX (SEL-SUB) EQUAL SPACES                            CL**2
01019          GO TO PREFIX-XIT.                                           CL**2
01020      MOVE SPACES TO WORK-AREA.                                       CL**2
01021      MOVE CVT-PREFIX (SEL-SUB) TO WORK-AREA.                         CL**2
01022      MOVE SPACES TO 88-VAL-AREA.                                     CL**2
01023      MOVE CATAL-NAME TO 88-VAL-AREA.                                 CL**2
01024      MOVE 1 TO PX-SUB.                                               CL**2
01025  PRFX-10.                                                            CL**2
01026      IF WORKA (PX-SUB) EQUAL TO SPACE                                CL**2
01027          GO TO PRFX-FND.                                             CL**2
01028      IF 88-AREA (PX-SUB) NOT EQUAL TO WORKA (PX-SUB)                 CL**2
01029          GO TO PREFIX-XIT.                                           CL**2
01030      ADD 1 TO PX-SUB.                                                CL**2
01031      IF PX-SUB NOT EQUAL TO 10                                       CL**2
01032          GO TO PRFX-10.                                              CL**2
01033      IF 88-AREA (PX-SUB) EQUAL TO "-"                                CL**2
01034          ADD 1 TO PX-SUB.                                            CL**2
01035  PRFX-FND.                                                           CL**2
01036      MOVE SPACES TO WORK-AREA.                                       CL**2
01037      MOVE 1 TO WK-SUB.                                               CL**2
01038  PRFX-20.                                                            CL**2
01039      IF 88-AREA (PX-SUB) EQUAL TO SPACE                              CL**2
01040          GO TO PRFX-30.                                              CL**2
01041      MOVE 88-AREA (PX-SUB) TO WORKA (WK-SUB).                        CL**2
01042      ADD 1 TO PX-SUB WK-SUB.                                         CL**2
01043      IF WK-SUB NOT GREATER THAN 32                                   CL**2
01044          GO TO PRFX-20.                                              CL**2
01045  PRFX-30.                                                            CL**2
01046      MOVE WORK-AREA TO CATAL-NAME.                                   CL**2
01047      MOVE CVT-PREFIX (SEL-SUB) TO PREFIX-OUT.                        CL**2
01048  PREFIX-XIT.                                                         CL**2
01049      EXIT.                                                           CL**2
*CALL     DISPLAYLN 
*CALL     WRITELN 
01052  USER-ROUTINE.                                                       CL**2
01053       GO TO USER-ROUTINE-XIT.                                        CL**2
01054  USER-ROUTINE-XIT.                                                   CL**2
01055       EXIT.                                                          CL**2
01056                                                                    DCCONTO
01057  READ-TOTAL.                                                         CL**2
01058      MOVE "N" TO RESET-SW.                                           CL**2
01059      READ TOTAL-FILE AT END                                          CL**2
01060          MOVE "E" TO END-SW                                          CL**2
01061          GO TO READ-TOTAL-XIT.                                       CL**2
01062      MOVE UNLABEL-COB TO TOTAL-IN.                                   CL**2
01063      IF TOTAL-SECTION (1) EQUAL TO SPACE                             CL**2
01064          MOVE "C" TO RESET-SW                                        CL**2
01065          GO TO READ-TOTAL-XIT.                                       CL**2
01066      IF TOTAL-SECTION2 EQUAL TO LITERAL-9                            CL**2
01067          MOVE "R" TO RESET-SW                                        CL**2
01068          GO TO READ-TOTAL-XIT.                                       CL**2
01069      IF TOTAL-SECTION4 EQUAL TO LITERAL-6                            CL**2
01070          GO TO READ-TOTAL.                                           CL**2
01071      IF TOTAL-SECTION5 EQUAL TO LITERAL-13                           CL**2
01072          MOVE "M" TO RESET-SW                                        CL**2
01073          GO TO READ-TOTAL-XIT.                                       CL**2
01074      IF TOTAL-SECTION5 EQUAL TO LITERAL-14                           CL**2
01075          MOVE "V" TO RESET-SW                                        CL**2
01076          GO TO READ-TOTAL-XIT.                                       CL**2
01077      IF TOTAL-SECTION3 EQUAL TO LITERAL-15                           CL**2
01078          MOVE "S" TO RESET-SW                                        CL**2
01079          GO TO READ-TOTAL-XIT.                                       CL**2
01080      IF TOTAL-SECTION2 EQUAL TO LITERAL-10                           CL**2
01081          MOVE "M" TO RESET-SW                                        CL**2
01082          GO TO READ-TOTAL-XIT.                                       CL**2
01083      IF TOTAL-SECTION2 EQUAL TO LITERAL-11                           CL**2
01084          MOVE "V" TO RESET-SW                                        CL**2
01085          GO TO READ-TOTAL-XIT.                                       CL**2
01086      IF TOTAL-SECTION5 EQUAL TO LITERAL-16                           CL**2
01087          MOVE "Q" TO RESET-SW                                        CL**2
01088          GO TO READ-TOTAL-XIT.                                       CL**2
01089      IF TOTAL-SECTION2 EQUAL TO LITERAL-17                           CL**2
01090          MOVE "E" TO RESET-SW                                        CL**2
01091          GO TO READ-TOTAL-XIT.                                       CL**2
01092      IF TOTAL-SECTION2 EQUAL TO LITERAL-18                           CL**2
01093          MOVE "F" TO RESET-SW                                        CL**2
01094          GO TO READ-TOTAL-XIT.                                       CL**2
01095      IF TOTAL-SECTION2 EQUAL TO LITERAL-19                           CL**2
01096          MOVE "X" TO END-SW                                          CL**2
01097          GO TO READ-TOTAL-XIT.                                       CL**2
01098      IF TOTAL-REC-CODE EQUAL TO "RECORD-CODE="                       CL**2
01099          MOVE "G" TO RESET-SW                                        CL**2
01100          GO TO READ-TOTAL-XIT.                                       CL**2
01101      IF TOTAL-SECTION (5) EQUAL TO "L" AND                           CL**2
01102          TOTAL-SECTION (6) EQUAL TO "K"                              CL**2
01103          MOVE "X" TO RESET-SW                                        CL**2
01104          GO TO READ-TOTAL-XIT.                                       CL**2
01105      IF TOTAL-SECTION (1) EQUAL TO "."                               CL**2
01106          GO TO FIND-CTRL.                                            CL**2
01107      IF FILLER-CTRL EQUAL TO "CTRL"                                  CL**2
                MOVE CTRL-NAMEC TO DATA-NAME
01109          MOVE FILLER-LEN TO SAVE-CTRL-LEN                            CL**2
01110          MOVE "Y" TO RESET-SW.                                       CL**2
01111      GO TO READ-TOTAL-XIT.                                           CL**2
01112  FIND-CTRL.                                                          CL**2
01113      IF TOTAL-SECTION (3) NOT EQUAL TO "."                           CL**2
01114          GO TO FIND-CTRL2.                                           CL**2
01115      IF FILLER-CTRL1 EQUAL TO "CTRL"                                 CL**2
                MOVE CTRL-NAMEA TO DATA-NAME
01117          MOVE FILLER-LEN1 TO SAVE-CTRL-LEN                           CL**2
01118          MOVE "Y" TO RESET-SW.                                       CL**2
01119      GO TO READ-TOTAL-XIT.                                           CL**2
01120  FIND-CTRL2.                                                         CL**2
01121      IF FILLER-CTRL2 EQUAL TO "CTRL"                                 CL**2
                MOVE CTRL-NAMEB TO DATA-NAME
01123          MOVE FILLER-LEN2 TO SAVE-CTRL-LEN                           CL**2
01124          MOVE "Y" TO RESET-SW.                                       CL**2
01125  READ-TOTAL-XIT.                                                     CL**2
01126      EXIT.                                                           CL**2
01127  CHECK-SWITCHES.                                                     CL**2
01128      IF END-SW EQUAL TO "E"                                          CL**2
01129          GO TO TOTAL-END.                                            CL**2
01130      IF END-SW EQUAL TO "X"                                          CL**2
01131          MOVE 0 TO STRUCT-COUNT                                      CL**2
01132          GO TO RESET-NEW-PROG.                                       CL**2
01133      IF RESET-SW EQUAL TO "C"                                        CL**2
01134          PERFORM TABLE-NOTES THRU TABLE-NOTES-XIT.                   CL**2
01135  CHECK-SWITCHES-XIT.                                                 CL**2
01136      EXIT.                                                           CL**2
01137 *                                                                    CL**2
01138 *    SET UP OUTPUT HEADER RECORD--ALIASES RENAME PREFIX AND LINE     CL**2
01139 *                                                                    CL**2
01140  SET-RENAME-FIELD.                                                   CL**2
01141      IF CVT-ALIAS-HOLD EQUAL TO "A"                                  CL**2
01142          MOVE CVT-CATNAME-HOLD TO OUT-RENAME                         CL**2
01143      ELSE                                                            CL**2
01144          MOVE CVT-RENAME-HOLD TO OUT-RENAME.                         CL**2
01145      MOVE CVT-BEGIN-HOLD TO OUT-RENAME-LINE.                         CL**2
01146      MOVE CVT-ALIAS-HOLD TO OUT-ALIAS.                               CL**2
01147      MOVE PREFIX-OUT TO OUT-PREFIX.                                  CL**2
01148      MOVE DATA-NAME TO OUT-SEGNAME.                                  CL**2
01149  SET-RENAME-FIELD-XIT.                                               CL**2
01150      EXIT.                                                           CL**2
01151 *****************************************************************    CL**2
01152 *     TABLES A TOTAL OF 50 COMMENT LINES                             CL**2
01153 *****************************************************************    CL**2
01154  TABLE-NOTES.                                                        CL**2
01155      IF CVT-NOTES-OPT (PROG-SUB) NOT EQUAL "Y"                       CL**2
01156          GO TO TABLE-NOTES-XIT.                                      CL**2
01157      IF COMMENT-TABLE EQUAL SPACES                                   CL**2
01158          MOVE 1 TO COM-SUB.                                          CL**2
01159      IF COM-SUB GREATER 50                                           CL**2
01160          GO TO TABLE-NOTES-XIT.                                      CL**2
01161      MOVE TOTAL-IN TO COM-LINE (COM-SUB).                            CL**2
01162      ADD 1 TO COM-SUB.                                               CL**2
01163  TABLE-NOTES-XIT.                                                    CL**2
01164      EXIT.                                                           CL**2
01165 *****************************************************************    CL**2
01166 *                                                                    CL**2
01167 *     COMMENT LINES ARE TAKEN FROM THE TABLE AND                     CL**2
01168 *          FORMATTED AS EITHER RECORD STRUCTURE RECORDS              CL**2
01169 *          OR GROUP STRUCTURE RECORDS                                CL**2
01170 *                                                                    CL**2
01171 *****************************************************************    CL**2
01172  WRITE-COMMENTS.                                                     CL**2
01173      IF CVT-NOTES-OPT (PROG-SUB) NOT EQUAL "Y"                       CL**2
01174          GO TO WRITE-COMMENTS-XIT.                                   CL**2
01175      IF COMMENT-TABLE EQUAL SPACES                                   CL**2
01176          GO TO WRITE-COMMENTS-XIT.                                   CL**2
01177      IF COM-SW EQUAL "G"                                             CL**2
01178          GO TO TEST-GROUPS.                                          CL**2
01179      IF CVT-RECORD (SEL-SUB) NOT EQUAL "Y"                           CL**2
01180          GO TO NO-COMMENTS.                                          CL**2
01181      MOVE 1 TO COM-SUB.                                              CL**2
01182      GO TO SET-UP-KEY.                                               CL**2
01183  TEST-GROUPS.                                                        CL**2
01184      IF CVT-GROUP (SEL-SUB) NOT EQUAL "Y"                            CL**2
01185          GO TO NO-COMMENTS.                                          CL**2
01186      MOVE 1 TO COM-SUB.                                              CL**2
01187  SET-UP-KEY.                                                         CL**2
01188      MOVE SPACES TO OUT-COMMENT-REC.                                 CL**2
01189      IF COM-SW EQUAL "R"                                             CL**2
01190          MOVE "15" TO OUT-ENTRY-TYPE                                 CL**2
01191          MOVE SEG-NAME TO OUT-CATNAME                                CL**2
01192          MOVE SEG-DNAME TO OUT-SEGNAME                               CL**2
01193      ELSE                                                            CL**2
01194          MOVE "10" TO OUT-ENTRY-TYPE                                 CL**2
01195          MOVE LEVT-NAME (LV-SUB) TO OUT-CATNAME                      CL**2
01196          MOVE GRP-DNAME TO OUT-SEGNAME.                              CL**2
01197      IF COM-SUB GREATER THAN 50                                      CL**2
01198          GO TO WRITE-COMMENTS-XIT.                                   CL**2
01199      IF COM-LINE (COM-SUB) EQUAL SPACES                              CL**2
01200          MOVE SPACES TO COMMENT-TABLE                                CL**2
01201          GO TO WRITE-COMMENTS-XIT.                                   CL**2
01202 *                                                                    CL**2
01203 *     PRINT COMMENT                                                  CL**2
01204 *                                                                    CL**2
01205      MOVE SPACES TO LINE1                                            CL**2
01206      MOVE COM-LINE (COM-SUB) TO LINE1C.                              CL**2
01207      MOVE LINE1 TO STD-REPORT-REC.                                   CL**2
01208      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01209 *                                                                    CL**2
01210 *     WRITE RECORD                                                   CL**2
01211 *                                                                    CL**2
01212      MOVE COM-LINE (COM-SUB) TO OUT-COMMENT.                         CL**2
01213      MOVE 1 TO OUT-REC-TYPE.                                         CL**2
01214      MOVE "C" TO OUT-LANG-CODE.                                      CL**2
01215      MOVE STRUCT-COUNT TO OUT-STCR.                                  CL**2
01216      WRITE OUT-COMMENT-REC.                                          CL**2
01217      ADD 1 TO STRUCT-COUNT.                                          CL**2
01218      ADD 1 TO COM-SUB.                                               CL**2
01219          GO TO SET-UP-KEY.                                           CL**2
01220  NO-COMMENTS.                                                        CL**2
01221      MOVE SPACES TO COMMENT-TABLE.                                   CL**2
01222  WRITE-COMMENTS-XIT.                                                 CL**2
01223      EXIT.                                                           CL**2
01224  TOTAL-END.                                                          CL**2
01225      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01226      MOVE 1 TO PROG-SUB.                                             CL**2
01227  TOTAL-END20.                                                        CL**2
01228      IF CVT-MOD-FND (PROG-SUB) EQUAL TO "X"                          CL**2
01229          GO TO TOTAL-END30.                                          CL**2
01230      MOVE CVT-PROG-NAME (PROG-SUB) TO PROG-NOT-FOUND.                CL**2
01231      MOVE NOT-FOUND-MSG TO STD-REPORT-REC.                           CL**2
01232      MOVE 8 TO RETURN-CODE                                           CL**2
01233      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01234  TOTAL-END30.                                                        CL**2
01235      ADD 1 TO PROG-SUB.                                              CL**2
01236      IF PROG-SUB NOT GREATER THAN PROG-SUB-HI                        CL**2
01237          GO TO TOTAL-END20.                                          CL**2
01238      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01239      MOVE END-REPORT-MSG TO STD-REPORT-REC.                          CL**2
01240      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01241      CLOSE WORK-FILE.                                                CL**2
01242      CLOSE TOTAL-FILE.                                               CL**2
01243      CLOSE SYSPRINT.                                                 CL**2
           EXIT PROGRAM.
