*DECK DCCVTGEN
00001  IDENTIFICATION DIVISION.                                         10/24/78
00002  PROGRAM-ID.    CVTGEN.                                           DCCVTGEN
*CALL COPYRIGHT 
      * THIS PROGRAM GENERATES TRANSACTIONS FOR THE UPDATE FROM 
      * COBOL, TOTAL DBDL.
00010  ENVIRONMENT DIVISION.                                               CL**2
00011  CONFIGURATION SECTION.                                              CL**2
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
00014  INPUT-OUTPUT SECTION.                                               CL**2
00015  FILE-CONTROL.                                                       CL**2
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
           SELECT WORK-FILE ASSIGN TO TEMP1 
               USE "RT=Z".
           SELECT PUNCH-FILE ASSIGN TO PNCHFIL
               USE "RT=Z".
00023  DATA DIVISION.                                                      CL**2
00024  FILE SECTION.                                                       CL**2
*CALL CVTWKFD 
*CALL SYSPRTFD
*CALL SYSPUNFD
00030  01  UPD-TRANS.                                                      CL**2
00031      03  UPD-LINE-NO             PICTURE 9(4).                       CL**2
00032      03  FILLER                  PICTURE X.                          CL**2
00033      03  UPD-AST                 PICTURE X.                          CL**2
00034      03  UPD-BODY.                                                   CL**2
00035          05  FILLER              PICTURE X(34).                      CL**2
00036          05  UPD-BAL             PICTURE X(31).                      CL**2
00037      03  FILLER                  PICTURE X(9).                       CL**2
00038  01  ATTR-ELEM.                                                      CL**2
00039      03  FILLER                  PICTURE X(16).                      CL**2
00040      03  PIC-FIELD.                                                  CL**2
00041          05  FILLER              PICTURE X(5).                       CL**2
00042          05  PIC-VAL             PICTURE X(25).                      CL**2
00043      03  ELE-ATT-COMMA           PICTURE X.                          CL**2
00044      03  FILLER                  PICTURE X(33).                      CL**2
00045  01  ATTR-ELEM1.                                                     CL**2
00046      03  FILLER                  PICTURE XX.                         CL**2
00047      03  VAL-FIELD.                                                  CL**2
00048          05  FILLER              PICTURE X(4).                       CL**2
00049          05  VAL-VAL             PICTURE X(25).                      CL**2
00050          05  ELE-ATT-COMMA2      PICTURE X.                          CL**2
00051      03  JUST-FIELD.                                                 CL**2
00052          05  FILLER              PICTURE X(4).                       CL**2
00053          05  JUST-VAL            PICTURE X.                          CL**2
00054          05  ELE-ATT-COMMA-3     PICTURE X.                          CL**2
00055      03  SYNC-FIELD.                                                 CL**2
00056          05  FILLER              PICTURE X(4).                       CL**2
00057          05  SYNC-VAL            PICTURE X.                          CL**2
00058      03  FILLER                  PICTURE X(37).                      CL**2
00059  01  OUT-ALI-LINE.                                                   CL**2
00060      03  ALI-LINE-NO             PICTURE 9(4).                       CL**2
00061      03  FILLER                  PICTURE X.                          CL**2
00062      03  ALI-LINE-OP.                                                CL**2
00063          05  ADA-FIELD.                                              CL**2
00064              07  FILLER          PICTURE X.                          CL**2
00065              07  ADA-KEY         PICTURE XX.                         CL**2
00066              07  FILLER          PICTURE X.                          CL**2
00067              07  ADA-VAL         PICTURE X(32).                      CL**2
00068              07  FILLER          PICTURE X.                          CL**2
00069          05  AFOR-FIELD.                                             CL**2
00070              07  FILLER          PICTURE X(4).                       CL**2
00071              07  ALI-FOR-VAL     PICTURE X.                          CL**2
00072              07  FILLER          PICTURE X.                          CL**2
00073          05  ALEN-FIELD.                                             CL**2
00074              07  FILLER          PICTURE X(4).                       CL**2
00075              07  ALEN-VAL        PICTURE X(4).                       CL**2
00076              07  ALI-COMMA1      PICTURE X.                          CL**2
00077      03  FILLER                  PICTURE X(23).                      CL**2
00078  01  OUT-ALI-LINE2.                                                  CL**2
00079      03  FILLER                  PICTURE X(6).                       CL**2
00080      03  APIC-FIELD.                                                 CL**2
00081          05  FILLER              PICTURE X(4).                       CL**2
00082          05  APIC-VAL            PICTURE X(25).                      CL**2
00083          05  FILLER              PICTURE X.                          CL**2
00084      03  AJUST-FIELD.                                                CL**2
00085          05  FILLER              PICTURE X(4).                       CL**2
00086          05  AJUST-VAL           PICTURE X.                          CL**2
00087          05  FILLER              PICTURE X.                          CL**2
00088      03  ASYNC-FIELD.                                                CL**2
00089          05  FILLER              PICTURE X(4).                       CL**2
00090          05  ASYNC-VAL           PICTURE X.                          CL**2
00091          05  ALI-COMMA2          PICTURE X.                          CL**2
00092      03  FILLER                  PICTURE X(32).                      CL**2
00093  01  OUT-ALI-LINE3.                                                  CL**2
00094      03  FILLER                  PICTURE X(6).                       CL**2
00095      03  AVAL-FIELD.                                                 CL**2
00096          05  FILLER              PICTURE X(4).                       CL**2
00097          05  AVAL-VAL            PICTURE X(25).                      CL**2
00098      03  FILLER                  PICTURE X(45).                      CL**2
00099  01  OUT-STR-LINE.                                                   CL**2
00100      03  OUT-STR-HDR.                                                CL**2
00101          05  FILLER              PICTURE X(5).                       CL**2
00102          05  CAT-KW              PICTURE X(4).                       CL**2
00103          05  STC-CATNAME         PICTURE X(32).                      CL**2
00104      03  OUT-STR-BAL-FILE.                                           CL**2
00105          05  STR-LINE-COMMA      PICTURE X.                          CL**2
00106          05  STC-FILLER-FIELD.                                       CL**2
00107              07  FILLER          PICTURE X(4).                       CL**2
00108              07  STC-FILLER-VAL  PICTURE X(4).                       CL**2
00109              07  STC-LINE-COMMA1 PICTURE X.                          CL**2
00110      03  OUT-STR-BAL.                                                CL**2
00111          05  STC-OCCT-FIELD.                                         CL**2
00112              07  FILLER          PICTURE X(3).                       CL**2
00113              07  STC-OCCT-VAL    PICTURE X(3).                       CL**2
00114              07  STR-LINE-COMMA2 PICTURE X.                          CL**2
00115          05  STC-OCCF-FIELD.                                         CL**2
00116              07  FILLER          PICTURE X(4).                       CL**2
00117              07  STC-OCCF-VAL    PICTURE X(3).                       CL**2
00118              07  STR-LINE-COMMA3 PICTURE X.                          CL**2
00119      03  FILLER                  PICTURE X(14).                      CL**2
00120  01  SHIFT-IN.                                                       CL**2
00121      05  IN-CHAR                 PICTURE X OCCURS 80.                CL**2
*CALL CVTCOM
       01  PRINT-AREA.
*CALL WKPRINT 
               10  ERROR-REC REDEFINES STD-REPORT-REC.
                   15  FILLER          PICTURE XX.
                   15  ERROR-POS1      PICTURE X(6).
                   15  ERROR-POS2      PICTURE X(50). 
*CALL WRKSTG77
00123  77  SUB1                        PICTURE 99 COMP VALUE ZERO.         CL**2
00124  77  SUB2                        PICTURE 99 COMP VALUE ZERO.         CL**2
00125  77  SUB-LIMIT                   PICTURE 99 COMP VALUE 71.           CL**2
00126  77  COMMA-CHAR                  PICTURE X       VALUE ",".          CL**2
       77  DONE                            PICTURE X. 
       77  MAX-FIELD-LEN                   PICTURE 99.
       77  NUM-CHARS                       PICTURE 99.
       77  START-CHAR-POS                  PICTURE 99.
       01  FIELD-AREA.
           03  FIELD-NAME                  PICTURE X(4).
           03  FIELD-VALUE                 PICTURE X(66). 
       01  FIELD-CHAR-ARRAY REDEFINES FIELD-AREA. 
           03  FIELD-CHAR                  PICTURE X OCCURS 70 TIMES. 
00128 *************************************************************        CL**2
00129 *     THESE ARE LINES CREATED                                        CL**2
00130 *************************************************************        CL**2
00131  01  ADD-ENTRY.                                                      CL**2
00132      05  FILLER                  PICTURE X(4)    VALUE "ADD ".       CL**2
00133      05  ADD-TYPE                PICTURE X(3).                       CL**2
           05  FILLER                  PICTURE X       VALUE "=". 
00135      05  ADD-NAME                PICTURE X(32).                      CL**2
00136  01  CATEGORIES.                                                     CL**2
00137      05  CON-CAT                 PICTURE X(3)    VALUE "CON".        CL**2
00138      05  DES-CAT                 PICTURE X(3)    VALUE "DES".        CL**2
00139      05  ATT-CAT                 PICTURE X(3)    VALUE "ATT".        CL**2
00140      05  NAM-CAT                 PICTURE X(3)    VALUE "NAM".        CL**2
00141      05  STR-CAT                 PICTURE X(3)    VALUE "STR".        CL**2
00142      05  REL-CAT                 PICTURE X(3)    VALUE "REL".        CL**2
00143      05  OTH-CAT                 PICTURE X(3)    VALUE "OTH".        CL**2
00144      05  ALI-CAT                 PICTURE X(3)    VALUE "ALI".        CL**2
00145      05  ENV-CAT                 PICTURE XXX     VALUE "ENV".        CL**2
00146      05  IOA-CAT                 PICTURE XXX     VALUE "IOA".        CL**2
00147  01  CON-CAT-LINE.                                                   CL**2
00148      05  FILLER                  PICTURE XX      VALUE "1 ".         CL**2
           05  EAL-VER                     PICTURE X(4).
00150      05  CON-NAME                PICTURE X(32).                      CL**2
00151  01  DES-LINE1.                                                      CL**2
00152      05  FILLER                  PICTURE XX      VALUE "1 ".         CL**2
00153      05  FILLER                  PICTURE X(51)   VALUE               CL**2
00154           "THIS ENTRY WAS CREATED BY THE CONVERT FACILITY ON".       CL**2
00155      05  DES-DATE                PICTURE X(8).                       CL**2
00156  01  DES-LINE2.                                                      CL**2
00157      05  FILLER                  PICTURE XX      VALUE "2 ".         CL**2
00158      05  FILLER                  PICTURE X(11)   VALUE               CL**2
00159          "PREFIX WAS ".                                              CL**2
00160      05  DES-LINE2-BUCKET        PICTURE X(9).                       CL**2
00161  01  NAME-LINE.                                                      CL**2
00162      05  FILLER                  PICTURE XX      VALUE "1 ".         CL**2
00163      05  NAME-KEYWORD            PICTURE X(3).                       CL**2
           05  FILLER                  PICTURE X       VALUE "=". 
00165      05  DATANAME                PICTURE X(32).                      CL**2
00166  01  DATASET-NAME-LINE.                                              CL**2
00167      03  FILLER                  PICTURE XX      VALUE "1 ".         CL**2
00168      03  DATASET-SPACED.                                             CL**2
00169      05  DATASET-LITERAL     PICTURE X(4).                           CL**2
00170      05  DATASET-DDNAME      PICTURE X(8).                           CL**2
00171      05  DATASET-COMMA       PICTURE X.                              CL**2
00172          05  DATASET-LITERAL2    PICTURE X(4).                       CL**2
00173          05  DATASET-DSNAME      PICTURE X(4).                       CL**2
00174          05  DATASET-COMMA2      PICTURE X.                          CL**2
00175          05  DATASET-LITERAL3    PICTURE X(4).                       CL**2
00176          05  DATASET-IOAREA      PICTURE X(4).                       CL**2
00177  01  DATASET-ENVIRONMENT-LINE.                                       CL**2
00178      03  FILLER                  PICTURE XX      VALUE "1 ".         CL**2
00179      03  DATA-ENVIRON.                                               CL**2
00180          05  LITERAL10           PICTURE X(4).                       CL**2
00181          05  DATA-DEVICE         PICTURE X(7).                       CL**2
00182          05  COMMA1              PICTURE X.                          CL**2
00183          05  LITERAL11           PICTURE X(4).                       CL**2
00184          05  DATA-RECS           PICTURE X(7).                       CL**2
00185          05  COMMA2              PICTURE X.                          CL**2
00186          05  LITERAL12           PICTURE X(4).                       CL**2
00187          05  DATA-TRACKS         PICTURE X(5).                       CL**2
00188          05  COMMA3              PICTURE X.                          CL**2
00189          05  LITERAL13           PICTURE X(4).                       CL**2
00190          05  DATA-LENGTH         PICTURE X(5).                       CL**2
00191          05  COMMA4              PICTURE X.                          CL**2
00192  01  DATASET-ENVIRONMENT-LINE2.                                      CL**2
00193      03  FILLER                  PICTURE X       VALUE SPACE.        CL**2
00194      03  DATA-ENVIRON2.                                              CL**2
00195          05  LITERAL14           PICTURE X(4).                       CL**2
00196          05  DATA-BLOCKS         PICTURE X(5).                       CL**2
00197          05  COMMA5              PICTURE X.                          CL**2
00198          05  LITERAL15           PICTURE X(4).                       CL**2
00199          05  DATA-EXTENTS        PICTURE XX.                         CL**2
00200          05  COMMA6              PICTURE X.                          CL**2
00201          05  LITERAL16           PICTURE X(4).                       CL**2
00202          05  DATA-FILE           PICTURE X.                          CL**2
00203          05  COMMA7              PICTURE X.                          CL**2
00204          05  LITERAL17           PICTURE X(4).                       CL**2
00205          05  DATA-CYLINDER       PICTURE XX.                         CL**2
00206  01  ELE-ATT-LINE.                                                   CL**2
00207      03  LEN-ATT.                                                    CL**2
00208          05  FILLER              PICTURE XX      VALUE "1 ".         CL**2
           05  FILLER                  PICTURE X(4)    VALUE "LEN=".
00210          05  ELE-LENGTH          PICTURE X(4).                       CL**2
00211      03  BAL-ATT.                                                    CL**2
           05  FILLER                  PICTURE X(5)    VALUE ",FOR=". 
00213          05  ELE-FORMAT          PICTURE X.                          CL**2
           05  FILLER                  PICTURE X(5)    VALUE ",PIC=". 
00215          05  FILLER              PICTURE X(25)   VALUE SPACE.        CL**2
00216          05  FILLER              PICTURE X       VALUE ",".          CL**2
00217  01  ELE-ATT-LINE2.                                                  CL**2
00218      05  FILLER                  PICTURE XX      VALUE SPACE.        CL**2
           05  FILLER                  PICTURE X(4)    VALUE "IVA=".
00220      05  FILLER                  PICTURE X(25).                      CL**2
00221      05  FILLER                  PICTURE X       VALUE ",".          CL**2
           05  FILLER                  PICTURE X(4)    VALUE "JUS=".
00223      05  FILLER                  PICTURE X       VALUE SPACE.        CL**2
00224      05  FILLER                  PICTURE  X      VALUE ",".          CL**2
           05  FILLER                  PICTURE X(4)    VALUE "SYN=".
00226      05  FILLER                  PICTURE X       VALUE SPACE.        CL**2
00227  01  88-LINE.                                                        CL**2
00228      05  OTH-LINE-NO             PICTURE 9(4)    VALUE ZERO.         CL**2
00231      05  88NAME                  PICTURE X(32).                      CL**2
00234  01  CHG-LINE.                                                       CL**2
           05  FILLER                  PICTURE X(8)    VALUE "CHG ELE=".
00236      05  CHG-NAME                PICTURE X(32).                      CL**2
00237  01  IOA-LINE1.                                                      CL**2
00238      03  IOA-NUMBER              PICTURE 9(4)    VALUE 0.            CL**2
00239      03  FILLER                  PICTURE X       VALUE SPACE.        CL**2
00240      03  IOA-LITERALS.                                               CL**2
00241          05  IOA-LIT1            PICTURE X(4).                       CL**2
00242          05  IOA-CONST1          PICTURE X(4).                       CL**2
00243          05  IOA-COMMA1          PICTURE X.                          CL**2
00244          05  IOA-LIT2            PICTURE X(4).                       CL**2
00245          05  IOA-CONST2          PICTURE XX.                         CL**2
00246  01  DATABASE-STR-LINE1.                                             CL**2
00247      03  STR-DATE-LINE           PICTURE 9(4).                       CL**2
00248      03  FILLER                  PICTURE X       VALUE SPACE.        CL**2
           03  FILLER                  PICTURE X(4)    VALUE "DSN=".
00250      03  STR-DATE-CONST1         PICTURE X(32).                      CL**2
00251      03  FILLER                  PICTURE X       VALUE ",".          CL**2
           03  FILLER                  PICTURE X(4)    VALUE "TYP=".
00253      03  STR-DATE-CONST2         PICTURE X.                          CL**2
00281  01  REC-ATT-LINE.                                                   CL**2
00282      03  FILLER                  PICTURE XX      VALUE "1 ".         CL**2
           03  FILLER                  PICTURE X(4)    VALUE "MAX=".
00284      03  REC-LEN                 PICTURE X(4).                       CL**2
00285  01  FD-LINE.                                                        CL**2
00286      05  FILLER                  PICTURE XX      VALUE "1 ".         CL**2
00287      05  FILLER                  PICTURE X       VALUE SPACE.        CL**2
           05  FILLER                  PICTURE X(4)    VALUE "FDN=".
00289      05  FD-NAME                 PICTURE X(32).                      CL**2
00290  01  FILE-ATT-LINE.                                                  CL**2
00291      03  FILLER                  PICTURE XX.                         CL**2
00292      03  FD-RECSIZE-FIELD.                                           CL**2
00293          05  FILLER              PICTURE X(4).                       CL**2
00294          05  FD-RECSIZE-VAL      PICTURE X(5).                       CL**2
00295          05  FILLER              PICTURE X.                          CL**2
00296      03  FD-BLKSIZE-FIELD.                                           CL**2
00297          05  FILLER              PICTURE X(4).                       CL**2
00298          05  FD-BLKSIZE-VAL      PICTURE X(5).                       CL**2
00299          05  FILLER              PICTURE X.                          CL**2
00300      03  FD-FORMAT-FIELD.                                            CL**2
00301          05  FILLER              PICTURE X(4).                       CL**2
00302          05  FD-FORMAT-VAL       PICTURE X(6).                       CL**2
00303          05  FILLER              PICTURE X.                          CL**2
00304      03  FD-LABELS-FIELD.                                            CL**2
00305          05  FILLER              PICTURE X(4).                       CL**2
00306          05  FD-LABELS-VAL       PICTURE XXX.                        CL**2
00307  01  FD-ATT-LINE.                                                    CL**2
00308      03  FILLER                  PICTURE XX      VALUE "1 ".         CL**2
           03  FILLER                  PICTURE X(4)    VALUE "REC=".
00310      03  FILLER                  PICTURE X(5)    VALUE SPACES.       CL**2
00311      03  FILLER                  PICTURE X       VALUE ",".          CL**2
           03  FILLER                  PICTURE X(4)    VALUE "BLK=".
00313      03  FILLER                  PICTURE X(5)    VALUE SPACES.       CL**2
00314      03  FILLER                  PICTURE X       VALUE ",".          CL**2
           03  FILLER                  PICTURE X(4)    VALUE "RFM=".
00316      03  FILLER                  PICTURE X(6)    VALUE SPACES.       CL**2
00317      03  FILLER                  PICTURE X       VALUE ",".          CL**2
           03  FILLER                  PICTURE X(4)    VALUE "LAB=".
00319      03  FILLER                  PICTURE XXX     VALUE SPACES.       CL**2
00320  01  STR-LINE1.                                                      CL**2
00321      03  STR-LINE-NO             PICTURE 9(4)    VALUE ZERO.         CL**2
00322      03  FILLER                  PICTURE X       VALUE SPACE.        CL**2
           03  FILLER                  PICTURE X(4)    VALUE "CAT=".
00324      03  FILE-STCNAME            PICTURE X(32).                      CL**2
00325      03  STRUCTURE-CLEAR.                                            CL**2
00326          05  FILLER              PICTURE X       VALUE ",".          CL**2
           05  FILLER                  PICTURE X(4)    VALUE "FIL=".
00328          05  FILLER              PICTURE X(4).                       CL**2
00329          05  FILLER              PICTURE X       VALUE ",".          CL**2
           05  FILLER                  PICTURE X(3)    VALUE "TO=". 
00331          05  FILLER              PICTURE X(3).                       CL**2
00332          05  FILLER              PICTURE X       VALUE ",".          CL**2
           05  FILLER                  PICTURE X(4)    VALUE "FRO=".
00334          05  FILLER              PICTURE X(3).                       CL**2
00335          05  FILLER              PICTURE X       VALUE ",".          CL**2
00336  01  STR-LINE-2  REDEFINES  STR-LINE1.                               CL**2
00337      03  FILLER                  PICTURE X(5).                       CL**2
00338      03  CLEAR-LITERALS.                                             CL**2
00339          05  STR-TOT-LIT1        PICTURE X(4).                       CL**2
00340          05  STR-TOT-NAME        PICTURE X(32).                      CL**2
           03  CLEAR-LITERALS1 REDEFINES CLEAR-LITERALS.
               05  STR-TOT-LIT2    PICTURE X(5).
00343          05  STR-TOT-KEY         PICTURE X.                          CL**2
00344      03  CLEAR-LITERALS2  REDEFINES  CLEAR-LITERALS.                 CL**2
00345          05  STR-TOT-LIT3        PICTURE X(4).                       CL**2
00346          05  STR-TOT-LINK        PICTURE X(6).                       CL**2
00347          05  FILLER              PICTURE X(32).                      CL**2
00348      03  CLEAR-LITERALS3  REDEFINES  CLEAR-LITERALS.                 CL**2
00349          05  STR-TOT-LIT4        PICTURE X(4).                       CL**2
00350          05  STR-TOT-RECCODE     PICTURE XX.                         CL**2
00351          05  FILLER              PICTURE X(36).                      CL**2
00352      03  CLEAR-LITERALS4  REDEFINES  CLEAR-LITERALS.                 CL**2
00353          05  STR-TOT-LIT5        PICTURE X(4).                       CL**2
00354          05  STR-TOT-COMP        PICTURE X(32).                      CL**2
00355          05  FILLER              PICTURE X(6).                       CL**2
00356  01  MOD-NAME-LINE.                                                  CL**2
00357          05  FILLER              PICTURE XX      VALUE "1 ".         CL**2
           05  FILLER                  PICTURE X(4)    VALUE "NAM=".
00359          05  MOD-NAME            PICTURE X(32).                      CL**2
00360  01  MOD-ATT-LINE.                                                   CL**2
00361          05  FILLER              PICTURE XX      VALUE "1 ".         CL**2
           05  FILLER                  PICTURE X(4)    VALUE "LAN=".
00363          05  MOD-LANG            PICTURE X.                          CL**2
00364  01  MOD-REL-LINE.                                                   CL**2
00365          05  MOD-STR-LINE-NO     PICTURE 9(4).                       CL**2
00366          05  FILLER              PICTURE X       VALUE SPACE.        CL**2
           05  FILLER                  PICTURE X(4)    VALUE "CAT=".
00368          05  MOD-STCNAME         PICTURE X(32).                      CL**2
00370  01  TEST-TYPES.                                                     CL**2
00371      03  ENTRY-TYPES.                                                CL**2
00372          05  ELEMENT-TYPE        PICTURE XX      VALUE "05".         CL**2
00373          05  GROUP-TYPE          PICTURE XX      VALUE "10".         CL**2
00374          05  RECORD-TYPE         PICTURE XX      VALUE "15".         CL**2
00375          05  FILE-TYPE           PICTURE XX      VALUE "20".         CL**2
00376          05  MODULE-TYPE         PICTURE XX      VALUE "50".         CL**2
00377          05  SEGMENT-TYPE        PICTURE XX      VALUE "17".         CL**2
00378          05  IMSDBD-TYPE         PICTURE XX      VALUE "30".         CL**2
00379          05  TOTAL-RECORD-TYPE   PICTURE XX      VALUE "13".         CL**2
00380          05  TOTALDS-TYPE        PICTURE XX      VALUE "19".         CL**2
00381          05  TOTALDBDL-TYPE      PICTURE XX      VALUE "32".         CL**2
00382      03  ENTRY-NAMES.                                                CL**2
00383          05  ELEMENT-NAME        PICTURE X(3)    VALUE "ELE".        CL**2
00384          05  GROUP-NAME          PICTURE X(3)    VALUE "GRO".        CL**2
00385          05  RECORD-NAME         PICTURE X(3)    VALUE "REC".        CL**2
00386          05  FILE-NAME           PICTURE X(3)    VALUE "FIL".        CL**2
00387          05  MODULE-NAME         PICTURE X(3)    VALUE "MOD".        CL**2
00388          05  SEGMENT-NAME        PICTURE X(3)    VALUE "SEG".        CL**2
00389          05  IMSDBD-NAME         PICTURE XXX     VALUE "DAT".        CL**2
00390          05  TOTALDS-NAME        PICTURE X(3)    VALUE "DAT".        CL**2
00391          05  TOTALDBDL-NAME      PICTURE X(3)    VALUE "TOT".        CL**2
00392      03  MISC-TYPES.                                                 CL**2
00393          05  COBOL-TYPE          PICTURE X       VALUE "C".          CL**2
00394          05  BAL-TYPE            PICTURE X       VALUE "B".          CL**2
00395          05  PL1-TYPE            PICTURE X       VALUE "P".          CL**2
00396          05  TOTAL-TYPE          PICTURE X       VALUE "T".          CL**2
00397          05  COBOL-NAME          PICTURE XXX     VALUE "DAT".        CL**2
00398          05  BAL-NAME            PICTURE XXX     VALUE "SYM".        CL**2
00399          05  PL1-NAME            PICTURE XXX     VALUE "IDE".        CL**2
00400          05  TOT-ELE-NAME        PICTURE XXX     VALUE "DBM".        CL**2
00401          05  ALIAS-TYPE          PICTURE X       VALUE "A".          CL**2
00402          05  88-TYPE             PICTURE X       VALUE "1".          CL**2
00403          05  AST-TYPE            PICTURE X       VALUE "*".          CL**2
00404          05  UPDATE-HDR          PICTURE X(7)    VALUE "$UPDATE".    CL**2
00405  01  SAVE-AREAS.                                                     CL**2
00406      03  SAVE-ENTRY-TYPE         PICTURE XX      VALUE SPACE.        CL**2
00407      03  SAVE-CATNAME            PICTURE X(32).                      CL**2
00408      03  SAVE-88-NAME            PICTURE X(32).                      CL**2
00409      03  SAVE-FILE-NAME          PICTURE X(32).                      CL**2
00410      03  SAVE-MODULE-NAME        PICTURE X(32).                      CL**2
00411      03  SAVE-STC-NAME           PICTURE X(32).                      CL**2
00412      03  SAVE-TOTAL-DBNAME       PICTURE X(32).                      CL**2
00413      03  SAVE-TOTAL-DSNAME       PICTURE X(32).                      CL**2
00414  01  SHIFT-OUT.                                                      CL**2
00415      03  OUT-CHAR                PICTURE X OCCURS 80 TIMES.          CL**2
00424  01  COUNT-AREAS.                                                    CL**2
00425      05  ELEMENT-COUNT           PICTURE 9(4).                       CL**2
00426      05  GROUP-COUNT             PICTURE 9(4).                       CL**2
00427      05  RECORD-COUNT            PICTURE 9(4).                       CL**2
00428      05  FILE-COUNT              PICTURE 9(4).                       CL**2
00429      05  MODULE-COUNT            PICTURE 9(4).                       CL**2
00430      05  SEGMENT-COUNT           PICTURE 9(4).                       CL**2
00431      05  IMSDBD-COUNT            PICTURE 9(4).                       CL**2
00432      05  TOTALDS-COUNT           PICTURE 9(4).                       CL**2
00433      05  TOTALDBDL-COUNT         PICTURE 9(4).                       CL**2
00435  01  WORK-AREAS.                                                     CL**2
00443      05  ENT-BRK-MSG.                                                CL**2
00444          10  FILLER              PICTURE XX      VALUE SPACE.        CL**2
00445          10  DISP-COUNT          PICTURE ZZZZZ9.                     CL**2
00446          10  FILLER              PICTURE X        VALUE SPACE.       CL**2
00447          10  DISP-NAME           PICTURE X(4).                       CL**2
00448          10  FILLER              PICTURE X(8)     VALUE "ENTRIES".   CL**2
00449          10  FILLER              PICTURE X(19)    VALUE              CL**2
00450              "HAVE BEEN GENERATED".                                  CL**2
00451      05  PROG-ID                 PICTURE X(6)     VALUE "DCCVT-".    CL**2
00452      05  END-MSG.                                                    CL**2
00453          10  FILLER              PICTURE X        VALUE SPACE.       CL**2
00454          10  FILLER              PICTURE X(50)    VALUE              CL**2
00455              "*** END OF CONVERSION CONTROL REPORT ***".             CL**2
00456      05  FILL-MSG.                                                   CL**2
00457          10  FILLER              PICTURE XX      VALUE SPACE.        CL**2
00458          10  FILLER              PICTURE X(65)    VALUE              CL**2
00459      "DCCVT-500-W ERROR * ENTRY WITH CATALOGUE NAME OF FILLER BYPA   CL**2
00460 -    "SSED".                                                         CL**2
00466  PROCEDURE DIVISION.                                                 CL**2
       BEGIN-PARA.
           MOVE PRT-CURRENT-DATE TO DES-DATE. 
00468      OPEN INPUT WORK-FILE.                                           CL**2
00469      OPEN OUTPUT SYSPRINT.                                           CL**2
00470      OPEN OUTPUT PUNCH-FILE.                                         CL**2
00498      MOVE UPDATE-HDR TO UPD-TRANS.                                   CL**2
00499      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00500      MOVE ZERO TO COUNT-AREAS.                                       CL**2
00502 ******************************************************************   CL**2
00503 *       M A I N   L I N E                                            CL**2
00504 ******************************************************************   CL**2
00505  READ-IT.                                                            CL**2
00506      MOVE SPACES TO SHIFT-OUT.                                       CL**2
00507      READ WORK-FILE                                                  CL**2
00508          AT END GO TO EOJ.                                           CL**2
00509      IF OUT-ENTRY-TYPE NOT EQUAL SAVE-ENTRY-TYPE                     CL**2
00510          PERFORM ENTRY-BREAK THRU ENTRY-BREAK-XIT.                   CL**2
00511      IF OUT-CATNAME EQUAL "FILLER "                                  CL**2
00512          PERFORM FILLER-BYPASS THRU FILLER-BYPASS-XIT                CL**2
00513          GO TO READ-IT.                                              CL**2
00514      IF OUT-CATNAME NOT EQUAL SAVE-CATNAME                           CL**2
00515          PERFORM NAME-BREAK THRU NAME-BREAK-XIT.                     CL**2
00516      IF OUT-ENTRY-TYPE EQUAL ELEMENT-TYPE                            CL**2
00517          PERFORM CREATE-ELEMENT THRU CREATE-ELEMENT-XIT              CL**2
00518          GO TO READ-IT.                                              CL**2
00519      IF OUT-ENTRY-TYPE EQUAL GROUP-TYPE                              CL**2
00520          PERFORM CREATE-GROUP THRU CREATE-GROUP-XIT                  CL**2
00521          GO TO READ-IT.                                              CL**2
00522      IF OUT-ENTRY-TYPE EQUAL RECORD-TYPE                             CL**2
00523          PERFORM CREATE-RECORD THRU CREATE-RECORD-XIT                CL**2
00524          GO TO READ-IT.                                              CL**2
00525      IF OUT-ENTRY-TYPE EQUAL FILE-TYPE                               CL**2
00526          PERFORM CREATE-FILE THRU CREATE-FILE-XIT                    CL**2
00527          GO TO READ-IT.                                              CL**2
00528      IF OUT-ENTRY-TYPE EQUAL MODULE-TYPE                             CL**2
00529          PERFORM CREATE-MODULE THRU CREATE-MODULE-XIT                CL**2
00530          GO TO READ-IT.                                              CL**2
00531      IF OUT-ENTRY-TYPE EQUAL SEGMENT-TYPE                            CL**2
00532          PERFORM CREATE-SEGMENT THRU CREATE-SEGMENT-XIT              CL**2
00533          GO TO READ-IT.                                              CL**2
00534      IF OUT-ENTRY-TYPE EQUAL IMSDBD-TYPE                             CL**2
00535          PERFORM CREATE-IMSDBD THRU CREATE-IMSDBD-XIT                CL**2
00536          GO TO READ-IT.                                              CL**2
00537      IF OUT-ENTRY-TYPE EQUAL TO TOTAL-RECORD-TYPE                    CL**2
00538          PERFORM CREATE-RECORD THRU CREATE-RECORD-XIT                CL**2
00539          GO TO READ-IT.                                              CL**2
00540      IF OUT-ENTRY-TYPE EQUAL TOTALDS-TYPE                            CL**2
00541          PERFORM CREATE-TOTALDS THRU CREATE-TOTALDS-XIT              CL**2
00542          GO TO READ-IT.                                              CL**2
00543      IF OUT-ENTRY-TYPE EQUAL TOTALDBDL-TYPE                          CL**2
00544          PERFORM CREATE-TOTALDBDL THRU CREATE-TOTALDBDL-XIT          CL**2
00545          GO TO READ-IT.                                              CL**2
00547 **************************************************************       CL**2
00548 *                                                                    CL**2
00549 *              E N D   O F    J O B                                  CL**2
00550 *                                                                    CL**2
00551 **************************************************************       CL**2
00552  EOJ.                                                                CL**2
00553      PERFORM ENTRY-BREAK THRU ENTRY-BREAK-XIT.                       CL**2
00554      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00555      MOVE END-MSG TO STD-REPORT-REC.                                 CL**2
00556  EOJ-100.                                                            CL**2
00557      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00558      CLOSE WORK-FILE.                                                CL**2
00559      CLOSE PUNCH-FILE.                                               CL**2
00560      CLOSE SYSPRINT.                                                 CL**2
           EXIT PROGRAM.
00570 **************************************************************       CL**2
00571 *                                                                    CL**2
00572 *        BREAK IN ENTRY TYPE HAS OCCURRED                            CL**2
00573 *                                                                    CL**2
00574 *************************************************************        CL**2
00575  ENTRY-BREAK.                                                        CL**2
00576      IF SAVE-ENTRY-TYPE EQUAL SPACE                                  CL**2
00577          GO TO ENTRY-BREAK-200.                                      CL**2
00578      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00579      IF SAVE-ENTRY-TYPE EQUAL ELEMENT-TYPE                           CL**2
00580          MOVE ELEMENT-COUNT TO DISP-COUNT                            CL**2
00581          MOVE ELEMENT-NAME TO DISP-NAME                              CL**2
00582           GO TO ENTRY-BREAK-100.                                     CL**2
00583      IF SAVE-ENTRY-TYPE EQUAL GROUP-TYPE                             CL**2
00584          MOVE GROUP-COUNT TO DISP-COUNT                              CL**2
00585          MOVE GROUP-NAME TO DISP-NAME                                CL**2
00586           GO TO ENTRY-BREAK-100.                                     CL**2
00587      IF SAVE-ENTRY-TYPE EQUAL RECORD-TYPE                            CL**2
00588           MOVE RECORD-COUNT TO DISP-COUNT                            CL**2
00589           MOVE RECORD-NAME TO DISP-NAME                              CL**2
00590           GO TO ENTRY-BREAK-100.                                     CL**2
00591      IF SAVE-ENTRY-TYPE EQUAL FILE-TYPE                              CL**2
00592           MOVE FILE-COUNT TO DISP-COUNT                              CL**2
00593           MOVE FILE-NAME TO DISP-NAME                                CL**2
00594           GO TO ENTRY-BREAK-100.                                     CL**2
00595      IF SAVE-ENTRY-TYPE EQUAL MODULE-TYPE                            CL**2
00596           MOVE MODULE-COUNT TO DISP-COUNT                            CL**2
00597           MOVE MODULE-NAME TO DISP-NAME                              CL**2
00598           GO TO ENTRY-BREAK-100.                                     CL**2
00599      IF SAVE-ENTRY-TYPE EQUAL IMSDBD-TYPE                            CL**2
00600           MOVE IMSDBD-COUNT TO DISP-COUNT                            CL**2
00601           MOVE IMSDBD-NAME TO DISP-NAME                              CL**2
00602           GO TO ENTRY-BREAK-100.                                     CL**2
00603      IF SAVE-ENTRY-TYPE EQUAL SEGMENT-TYPE                           CL**2
00604           MOVE SEGMENT-COUNT TO DISP-COUNT                           CL**2
00605           MOVE SEGMENT-NAME TO DISP-NAME                             CL**2
00606           GO TO ENTRY-BREAK-100.                                     CL**2
00607      IF SAVE-ENTRY-TYPE EQUAL TO TOTAL-RECORD-TYPE                   CL**2
00608          MOVE RECORD-COUNT TO DISP-COUNT                             CL**2
00609          MOVE RECORD-NAME TO DISP-NAME                               CL**2
00610          GO TO ENTRY-BREAK-100.                                      CL**2
00611      IF SAVE-ENTRY-TYPE EQUAL TOTALDS-TYPE                           CL**2
00612           MOVE TOTALDS-COUNT TO DISP-COUNT                           CL**2
00613           MOVE TOTALDS-NAME TO DISP-NAME                             CL**2
00614           GO TO ENTRY-BREAK-100.                                     CL**2
00615      IF SAVE-ENTRY-TYPE EQUAL TOTALDBDL-TYPE                         CL**2
00616           MOVE TOTALDBDL-COUNT TO DISP-COUNT                         CL**2
00617           MOVE TOTALDBDL-NAME TO DISP-NAME                           CL**2
00618           GO TO ENTRY-BREAK-100.                                     CL**2
00619  ENTRY-BREAK-100.                                                    CL**2
00620      MOVE ENT-BRK-MSG TO STD-REPORT-REC.                             CL**2
00621      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00622      MOVE MAX-LINES TO LINE-CT.                                      CL**2
00623  ENTRY-BREAK-200.                                                    CL**2
00624      MOVE OUT-ENTRY-TYPE TO SAVE-ENTRY-TYPE.                         CL**2
00625      MOVE SPACE TO SAVE-CATNAME.                                     CL**2
00626  ENTRY-BREAK-XIT.                                                    CL**2
00627      EXIT.                                                           CL**2
00629 ******************************************************************   CL**2
00630 ******************************************************************   CL**2
00631 *                                                                *   CL**2
00632 *    BREAK IN NAME HAS OCCURRED -  CREATE COMMON CATEGORIES      *   CL**2
00633 *                                                                *   CL**2
00634 ******************************************************************   CL**2
00635 ******************************************************************   CL**2
00636  NAME-BREAK.                                                         CL**2
00637      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
00638      MOVE OUT-CATNAME TO SAVE-CATNAME.                               CL**2
00639      IF OUT-ENTRY-TYPE EQUAL ELEMENT-TYPE                            CL**2
00640          MOVE ELEMENT-NAME TO ADD-TYPE                               CL**2
00641          ADD 1 TO ELEMENT-COUNT                                      CL**2
00642          GO TO NAME-BREAK-100.                                       CL**2
00643      IF OUT-ENTRY-TYPE EQUAL GROUP-TYPE                              CL**2
00644          MOVE GROUP-NAME  TO ADD-TYPE                                CL**2
00645          ADD 1 TO GROUP-COUNT                                        CL**2
00646          GO TO NAME-BREAK-100.                                       CL**2
00647      IF OUT-ENTRY-TYPE EQUAL RECORD-TYPE                             CL**2
00648          MOVE RECORD-NAME  TO ADD-TYPE                               CL**2
00649          ADD 1 TO RECORD-COUNT                                       CL**2
00650          GO TO NAME-BREAK-100.                                       CL**2
00651      IF OUT-ENTRY-TYPE EQUAL FILE-TYPE                               CL**2
00652          MOVE FILE-NAME TO ADD-TYPE                                  CL**2
00653          ADD 1 TO FILE-COUNT                                         CL**2
00654          GO TO NAME-BREAK-100.                                       CL**2
00655      IF OUT-ENTRY-TYPE EQUAL MODULE-TYPE                             CL**2
00656          MOVE MODULE-NAME TO ADD-TYPE                                CL**2
00657          ADD 1 TO MODULE-COUNT                                       CL**2
00658          GO TO NAME-BREAK-100.                                       CL**2
00659      IF OUT-ENTRY-TYPE EQUAL SEGMENT-TYPE                            CL**2
00660          MOVE SEGMENT-NAME TO ADD-TYPE                               CL**2
00661          ADD 1 TO SEGMENT-COUNT                                      CL**2
00662          GO TO NAME-BREAK-100.                                       CL**2
00663      IF OUT-ENTRY-TYPE EQUAL IMSDBD-TYPE                             CL**2
00664          MOVE IMSDBD-NAME TO ADD-TYPE                                CL**2
00665          ADD 1 TO IMSDBD-COUNT                                       CL**2
00666          GO TO NAME-BREAK-100.                                       CL**2
00667      IF OUT-ENTRY-TYPE EQUAL TO TOTAL-RECORD-TYPE                    CL**2
00668          MOVE RECORD-NAME TO ADD-TYPE                                CL**2
00669          ADD 1 TO RECORD-COUNT                                       CL**2
00670          GO TO NAME-BREAK-100.                                       CL**2
00671      IF OUT-ENTRY-TYPE EQUAL TOTALDS-TYPE                            CL**2
00672          MOVE TOTALDS-NAME TO ADD-TYPE                               CL**2
00673          ADD 1 TO TOTALDS-COUNT                                      CL**2
00674          GO TO NAME-BREAK-100.                                       CL**2
00675      IF OUT-ENTRY-TYPE EQUAL TOTALDBDL-TYPE                          CL**2
00676         ADD 1 TO TOTALDBDL-COUNT                                     CL**2
00677          MOVE TOTALDBDL-NAME TO ADD-TYPE.                            CL**2
00678  NAME-BREAK-100.                                                     CL**2
00679      IF OUT-RENAME-LINE NOT EQUAL SPACE                              CL**2
00680          GO TO NAME-BREAK-XIT.                                       CL**2
00681      MOVE OUT-CATNAME TO ADD-NAME.                                   CL**2
00682      MOVE ADD-ENTRY TO UPD-TRANS.                                    CL**2
00683      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00684      IF OUT-ALIAS NOT EQUAL ALIAS-TYPE                               CL**2
00685          GO TO NAME-BREAK-200.                                       CL**2
00686 *                                                                *   CL**2
00687 *    PUT OUT CONTROL CATEGORY                                    *   CL**2
00688 *        SPECIFY ALIAS OF NAME                                   *   CL**2
00689 *                                                                *   CL**2
00690      MOVE CON-CAT TO UPD-TRANS.                                      CL**2
00691      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
           IF OUT-ENTRY-TYPE IS LESS THAN "20"
               MOVE "EAL=" TO EAL-VER 
           ELSE 
               MOVE "VER=" TO EAL-VER 
           END-IF.
00692      MOVE OUT-RENAME TO CON-NAME.                                    CL**2
00693      MOVE CON-CAT-LINE TO UPD-TRANS.                                 CL**2
00694      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00695  NAME-BREAK-200.                                                     CL**2
00696      MOVE DES-CAT TO UPD-TRANS.                                      CL**2
00697      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00698      MOVE DES-LINE1 TO UPD-TRANS.                                    CL**2
00699      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00700      IF OUT-PREFIX NOT EQUAL SPACE                                   CL**2
00701          MOVE OUT-PREFIX TO DES-LINE2-BUCKET                         CL**2
00702          MOVE DES-LINE2 TO UPD-TRANS                                 CL**2
00703          PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                   CL**2
00704  NAME-BREAK-XIT.                                                     CL**2
00705      EXIT.                                                           CL**2
00707 ******************************************************************   CL**2
00708 ******************************************************************   CL**2
00709 *    CREATE NAME, ATTRIBUTE AND OTHER CATEGORIES FOR             *   CL**2
00710 *                E L E M E N T S                                 *   CL**2
00711 ******************************************************************   CL**2
00712 ******************************************************************   CL**2
00713  CREATE-ELEMENT.                                                     CL**2
00714      IF OUT-REC-TYPE EQUAL 88-TYPE                                   CL**2
00715          GO TO CREATE-88.                                            CL**2
00716      IF OUT-RENAME-LINE NOT EQUAL SPACE                              CL**2
00717          GO TO CREATE-ALIAS-CATEGORY.                                CL**2
00718 ******************************************************************   CL**2
00719 *    CREATE NAME CATEGORY                                        *   CL**2
00720 ******************************************************************   CL**2
00721      MOVE NAM-CAT TO UPD-TRANS.                                      CL**2
00722      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00723      PERFORM LANG-TRANS THRU LANG-TRANS-XIT.                         CL**2
00724      MOVE OUT-CATNAME TO DATANAME.                                   CL**2
00725      IF OUT-RENAME NOT EQUAL SPACE                                   CL**2
00726          AND OUT-ALIAS NOT EQUAL "A"                                 CL**2
00727          MOVE OUT-RENAME TO DATANAME.                                CL**2
00728      MOVE NAME-LINE TO UPD-TRANS.                                    CL**2
00729      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
           IF (OUT-LENGTH IS EQUAL TO SPACE 
             OR OUT-LENGTH IS EQUAL TO "0000")
             AND OUT-COBOL-REC IS EQUAL TO SPACE
               GO TO CREATE-ELEMENT-XIT.
00730 ******************************************************************   CL**2
00731 *    CREATE ATTRIBUTE CATEGORY                                   *   CL**2
00732 ******************************************************************   CL**2
00733  ELE-ATT-RTN.                                                        CL**2
00734      IF OUT-LANG-CODE EQUAL TO "T" AND                               CL**2
00735          OUT-LENGTH EQUAL TO SPACES                                  CL**2
00736          GO TO CREATE-ELEMENT-XIT.                                   CL**2
00737      MOVE ATT-CAT TO UPD-TRANS.                                      CL**2
00738      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00739      MOVE OUT-LENGTH TO ELE-LENGTH.                                  CL**2
00740      IF OUT-LANG-CODE EQUAL TO "T"                                   CL**2
00741          MOVE SPACES TO BAL-ATT                                      CL**2
00742          MOVE ELE-ATT-LINE TO UPD-TRANS                              CL**2
00743          GO TO CREATE-ELEMENT-200.                                   CL**2
00744      PERFORM USE-TRANS THRU USE-TRANS-XIT.                           CL**2
00745      MOVE OUT-USE TO ELE-FORMAT.                                     CL**2
00746      MOVE ELE-ATT-LINE TO UPD-TRANS.                                 CL**2
00747      IF OUT-PIC EQUAL SPACE                                          CL**2
00748          MOVE SPACE TO PIC-FIELD                                     CL**2
00749      ELSE MOVE OUT-PIC TO PIC-VAL.                                   CL**2
00750      IF OUT-VAL EQUAL SPACE                                          CL**2
00751      AND OUT-JUST EQUAL SPACE                                        CL**2
00752      AND OUT-SYNC EQUAL SPACE                                        CL**2
00753          MOVE SPACE TO ELE-ATT-COMMA                                 CL**2
00754          PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT                    CL**2
00755          GO TO CREATE-ELEMENT-XIT.                                   CL**2
00756      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00757      MOVE ELE-ATT-LINE2 TO UPD-TRANS.                                CL**2
00758      IF OUT-VAL EQUAL SPACE                                          CL**2
00759          MOVE SPACE TO VAL-FIELD                                     CL**2
00760      ELSE MOVE OUT-VAL TO VAL-VAL.                                   CL**2
00761      IF OUT-JUST EQUAL SPACE                                         CL**2
00762      AND OUT-SYNC EQUAL SPACE                                        CL**2
00763          MOVE SPACE TO ELE-ATT-COMMA2 JUST-FIELD SYNC-FIELD          CL**2
00764          GO TO CREATE-ELEMENT-200.                                   CL**2
00765      IF OUT-JUST EQUAL SPACE                                         CL**2
00766          MOVE SPACE TO  JUST-FIELD                                   CL**2
00767      ELSE MOVE OUT-JUST TO JUST-VAL.                                 CL**2
00768      IF OUT-SYNC EQUAL SPACE                                         CL**2
00769          MOVE SPACE TO SYNC-FIELD                                    CL**2
00770          MOVE SPACE TO ELE-ATT-COMMA-3                               CL**2
00771      ELSE MOVE OUT-SYNC TO SYNC-VAL.                                 CL**2
00772      IF OUT-VAL EQUAL SPACE                                          CL**2
00773         GO TO CREATE-ELEMENT-200.                                    CL**2
00774      IF OUT-JUST NOT EQUAL SPACE                                     CL**2
00775         GO TO CREATE-ELEMENT-200.                                    CL**2
00776      MOVE SYNC-FIELD TO JUST-FIELD.                                  CL**2
00777      MOVE SPACE TO SYNC-FIELD.                                       CL**2
00778  CREATE-ELEMENT-200.                                                 CL**2
00779      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00780  CREATE-ELEMENT-XIT.                                                 CL**2
00781      EXIT.                                                           CL**2
00782 ******************************************************************   CL**2
00783 *    CREATE OTHER CATEGORY                                       *   CL**2
00784 ******************************************************************   CL**2
00785  CREATE-88.                                                          CL**2
00786      IF OUT-CATNAME NOT EQUAL SAVE-88-NAME                           CL**2
00787          MOVE OUT-CATNAME TO SAVE-88-NAME                            CL**2
00788          MOVE OTH-CAT TO UPD-TRANS                                   CL**2
00789          PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT                    CL**2
00790         MOVE ZERO TO OTH-LINE-NO.                                    CL**2
00791        MOVE OUT-SEGNAME TO 88NAME.                                   CL**2
00792      ADD 5 TO OTH-LINE-NO.                                           CL**2
           MOVE OTH-LINE-NO TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           MOVE "88L=" TO FIELD-NAME. 
           MOVE 88NAME TO FIELD-VALUE.
           MOVE 36 TO MAX-FIELD-LEN.
           PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT. 
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE " VALUE " TO UPD-TRANS (START-CHAR-POS : 7).
           ADD 7 TO START-CHAR-POS. 
           MOVE OUT-VAL-88 TO UPD-TRANS (START-CHAR-POS : END). 
00795      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00796      GO TO CREATE-ELEMENT-XIT.                                       CL**2
00797 ******************************************************************   CL**2
00798 *                                                                *   CL**2
00799 *    PUT OUT ALIAS CATEGORY                                      *   CL**2
00800 *                                                                *   CL**2
00801 *                                                                *   CL**2
00802 ******************************************************************   CL**2
00803  CREATE-ALIAS-CATEGORY.                                              CL**2
00804      MOVE OUT-RENAME TO CHG-NAME.                                    CL**2
00805      MOVE CHG-LINE TO UPD-TRANS.                                     CL**2
00806      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00807      MOVE ALI-CAT TO UPD-TRANS.                                      CL**2
00808      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
           MOVE OUT-RENAME-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           PERFORM LANG-TRANS THRU LANG-TRANS-XIT.
           MOVE "ADA=" TO FIELD-NAME. 
           MOVE NAME-KEYWORD (1 : 2) TO FIELD-NAME (2 : 2). 
           MOVE OUT-CATNAME TO FIELD-VALUE. 
           MOVE 36 TO MAX-FIELD-LEN.
           PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT. 
           IF OUT-LENGTH IS NOT EQUAL TO SPACE
             AND OUT-LENGTH IS NOT EQUAL TO "0000"
               MOVE "ALE=" TO FIELD-NAME
               MOVE OUT-LENGTH TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-USE IS NOT EQUAL TO SPACE 
               PERFORM USE-TRANS THRU USE-TRANS-XIT 
               MOVE "AFO=" TO FIELD-NAME
               MOVE OUT-USE TO FIELD-VALUE
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-PIC IS NOT EQUAL TO SPACE 
               MOVE "API=" TO FIELD-NAME
               MOVE OUT-PIC TO FIELD-VALUE
               MOVE 29 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-VAL IS NOT EQUAL TO SPACE 
               MOVE "AIN=" TO FIELD-NAME
               MOVE OUT-VAL TO FIELD-VALUE
               MOVE 29 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-JUST IS NOT EQUAL TO SPACE
               MOVE "AJU=" TO FIELD-NAME
               MOVE OUT-JUST TO FIELD-VALUE 
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SYNC IS NOT EQUAL TO SPACE
               MOVE "ALI=" TO FIELD-NAME
               MOVE OUT-SYNC TO FIELD-VALUE 
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.
00856      GO TO CREATE-ELEMENT-XIT.                                       CL**2
00858 ******************************************************************   CL**2
00859 ******************************************************************   CL**2
00860 *                                                                *   CL**2
00861 *    CREATE NAME AND STRUCTURE CATEGORIES FOR                    *   CL**2
00862 *            R E C O R D S                                       *   CL**2
00863 *                                                                *   CL**2
00864 ******************************************************************   CL**2
00865 ******************************************************************   CL**2
00866  CREATE-RECORD.                                                      CL**2
00867      IF OUT-REC-TYPE EQUAL 1                                         CL**2
00868          GO TO CREATE-STRUCTURE.                                     CL**2
00869      MOVE NAM-CAT TO UPD-TRANS.                                      CL**2
00870      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00871      PERFORM LANG-TRANS THRU LANG-TRANS-XIT.                         CL**2
00872      MOVE OUT-CATNAME TO DATANAME.                                   CL**2
00873      IF OUT-RENAME NOT EQUAL SPACE                                   CL**2
00874          MOVE OUT-RENAME TO DATANAME.                                CL**2
00875      MOVE NAME-LINE TO UPD-TRANS.                                    CL**2
00876      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00877      IF OUT-LANG-CODE EQUAL TO "T" AND                               CL**2
00878          OUT-ENTRY-TYPE EQUAL TO "10"                                CL**2
00879          GO TO CREATE-RECORD-XIT.                                    CL**2
00880      IF OUT-ENTRY-TYPE EQUAL TO "10"                                 CL**2
00881          GO TO CREATE-RECORD-XIT.                                    CL**2
00882      IF OUT-LENGTH EQUAL SPACES                                      CL**2
00883          GO TO CREATE-RECORD-XIT.                                    CL**2
00884      MOVE ATT-CAT TO UPD-TRANS.                                      CL**2
00885      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00886      MOVE OUT-LENGTH TO REC-LEN.                                     CL**2
00887      MOVE REC-ATT-LINE TO UPD-TRANS.                                 CL**2
00888      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
00889      GO TO CREATE-RECORD-XIT.                                        CL**2
00890 *      CREATE STRUCTURE LINES                                        CL**2
00891  CREATE-STRUCTURE.                                                   CL**2
00892      IF OUT-LANG-CODE EQUAL TO "T"                                   CL**2
00893          MOVE SPACES TO STRUCTURE-CLEAR.                             CL**2
00894      IF OUT-CATNAME NOT EQUAL SAVE-STC-NAME                          CL**2
00895          MOVE STR-CAT TO UPD-TRANS                                   CL**2
00896          PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT                    CL**2
00897          MOVE OUT-CATNAME TO SAVE-STC-NAME                           CL**2
00898          MOVE ZERO TO STR-LINE-NO.                                   CL**2
00899      IF OUT-AST EQUAL AST-TYPE                                       CL**2
00900          PERFORM CREATE-COMMENT THRU CREATE-COMMENT-XIT              CL**2
00901          GO TO CREATE-RECORD-XIT.                                    CL**2
00902      ADD 5 TO STR-LINE-NO.                                           CL**2
00903      IF OUT-ENTRY-TYPE EQUAL TO "13"                                 CL**2
00904          MOVE SPACES TO CLEAR-LITERALS                               CL**2
00905          GO TO CREATE-TOTAL-STRUCTURE.                               CL**2
00906      IF OUT-LANG-CODE EQUAL TO "T"                                   CL**2
00907          MOVE SPACES TO CLEAR-LITERALS                               CL**2
00908          GO TO CREATE-TOTAL-STRUCTURE-1.                             CL**2
           MOVE STR-LINE-NO TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-REC-CODE IS NOT EQUAL TO "1"
               GO TO CREATE-STRUCTURE-2.
           IF OUT-STCNAME IS NOT EQUAL TO SPACE 
               MOVE "CAT=" TO FIELD-NAME
               MOVE OUT-STCNAME TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-STC-ALIAS-NO IS NOT EQUAL TO SPACE
             AND OUT-STC-ALIAS-NO IS NOT EQUAL TO "0000"
               MOVE "ALI=" TO FIELD-NAME
               MOVE OUT-STC-ALIAS-NO TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF FILLER-LENGTH IS NOT EQUAL TO SPACE 
             AND FILLER-LENGTH IS NOT EQUAL TO "0000" 
               MOVE "FIL=" TO FIELD-NAME
               MOVE FILLER-LENGTH TO FIELD-VALUE
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-REDEF IS NOT EQUAL TO SPACE 
               MOVE "RED=" TO FIELD-NAME
               MOVE OUT-REDEF TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-RDALIAS NOT EQUAL TO SPACE
               MOVE "RDA=" TO FIELD-NAME
               MOVE OUT-RDALIAS TO FIELD-VALUE
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-STRUCTURE-100.
       CREATE-STRUCTURE-2.
           IF OUT-REC-CODE IS NOT EQUAL TO "2"
               GO TO CREATE-STRUCTURE-3.
           IF OUT-OCCF IS NOT EQUAL TO SPACE
               MOVE "FRO=" TO FIELD-NAME
               MOVE OUT-OCCF TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-OCCT IS NOT EQUAL TO SPACE
               MOVE "TO=" TO FIELD-NAME 
               MOVE OUT-OCCT TO FIELD-AREA (4 : END)
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-DEPEND IS NOT EQUAL TO SPACE
               MOVE "DEP=" TO FIELD-NAME
               MOVE OUT-DEPEND TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-STRUCTURE-100.
       CREATE-STRUCTURE-3.
           IF OUT-REC-CODE IS NOT EQUAL TO "3"
               GO TO CREATE-STRUCTURE-4.
           IF OUT-INDEX IS NOT EQUAL TO SPACE 
               MOVE "IND=" TO FIELD-NAME
               MOVE OUT-INDEX TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-STRUCTURE-100.
       CREATE-STRUCTURE-4.
           IF OUT-REC-CODE IS NOT EQUAL TO "4"
               GO TO CREATE-STRUCTURE-5.
           IF OUT-KORDER IS NOT EQUAL TO SPACE
               MOVE "KOR=" TO FIELD-NAME
               MOVE OUT-KORDER TO FIELD-VALUE 
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-KNAME IS NOT EQUAL TO SPACE 
               MOVE "KNA=" TO FIELD-NAME
               MOVE OUT-KNAME TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-KALIAS IS NOT EQUAL TO SPACE
             AND OUT-KALIAS IS NOT EQUAL TO "0000"
               MOVE "KAL=" TO FIELD-NAME
               MOVE OUT-KALIAS TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-STRUCTURE-100.
       CREATE-STRUCTURE-5.
           IF OUT-REC-CODE IS NOT EQUAL TO "5"
               GO TO CREATE-STRUCTURE-6.
           IF OUT-RENAMES IS NOT EQUAL TO SPACE 
               MOVE "REN=" TO FIELD-NAME
               MOVE OUT-RENAMES TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-RNALIAS IS NOT EQUAL TO SPACE 
             AND OUT-RNALIAS IS NOT EQUAL TO "0000" 
               MOVE "RNA=" TO FIELD-NAME
               MOVE OUT-RNALIAS TO FIELD-VALUE
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-STRUCTURE-100.
       CREATE-STRUCTURE-6.
           IF OUT-REC-CODE IS NOT EQUAL TO "6"
               GO TO CREATE-STRUCTURE-100.
           IF OUT-THRU IS NOT EQUAL TO SPACE
               MOVE "THR=" TO FIELD-NAME
               MOVE OUT-THRU TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-THALIAS IS NOT EQUAL TO SPACE 
             AND OUT-THALIAS IS NOT EQUAL TO "0000" 
               MOVE "THA=" TO FIELD-NAME
               MOVE OUT-THALIAS TO FIELD-VALUE
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
       CREATE-STRUCTURE-100.
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           GO TO CREATE-STRUCTURE-300.
00965  CREATE-TOTAL-STRUCTURE.                                             CL**2
00966      IF OUT-ELEGRP-STC EQUAL TO SPACES                               CL**2
00967          GO TO CREATE-LINKAGE-STRUCTURE.                             CL**2
00968      IF OUT-REC-CODE EQUAL TO "1" AND                                CL**2
00969          OUT-ENTRY-TYPE EQUAL TO "13"                                CL**2
00970          GO TO CREATE-COMPNAME.                                      CL**2
00971  CREATE-TOTAL-STRUCTURE-1.                                           CL**2
00972      MOVE OUT-ELEGRP-STC TO STR-TOT-NAME.                            CL**2
           MOVE "CAT=" TO STR-TOT-LIT1. 
00974      IF OUT-ENTRY-TYPE EQUAL TO "19"                                 CL**2
00975          MOVE STR-LINE-2 TO UPD-TRANS                                CL**2
00976          PERFORM CLEAR-SPACES THRU CLEAR-SPACES-XIT                  CL**2
00977          GO TO CREATE-STRUCTURE-300.                                 CL**2
           MOVE STR-LINE-2 TO UPD-TRANS.
           IF OUT-CTRL EQUAL SPACE
                GO TO CREATE-STRUCTURE-300. 
           PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.
           MOVE SPACES TO CLEAR-LITERALS. 
           ADD 5 TO STR-LINE-NO.
           MOVE "Y" TO STR-TOT-KEY. 
           MOVE "TKEY=" TO STR-TOT-LIT2.
           MOVE STR-LINE-2 TO UPD-TRANS.
00984      GO TO CREATE-STRUCTURE-300.                                     CL**2
00985  CREATE-LINKAGE-STRUCTURE.                                           CL**2
00986      IF OUT-LINKPATH EQUAL TO SPACES                                 CL**2
00987          GO TO CREATE-RCCODE.                                        CL**2
               MOVE "LIN=" TO STR-TOT-LIT3. 
00989      MOVE OUT-LINKPATH TO STR-TOT-LINK.                              CL**2
00990      MOVE STR-LINE-2 TO UPD-TRANS.                                   CL**2
00991      GO TO CREATE-STRUCTURE-300.                                     CL**2
00992  CREATE-RCCODE.                                                      CL**2
00993      IF OUT-RECORD-CODE EQUAL TO SPACES                              CL**2
00994          GO TO CREATE-RECORD-XIT.                                    CL**2
           MOVE "RCC=" TO STR-TOT-LIT4. 
00996      MOVE OUT-RECORD-CODE TO STR-TOT-RECCODE.                        CL**2
00997      MOVE STR-LINE-2 TO UPD-TRANS.                                   CL**2
00998      GO TO CREATE-STRUCTURE-300.                                     CL**2
00999  CREATE-COMPNAME.                                                    CL**2
01000      MOVE OUT-ELEGRP-STC TO STR-TOT-COMP.                            CL**2
           MOVE "COM=" TO STR-TOT-LIT5. 
01002      MOVE STR-LINE-2 TO UPD-TRANS.                                   CL**2
01003      GO TO CREATE-STRUCTURE-300.                                     CL**2
01004  CREATE-STRUCTURE-200.                                               CL**2
01005      PERFORM SHIFT-LINE THRU SHIFT-LINE-XIT.                         CL**2
01006  CREATE-STRUCTURE-300.                                               CL**2
01007      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01008  CREATE-RECORD-XIT.                                                  CL**2
01009      EXIT.                                                           CL**2
01011 ******************************************************************   CL**2
01012 ******************************************************************   CL**2
01013 *       CREATE GROUP ENTRIES                                         CL**2
01014 ****************************************************************     CL**2
01015  CREATE-GROUP.                                                       CL**2
01016      IF OUT-REC-TYPE EQUAL 1                                         CL**2
01017          GO TO CREATE-GROUP-200.                                     CL**2
           IF (OUT-LENGTH IS EQUAL TO SPACE 
             OR OUT-LENGTH IS EQUAL TO "0000") AND
01019          OUT-USE EQUAL SPACE AND                                     CL**2
01020          OUT-PIC EQUAL SPACE AND                                     CL**2
01021          OUT-VAL EQUAL SPACE AND                                     CL**2
01022          OUT-JUST EQUAL SPACE AND                                    CL**2
01023          OUT-SYNC EQUAL SPACE                                        CL**2
01024          GO TO CREATE-GROUP-200.                                     CL**2
01025      PERFORM ELE-ATT-RTN THRU CREATE-ELEMENT-XIT.                    CL**2
01026  CREATE-GROUP-200.                                                   CL**2
01027      PERFORM CREATE-RECORD THRU CREATE-RECORD-XIT.                   CL**2
01028  CREATE-GROUP-XIT.                                                   CL**2
01029      EXIT.                                                           CL**2
01031 ******************************************************************   CL**2
01032 *                                                                *   CL**2
01033 *    CREATE NAME, ATTRIBUTE AND STRUCTURE CATEGORIES             *   CL**2
01034 *                F I L E S                                       *   CL**2
01035 ******************************************************************   CL**2
01036  CREATE-FILE.                                                        CL**2
           IF OUT-REC-TYPE EQUAL 1
               GO TO CREATE-FILE-STRUCT.
01039      MOVE ZERO TO STR-LINE-NO.                                       CL**2
01040      MOVE OUT-CATNAME TO SAVE-FILE-NAME.                             CL**2
01041      MOVE OUT-CATNAME TO FD-NAME.                                    CL**2
01042      IF OUT-RENAME NOT EQUAL SPACE                                   CL**2
01043          MOVE OUT-RENAME TO FD-NAME.                                 CL**2
01044      MOVE NAM-CAT TO UPD-TRANS.                                      CL**2
01045      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01046      MOVE FD-LINE TO UPD-TRANS.                                      CL**2
01047      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01048      IF OUT-ATTR EQUAL SPACE                                         CL**2
01049          GO TO CREATE-FILE-XIT.                                      CL**2
01050      MOVE ATT-CAT TO UPD-TRANS.                                      CL**2
01051      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01052      MOVE FD-ATT-LINE TO FILE-ATT-LINE.                              CL**2
01053      IF OUT-RECSIZE NOT EQUAL SPACE                                  CL**2
01054          MOVE OUT-RECSIZE TO FD-RECSIZE-VAL                          CL**2
01055      ELSE MOVE SPACE TO FD-RECSIZE-FIELD.                            CL**2
01056      IF OUT-BLKSIZE NOT EQUAL SPACE                                  CL**2
01057          MOVE OUT-BLKSIZE TO FD-BLKSIZE-VAL                          CL**2
01058      ELSE MOVE SPACE TO FD-BLKSIZE-FIELD.                            CL**2
01059      IF OUT-FORMAT NOT EQUAL SPACE                                   CL**2
01060          MOVE OUT-FORMAT TO FD-FORMAT-VAL                            CL**2
01061      ELSE MOVE SPACE TO FD-FORMAT-FIELD.                             CL**2
01062      IF OUT-LABELS NOT EQUAL SPACE                                   CL**2
01063          MOVE OUT-LABELS TO FD-LABELS-VAL                            CL**2
01064      ELSE MOVE SPACE TO FD-LABELS-FIELD.                             CL**2
01065      MOVE FILE-ATT-LINE TO UPD-TRANS.                                CL**2
01066      PERFORM SHIFT-LINE THRU SHIFT-LINE-XIT.                         CL**2
01067      PERFORM REMOVE-COMMA THRU REMOVE-COMMA-XIT.                     CL**2
01068      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01069      GO TO CREATE-FILE-XIT.                                          CL**2
01070  CREATE-FILE-STRUCT.                                                 CL**2
01071      IF OUT-CATNAME NOT EQUAL SAVE-STC-NAME                          CL**2
01072           MOVE STR-CAT TO UPD-TRANS                                  CL**2
01073           PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT                   CL**2
01074           MOVE OUT-CATNAME TO SAVE-STC-NAME                          CL**2
01075           MOVE ZERO TO STR-LINE-NO.                                  CL**2
01076      IF OUT-AST EQUAL AST-TYPE                                       CL**2
01077          PERFORM CREATE-COMMENT THRU CREATE-COMMENT-XIT              CL**2
01078          GO TO CREATE-FILE-XIT.                                      CL**2
01079      MOVE OUT-FIL-STCNAME TO FILE-STCNAME.                           CL**2
01080      ADD 5 TO STR-LINE-NO.                                           CL**2
01081      MOVE STR-LINE1 TO UPD-TRANS.                                    CL**2
01082      MOVE SPACE TO  OUT-STR-BAL OUT-STR-BAL-FILE.                    CL**2
01083      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01084  CREATE-FILE-XIT.                                                    CL**2
01085      EXIT.                                                           CL**2
01087 ******************************************************************   CL**2
01088 *                                                                *   CL**2
01089 *    CREATE NAME AND RELATIONAL CATEGORIES                       *   CL**2
01090 *            M O D U L E                                         *   CL**2
01091 *                                                                *   CL**2
01092 ******************************************************************   CL**2
01093  CREATE-MODULE.                                                      CL**2
01094      IF OUT-CATNAME NOT EQUAL SAVE-MODULE-NAME                       CL**2
01095          MOVE OUT-CATNAME TO SAVE-MODULE-NAME                        CL**2
01096          MOVE ZERO TO MOD-STR-LINE-NO                                CL**2
01097          MOVE NAM-CAT TO UPD-TRANS                                   CL**2
01098          PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT                    CL**2
01099          MOVE OUT-MODULE-ID TO MOD-NAME                              CL**2
01100          MOVE MOD-NAME-LINE TO UPD-TRANS                             CL**2
01101          PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                   CL**2
01102      IF OUT-REC-TYPE EQUAL 1                                         CL**2
01103          GO TO CREATE-MODULE-200.                                    CL**2
01104      MOVE ATT-CAT TO UPD-TRANS.                                      CL**2
01105      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01106      IF OUT-LANG-CODE EQUAL COBOL-TYPE                               CL**2
01107           MOVE COBOL-TYPE TO MOD-LANG.                               CL**2
01108      IF OUT-LANG-CODE EQUAL PL1-TYPE                                 CL**2
01109           MOVE PL1-TYPE TO MOD-LANG.                                 CL**2
01110      IF OUT-LANG-CODE EQUAL BAL-TYPE                                 CL**2
01111           MOVE "A" TO MOD-LANG.                                      CL**2
01112      MOVE MOD-ATT-LINE TO UPD-TRANS.                                 CL**2
01113      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01114      GO TO CREATE-MODULE-XIT.                                        CL**2
01115  CREATE-MODULE-200.                                                  CL**2
01116      IF MOD-STR-LINE-NO EQUAL ZERO                                   CL**2
01117          MOVE REL-CAT TO UPD-TRANS                                   CL**2
01118          PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                   CL**2
01119      IF OUT-AST EQUAL AST-TYPE                                       CL**2
01120          MOVE MOD-STR-LINE-NO TO STR-LINE-NO                         CL**2
01121          PERFORM CREATE-COMMENT THRU CREATE-COMMENT-XIT              CL**2
01122          MOVE STR-LINE-NO TO MOD-STR-LINE-NO                         CL**2
01123          GO TO CREATE-MODULE-XIT.                                    CL**2
01124      ADD 5 TO MOD-STR-LINE-NO.                                       CL**2
01125      MOVE OUT-MOD-STCNAME TO MOD-STCNAME.                            CL**2
01126      MOVE MOD-REL-LINE TO UPD-TRANS.                                 CL**2
01127      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01128  CREATE-MODULE-XIT.                                                  CL**2
01129      EXIT.                                                           CL**2
01131 ***********************************************************          CL**2
01132 *    THESE ROUTINES DO NOT YET FUNCTION                              CL**2
01133 ***********************************************************          CL**2
01134  CREATE-SEGMENT.                                                     CL**2
01135  CREATE-SEGMENT-XIT.                                                 CL**2
01136      EXIT.                                                           CL**2
01137  CREATE-IMSDBD.                                                      CL**2
01138  CREATE-IMSDBD-XIT.                                                  CL**2
01139      EXIT.                                                           CL**2
01140 ******************************************************************   CL**2
01141 *                                                                    CL**2
01142 *    CREATE DATASET ENTRIES                                          CL**2
01143 *                                                                    CL**2
01144 ******************************************************************   CL**2
01145  CREATE-TOTALDS.                                                     CL**2
01146      IF OUT-REC-TYPE EQUAL TO 1                                      CL**2
01147          GO TO CREATE-DATASET-STRUCTURE.                             CL**2
01148      IF OUT-REC-TYPE EQUAL TO 2                                      CL**2
01149          MOVE SPACES TO DATA-ENVIRON, DATA-ENVIRON2                  CL**2
01150          GO TO CREATE-DATASET-ENVIRONMENT.                           CL**2
01151      MOVE SPACES TO DATASET-SPACED.                                  CL**2
01152      MOVE NAM-CAT TO UPD-TRANS.                                      CL**2
01153      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01154      IF SET-NAME NOT EQUAL TO SPACES                                 CL**2
               MOVE COMMA-CHAR TO DATASET-COMMA2
               MOVE "TDS=" TO DATASET-LITERAL2
01157          MOVE SET-NAME TO DATASET-DSNAME.                            CL**2
01158      IF SET-IOAREA NOT EQUAL TO SPACES                               CL**2
               MOVE "IOA=" TO DATASET-LITERAL3
01160          MOVE SET-IOAREA TO DATASET-IOAREA.                          CL**2
01161      MOVE DATASET-NAME-LINE TO UPD-TRANS.                            CL**2
01162      PERFORM SHIFT-LINE THRU SHIFT-LINE-XIT.                         CL**2
01163      PERFORM REMOVE-COMMA THRU REMOVE-COMMA-XIT.                     CL**2
01164      PERFORM CLEAR-SPACES THRU CLEAR-SPACES-XIT.                     CL**2
01165      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01166      GO TO CREATE-TOTALDS-XIT.                                       CL**2
01167  CREATE-DATASET-STRUCTURE.                                           CL**2
01168      PERFORM CREATE-RECORD THRU CREATE-RECORD-XIT.                   CL**2
01169      GO TO CREATE-TOTALDS-XIT.                                       CL**2
01170  CREATE-DATASET-ENVIRONMENT.                                         CL**2
01171      MOVE ENV-CAT TO UPD-TRANS.                                      CL**2
01172      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01173      IF OUT-DEVICE NOT EQUAL TO SPACES                               CL**2
01174          MOVE COMMA-CHAR TO COMMA1                                   CL**2
               MOVE "DEV=" TO LITERAL10 
01176          MOVE OUT-DEVICE TO DATA-DEVICE.                             CL**2
01177      IF OUT-TOT-REC NOT EQUAL TO SPACES                              CL**2
01178          MOVE COMMA-CHAR TO COMMA2                                   CL**2
               MOVE "TRE=" TO LITERAL11 
01180          MOVE OUT-TOT-REC TO DATA-RECS.                              CL**2
01181      IF OUT-TOTAL-TRACKS NOT EQUAL TO SPACES                         CL**2
01182          MOVE COMMA-CHAR TO COMMA3                                   CL**2
               MOVE "TTR=" TO LITERAL12 
01184          MOVE OUT-TOTAL-TRACKS TO DATA-TRACKS.                       CL**2
01185      IF OUT-RECORD-LENGTH NOT EQUAL TO SPACES                        CL**2
01186          MOVE COMMA-CHAR TO COMMA4                                   CL**2
               MOVE "TLE=" TO LITERAL13 
01188          MOVE OUT-RECORD-LENGTH TO DATA-LENGTH.                      CL**2
01189      IF OUT-BLOCKS EQUAL TO SPACES AND                               CL**2
01190          OUT-DISK-EXTENTS EQUAL TO SPACES AND                        CL**2
01191          OUT-OLD-FILE EQUAL TO SPACES AND                            CL**2
01192          OUT-CYLINDER EQUAL TO SPACES                                CL**2
01193          MOVE DATASET-ENVIRONMENT-LINE TO UPD-TRANS                  CL**2
01194          PERFORM SHIFT-LINE THRU SHIFT-LINE-XIT                      CL**2
01195          PERFORM REMOVE-COMMA THRU REMOVE-COMMA-XIT                  CL**2
01196          PERFORM CLEAR-SPACES THRU CLEAR-SPACES-XIT                  CL**2
01197          PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT                    CL**2
01198          GO TO CREATE-TOTALDS-XIT.                                   CL**2
01199      GO TO MOVE-ENV-LINE.                                            CL**2
01200  ENVIRONMENT-COMEBACK.                                               CL**2
01201      IF OUT-BLOCKS NOT EQUAL TO SPACES                               CL**2
01202          MOVE COMMA-CHAR TO COMMA5                                   CL**2
               MOVE "BLO=" TO LITERAL14 
01204          MOVE OUT-BLOCKS TO DATA-BLOCKS.                             CL**2
01205      IF OUT-DISK-EXTENTS NOT EQUAL TO SPACES                         CL**2
01206          MOVE COMMA-CHAR TO COMMA6                                   CL**2
               MOVE "TEX=" TO LITERAL15 
01208          MOVE OUT-DISK-EXTENTS TO DATA-EXTENTS.                      CL**2
01209      IF OUT-OLD-FILE NOT EQUAL TO SPACES                             CL**2
01210          MOVE COMMA-CHAR TO COMMA7                                   CL**2
               MOVE "OLD=" TO LITERAL16 
01212          MOVE OUT-OLD-FILE TO DATA-FILE.                             CL**2
01213      IF OUT-CYLINDER NOT EQUAL TO SPACES                             CL**2
               MOVE "LOA=" TO LITERAL17 
01215          MOVE OUT-CYLINDER TO DATA-CYLINDER.                         CL**2
01216      MOVE DATASET-ENVIRONMENT-LINE2 TO UPD-TRANS.                    CL**2
01217      PERFORM SHIFT-LINE THRU SHIFT-LINE-XIT.                         CL**2
01218      PERFORM REMOVE-COMMA THRU REMOVE-COMMA-XIT.                     CL**2
01219      PERFORM CLEAR-SPACES THRU CLEAR-SPACES-XIT.                     CL**2
01220      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01221      GO TO CREATE-TOTALDS-XIT.                                       CL**2
01222  MOVE-ENV-LINE.                                                      CL**2
01223      MOVE DATASET-ENVIRONMENT-LINE TO UPD-TRANS.                     CL**2
01224      PERFORM SHIFT-LINE THRU SHIFT-LINE-XIT.                         CL**2
01225      PERFORM CLEAR-SPACES THRU CLEAR-SPACES-XIT.                     CL**2
01226      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01227      GO TO ENVIRONMENT-COMEBACK.                                     CL**2
01228  CREATE-TOTALDS-XIT.                                                 CL**2
01229      EXIT.                                                           CL**2
01230 ******************************************************************   CL**2
01231 *                                                                    CL**2
01232 *    CREATE DATABASE ENTRIES                                         CL**2
01233 *                                                                    CL**2
01234 ******************************************************************   CL**2
01235  CREATE-TOTALDBDL.                                                   CL**2
01236      IF OUT-REC-TYPE EQUAL TO 1                                      CL**2
01237          GO TO CREATE-DATABASE-STRUCTURE.                            CL**2
01238      MOVE NAM-CAT TO UPD-TRANS.                                      CL**2
01239      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01240      MOVE SPACES TO DATASET-SPACED.                                  CL**2
01241      MOVE OUT-CATNAME TO DATASET-DDNAME.                             CL**2
           MOVE "DBN=" TO DATASET-LITERAL.
01243      IF OUT-RENAME NOT EQUAL TO SPACE                                CL**2
01244          MOVE OUT-RENAME TO DATASET-DDNAME.                          CL**2
01245      MOVE DATASET-NAME-LINE TO UPD-TRANS.                            CL**2
01246      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01247      MOVE 1 TO SUB1.                                                 CL**2
01248      IF OUT-DATABASE-IO (SUB1) EQUAL TO SPACES                       CL**2
01249          GO TO CREATE-TOTALDBDL-XIT.                                 CL**2
01250      MOVE IOA-CAT TO UPD-TRANS.                                      CL**2
01251      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01252  FIND-IOAREAS.                                                       CL**2
01253      MOVE SPACES TO IOA-LITERALS.                                    CL**2
01254      IF OUT-DB-IOA (SUB1) EQUAL TO SPACES                            CL**2
01255          GO TO CREATE-TOTALDBDL-XIT.                                 CL**2
01256      ADD 1 TO IOA-NUMBER.                                            CL**2
01257      MOVE OUT-DB-IOA (SUB1) TO IOA-CONST1.                           CL**2
           MOVE "IOA=" TO IOA-LIT1. 
01259      IF OUT-DB-OCC (SUB1) NOT EQUAL TO SPACES                        CL**2
01260          MOVE COMMA-CHAR TO IOA-COMMA1                               CL**2
01261          MOVE OUT-DB-OCC (SUB1) TO IOA-CONST2                        CL**2
               MOVE "OCC=" TO IOA-LIT2. 
01263      MOVE IOA-LINE1 TO UPD-TRANS.                                    CL**2
01264      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01265      ADD 1 TO SUB1.                                                  CL**2
01266      GO TO FIND-IOAREAS.                                             CL**2
01267  CREATE-DATABASE-STRUCTURE.                                          CL**2
01268      IF OUT-CATNAME NOT EQUAL TO SAVE-STC-NAME                       CL**2
01269          MOVE STR-CAT TO UPD-TRANS                                   CL**2
01270          PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT                    CL**2
01271          MOVE OUT-CATNAME TO SAVE-STC-NAME                           CL**2
01272          MOVE 0 TO STR-DATE-LINE.                                    CL**2
01273      ADD 5 TO STR-DATE-LINE.                                         CL**2
01274      MOVE OUT-DATASET-STCNAME TO STR-DATE-CONST1.                    CL**2
01275      MOVE OUT-DATE-TYPE TO STR-DATE-CONST2.                          CL**2
01276      MOVE DATABASE-STR-LINE1 TO UPD-TRANS.                           CL**2
01277      PERFORM CLEAR-SPACES THRU CLEAR-SPACES-XIT.                     CL**2
01278      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01279  CREATE-TOTALDBDL-XIT.                                               CL**2
01280      EXIT.                                                           CL**2
01282 **********************************************************           CL**2
01283 *    PRINT FILLER BYPASSED                                           CL**2
01284 **********************************************************           CL**2
01285  FILLER-BYPASS.                                                      CL**2
01286      MOVE FILL-MSG TO STD-REPORT-REC.                                CL**2
01287      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01288  FILLER-BYPASS-XIT.                                                  CL**2
01289      EXIT.                                                           CL**2
01290 ***************************************************************      CL**2
01291 *     SET UP NAME KEYWORD FOR LANGUAGE                               CL**2
01292 **************************************************************       CL**2
01293  LANG-TRANS.                                                         CL**2
01294      IF OUT-LANG-CODE EQUAL COBOL-TYPE                               CL**2
01295            MOVE COBOL-NAME TO NAME-KEYWORD                           CL**2
01296            GO TO LANG-TRANS-XIT.                                     CL**2
01297      IF OUT-LANG-CODE EQUAL PL1-TYPE                                 CL**2
01298            MOVE PL1-NAME TO NAME-KEYWORD                             CL**2
01299            GO TO LANG-TRANS-XIT.                                     CL**2
01300      IF OUT-LANG-CODE EQUAL BAL-TYPE                                 CL**2
01301            MOVE BAL-NAME TO NAME-KEYWORD                             CL**2
01302            GO TO LANG-TRANS-XIT.                                     CL**2
01303      IF OUT-LANG-CODE EQUAL TO TOTAL-TYPE AND                        CL**2
01304          OUT-ENTRY-TYPE EQUAL TO "05" OR "10" OR "13"                CL**2
01305          MOVE TOT-ELE-NAME TO NAME-KEYWORD.                          CL**2
01306  LANG-TRANS-XIT.                                                     CL**2
01307      EXIT.                                                           CL**2
01308 *************************************************************        CL**2
01309 *   SET UP USAGE CODE                                                CL**2
01310 **************************************************************       CL**2
01311  USE-TRANS.                                                          CL**2
01312      IF OUT-USE EQUAL "X"                                            CL**2
01313          MOVE "C" TO OUT-USE                                         CL**2
01314          GO TO USE-TRANS-XIT.                                        CL**2
01315      IF OUT-USE EQUAL "N"                                            CL**2
01316          MOVE "N" TO OUT-USE.                                        CL**2
01317      IF OUT-USE EQUAL "D"                                            CL**2
01318          MOVE "C" TO OUT-USE                                         CL**2
01319          GO TO USE-TRANS-XIT.                                        CL**2
01320      IF OUT-USE EQUAL "3"                                            CL**2
01321          MOVE "P" TO OUT-USE.                                        CL**2
01322      IF OUT-USE EQUAL "C"                                            CL**2
01323          MOVE "B" TO OUT-USE.                                        CL**2
01324      IF OUT-USE EQUAL "1"                                            CL**2
01325          MOVE "F" TO OUT-USE.                                        CL**2
01326      IF OUT-USE EQUAL "2"                                            CL**2
01327          MOVE "F" TO OUT-USE.                                        CL**2
01328  USE-TRANS-XIT.                                                      CL**2
01329      EXIT.                                                           CL**2
01330 ***********************************************************          CL**2
01331 *    SHIFT OUT SPACES ON OUTPUT LINE                                 CL**2
01332 ***********************************************************          CL**2
01333  CLEAR-SPACES.                                                       CL**2
01334      MOVE SPACES TO SHIFT-OUT.                                       CL**2
01335      MOVE 1 TO SUB1, SUB2.                                           CL**2
01336  CLEAR-SPACES-100.                                                   CL**2
           IF OUT-ENTRY-TYPE EQUAL TO "19" AND
               OUT-REC-TYPE EQUAL TO 1
               GO TO CLEAR-SPACES-50. 
           IF OUT-ENTRY-TYPE EQUAL TO "19" AND
01338          SUB1 GREATER THAN 2                                         CL**2
01339          GO TO CLEAR-SPACES-200.                                     CL**2
       CLEAR-SPACES-50. 
01340      IF SUB1 GREATER THAN 5                                          CL**2
01341          GO TO CLEAR-SPACES-200.                                     CL**2
01342      MOVE IN-CHAR (SUB1) TO OUT-CHAR (SUB2).                         CL**2
01343      ADD 1 TO SUB1, SUB2.                                            CL**2
01344      GO TO CLEAR-SPACES-100.                                         CL**2
01345  CLEAR-SPACES-200.                                                   CL**2
01346      IF SUB1 GREATER THAN SUB-LIMIT                                  CL**2
01347          GO TO CLEAR-SPACES-300.                                     CL**2
01348      IF IN-CHAR (SUB1) EQUAL TO SPACE                                CL**2
01349          ADD 1 TO SUB1                                               CL**2
01350          GO TO CLEAR-SPACES-200.                                     CL**2
01351      MOVE IN-CHAR (SUB1) TO OUT-CHAR (SUB2).                         CL**2
01352      ADD 1 TO SUB1, SUB2.                                            CL**2
01353      GO TO CLEAR-SPACES-200.                                         CL**2
01354  CLEAR-SPACES-300.                                                   CL**2
01355      MOVE SHIFT-OUT TO UPD-TRANS.                                    CL**2
01356  CLEAR-SPACES-XIT.                                                   CL**2
01357 ****************************************************************     CL**2
01358 *    SHIFT OUT SPACES BETWEEN TRAILING COMMA AND NEXT KEYWORD        CL**2
01359 *****************************************************************    CL**2
01360  SHIFT-LINE.                                                         CL**2
01361      MOVE SPACE TO SHIFT-OUT.                                        CL**2
01362      MOVE 1 TO SUB1 SUB2.                                            CL**2
01363  SHIFT-100.                                                          CL**2
01364      IF SUB1 GREATER THAN SUB-LIMIT                                  CL**2
01365          GO TO SHIFT-300.                                            CL**2
01366      MOVE IN-CHAR (SUB1) TO OUT-CHAR (SUB2).                         CL**2
01367      IF IN-CHAR (SUB1) EQUAL COMMA-CHAR                              CL**2
01368         GO TO SHIFT-200.                                             CL**2
01369      ADD 1 TO SUB1 SUB2.                                             CL**2
01370      GO TO SHIFT-100.                                                CL**2
01371  SHIFT-200.                                                          CL**2
01372      ADD 1 TO SUB1.                                                  CL**2
01373      IF IN-CHAR (SUB1) NOT EQUAL SPACE                               CL**2
01374          ADD 1 TO SUB2                                               CL**2
01375          GO TO SHIFT-100.                                            CL**2
01376      IF SUB1 GREATER THAN SUB-LIMIT                                  CL**2
01377          GO TO SHIFT-300.                                            CL**2
01378      GO TO SHIFT-200.                                                CL**2
01379  SHIFT-300.                                                          CL**2
01380      MOVE SHIFT-OUT TO UPD-TRANS.                                    CL**2
01381  SHIFT-LINE-XIT.                                                     CL**2
01382      EXIT.                                                           CL**2
01383 *******************************                                      CL**2
01384 *    REMOVE TRAILING COMMA                                           CL**2
01385 *******************************                                      CL**2
01386  REMOVE-COMMA.                                                       CL**2
01387      MOVE SUB-LIMIT TO SUB1.                                         CL**2
01388  COMMA-LOOP.                                                         CL**2
01389      IF IN-CHAR (SUB1) EQUAL SPACES                                  CL**2
01390          SUBTRACT 1 FROM SUB1                                        CL**2
01391          GO TO COMMA-LOOP.                                           CL**2
01392      IF IN-CHAR (SUB1) EQUAL COMMA-CHAR                              CL**2
01393          MOVE SPACE TO IN-CHAR (SUB1).                               CL**2
01394  REMOVE-COMMA-XIT.                                                   CL**2
01395      EXIT.                                                           CL**2
01396 ***************************************************************      CL**2
01397 *         WRITE OUT TRANSACTIONS                                     CL**2
01398 **************************************************************       CL**2
01399  WRITE-TRANS.                                                        CL**2
01400      MOVE UPD-TRANS TO STD-REPORT-REC.                               CL**2
01401      PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.                     CL**2
01402      WRITE UPD-TRANS.                                                CL**2
01403      MOVE SPACE TO UPD-TRANS.                                        CL**2
01404  WRITE-TRANS-XIT.                                                    CL**2
01405      EXIT.                                                           CL**2
01406 ***************************************************************      CL**2
01407 *          CREATE COMMENT LINES                                      CL**2
01408 ***************************************************************      CL**2
01409  CREATE-COMMENT.                                                     CL**2
01410       ADD 5 TO STR-LINE-NO.                                          CL**2
01411      MOVE STR-LINE-NO TO UPD-LINE-NO.                                CL**2
01412      MOVE OUT-AST TO UPD-AST.                                        CL**2
01413      MOVE OUT-BODY TO UPD-BODY.                                      CL**2
01414      PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT.                       CL**2
01415  CREATE-COMMENT-XIT.                                                 CL**2
01416      EXIT.                                                           CL**2
      ******************************************************************
      * 
      *    INSERT-FIELD THRU INSERT-FIELD-EXIT
      * 
      *    DETERMINE HOW MANY CHARACTERS IN FIELD-AREA TO MOVE BY 
      *    SEARCHING BACKWARDS FROM (MAX-FIELD-LEN)TH CHARACTER UNTIL 
      *    FIRST NONBLANK CHARACTER IS ENCOUNTERED. APPEND COMMA. 
      *    COPY "FIELD-NAME=FIELD-VALUE," FROM FIELD-AREA TO NEXT 
      *    AVAILABLE CHARACTER POSITIONS IN UPD-TRANS.  IF IT 
      *    WILL NOT FIT ON CURRENT LINE, TERMINATE CURRENT LINE WITH
      *    A COMMA, WRITE CURRENT LINE, AND START NEW LINE. 
      * 
      *    ON INPUT 
      *    FIELD-AREA = "FIELD-NAME=FIELD-VALUE"
      *    MAX-FIELD-LEN = MAXIMUM NUMBER OF CHARACTERS TO BE COPIED
      *      FROM FIELD-AREA
      *    START-CHAR-POS = NEXT AVAILABLE CHARACTER POSITION WITHIN
      *      UPD-TRANS
      * 
      *    ON OUTPUT
      *    START-CHAR-POS UPDATED 
      *    FIELD-AREA COPIED TO UPD-TRANS 
      * 
      ******************************************************************
  
       INSERT-FIELD.
           MOVE SPACE TO DONE.
           PERFORM VARYING NUM-CHARS FROM MAX-FIELD-LEN BY -1 
             UNTIL DONE IS EQUAL TO "T" 
               IF FIELD-CHAR (NUM-CHARS) IS NOT EQUAL TO SPACE
                   MOVE "T" TO DONE 
               END-IF 
           END-PERFORM. 
           ADD 2 TO NUM-CHARS.
           MOVE "," TO FIELD-CHAR (NUM-CHARS).
           IF NUM-CHARS + START-CHAR-POS IS GREATER THAN 73 
               PERFORM WRITE-TRANS THRU WRITE-TRANS-XIT 
               MOVE 2 TO START-CHAR-POS 
           END-IF.
           MOVE FIELD-AREA (1 : NUM-CHARS)
             TO UPD-TRANS (START-CHAR-POS : NUM-CHARS). 
           ADD NUM-CHARS, START-CHAR-POS GIVING START-CHAR-POS. 
       INSERT-FIELD-EXIT. 
           EXIT.
  
  
01417  USER-ROUTINE.                                                       CL**2
01418      GO TO USER-ROUTINE-XIT.                                         CL**2
01419  USER-ROUTINE-XIT.                                                   CL**2
01420      EXIT.                                                           CL**2
*CALL DISPLAYLN 
*CALL WRITELN 
