*DECK     DCUTL800
00001  IDENTIFICATION DIVISION.                                         11/09/78
       PROGRAM-ID.   UTL800.
00003 *****************************************************                LV002
00004 *                                                                 DCUTL800
00005 *    THIS PROGRAM IMPLEMENTS THE COPY/MOVE FACILITY                  CL**2
00006 *        IT IS CALLED BY DCUTL                                    DCUTL800
00007 *                                                                 DCUTL800
00008 *****************************************************             DCUTL800
*CALL     PROGSHEL
           SELECT WORK-FILE ASSIGN TO "WORK"
               ACCESS MODE IS RANDOM
               ORGANIZATION IS DIRECT 
               RECORD KEY IS WORK-KEY 
               BLOCK COUNT IS 11. 
00010  DATA DIVISION.                                                   DCUTL800
       FILE SECTION.
       FD  WORK-FILE
           LABEL RECORDS ARE OMITTED
           BLOCK CONTAINS 630 RECORDS 
           DATA RECORDS ARE WORK-RECORD.
       01  WORK-RECORD. 
           03  WORK-KEY          PIC X(32). 
       COMMON-STORAGE SECTION.
       77 RETURN-CODE   PICTURE 99. 
  
       01  UC-WKPRINT                  PICTURE X(535).
       01  UC-BACKUP-R                 PICTURE X(533).
       01  UC-RENAME1                  PICTURE X(72). 
       01  UC-RENAME2                  PICTURE X(11). 
       01  UC-STDS                     PICTURE X. 
       01  UC-OPTIONS                  PICTURE X(92). 
       01  UC-INIT                     PICTURE X(216).
  
*CALL MAST1LK 
*CALL ENTSAVE 
*CALL COPYWORK
       01 DUMMY-Z PIC X.
*CALL     WRKSTG77
00012  77  MAX-POS  PICTURE 99 COMP SYNC VALUE 70.                      DCUTL800
       77  WORK-KEY-FLG          PIC 9. 
           88  WORK-KEY-VALID            VALUE 0. 
           88  WORK-KEY-INVALID          VALUE 1. 
*CALL     MAST1WS 
*CALL     TESTWACOM 
*CALL DCDPTRS 
      * 
      *    AREA KEYS
      * 
           02 CKEY-LINE REDEFINES CAT-DETAIL. 
              03  FILLER                 PICTURE X. 
              03  AK-CON-NAME            PICTURE X(30). 
              03  AK-CON-TYPE            PICTURE X. 
              03  AK-CON-DUPES           PICTURE X. 
              03  AK-CON-USING           PICTURE X. 
  
           02 IKEY-LINE REDEFINES CAT-DETAIL. 
              03  FILLER                 PICTURE X. 
              03  AK-CON-ID              PICTURE X(32). 
              03  AK-CON-ID-ALIAS        PICTURE X(4).
              03  AK-CON-QUAL            PICTURE X(32). 
      * 
      *    AREA PROCESS 
      * 
           02 ACCESS-LINE REDEFINES CAT-DETAIL. 
              03  FILLER                 PICTURE X. 
              03  ACC-A-LOCK             PICTURE X(32). 
              03  ACC-A-TYPE             PICTURE X. 
      * 
      *    AREA STRUCTURE 
      * 
           02 AREA-STC-LINE REDEFINES CAT-DETAIL. 
              03  FILLER                 PICTURE X. 
              03  STC-AREA-NAME          PICTURE X(32). 
              03  STC-AREA-ALIAS         PICTURE X(4).
              03  STC-AREA-RCVAL         PICTURE X(30). 
              03  STC-AREA-INC           PICTURE X. 
              03  STC-AREA-RCV-FLAG      PICTURE X. 
      * 
      *    TOTAL RECORD STRUCTURE LINE "B"
      * 
           02 LINEB REDEFINES CAT-DETAIL. 
              03  FILLER                 PICTURE X. 
              03  TOT-KEY                PICTURE X. 
              03  TOT-LINKPATH           PICTURE X(6).
              03  TOT-VARLEN             PICTURE X(5).
              03  TOT-LKFIELD            PICTURE X(32). 
              03  TOT-LKALIAS            PICTURE X(4).
      * 
      *    TOTAL RECORD STRUCTURE LINE "C"
      * 
           02 LINEC REDEFINES CAT-DETAIL. 
              03  FILLER                 PICTURE X. 
              03  TOT-COMPNAME           PICTURE X(32). 
              03  TOT-RCCODE             PICTURE XX.
              03  TOT-CPALIAS            PICTURE X(4).
      * 
      *    ELEMENT VALUES LINE-TYPES C AND P
      * 
           02 VALUES-LINE REDEFINES CAT-DETAIL. 
              03  FILLER                 PICTURE X. 
              03  VAL-CHECKBY            PICTURE X(13). 
              03  VAL-CKVAL              PICTURE X(30). 
              03  VAL-THRU               PICTURE X(30). 
              03  CKVAL-FLAG             PICTURE X. 
              03  THRUVAL-FLAG           PICTURE X. 
00016  01  WORK-AREAS.                                                  DCUTL800
00017      05  PROG-ID PICTURE X(6) VALUE "DCUTL-".                     DCUTL800
00018      05  ERROR-MESSAGES.                                          DCUTL800
00019          10  ERROR-MSG1.                                          DCUTL800
00020              15  FILLER PICTURE X(13) VALUE "500-S *ERROR ".      DCUTL800
00021              15  FILLER PICTURE X(15) VALUE "ILLEGAL KEYWORD".    DCUTL800
00022          10  ERROR-MSG2.                                          DCUTL800
00023              15  FILLER PICTURE X(13) VALUE                       DCUTL800
00024              "515-S *ERROR ".                                     DCUTL800
00025              15  FILLER PICTURE X(23) VALUE                       DCUTL800
00026              "NAMED ENTRY NOT ON FILE".                           DCUTL800
00027          10  ERROR-MSG3.                                          DCUTL800
00028              15  FILLER PICTURE X(13) VALUE                       DCUTL800
00029              "516-S *ERROR".                                      DCUTL800
00030              15  FILLER PICTURE X(27) VALUE                       DCUTL800
00031              "NAMED HIERARCHY NOT ON FILE".                       DCUTL800
00032           10  ERROR-MSG4.                                         DCUTL800
00033              15  FILLER PICTURE X(13) VALUE                       DCUTL800
00034              "515-S *ERROR ".                                     DCUTL800
00035              15  FILLER PICTURE X(30) VALUE                       DCUTL800
00036              "EQUAL SIGN MUST FOLLOW KEYWORD".                    DCUTL800
00037           10  ERROR-MSG5.                                         DCUTL800
00038              15  FILLER PICTURE X(13) VALUE                       DCUTL800
00039              "525-S *ERROR".                                      DCUTL800
00040              15  FILLER PICTURE X(14) VALUE                       DCUTL800
00041              "ILLEGAL SYNTAX".                                    DCUTL800
00042          10  ERROR-MSG6.                                             CL**2
00043              15  FILLER  PICTURE X(14)  VALUE                        CL**2
00044              "900-S * ERROR ".                                       CL**2
00045              15  FILLER PICTURE X(18)  VALUE                         CL**2
00046              " MAST1 READ ERROR ".                                   CL**2
00047              15  MAST1-BADNAME  PICTURE X(32).                       CL**2
               10  ERROR-MSG6A.                                          DC2A007
                   15  FILLER PICTURE X(9) VALUE                         DC2A007
                    "901-I    ".                                         DC2A007
                   15  FILLER PICTURE X(25) VALUE                        DC2A007
                    "ENTRY HAS NO DETAILS".                              DC2A007
                   15  MAST1-NODETAILS PICTURE X(32).                    DC2A007
00048          10  ERROR-MSG7.                                             CL**2
00049              15  FILLER     PICTURE X(13) VALUE                      CL**2
00050              "530-S *ERROR ".                                        CL**2
00051              15  FILLER     PICTURE X(32) VALUE                      CL**2
00052              "INVALID CONTINUATION TRANSACTION".                     CL**2
00053          10  ERROR-MSG8.                                             CL**2
00054              15  FILLER     PICTURE X(13) VALUE                      CL**2
00055              "960-F ERROR ".                                         CL**2
00056              15  FILLER     PICTURE X(25) VALUE                      CL**2
00057              "MAST3-READ ENTRY RECORD ".                             CL**2
00058          10  ERROR-MSG9.                                             CL**2
00059              15  FILLER     PICTURE X(13) VALUE                      CL**2
00060              "965-F ERROR ".                                         CL**2
00061              15  FILLER     PICTURE X(25) VALUE                      CL**2
00062              "MAST3-READ CATG RECORD ".                              CL**2
00063          10  ERROR-MSG10.                                            CL**2
00064              15  FILLER     PICTURE X(13) VALUE                      CL**2
00065              "970-F ERROR ".                                         CL**2
00066              15  FILLER     PICTURE X(25) VALUE                      CL**2
00067              "MAST3-READ FIELD RECORD ".                             CL**2
00068      05  ERROR-LINE.                                                 CL**2
00069          10  FILLER     PICTURE X(20).                               CL**2
00070          10  ERROR-POS1  PICTURE X(6).                               CL**2
00071          10  ERROR-POS2  PICTURE X(90).                              CL**2
00072          10  FILLER      PICTURE X(16).                              CL**2
00073      05  SUB-SCRIPTS.                                             DCUTL800
00074          10  TX-SUB PICTURE 99 COMP SYNC.                         DCUTL800
00075      05  FLAGS.                                                   DCUTL800
00076          10  CHAR-NOT-FOUND PICTURE X.                            DCUTL800
00077          10  END-OF-CARD    PICTURE X VALUE "N".                  DCUTL800
00078      05  TEST-TYPES.                                              DCUTL800
00079          10  TEST-CHAR      PICTURE X.                            DCUTL800
00080          10  EQUAL-SIGN     PICTURE X VALUE "=".                  DCUTL800
00081          10  COMMA-CHAR     PICTURE X VALUE ",".                  DCUTL800
00082      05  AREA-SCAN.                                               DCUTL800
00083          10  SCAN-FIELD-32.                                       DCUTL800
00084              15  SCAN-FIELD-4.                                    DCUTL800
00085                  17  SCAN-FIELD-3.                                DCUTL800
00086                      20  SCAN-FIELD-1 PICTURE X.                  DCUTL800
00087                      20  SCAN-FIELD-2ND PICTURE X.                DCUTL800
00088                      20  SCAN-FIELD-3RD PICTURE X.                DCUTL800
00089                  17  SCAN-FIELD-4TH PICTURE X.                    DCUTL800
00090              15  FILLER PICTURE X(28).                            DCUTL800
00091          10  FILLER PICTURE X(40).                                DCUTL800
00092      05  SCAN-AREA REDEFINES AREA-SCAN PICTURE X OCCURS 72 TIMES. DCUTL800
00095  01  COPY-CARD.                                                      CL**2
00096      02  DAT-WORK.                                                   CL**2
00097      03  DATA-LINE-NO            PICTURE X(4).                       CL**2
00098      03  FILLER                  PICTURE X.                          CL**2
00099      03  UPDATE-TX-DATA.                                             CL**2
00100          05  DAT-LINE       PICTURE X OCCURS 67 TIMES.               CL**2
00101  01  CATEGORY-LINE.                                                  CL**2
00102      03  CATEGORY-NAME           PICTURE X(3).                       CL**2
00103      03  FILLER                  PICTURE X(69)  VALUE SPACE.         CL**2
00104  01  ADD-LINE.                                                       CL**2
00105      03  FILLER                  PICTURE X(4)  VALUE "ADD ".         CL**2
00106      03  ADD-LINE-ENT            PICTURE X(3).                       CL**2
00107      03  FILLER                  PICTURE X  VALUE "=".               CL**2
00108      03  ADD-LINE-NAME           PICTURE X(32).                      CL**2
00109      03  FILLER                  PICTURE X(32)  VALUE SPACE.         CL**2
00110  01  CHG-LINE.                                                       CL**2
00111      03  FILLER                  PICTURE X(4)  VALUE "CHG ".         CL**2
00112      03  CHG-LINE-ENT            PICTURE X(3).                       CL**2
00113      03  FILLER                  PICTURE X VALUE "=".                CL**2
00114      03  CHG-LINE-NAME           PICTURE X(32).                      CL**2
00115      03  FILLER                  PICTURE X(32)  VALUE SPACE.         CL**2
00116  01  DEL-LINE.                                                       CL**2
00117      03  FILLER PICTURE X(4) VALUE "DEL ".                           CL**2
00118      03  DEL-LINE-ENT                  PICTURE X(3).                 CL**2
00119      03  FILLER                 PICTURE X VALUE "=".                 CL**2
00120      03  DEL-LINE-NAME                 PICTURE X(32).                CL**2
00121      03  FILLER                 PICTURE X(10) VALUE                  CL**2
00122      " WHEREUSED".                                                   CL**2
00123      03  FILLER PICTURE X(22) VALUE SPACES.                          CL**2
00124  01  SUBS-SWITCHES.                                                  CL**2
00125      03  CHAR-MOVED         PICTURE 99 COMP SYNC.                    CL**2
00126      03  SUB1               PICTURE 99 COMP SYNC.                    CL**2
00127      03  OPT-SUB            PICTURE 99 COMP SYNC.                    CL**2
00128      03  FROM-SUB         PICTURE 99 COMP SYNC.                      CL**2
00129      03  TO-SUB           PICTURE 99 COMP SYNC.                      CL**2
00130      03  NAME-SUB           PICTURE 99 COMP SYNC.                    CL**2
00131      03  TOTAL-1            PICTURE 999 COMP SYNC.                   CL**2
00132      03  TOTAL-2            PICTURE 999 COMP SYNC.                   CL**2
00133      03  TOTAL-3            PICTURE 999 COMP SYNC.                   CL**2
           03  DIR-SUB               PICTURE 999 COMP SYNC. 
           03  RTQUAL-COUNT          PICTURE 99  COMP SYNC. 
           03  LEFT-PAREN-COUNT      PICTURE 99  COMP SYNC. 
           03  RIGHT-PAREN-COUNT     PICTURE 99  COMP SYNC. 
00135      03  LENGTH-SW           PICTURE X.                              CL**2
00136      03  ERROR-MESSAGE         PICTURE X.                            CL**2
00137      03  USER-NAME.                                                  CL**2
00138          05  USER-WORD       PICTURE X(6) VALUE                      CL**2
00139          ",USER=".                                                   CL**2
00140          05  USER-NUM PICTURE XXX VALUE SPACES.                      CL**2
00141      03  FLDNAME        PICTURE X(8).                                CL**2
00142      03  FIELD-NAME REDEFINES FLDNAME.                               CL**2
00143          05  FLD-WORK   PICTURE X OCCURS 8 TIMES.                    CL**2
00144      03  CONTROL-DIRECTORY.                                          CL**2
           05  CTL-DIR-TABLE OCCURS 126 TIMES.
               07 CTL-DIR-ID             PICTURE XX.
               07 CTL-DIR-CAT            PICTURE XXX. 
               07 CTL-DIR-START          PICTURE 999. 
00149  01  OPT-WORK-AREAS.                                                 CL**2
00150      03  OPT-WORK-LINE1.                                             CL**2
00151          05  FILLER       PICTURE X(7) VALUE                         CL**2
00152          "REV-NO=".                                                  CL**2
00153          05  REV-NUM    PICTURE X(6) VALUE SPACES.                   CL**2
00154          05  FILLER       PICTURE X(11) VALUE                        CL**2
00155          ",EDIT-ONLY=".                                              CL**2
00156          05  EDIT-COMMAND PICTURE X(3) VALUE SPACES.                 CL**2
00157          05  USER-INIT    PICTURE X(9) VALUE SPACES.                 CL**2
00158          05  FILLER         PICTURE X(10) VALUE SPACES.              CL**2
00159      03  OPT-WORK-LINE2 REDEFINES OPT-WORK-LINE1.                    CL**2
00160          05  OPT-WORK     PICTURE X OCCURS 46 TIMES.                 CL**2
00161      03  OPTION-LINE.                                                CL**2
00162          05  FILLER       PICTURE X(9) VALUE                         CL**2
00163          "OPTIONS ".                                                 CL**2
00164          05  OPT-AREA.                                               CL**2
00165              07  OPT-CHAR PICTURE X OCCURS 72 TIMES.                 CL**2
00166  01  UPDATE-LINE.                                                    CL**2
00167      03  FILLER             PICTURE X(7)  VALUE "$UPDATE".           CL**2
  
       01  SAVE-SSREL-LINES.
           03  REL-LINEI. 
               05 FILLER                 PICTURE X. 
               05 S-PRELOP               PICTURE X(3).
               05 S-LEFT-PAREN           PICTURE 99.
               05 S-ID1                  PICTURE X(32). 
               05 S-ID1-TYPE             PICTURE X. 
               05 S-ID1-ALIAS            PICTURE X(4).
               05 S-ID1-SUBS. 
                  07 S-ID1-SUB1          PICTURE X(4).
                  07 S-ID1-SUB2          PICTURE X(4).
                  07 S-ID1-SUB3          PICTURE X(4).
               05 S-ID1-QUAL-FLAG        PICTURE 9. 
               05 S-RELOP                PICTURE XX.
               05 S-ID2                  PICTURE X(32). 
               05 S-ID2-TYPE             PICTURE X. 
               05 S-ID2-ALIAS            PICTURE X(4).
               05 S-ID2-SUBS. 
                  07 S-ID2-SUB1          PICTURE X(4).
                  07 S-ID2-SUB2          PICTURE X(4).
                  07 S-ID2-SUB3          PICTURE X(4).
               05 S-ID2-QUAL-FLAG        PICTURE 9. 
               05 S-RIGHT-PAREN          PICTURE 99.
               05 S-LOP                  PICTURE X(6).
           03  REL-LINEQ. 
               05 FILLER                 PICTURE X. 
               05 S-ID1-A1QUAL           PICTURE X(32). 
               05 S-ID1-A1Q-SUBS. 
                  07 S-ID1-A1Q-SUB1      PICTURE X(4).
                  07 S-ID1-A1Q-SUB2      PICTURE X(4).
                  07 S-ID1-A1Q-SUB3      PICTURE X(4).
               05 S-ID1-A2QUAL           PICTURE X(32). 
               05 S-ID1-A2Q-SUBS. 
                  07 S-ID1-A2Q-SUB1      PICTURE X(4).
                  07 S-ID1-A2Q-SUB2      PICTURE X(4).
                  07 S-ID1-A2Q-SUB3      PICTURE X(4).
               05 S-ID1-A3QUAL           PICTURE X(32). 
               05 S-ID1-A3Q-SUBS. 
                  07 S-ID1-A3Q-SUB1      PICTURE X(4).
                  07 S-ID1-A3Q-SUB2      PICTURE X(4).
                  07 S-ID1-A3Q-SUB3      PICTURE X(4).
           03 REL-LINE2.
               05 FILLER                 PICTURE X. 
               05 S-ID1-A4QUAL           PICTURE X(32). 
               05 S-ID1-A4Q-SUBS. 
                  07 S-ID1-A4Q-SUB1      PICTURE X(4).
                  07 S-ID1-A4Q-SUB2      PICTURE X(4).
                  07 S-ID1-A4Q-SUB3      PICTURE X(4).
               05 S-ID1-A5QUAL           PICTURE X(32). 
               05 S-ID1-A5Q-SUBS. 
                  07 S-ID1-A5Q-SUB1      PICTURE X(4).
                  07 S-ID1-A5Q-SUB2      PICTURE X(4).
                  07 S-ID1-A5Q-SUB3      PICTURE X(4).
           03  REL-LINEB. 
               05 FILLER                 PICTURE X. 
               05 S-ID2-B1QUAL           PICTURE X(32). 
               05 S-ID2-B1Q-SUBS. 
                  07 S-ID2-B1Q-SUB1      PICTURE X(4).
                  07 S-ID2-B1Q-SUB2      PICTURE X(4).
                  07 S-ID2-B1Q-SUB3      PICTURE X(4).
               05 S-ID2-B2QUAL           PICTURE X(32). 
               05 S-ID2-B2Q-SUBS. 
                  07 S-ID2-B2Q-SUB1      PICTURE X(4).
                  07 S-ID2-B2Q-SUB2      PICTURE X(4).
                  07 S-ID2-B2Q-SUB3      PICTURE X(4).
               05 S-ID2-B3QUAL           PICTURE X(32). 
               05 S-ID2-B3Q-SUBS. 
                  07 S-ID2-B3Q-SUB1      PICTURE X(4).
                  07 S-ID2-B3Q-SUB2      PICTURE X(4).
                  07 S-ID2-B3Q-SUB3      PICTURE X(4).
           03 REL-LINE3.
               05 FILLER                 PICTURE X. 
               05 S-ID2-B4QUAL           PICTURE X(32). 
               05 S-ID2-B4Q-SUBS. 
                  07 S-ID2-B4Q-SUB1      PICTURE X(4).
                  07 S-ID2-B4Q-SUB2      PICTURE X(4).
                  07 S-ID2-B4Q-SUB3      PICTURE X(4).
               05 S-ID2-B5QUAL           PICTURE X(32). 
               05 S-ID2-B5Q-SUBS. 
                  07 S-ID2-B5Q-SUB1      PICTURE X(4).
                  07 S-ID2-B5Q-SUB2      PICTURE X(4).
                  07 S-ID2-B5Q-SUB3      PICTURE X(4).
       01  SUBS-WAREA.
           05  SUBS                      PICTURE X OCCURS 12 TIMES. 
       01  SAVE-STC-LINES.
           03  SAVE-STC-LINES-R-T.
               05 LINE-RT-TYPE           PICTURE X. 
               05 S-RTNAME               PICTURE X(32). 
               05 S-RTALIAS              PICTURE X(4).
               05 S-RTQUAL-FLAG          PICTURE 9. 
               05 S-RTQUAL1              PICTURE X(32). 
               05 S-RTQUAL2              PICTURE X(32). 
               05 S-RTQUAL3              PICTURE X(32). 
           03  SAVE-STC-LINES-Q-2.
               05 LINE-Q2-TYPE           PICTURE X. 
               05 S-RTQUAL4              PICTURE X(32). 
               05 S-RTQUAL5              PICTURE X(32). 
           03  SAVE-STC-LINES-O.
               05 FILLER                 PICTURE X. 
               05 S-STC-FROM             PICTURE X(4).
               05 S-STC-TO               PICTURE X(32). 
               05 S-STC-TO-ALIAS         PICTURE X(4).
               05 S-STC-DEPENDS          PICTURE X(32). 
               05 S-STC-DEP-ALIAS        PICTURE X(4).
               05 S-STC-DEP-QUAL-FLAG    PICTURE X. 
               05 S-STC-DEP-QUAL1        PICTURE X(32). 
               05 S-STC-DEP-QUAL2        PICTURE X(32). 
           03  SAVE-STC-LINES-D.
               05 FILLER                 PICTURE X. 
               05 S-STC-DEP-QUAL3        PICTURE X(32). 
               05 S-STC-DEP-QUAL4        PICTURE X(32). 
               05 S-STC-DEP-QUAL5        PICTURE X(32). 
       01  SAVE-CON-LINES.
           03  SAVE-CON-LINE-N. 
               05 FILLER                 PICTURE X. 
               05 S-CONNAME              PICTURE X(30). 
               05 S-CATNAME              PICTURE X(32). 
               05 S-CON-CAT-ALY          PICTURE X(4).
               05 S-AOFREC               PICTURE X(32). 
           03  SAVE-CON-LINE-O. 
               05 FILLER                 PICTURE X. 
               05 S-DEPEND               PICTURE X(32). 
               05 S-DALIAS               PICTURE X(4).
               05 S-BOFREC               PICTURE X(32). 
       01  BIN-ZERO                  PICTURE 999 COMP-1 VALUE ZERO. 
       01  ANOTHER-BIN  REDEFINES  BIN-ZERO.
           02  SIX-BIT-ZERO          PICTURE X. 
           02  FILLER                PICTURE X(9).
       01  BIN-ONE                   PICTURE 999 COMP-1 VALUE 1.
       01  DUMMY-FIT. 
           02  LFN                   PICTURE X(7).
           02  FIT-STAT              PICTURE 9(4) COMP-4. 
           02  WORD1                 PICTURE 99   COMP-1. 
           02  WORD2                 PICTURE 99   COMP-1. 
           02  WORD3                 PICTURE 99   COMP-1. 
           02  WORD4                 PICTURE 99   COMP-1. 
  
00178  PROCEDURE DIVISION.                                              DCUTL800
       OLD-ENTRY. 
00185 ********************************************************             CL**2
00186 *                                                                    CL**2
00187 *    PROCESS RETURNS AFTER I/O REQUESTS FULFILLED                    CL**2
00188 *                                                                    CL**2
00189 ********************************************************             CL**2
00190      IF COPY-FUNCTION-CODE EQUAL "4"                                 CL**2
00191          GO TO COPY-OUT-RETURN.                                      CL**2
00192      IF COPY-FUNCTION-CODE EQUAL TO "1"                              CL**2
00193          GO TO DATA-READ-RETURN.                                     CL**2
00194      IF COPY-FUNCTION-CODE EQUAL TO "3"                              CL**2
00195          GO TO MAST3-READ-RETURN.                                    CL**2
00196      IF COPY-FUNCTION-CODE EQUAL TO "5"                              CL**2
00197          GO TO CARD-READ-RETURN.                                     CL**2
      ******************************************************************
      * 
      *    OPEN WORK FILE 
      * 
      ******************************************************************
           MOVE "WORK" TO LFN.
           INSPECT LFN REPLACING ALL " " BY SIX-BIT-ZERO. 
           ENTER FTN5 "EVICT" USING DUMMY-FIT, BIN-ONE. 
           OPEN OUTPUT WORK-FILE. 
           MOVE "STARTER*************************" TO 
                 CURRENT-ENTRY-NAME.
           PERFORM WRITE-WORK-FILE THRU 
                   WRITE-WORK-FILE-XIT. 
           CLOSE WORK-FILE. 
           OPEN I-O WORK-FILE.
00198 ********************************************************             CL**2
00199 *    INITIALIZE FOR COPY TRANSACTION PROCESSING                      CL**2
00200 ********************************************************             CL**2
00202      MOVE ZERO TO COPY-COUNT.                                        CL**2
00203      MOVE SPACES TO COPY-OUTPUT-AREA.                                CL**2
00204      MOVE SPACES TO ERROR-LINE.                                      CL**2
00205      MOVE "DCUTL-" TO ERROR-POS1.                                    CL**2
00206      MOVE "Y" TO PASSZERO-TX1.                                       CL**2
00207      MOVE "Y" TO PASS1-TX1.                                          CL**2
00208      MOVE "Y" TO PASS2-TX1.                                          CL**2
00209      MOVE "X" TO DATA-PRESENT-SW.                                    CL**2
00210      MOVE "T" TO FILE-INDICATOR.                                     CL**2
00211      MOVE SPACES TO COPY-CARD.                                       CL**2
           MOVE 4 TO CON-KEY. 
00214      PERFORM MAST3-READ THRU MAST3-READ-XIT.                         CL**2
00215      IF MAST3-RETURN-CODE EQUAL TO "1"                               CL**2
00216          MOVE ERROR-MSG9 TO ERROR-POS2                               CL**2
00217          GO TO PRINT-FATAL-ERROR.                                    CL**2
00218      MOVE SPACES TO TOP-LEVEL-NAME.                                  CL**2
00219      MOVE SPACES TO CURRENT-ENTRY-NAME.                           DCUTL800
00220      MOVE SPACES TO NEW-ENTRY-NAME.                                  CL**2
00221      MOVE SPACE TO TYPE-TX.                                          CL**2
00222      MOVE "N" TO END-OF-CARD.                                        CL**2
           MOVE 3 TO CON-KEY. 
00224      PERFORM MAST3-READ THRU MAST3-READ-XIT.                         CL**2
00225      IF MAST3-RETURN-CODE EQUAL TO "1"                               CL**2
00226          MOVE ERROR-MSG8 TO ERROR-POS2                               CL**2
00227          GO TO PRINT-FATAL-ERROR.                                    CL**2
00228      MOVE DIRECTORY-TABLE TO CONTROL-DIRECTORY.                      CL**2
00229      MOVE 1 TO SUB1.                                                 CL**2
00232 **************************************************                DCUTL800
00233 *                                                                 DCUTL800
00234 *     PROCESS COPY TRANSACTION                                    DCUTL800
00235 *       EDIT THE TRANSACTION                                      DCUTL800
00236 *                                                                 DCUTL800
00237 *************************************************                 DCUTL800
00238  EDIT-COPY.                                                       DCUTL800
00239      MOVE ZERO TO TX-SUB.                                         DCUTL800
00240      MOVE SPACE TO TEST-CHAR.                                     DCUTL800
00241 *  BYPASS BALANCE OF KW COPY                                      DCUTL800
00242      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                        DCUTL800
00243      IF END-OF-CARD EQUAL TO "Y"                                     CL**2
00244          MOVE ERROR-MSG5 TO ERROR-POS2                               CL**2
00245          GO TO PRINT-FATAL-ERROR.                                    CL**2
00246      MOVE SCAN-FIELD-3 TO TYPE-TX.                                   CL**2
00247 *                                                                    CL**2
00248 *     PROCESS ENT=CATNAME OR HIR=CATNAME PARAMETER                   CL**2
00249 *                                                                    CL**2
00250      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                      DCUTL800
00251      MOVE EQUAL-SIGN TO TEST-CHAR.                                DCUTL800
00252      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                        DCUTL800
00253      IF CHAR-NOT-FOUND NOT EQUAL "Y"                              DCUTL800
00254          MOVE ERROR-MSG5 TO ERROR-POS2                               CL**2
00255          GO TO PRINT-FATAL-ERROR.                                    CL**2
           IF SCAN-FIELD-3 IS EQUAL TO "ENT" OR "HIE" 
00257          GO TO GET-COPY-NAME.                                     DCUTL800
00260      MOVE ERROR-MSG1 TO ERROR-POS2.                               DCUTL800
00261      GO TO PRINT-FATAL-ERROR.                                     DCUTL800
00262  GET-COPY-NAME.                                                   DCUTL800
00263      MOVE SCAN-FIELD-3 TO TYPE-COPY.                              DCUTL800
00264 *                                                                    CL**2
00265 *     PROCESS NEW=NAME PARAMETER IS SPECIFIED                        CL**2
00266 *                                                                    CL**2
00267      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                      DCUTL800
00268      MOVE COMMA-CHAR TO TEST-CHAR.                                DCUTL800
00269      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00270      MOVE SCAN-FIELD-32 TO ENTRY-NAME.                               CL**2
00271      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00272          GO TO CHECK-OPTION-VALUES.                                  CL**2
00273  GET-NEXT-OPT.                                                       CL**2
00274      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00275      IF END-OF-CARD EQUAL "Y"                                        CL**2
00276          PERFORM GET-NEXT-CARD THRU GET-NEXT-CARD-XIT.               CL**2
00277      MOVE EQUAL-SIGN TO TEST-CHAR.                                   CL**2
00278      PERFORM FIND-CHAR THRU FIND-CHAR-XIT.                           CL**2
00279      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00280          MOVE ERROR-MSG5 TO ERROR-POS2                               CL**2
00281          GO TO PRINT-FATAL-ERROR.                                    CL**2
00282      IF SCAN-FIELD-3 EQUAL "NEW"                                     CL**2
00283          PERFORM FIND-BLANK THRU FIND-BLANK-XIT                      CL**2
00284          MOVE COMMA-CHAR TO TEST-CHAR                                CL**2
00285          PERFORM FIND-CHAR THRU FIND-CHAR-XIT                        CL**2
00286          MOVE SCAN-FIELD-32 TO NEW-ENTRY-NAME                        CL**2
00287          GO TO CK-COMMA.                                             CL**2
00288      IF SCAN-FIELD-3 EQUAL "USE"                                     CL**2
00289          PERFORM FIND-BLANK THRU FIND-BLANK-XIT                      CL**2
00290          MOVE COMMA-CHAR TO TEST-CHAR                                CL**2
00291          PERFORM FIND-CHAR THRU FIND-CHAR-XIT                        CL**2
00292          MOVE SCAN-FIELD-32 TO USER-NUM                              CL**2
00293          GO TO CK-COMMA.                                             CL**2
00294      IF SCAN-FIELD-3 EQUAL "REV"                                     CL**2
00295          PERFORM FIND-BLANK THRU FIND-BLANK-XIT                      CL**2
00296          MOVE COMMA-CHAR TO TEST-CHAR                                CL**2
00297          PERFORM FIND-CHAR THRU FIND-CHAR-XIT                        CL**2
00298          MOVE SCAN-FIELD-32 TO REV-NUM                               CL**2
00299          GO TO CK-COMMA.                                             CL**2
00300      IF SCAN-FIELD-3 EQUAL "EDI"                                     CL**2
00301          PERFORM FIND-BLANK THRU FIND-BLANK-XIT                      CL**2
00302          MOVE COMMA-CHAR TO TEST-CHAR                                CL**2
00303          PERFORM FIND-CHAR THRU FIND-CHAR-XIT                        CL**2
00304          MOVE SCAN-FIELD-32 TO EDIT-COMMAND                          CL**2
00305          GO TO CK-COMMA.                                             CL**2
00306      IF SCAN-FIELD-3 EQUAL "LIS"                                     CL**2
00307          PERFORM FIND-BLANK THRU FIND-BLANK-XIT                      CL**2
00308          MOVE COMMA-CHAR TO TEST-CHAR                                CL**2
00309          PERFORM FIND-CHAR THRU FIND-CHAR-XIT                        CL**2
00310          MOVE SCAN-FIELD-32 TO LIST-OPT                              CL**2
00311          GO TO CK-COMMA.                                             CL**2
00312      MOVE ERROR-MSG1 TO ERROR-POS2.                                  CL**2
00313      GO TO PRINT-FATAL-ERROR.                                        CL**2
00314  CK-COMMA.                                                           CL**2
00315      IF CHAR-NOT-FOUND NOT EQUAL "Y"                                 CL**2
00316          GO TO CHECK-OPTION-VALUES.                                  CL**2
00317      GO TO GET-NEXT-OPT.                                             CL**2
00318  CHECK-OPTION-VALUES.                                                CL**2
00319 *                                                                    CL**2
00320 *    INSERT OPTION DEFAULT VALUES                                    CL**2
00321 *                                                                    CL**2
00322      IF REV-NUM EQUAL SPACE                                          CL**2
00323          MOVE "NO-CHK" TO REV-NUM.                                   CL**2
00324      IF EDIT-COMMAND EQUAL SPACE                                     CL**2
00325          MOVE "NO" TO EDIT-COMMAND.                                  CL**2
00326      IF EDIT-COMMAND EQUAL "YES" OR "NO"                             CL**2
00327          GO TO CHECK-LIST-OPT.                                       CL**2
00328      MOVE ERROR-MSG5 TO ERROR-POS2.                                  CL**2
00329      GO TO PRINT-FATAL-ERROR.                                        CL**2
00330  CHECK-LIST-OPT.                                                     CL**2
00331      IF LIST-OPT EQUAL SPACE                                         CL**2
00332          MOVE "NO" TO LIST-OPT.                                      CL**2
           IF LIST-OPT IS EQUAL TO "YES" OR "NO"
00334          GO TO CHECK-COPY-NAME                                       CL**2
00335      ELSE                                                            CL**2
00336          MOVE ERROR-MSG5 TO ERROR-POS2                               CL**2
00337          GO TO PRINT-FATAL-ERROR.                                    CL**2
00338      IF USER-NUM NOT EQUAL SPACES                                    CL**2
00339          MOVE USER-NAME TO USER-INIT.                                CL**2
00340  CHECK-COPY-NAME.                                                    CL**2
00341      MOVE ENTRY-NAME TO DATA-ENTRY-NAME.                             CL**2
00342      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00343      IF DATA-RETURN-CODE EQUAL TO "8"                                CL**2
00344          MOVE ERROR-MSG2 TO ERROR-POS2                            DCUTL800
00345          GO TO PRINT-FATAL-ERROR.                                 DCUTL800
           IF DATA-RETURN-CODE EQUAL TO "1" 
               MOVE "010-I * NO CATEGORIES EXIST FOR THIS ENTRY " 
                   TO ERROR-POS2
               MOVE "Y" TO ERROR-MESSAGE
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
               MOVE "N" TO ERROR-MESSAGE
               PERFORM OUTPUT-UPDATE-HEADER THRU
                   OUTPUT-UPDATE-HEADER-XIT 
               MOVE "1" TO EXPLOSION-PASS 
               MOVE DATA-ENTRY-NAME TO CURRENT-ENTRY-NAME 
               PERFORM OUTPUT-UPDATE-TX THRU OUTPUT-UPDATE-TX-XIT 
               GO TO END-OF-COPY. 
00347 ***********************************************************          CL**2
00348 *                                                                    CL**2
00349 *    OUTPUT $UPDATE AND OPTIONS STATEMENTS                           CL**2
00350 *       OUTPUT ONCE FOR SOURCE AND TARGET FILE                       CL**2
      *       OUTPUT TO SOURCE ONLY IF COPY COMMAND PROCESSED 
00352 *                                                                    CL**2
00353 **********************************************************           CL**2
00354  OUTPUT-UPDATE-HEADER.                                               CL**2
00355      IF TARGET-UPDATE-WRITTEN EQUAL "Y"                              CL**2
00356          GO TO TEST-SOURCE-UPD.                                      CL**2
00357      MOVE "Y" TO TARGET-UPDATE-WRITTEN.                              CL**2
00358 *                                                                    CL**2
00359 *   REMOVE SPACES FROM OPTIONS STATEMENT                             CL**2
00360 *                                                                    CL**2
00361      MOVE SPACES TO OPT-AREA.                                        CL**2
00362      MOVE 1 TO FROM-SUB.                                             CL**2
00363      MOVE 1 TO TO-SUB.                                               CL**2
00364  SQUEEZE-IT.                                                         CL**2
00365      IF FROM-SUB GREATER THAN 44                                     CL**2
00366          GO TO UPDATE-NOW.                                           CL**2
00367      IF OPT-WORK (FROM-SUB) EQUAL TO SPACE                           CL**2
00368          ADD 1 TO FROM-SUB                                           CL**2
00369          GO TO SQUEEZE-IT.                                           CL**2
00370      MOVE OPT-WORK (FROM-SUB) TO OPT-CHAR (TO-SUB).                  CL**2
00371      ADD 1 TO FROM-SUB.                                              CL**2
00372      ADD 1 TO TO-SUB.                                                CL**2
00373      GO TO SQUEEZE-IT.                                               CL**2
00374 *                                                                    CL**2
00375 *    OUTPUT TARGET FILE HEADER                                       CL**2
00376 *                                                                    CL**2
00377  UPDATE-NOW.                                                         CL**2
00378      MOVE UPDATE-LINE TO COPY-CARD.                                  CL**2
00379      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
00380      MOVE OPTION-LINE TO COPY-CARD.                                  CL**2
00381      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
00382 *                                                                    CL**2
00383 *    OUTPUT SOURCE FILE HEADERS (1ST MOVE COMMAND ONLY)              CL**2
00384 *                                                                    CL**2
00385  TEST-SOURCE-UPD.                                                    CL**2
           IF TYPE-TX EQUAL "P" 
           GO TO OUTPUT-UPDATE-HEADER-XIT.
00388      IF SOURCE-UPDATE-WRITTEN EQUAL TO "N"                           CL**2
00389          MOVE "Y" TO SOURCE-UPDATE-WRITTEN                           CL**2
00390          MOVE "S" TO FILE-INDICATOR                                  CL**2
00391          MOVE UPDATE-LINE TO COPY-CARD                               CL**2
00392          PERFORM COPY-OUT THRU COPY-OUT-XIT                          CL**2
00393          MOVE "S" TO FILE-INDICATOR                                  CL**2
00394          MOVE OPTION-LINE TO COPY-CARD                               CL**2
00395          PERFORM COPY-OUT THRU COPY-OUT-XIT.                         CL**2
      * 
       OUTPUT-UPDATE-HEADER-XIT.
           EXIT.
      * 
00397 *********************************************************            CL**2
00398 *                                                                    CL**2
00399 *    PROCESS TRANSACTION                                             CL**2
00400 *       DETERMINE IF SINGLE ENTRY TRANSACTION OR HIERARCHY           CL**2
00401 *                                                                    CL**2
00402 *********************************************************            CL**2
00403  DETERMINE-TRANS-TYPE.                                               CL**2
00404      IF TYPE-COPY EQUAL "HIE"                                        CL**2
00405          MOVE "1" TO EXPLOSION-PASS                                  CL**2
00406          MOVE ENTRY-NAME TO TOP-LEVEL-NAME                           CL**2
00407          GO TO EXPLODE-HIERARCHY.                                    CL**2
00408 ***********************************************************          CL**2
00409 *                                                                    CL**2
00410 *    PROCESS SINGLE ENTRY TRANSACTION                                CL**2
00411 *         WILL OUTPUT ADD TRANSACTION                                CL**2
00412 *                                                                    CL**2
00413 ************************************************************         CL**2
00414      MOVE ZERO TO EXPLOSION-PASS.                                    CL**2
00415      MOVE ENTRY-NAME TO CURRENT-ENTRY-NAME.                          CL**2
00416      MOVE SPACES TO TOP-LEVEL-NAME.                                  CL**2
00417      PERFORM OUTPUT-UPDATE-TX THRU OUTPUT-UPDATE-TX-XIT.             CL**2
00418      GO TO END-OF-COPY.                                              CL**2
00420 *********************************************************            CL**2
00421 *                                                                    CL**2
00422 *                                                                    CL**2
00423 *     PROCESS MOVE/COPY OF HIERARCHY                                 CL**2
00424 *        ON FIRST PASS OF HIERARCHY PRODUCES:                        CL**2
00425 *           ADD TX-S FOR TARGET DICTIONARY                           CL**2
00426 *              (BOTH COPY AND MOVE)                                  CL**2
00427 *           DEL WHEREUSED FOR SOURCE DICTIONARY                      CL**2
00428 *              (MOVE ONLY)                                           CL**2
00429 *        ON SECOND PASS OF HIERARCHY PRODUCES:                       CL**2
00430 *           CHG TX-S FOR TARGET DICTIONARY                           CL**2
00431 *              (BOTH COPY AND MOVE)                                  CL**2
00432 *                                                                    CL**2
00433 *                                                                    CL**2
00434 ***********************************************************          CL**2
00435  EXPLODE-HIERARCHY.                                                  CL**2
00436      MOVE TOP-LEVEL-NAME TO DATA-ENTRY-NAME.                         CL**2
00437      MOVE TOP-LEVEL-NAME TO CURRENT-ENTRY-NAME.                      CL**2
00438      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
           IF DATA-RETURN-CODE EQUAL "1"                                 DC2A007
               MOVE DATA-ENTRY-NAME TO MAST1-NODETAILS                   DC2A007
               MOVE ERROR-MSG6A TO ERROR-POS2                            DC2A007
               MOVE "Y" TO ERROR-MESSAGE                                 DC2A007
               PERFORM COPY-OUT THRU COPY-OUT-XIT                        DC2A007
               MOVE "N" TO ERROR-MESSAGE                                 DC2A007
               GO TO END-OF-COPY.                                        DC2A007
00439      PERFORM OUTPUT-UPDATE-TX THRU OUTPUT-UPDATE-TX-XIT.             CL**2
00440      IF EXPLOSION-PASS EQUAL TO "2"                                  CL**2
00441          GO TO SET-PRESENT.                                          CL**2
00442      IF DATA-RETURN-CODE NOT EQUAL TO "0"                            CL**2
00443          MOVE "N" TO FIRST-REC-SW                                    CL**2
00444          MOVE "N" TO DATA-PRESENT-SW                                 CL**2
00445          GO TO EXPLOSION-END.                                        CL**2
00446  SET-PRESENT.                                                        CL**2
00447      MOVE "Y" TO DATA-PRESENT-SW.                                    CL**2
           IF DATA-HDR-ENT-ID IS EQUAL TO 05
              MOVE "400" TO DATA-ENTRY-CAT
              GO TO READ-CAT
           END-IF.
00448      IF DATA-HDR-ENT-ID LESS THAN "35"                               CL**2
00449          MOVE "300" TO DATA-ENTRY-CAT                                CL**2
00450      ELSE                                                            CL**2
00451          MOVE "800" TO DATA-ENTRY-CAT.                               CL**2
       READ-CAT.
00452      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
           IF ( DATA-RETURN-CODE IS EQUAL TO "0" OR "2" ) 
00454          GO TO CK-COMMENT.                                           CL**2
00455      IF DATA-RETURN-CODE EQUAL "8"                                   CL**2
00456          GO TO MAST1-READ-ERROR.                                     CL**2
00457 *    NO RELATIONAL LINES                                             CL**2
00458      GO TO EXPLOSION-END.                                            CL**2
00459  CK-COMMENT.                                                         CL**2
00460 *      BYPASS PROCESSING OF LINES WITHOUT STC-CNAME                  CL**2
00463      IF CAT-COMMENT EQUAL "*"                                        CL**2
00464          GO TO BYPASS.                                               CL**2
00465      IF STC-CNAME EQUAL "FILLER "                                    CL**2
00466          GO TO BYPASS.                                               CL**2
00467      IF STC-CNAME EQUAL SPACES                                       CL**2
00468          GO TO BYPASS.                                               CL**2
  
      *    IF THE ENTITY-ID IS FOR GROUP OR RECORD AND
      *    WE ARE CURRENTLY EXAMINING THE STRUCTURE CATEGORY
      *    ONLY CHECK STANDARD STRUCTURE LINE TYPE, 
      *    BYPASS ALL OTHERS. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 10 OR 13)
              AND ( CAT-CATEGORY IS EQUAL TO "300" )
              AND ( STC-LINE-TYPE IS NOT EQUAL TO "A" ))
           THEN 
              GO TO BYPASS
           END-IF.
  
      *    IF THE ENTITY-ID IS FOR FILE AND WE ARE
      *    CURRENTLY EXAMINING THE MDINFO CATEGORY
      *    BYPASS IT. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 20 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "450" )) 
           THEN 
              GO TO BYPASS
           END-IF.
  
      *    IF THE ENTITY-ID IS FOR AREA AND WE ARE
      *    CURRENTLY EXAMINING THE PROCESS CATEGORY 
      *    ONLY CHECK THE DBP LINE TYPE, BYPASS 
      *    RECORD CODE. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "400" )
              AND ( STC-LINE-TYPE IS NOT EQUAL TO "P" ))
           THEN 
              GO TO BYPASS
           END-IF.
  
      *    IF THE ENTITY-ID IS FOR AREA AND WE ARE
      *    CURRENTLY EXAMINING THE PROCESS CATEGORY 
      *    BYPASS LINES WITH DBP NAME "SYSTEM". 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "400" )
              AND ( STC-CNAME IS EQUAL TO "SYSTEM" )) 
           THEN 
              GO TO BYPASS
           END-IF.
  
      *    IF THE ENTITY-ID IS FOR AREA AND WE ARE
      *    CURRENTLY EXAMINING THE ACCESS CATEGORY
      *    BYPASS THE LINE IF THE LOCK IS BY LITERAL. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "425" )
              AND ( ACC-A-TYPE IS EQUAL TO "L" )) 
           THEN 
              GO TO BYPASS
           END-IF.
  
      *    IF THE ENTITY-ID IS FOR AREA AND WE ARE
      *    CURRENTLY EXAMINING THE ACCESS CATEGORY
      *    BYPASS THE MODE LINE.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "425" )
              AND ( STC-LINE-TYPE IS EQUAL TO "M" ))
           THEN 
              GO TO BYPASS
           END-IF.
  
      *    IF THE ENTITY-ID IS FOR AREA AND WE ARE
      *    CURRENTLY EXAMINING THE AREAKEYS CATEGORY
      *    BYPASS THE CONCATENATED KEY LINE.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "500" )
              AND ( STC-LINE-TYPE IS EQUAL TO "C" ))
           THEN 
              GO TO BYPASS
           END-IF.
  
      *    IF THE ENTITY-ID IS FOR SUBSCHEMA AND WE ARE 
      *    CURRENTLY EXAMINING THE MDINFO OR SSREL CATEGORY 
      *    BYPASS IT. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 24 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "450" OR "525" ))
           THEN 
              GO TO BYPASS
           END-IF.
  
      *    IF THE ENTITY-ID IS FOR SCHEMA AND WE ARE
      *    CURRENTLY EXAMINING THE MDINFO CATEGORY
      *    BYPASS THE SCHEMA LFN LINE TYPE. 
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "450" )
              AND ( STC-LINE-TYPE IS EQUAL TO "L" ))
           THEN 
              GO TO BYPASS
           END-IF.
  
      *    IF THE ENTITY-ID IS FOR SCHEMA,
      *    BYPASS EXAMINING THE JOBCONTROL, BOND
      *    AND JOINS CATEGORY.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "475" OR "550" OR "575" )) 
           THEN 
              GO TO BYPASS
           END-IF.
  
00483      GO TO RESET-1.                                                  CL**2
00487  BYPASS.                                                             CL**2
00488      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
           IF ( DATA-RETURN-CODE IS EQUAL TO "1" )
           THEN 
              GO TO EXPLOSION-END 
           END-IF.
           IF (( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              AND ( CAT-CATEGORY IS GREATER THAN "800" )) 
           THEN 
              GO TO EXPLOSION-END 
           END-IF.
00491      IF DATA-RETURN-CODE EQUAL TO "8"                                CL**2
00492          GO TO MAST1-READ-ERROR.                                     CL**2
00493      GO TO CK-COMMENT.                                               CL**2
00494  RESET-1.                                                            CL**2
00495      MOVE SPACES TO HOLD-KEY-AREA.                                   CL**2
00496      MOVE ZERO TO KEY-CNT.                                           CL**2
      ********************************************************
      *    R E T R I E V E    C O M P O N E N T S 
      *    SAVE POSITION IN CURRENT CATEGORY. 
      ********************************************************
00500  CHECK-ENTRY.                                                        CL**2
00501      MOVE DATA-ENTRY-NAME TO SAVE-NAME.                              CL**2
00502      MOVE CAT-CATEGORY TO SAVE-CAT.                                  CL**2
00503      MOVE CAT-LINE TO SAVE-LINE-NO.                                  CL**2
00504      MOVE STC-CNAME TO DATA-ENTRY-NAME.                              CL**2
00505      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
           IF DATA-RETURN-CODE EQUAL "1" AND                             DC2A007
                 EXPLOSION-PASS EQUAL "2"                                DC2A007
               MOVE DATA-ENTRY-NAME TO MAST1-NODETAILS                   DC2A007
               MOVE ERROR-MSG6A TO ERROR-POS2                            DC2A007
               MOVE "Y" TO ERROR-MESSAGE                                 DC2A007
               PERFORM COPY-OUT THRU COPY-OUT-XIT                        DC2A007
               MOVE "N" TO ERROR-MESSAGE                                 DC2A007
               GO TO RESTORE.                                            DC2A007
00506      IF DATA-RETURN-CODE EQUAL "8"                                   CL**2
00507          GO TO MAST1-READ-ERROR.                                     CL**2
00508      MOVE DATA-HDR-ENT-ID TO HOLD-STC-ENTRY-TYPE.                    CL**2
00509      MOVE DATA-ENTRY-NAME TO CURRENT-ENTRY-NAME.                     CL**2
00510      PERFORM OUTPUT-UPDATE-TX THRU OUTPUT-UPDATE-TX-XIT.             CL**2
00511  RESTORE.                                                            CL**2
00512      MOVE SAVE-NAME TO DATA-ENTRY-NAME.                              CL**2
00513      MOVE SAVE-CAT TO DATA-ENTRY-CAT.                                CL**2
00514      MOVE SAVE-LINE-NO TO DATA-ENTRY-LINE.                           CL**2
00515      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
00516  DOWN-A-LEVEL.                                                       CL**2
           IF HOLD-STC-ENTRY-TYPE IS EQUAL TO "03"
00518          GO TO READ-STCLINE.                                         CL**2
00519      ADD 1 TO KEY-CNT.                                               CL**2
00520      IF KEY-CNT GREATER THAN 30                                      CL**2
00521          SUBTRACT 1 FROM KEY-CNT                                     CL**2
00522          GO TO READ-STCLINE.                                         CL**2
      ********************************************************
      *    SAVE CURRENT LINE LOCATION 
      ********************************************************
00524      MOVE DATA-ENTRY-NAME TO KEY-NAME (KEY-CNT).                     CL**2
00525      MOVE CAT-CATEGORY TO KEY-CATEGORY (KEY-CNT).                    CL**2
00526      MOVE CAT-LINE TO KEY-LINE (KEY-CNT).                            CL**2
      ********************************************************
      *    RETRIEVE THE STRUCTURE, PROCESS, MDINFO OR 
      *    RELATIONAL LINE
      ********************************************************
00528      MOVE STC-CNAME TO DATA-ENTRY-NAME.                              CL**2
00529      MOVE "300" TO DATA-ENTRY-CAT.                                   CL**2
00530      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00531      IF DATA-RETURN-CODE EQUAL TO "0"                                CL**2
00532          GO TO CK-COMMENT-2.                                         CL**2
00533      IF DATA-RETURN-CODE EQUAL "8"                                   CL**2
00534          GO TO MAST1-READ-ERROR.                                     CL**2
           MOVE "400" TO DATA-ENTRY-CAT.
           PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.
           IF DATA-RETURN-CODE IS EQUAL TO "0"
              GO TO CK-COMMENT-2
           END-IF.
           IF DATA-RETURN-CODE IS EQUAL TO "8"
              GO TO MAST1-READ-ERROR
           END-IF.
           MOVE "450" TO DATA-ENTRY-CAT.
           PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.
           IF DATA-RETURN-CODE IS EQUAL TO "0"
              GO TO CK-COMMENT-2
           END-IF.
           IF DATA-RETURN-CODE IS EQUAL TO "8"
              GO TO MAST1-READ-ERROR
           END-IF.
00535      MOVE "800" TO DATA-ENTRY-CAT.                                   CL**2
00536      PERFORM READ-CATEGORY THRU READ-CATEGORY-XIT.                   CL**2
00537      IF DATA-RETURN-CODE EQUAL TO "2"                                CL**2
00538          GO TO RETURN-A-LEVEL.                                       CL**2
00539      IF DATA-RETURN-CODE EQUAL "8"                                   CL**2
00540          GO TO MAST1-READ-ERROR.                                     CL**2
00541      GO TO CK-COMMENT-2.                                             CL**2
00542 *       GO BACK TO PREVIOUSLY PROCESSED ENTRY                        CL**2
00543  RETURN-A-LEVEL.                                                     CL**2
00544      IF KEY-CNT NOT LESS THAN 01                                     CL**2
00545          GO TO RESTORE-KEY.                                          CL**2
00546      GO TO EXPLOSION-END.                                            CL**2
00547  RESTORE-KEY.                                                        CL**2
00548      MOVE KEY-NAME (KEY-CNT) TO DATA-ENTRY-NAME.                     CL**2
00549      MOVE KEY-CATEGORY (KEY-CNT) TO DATA-ENTRY-CAT.                  CL**2
00550      MOVE KEY-LINE (KEY-CNT) TO DATA-ENTRY-LINE.                     CL**2
00551      SUBTRACT 1 FROM KEY-CNT.                                        CL**2
00552      PERFORM RETURN-KEY THRU RETURN-KEY-XIT.                         CL**2
00553      IF DATA-RETURN-CODE NOT EQUAL "0"                               CL**2
00554          GO TO MAST1-READ-ERROR.                                     CL**2
      ********************************************************
      *    GET THE NEXT STRUCTURE, PROCESS, MDINFO OR 
      *    RELATIONAL LINE
      ********************************************************
00556  READ-STCLINE.                                                       CL**2
00557      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
           IF ( DATA-RETURN-CODE IS EQUAL TO "1" )
00559          GO TO RETURN-A-LEVEL.                                       CL**2
           IF ( CAT-CATEGORY IS GREATER THAN 800 )
           THEN 
              GO TO RETURN-A-LEVEL
           END-IF.
00560  CK-COMMENT-2.                                                       CL**2
00561      IF CAT-COMMENT EQUAL TO "*"                                     CL**2
00562          GO TO READ-STCLINE.                                         CL**2
00578      IF STC-CNAME EQUAL TO "FILLER "                                 CL**2
00579          GO TO READ-STCLINE.                                         CL**2
00580      IF STC-CNAME EQUAL TO SPACES                                    CL**2
00581          GO TO READ-STCLINE.                                         CL**2
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 10 OR 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "300" )
              AND ( CTL-LINE-TYPE IS NOT EQUAL TO "A" ))
           THEN 
              GO TO READ-STCLINE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 20 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "450" )) 
           THEN 
              GO TO READ-STCLINE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "400" )
              AND ( STC-LINE-TYPE IS NOT EQUAL TO "P" ))
           THEN 
              GO TO READ-STCLINE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "400" )
              AND ( STC-CNAME IS EQUAL TO "SYSTEM" )) 
           THEN 
              GO TO READ-STCLINE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "425" )
              AND ( ACC-A-TYPE IS EQUAL TO "L" )) 
           THEN 
              GO TO READ-STCLINE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "425" )
              AND ( STC-LINE-TYPE IS EQUAL TO "M" ))
           THEN 
              GO TO READ-STCLINE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "500" )
              AND ( STC-LINE-TYPE IS EQUAL TO "C" ))
           THEN 
              GO TO READ-STCLINE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 24 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "450" OR "525" ))
           THEN 
              GO TO READ-STCLINE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "450" )
              AND ( STC-LINE-TYPE IS EQUAL TO "L" ))
           THEN 
              GO TO READ-STCLINE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "475" OR "550" OR "575" )) 
           THEN 
              GO TO READ-STCLINE
           END-IF.
00582      GO TO CHECK-ENTRY.                                              CL**2
00584 ********************************************************             CL**2
      *    FORMAT ADD AND CHG STATEMENTS FOR COPY.
      *    FORMAT DEL WHEREUSED STATEMENTS FOR MOVE.
00587 ********************************************************             CL**2
00588  OUTPUT-UPDATE-TX.                                                   CL**2
00589      MOVE ZERO TO ENT.                                               CL**2
00590      IF EXPLOSION-PASS NOT EQUAL TO "1"                              CL**2
00591          GO TO TRY-PASS-2.                                           CL**2
00592      PERFORM GET-ENT THRU GET-ENT-XIT.                               CL**2
00593      MOVE ENT-HOLD TO ADD-LINE-ENT.                                  CL**2
00594 *                                                                    CL**2
00595 *      OUTPUT NEW NAME FOR FIRST NAME PROCESSED                      CL**2
00596 *                                                                    CL**2
00597      IF PASS1-TX1 EQUAL TO "N"                                       CL**2
00598          MOVE CURRENT-ENTRY-NAME TO ADD-LINE-NAME                    CL**2
00599          GO TO MOVE-ADD-LINE.                                        CL**2
00600      MOVE "N" TO PASS1-TX1.                                          CL**2
00601      IF NEW-ENTRY-NAME EQUAL TO SPACES                               CL**2
00602          MOVE CURRENT-ENTRY-NAME TO ADD-LINE-NAME                    CL**2
00603      ELSE                                                            CL**2
00604          MOVE NEW-ENTRY-NAME TO ADD-LINE-NAME.                       CL**2
00605  MOVE-ADD-LINE.                                                      CL**2
      ******************************************************************
      * 
      *   THE WORK FILE IS USED TO PREVENT DUPLICATE  'ADD' 
      *   AND 'CHG' STATEMENTS
      * 
      ******************************************************************
      * 
      *   DETERMINE IF AN 'ADD' STATEMENT HAS ALREADY BEEN WRITTEN
      * 
           PERFORM READ-WORK-FILE THRU
                   READ-WORK-FILE-XIT.
           IF WORK-KEY-VALID THEN 
               GO TO OUTPUT-UPDATE-TX-XIT 
           ELSE 
               PERFORM WRITE-WORK-FILE THRU 
                       WRITE-WORK-FILE-XIT. 
00606      MOVE ADD-LINE TO COPY-CARD.                                     CL**2
00607      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
00608      ADD 1 TO TARGET-TOTAL.                                          CL**2
00609 *                                                                    CL**2
00610 *    TEST FOR COPY (P)                                               CL**2
00611 *                                                                    CL**2
00612      IF TYPE-TX EQUAL "P"                                            CL**2
00613          GO TO OUTPUT-UPDATE-TX-XIT.                                 CL**2
00614 *                                                                    CL**2
00615 *     FORMAT DEL WHERE USED FOR MOVE                                 CL**2
00616 *                                                                    CL**2
00617      MOVE ENT-HOLD TO DEL-LINE-ENT.                                  CL**2
00618      MOVE CURRENT-ENTRY-NAME TO DEL-LINE-NAME.                       CL**2
00619      MOVE DEL-LINE TO COPY-CARD.                                     CL**2
00620      MOVE "S" TO FILE-INDICATOR.                                     CL**2
00621      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
00622      ADD 1 TO SOURCE-TOTAL.                                          CL**2
00623      GO TO OUTPUT-UPDATE-TX-XIT.                                     CL**2
00624  TRY-PASS-2.                                                         CL**2
00625      IF EXPLOSION-PASS EQUAL 2                                       CL**2
00626          MOVE CURRENT-ENTRY-NAME TO DATA-ENTRY-NAME                  CL**2
00627          GO TO READ-MAST1.                                           CL**2
00628      IF EXPLOSION-PASS EQUAL ZERO                                    CL**2
00629          MOVE CURRENT-ENTRY-NAME TO DATA-ENTRY-NAME                  CL**2
00630          GO TO READ-MAST1.                                           CL**2
00631      GO TO OUTPUT-UPDATE-TX-XIT.                                     CL**2
00632  READ-MAST1.                                                         CL**2
00633      PERFORM READ-FIRST-DATA THRU READ-FIRST-DATA-XIT.               CL**2
00634      IF DATA-RETURN-CODE EQUAL ZERO                                  CL**2
00635          GO TO CHECK-PASS-2.                                         CL**2
00636      GO TO CHECK-PASS-0.                                             CL**2
00637  CHECK-PASS-2.                                                       CL**2
00638      IF EXPLOSION-PASS NOT EQUAL 2                                   CL**2
00639          GO TO CHECK-PASS-0.                                         CL**2
00640      PERFORM GET-ENT THRU GET-ENT-XIT.                               CL**2
00641      MOVE ENT-HOLD TO CHG-LINE-ENT.                                  CL**2
00643 *                                                                    CL**2
00644 *      OUTPUT NEW NAME FOR FIRST NAME PROCESSED                      CL**2
00645 *                                                                    CL**2
00646      IF PASS2-TX1 EQUAL TO "N"                                       CL**2
00647          MOVE CURRENT-ENTRY-NAME TO CHG-LINE-NAME                    CL**2
00648          GO TO MOVE-CHG-LINE.                                        CL**2
00649      MOVE "N" TO PASS2-TX1.                                          CL**2
00650      IF NEW-ENTRY-NAME EQUAL SPACE                                   CL**2
00651          MOVE CURRENT-ENTRY-NAME TO CHG-LINE-NAME                    CL**2
           ELSE 
               MOVE NEW-ENTRY-NAME TO CHG-LINE-NAME.
00656  MOVE-CHG-LINE.                                                      CL**2
      * 
      *   DETERMINE IF A 'CHG' STATEMENT HAS ALREADY BEEN WRITTEN 
      * 
           PERFORM READ-WORK-FILE THRU
                   READ-WORK-FILE-XIT.
           IF WORK-KEY-INVALID THEN 
               GO TO OUTPUT-UPDATE-TX-XIT 
           ELSE 
               PERFORM DELETE-WORK-FILE THRU
                       DELETE-WORK-FILE-XIT.
00657      MOVE CHG-LINE TO COPY-CARD.                                     CL**2
00658      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
           ADD 1 TO TARGET-TOTAL. 
00659      GO TO PROCESS-FIELDS.                                           CL**2
00660  CHECK-PASS-0.                                                       CL**2
00661      IF EXPLOSION-PASS NOT EQUAL 0                                   CL**2
00662          GO TO OUTPUT-UPDATE-TX-XIT.                                 CL**2
00663 *                                                                    CL**2
00664 *    FORMAT ADD XXX=CATNAME LINE                                     CL**2
00665 *                                                                    CL**2
00666      PERFORM GET-ENT THRU GET-ENT-XIT.                               CL**2
00667      ADD 1 TO TARGET-TOTAL.                                          CL**2
00668      MOVE ENT-HOLD TO ADD-LINE-ENT.                                  CL**2
00669 *                                                                    CL**2
00670 *      OUTPUT NEW NAME FOR FIRST NAME PROCESSED                      CL**2
00671 *                                                                    CL**2
00672      IF PASSZERO-TX1 EQUAL "N"                                       CL**2
00673          MOVE CURRENT-ENTRY-NAME TO ADD-LINE-NAME                    CL**2
00674          GO TO MOVE-ADD-LINE-2.                                      CL**2
00675      MOVE "N" TO PASSZERO-TX1.                                       CL**2
00676      IF NEW-ENTRY-NAME EQUAL SPACE                                   CL**2
00677          MOVE CURRENT-ENTRY-NAME TO ADD-LINE-NAME                    CL**2
00678          MOVE ADD-LINE TO COPY-CARD                                  CL**2
00679          PERFORM COPY-OUT THRU COPY-OUT-XIT                          CL**2
00680          GO TO CHECK-FOR-MOVE-DEL.                                   CL**2
00681      MOVE NEW-ENTRY-NAME TO ADD-LINE-NAME.                           CL**2
00682  MOVE-ADD-LINE-2.                                                    CL**2
00683      MOVE ADD-LINE TO COPY-CARD.                                     CL**2
00684      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
00685  CHECK-FOR-MOVE-DEL.                                                 CL**2
00686 *                                                                    CL**2
00687 *    TEST FOR COPY (P)                                               CL**2
00688 *                                                                    CL**2
00689      IF TYPE-TX EQUAL "P"                                            CL**2
00690          GO TO PROCESS-FIELDS.                                       CL**2
00691 *                                                                    CL**2
00692 *    FORMAT DELETE WHEREUSED FOR MOVE                                CL**2
00693 *                                                                    CL**2
00694      MOVE ENT-HOLD TO DEL-LINE-ENT.                                  CL**2
00695      MOVE CURRENT-ENTRY-NAME TO DEL-LINE-NAME.                       CL**2
00696      MOVE DEL-LINE TO COPY-CARD.                                     CL**2
00697      MOVE "S" TO FILE-INDICATOR.                                     CL**2
00698      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
00699      ADD 1 TO SOURCE-TOTAL.                                          CL**2
00700 *                                                                    CL**2
00701 *    FORMAT CATEGORY HEADER LINE                                     CL**2
00702 *                                                                    CL**2
00703  PROCESS-FIELDS.                                                     CL**2
00704      PERFORM READ-DIR THRU READ-DIR-XIT.                             CL**2
00705      MOVE HOLD-CAT TO CATEGORY-NAME.                                 CL**2
00706      MOVE CATEGORY-LINE TO COPY-CARD.                                CL**2
00707      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
00708 *                                                                    CL**2
00709 *    FORMAT FIELD UPDATE TX-S                                        CL**2
00710 *       FOR EVERY FIELD IN DATA FILE LINE WITH VALUE OUTPUT          CL**2
00711 *       KW=VALUE NOTATION, SEPARATE MULTIPLE FIELDS WITH COMMA       CL**2
00712  CHECK-COMMENT.                                                      CL**2
00713      MOVE CAT-LINE TO DATA-LINE-NO.                                  CL**2
00714      IF CAT-CATEGORY EQUAL "030" OR "900"                            CL**2
00715          MOVE CAT-DETAIL TO UPDATE-TX-DATA                           CL**2
00716          PERFORM COPY-OUT THRU COPY-OUT-XIT                          CL**2
00717          GO TO READ-AGAIN.                                           CL**2
00718      IF CAT-COMMENT EQUAL "*"                                        CL**2
00719          MOVE CAT-DETAIL TO UPDATE-TX-DATA                           CL**2
00720          PERFORM COPY-OUT THRU COPY-OUT-XIT                          CL**2
00721          GO TO READ-AGAIN.                                           CL**2
00722      GO TO INITIALIZE-SUBS.                                          CL**2
00723  READ-AGAIN.                                                         CL**2
00724      PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT.                 CL**2
00725      IF DATA-RETURN-CODE EQUAL ZERO                                  CL**2
00726          GO TO CHECK-COMMENT.                                        CL**2
00727      IF DATA-RETURN-CODE EQUAL TO "2"                                CL**2
00728          GO TO PROCESS-FIELDS.                                       CL**2
00729      GO TO OUTPUT-UPDATE-TX-XIT.                                     CL**2
00730  INITIALIZE-SUBS.                                                    CL**2
00731      MOVE 1 TO DAT-SUB.                                              CL**2
00732      MOVE 0 TO TOTAL-1.                                              CL**2
00733      MOVE 1 TO FLD-SUB.                                              CL**2
00734      MOVE 1 TO NAME-SUB.                                             CL**2
00735      MOVE 1 TO DETAIL-SUB.                                           CL**2
00736 *                                                                    CL**2
00737 *    PROCESS FIELD NAMES                                             CL**2
00738 *                                                                    CL**2
00739  FIND-1ST-DATA-FLD.                                                  CL**2
00740      MOVE FLD-START (FLD-SUB) TO DETAIL-SUB.                         CL**2
           IF ( CAT-CATEGORY IS EQUAL TO "010" )
           THEN 
              GO TO PROCESS-CONTROL 
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 05 ) 
               AND ( CAT-CATEGORY IS EQUAL TO "110" ) 
               AND ( CTL-LINE-TYPE IS EQUAL TO "C" OR "P" ))
               GO TO PROCESS-VALUES 
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "300" )
              AND ( CTL-LINE-TYPE IS EQUAL TO "B" OR "C" )) 
              GO TO PROCESS-TOTAL 
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 10 OR 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "300" )
              AND ( CTL-LINE-TYPE IS EQUAL TO "O" OR "D" OR "I" ))
              GO TO PROCESS-DEPENDS 
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 10 OR 13 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "300" )
              AND ( CTL-LINE-TYPE IS EQUAL TO "R" OR "T" )) 
              GO TO PROCESS-RENAM-THRU
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "300" )) 
              GO TO PROCESS-AREA-STRUCTURE
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 22 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "500" )
              AND ( CTL-LINE-TYPE IS EQUAL TO "C" OR "I" )) 
              GO TO PROCESS-AREAKEYS
           END-IF.
  
           IF (( CAT-CATEGORY IS EQUAL TO "425" ) 
              AND ( CTL-LINE-TYPE IS EQUAL TO "L" ))
              GO TO PROCESS-ACCESS
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 26 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "450" )) 
              GO TO PROCESS-SCH-MDI 
           END-IF.
  
           IF (( DATA-HDR-ENT-ID IS EQUAL TO 24 ) 
              AND ( CAT-CATEGORY IS EQUAL TO "525" )
              AND ( CTL-LINE-TYPE IS EQUAL TO "I" 
                  OR "Q" OR "2" OR "B" OR "3"  )) 
              GO TO PROCESS-SSREL 
           END-IF.
  
           IF ( CAT-CATEGORY IS EQUAL TO "575" )
              GO TO PROCESS-JOINS 
           END-IF.
  
           IF ( CAT-CATEGORY IS EQUAL TO "550" )
              GO TO PROCESS-CONSTRAINTS 
           END-IF.
00741      IF DETAIL-LINE (DETAIL-SUB) NOT EQUAL TO SPACE                  CL**2
00742          GO TO MOVE-NAME.                                            CL**2
00743      ADD 1 TO FLD-SUB.                                               CL**2
00744      IF FLD-NAME (FLD-SUB) EQUAL SPACES                              CL**2
00745          PERFORM COPY-OUT THRU COPY-OUT-XIT                          CL**2
00746          GO TO READ-AGAIN.                                           CL**2
00747      GO TO FIND-1ST-DATA-FLD.                                        CL**2
00748  MOVE-NAME.                                                          CL**2
00749      MOVE FLD-NAME (FLD-SUB) TO FIELD-NAME.                          CL**2
           IF FIELD-NAME = "KEYWORD"
               MOVE 1 TO NAME-SUB 
               MOVE 1 TO CHAR-MOVED 
               GO TO MOVE-DATA. 
00750  MOVE-NAME-2.                                                        CL**2
00751      MOVE FLD-WORK (NAME-SUB) TO DAT-LINE (DAT-SUB).                 CL**2
00752      ADD 1 TO NAME-SUB DAT-SUB TOTAL-1.                              CL**2
00753      IF NAME-SUB GREATER THAN 3                                      CL**2
00754          MOVE "=" TO DAT-LINE (DAT-SUB)                              CL**2
00755          ADD 1 TO DAT-SUB TOTAL-1                                    CL**2
00756          MOVE 1 TO NAME-SUB                                          CL**2
00757          MOVE 1 TO CHAR-MOVED                                        CL**2
00758          GO TO MOVE-DATA.                                            CL**2
00759      GO TO MOVE-NAME-2.                                              CL**2
00760  MOVE-DATA.                                                          CL**2
00761      MOVE DETAIL-LINE (DETAIL-SUB) TO DAT-LINE (DAT-SUB).            CL**2
00762      ADD 1 TO DETAIL-SUB DAT-SUB TOTAL-1 CHAR-MOVED.                 CL**2
00763      IF CHAR-MOVED GREATER THAN FLD-LENGTH (FLD-SUB)                 CL**2
00764          GO TO GET-NEXT-FLD.                                         CL**2
00765      GO TO MOVE-DATA.                                                CL**2
00766  GET-NEXT-FLD.                                                       CL**2
00767      ADD 1 TO FLD-SUB.                                               CL**2
00768      IF FLD-NAME (FLD-SUB) EQUAL SPACE                               CL**2
00769          PERFORM COPY-OUT THRU COPY-OUT-XIT                          CL**2
00770          GO TO READ-AGAIN.                                           CL**2
00771      MOVE "Y" TO FLD-SW.                                             CL**2
00772      MOVE FLD-START (FLD-SUB) TO DETAIL-SUB.                         CL**2
00773      IF DETAIL-LINE (DETAIL-SUB) EQUAL SPACE                         CL**2
00774          MOVE "N" TO FLD-SW                                          CL**2
00775          GO TO GET-NEXT-FLD.                                         CL**2
00776      IF FLD-SW EQUAL "N"                                             CL**2
00777          MOVE "Y" TO FLD-SW                                          CL**2
00778          GO TO CK-LENGTH.                                            CL**2
00779      PERFORM INSERT-COMMA THRU INSERT-COMMA-XIT.                     CL**2
00780      ADD 1 TO DAT-SUB TOTAL-1.                                       CL**2
00781 *                                                                    CL**2
00782 *   DETERMINE IF NEXT FIELD WILL FIT IN TRANSCTION LINE              CL**2
00783 *                                                                    CL**2
00784  CK-LENGTH.                                                          CL**2
00785      PERFORM CHECK-LENGTH THRU CHECK-LENGTH-XIT.                     CL**2
00786      IF LENGTH-SW EQUAL "Y"                                          CL**2
00787          GO TO MOVE-NAME.                                            CL**2
00788      GO TO USE-DATA-LINE-2.                                          CL**2
00789  USE-DATA-LINE-2.                                                    CL**2
00790      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
00791      MOVE 1 TO DAT-SUB                                               CL**2
00792      MOVE ZERO TO TOTAL-1                                            CL**2
00793      MOVE SPACE TO DATA-LINE-NO                                      CL**2
00794      GO TO MOVE-NAME.                                                CL**2
00795  OUTPUT-UPDATE-TX-XIT.                                               CL**2
00796      EXIT.                                                           CL**2
00797 *                                                                    CL**2
00798 *    DERTERMINE REMAINING LINE SPACE SUBROUTINE                      CL**2
00799 *                                                                    CL**2
00800  CHECK-LENGTH.                                                       CL**2
00801      SUBTRACT TOTAL-1 FROM 67                                        CL**2
00802          GIVING TOTAL-3.                                             CL**2
00803      MOVE FLD-LENGTH (FLD-SUB) TO TOTAL-2.                           CL**2
00804      ADD 5 TO TOTAL-2.                                               CL**2
00805      IF TOTAL-2 LESS THAN TOTAL-3                                    CL**2
00806          MOVE ZERO TO TOTAL-2 TOTAL-3                                CL**2
00807          MOVE "Y" TO LENGTH-SW                                       CL**2
00808          GO TO CHECK-LENGTH-XIT.                                     CL**2
00809      MOVE ZERO TO TOTAL-2 TOTAL-3.                                   CL**2
00810      MOVE "N" TO LENGTH-SW.                                          CL**2
00811  CHECK-LENGTH-XIT.                                                   CL**2
00812      EXIT.                                                           CL**2
00813 *                                                                    CL**2
00814 *    SUBROUTINE FOR DERIVING ENTRY NAME                              CL**2
00815 *                                                                    CL**2
00816  GET-ENT.                                                            CL**2
00817      MOVE 1 TO ENT.                                                  CL**2
00818  READ-ENT-TABLE.                                                     CL**2
00819      IF ENT-ID (ENT) EQUAL DATA-HDR-ENT-ID                           CL**2
00820          MOVE ENT-NAME (ENT) TO ENT-HOLD                             CL**2
00821          GO TO GET-ENT-XIT.                                          CL**2
00822      ADD 1 TO ENT.                                                   CL**2
00823      GO TO READ-ENT-TABLE.                                           CL**2
00824  GET-ENT-XIT.                                                        CL**2
00825      EXIT.                                                           CL**2
00826 *                                                                    CL**2
00827 *    SUBROUTINE FOR READING DIRECTORY TO GET FIELD NAMES             CL**2
00828 *                                                                    CL**2
00829  READ-DIR.                                                           CL**2
00830      MOVE 1 TO DIR-SUB.                                              CL**2
00831      IF CAT-CATEGORY EQUAL TO 010 OR 020 OR 030 OR 900               CL**2
00832          GO TO GET-DIR-CAT.                                          CL**2
00833  GET-DIR-ENT.                                                        CL**2
00834      IF DIR-ID (DIR-SUB) EQUAL DATA-HDR-ENT-ID                       CL**2
00835          GO TO GET-DIR-CAT.                                          CL**2
00836      ADD 1 TO DIR-SUB.                                               CL**2
00837      GO TO GET-DIR-ENT.                                              CL**2
00838  GET-DIR-CAT.                                                        CL**2
00839      IF DIR-CAT (DIR-SUB) NOT EQUAL CAT-CATEGORY                     CL**2
00840          ADD 1 TO DIR-SUB                                            CL**2
00841          GO TO GET-DIR-CAT.                                          CL**2
00842      MOVE DIR-START (DIR-SUB) TO CON-KEY.                            CL**2
00843      PERFORM MAST3-READ THRU MAST3-READ-XIT.                         CL**2
00844      IF MAST3-RETURN-CODE EQUAL TO "1"                               CL**2
00845          MOVE ERROR-MSG10 TO ERROR-POS2                              CL**2
00846          GO TO PRINT-FATAL-ERROR.                                    CL**2
00847  GET-CAT.                                                            CL**2
00848      MOVE 1 TO CAT.                                                  CL**2
00849  READ-CAT-TABLE.                                                     CL**2
00850      IF CAT-ID (CAT) EQUAL TO CAT-CATEGORY                           CL**2
00851          MOVE CAT-NAME (CAT) TO HOLD-CAT                             CL**2
00852          GO TO READ-DIR-XIT.                                         CL**2
00853      ADD 1 TO CAT.                                                   CL**2
00854      GO TO READ-CAT-TABLE.                                           CL**2
00855  READ-DIR-XIT.                                                       CL**2
00856      EXIT.                                                           CL**2
00857 *                                                                    CL**2
00858 *   INSERT COMMA AFTER LAST NON BLANK FIELD                          CL**2
00859 *                                                                    CL**2
00860  INSERT-COMMA.                                                       CL**2
00861      SUBTRACT 1 FROM DAT-SUB TOTAL-1.                                CL**2
00862      IF DAT-LINE (DAT-SUB) EQUAL SPACE                               CL**2
00863          GO TO INSERT-COMMA.                                         CL**2
00864      ADD 1 TO DAT-SUB TOTAL-1.                                       CL**2
00865      MOVE "," TO DAT-LINE (DAT-SUB).                                 CL**2
00866  INSERT-COMMA-XIT.                                                   CL**2
00867      EXIT.                                                           CL**2
00869 ***************************************************                  CL**2
00870 *                                                                    CL**2
00871 *    END OF MODULE PROCESSING                                        CL**2
00872 *        CLOSE FILES AND RETURN CONTROL TO UTL                       CL**2
00873 *                                                                    CL**2
00874 ****************************************************                 CL**2
00875  EXPLOSION-END.                                                      CL**2
00876      IF EXPLOSION-PASS EQUAL TO "2" OR "0"                           CL**2
00877          GO TO END-OF-COPY.                                          CL**2
00878      IF DATA-PRESENT-SW EQUAL TO "N"                                 CL**2
00879          GO TO END-OF-COPY.                                          CL**2
00880      MOVE 2 TO EXPLOSION-PASS.                                       CL**2
00881      GO TO EXPLODE-HIERARCHY.                                        CL**2
00882  END-OF-COPY.                                                        CL**2
00883      MOVE "9" TO COPY-FUNCTION-CODE.                                 CL**2
           CLOSE WORK-FILE. 
           EXIT PROGRAM.
00885  ABORT-END.                                                          CL**2
00886      MOVE "8" TO COPY-FUNCTION-CODE.                                 CL**2
           CLOSE WORK-FILE. 
           EXIT PROGRAM.
       PROCESS-DEPENDS. 
  
      *********************************************************** 
      *    THIS SECTION OF THE CODE MASSAGES THE GROUP OR RECORD
      *    OCCURS DETAIL LINES TO COPY THEM IN THE CORRECT
      *    ORDER. 
      ********************************************************* 
  
           IF ( CTL-LINE-TYPE IS EQUAL TO "I" ) 
           THEN 
              MOVE "IND=" TO UPDATE-TX-DATA (DAT-SUB : 4) 
              ADD 4  TO DAT-SUB 
              MOVE CTL-ALY-VER TO UPDATE-TX-DATA (DAT-SUB : 32) 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
           END-IF 
           IF ( CTL-LINE-TYPE IS EQUAL TO "D" ) 
           THEN 
              MOVE DETAIL-WORK TO SAVE-STC-LINES-D
              GO TO CHECK-DEP-QUAL3 
           END-IF.
           MOVE DETAIL-WORK TO SAVE-STC-LINES-O.
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
           IF ( DATA-RETURN-CODE IS NOT EQUAL TO ZERO ) 
           THEN 
              GO TO PROCESS-DEP-FIELDS
           END-IF 
           IF (( CAT-CATEGORY IS EQUAL TO "300" ) 
              AND (CTL-LINE-TYPE IS EQUAL TO "D" )) 
           THEN 
              MOVE DETAIL-WORK TO SAVE-STC-LINES-D
           END-IF.
  
       PROCESS-DEP-FIELDS.
  
           IF ( S-STC-FROM IS EQUAL TO SPACES ) 
           THEN 
              GO TO CHECK-TO-FIELD
           END-IF 
           MOVE "FRO=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-STC-FROM TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           IF (( S-STC-TO IS EQUAL TO SPACES )
              AND ( S-STC-TO-ALIAS IS EQUAL TO SPACES ) 
              AND ( S-STC-DEPENDS IS EQUAL TO SPACES )
              AND ( S-STC-DEP-ALIAS IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL1 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL2 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL3 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL4 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       CHECK-TO-FIELD.
  
           IF ( S-STC-TO IS EQUAL TO SPACES ) 
           THEN 
              GO TO CHECK-TO-ALIAS
           END-IF 
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
           MOVE "TO=" TO UPDATE-TX-DATA (DAT-SUB : 3) 
           ADD 3 TO DAT-SUB 
           MOVE S-STC-TO TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           IF (( S-STC-TO-ALIAS IS EQUAL TO SPACES )
              AND ( S-STC-DEPENDS IS EQUAL TO SPACES )
              AND ( S-STC-DEP-ALIAS IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL1 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL2 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL3 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL4 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       CHECK-TO-ALIAS.
  
           IF ( S-STC-TO-ALIAS IS EQUAL TO SPACES ) 
           THEN 
              GO TO CHECK-DEPEND-FIELD
           END-IF.
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
           MOVE "TAL=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-STC-TO-ALIAS TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           IF (( S-STC-DEPENDS IS EQUAL TO SPACES ) 
              AND ( S-STC-DEP-ALIAS IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL1 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL2 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL3 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL4 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       CHECK-DEPEND-FIELD.
  
           IF ( S-STC-DEPENDS IS EQUAL TO SPACES )
           THEN 
              GO TO CHECK-DEP-ALIAS 
           END-IF.
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO DATA-LINE-NO 
           END-IF 
           MOVE "DEP=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-STC-DEPENDS TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           IF (( S-STC-DEP-ALIAS IS EQUAL TO SPACES ) 
              AND ( S-STC-DEP-QUAL1 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL2 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL3 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL4 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       CHECK-DEP-ALIAS. 
  
           IF ( S-STC-DEP-ALIAS IS EQUAL TO SPACES )
           THEN 
              GO TO CHECK-DEPEND-QUAL1
           END-IF 
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
           MOVE "DAL=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-STC-DEP-ALIAS TO UPDATE-TX-DATA (DAT-SUB : 4) 
           ADD 4 TO DAT-SUB 
           IF (( S-STC-DEP-QUAL1 IS EQUAL TO SPACES)
              AND ( S-STC-DEP-QUAL2 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL3 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL4 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       CHECK-DEPEND-QUAL1.
  
           IF ( S-STC-DEP-QUAL1 IS EQUAL TO SPACES )
           THEN 
              GO TO CHECK-DEP-QUAL2 
           END-IF 
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO DATA-LINE-NO 
           END-IF 
           MOVE "D1Q=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-STC-DEP-QUAL1 TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           IF (( S-STC-DEP-QUAL2 IS EQUAL TO SPACES)
              AND ( S-STC-DEP-QUAL3 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL4 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       CHECK-DEP-QUAL2. 
  
           IF ( S-STC-DEP-QUAL2 IS EQUAL TO SPACES )
           THEN 
              GO TO CHECK-DEP-QUAL3 
           END-IF 
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO DATA-LINE-NO 
           END-IF 
           MOVE "D2Q=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-STC-DEP-QUAL2 TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           IF (( S-STC-DEP-QUAL3 IS EQUAL TO SPACES)
              AND ( S-STC-DEP-QUAL4 IS EQUAL TO SPACES )
              AND ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       CHECK-DEP-QUAL3. 
  
           IF ( S-STC-DEP-QUAL3 IS EQUAL TO SPACES )
           THEN 
              GO TO CHECK-DEP-QUAL4 
           END-IF 
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO DATA-LINE-NO 
           END-IF 
           MOVE "D3Q=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-STC-DEP-QUAL3 TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           IF (( S-STC-DEP-QUAL4 IS EQUAL TO SPACES)
              AND ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              GO TO PROCESS-DEPEND-COMPLETE 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       CHECK-DEP-QUAL4. 
  
           IF ( S-STC-DEP-QUAL4 IS EQUAL TO SPACES )
           THEN 
              GO TO CHECK-DEP-QUAL5 
           END-IF 
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO DATA-LINE-NO 
           END-IF 
           MOVE "D4Q=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-STC-DEP-QUAL4 TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           IF ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              GO TO PROCESS-DEPEND-COMPLETE 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       CHECK-DEP-QUAL5. 
  
           IF ( S-STC-DEP-QUAL5 IS EQUAL TO SPACES )
           THEN 
              GO TO PROCESS-DEPEND-COMPLETE 
           END-IF 
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO DATA-LINE-NO 
           END-IF 
           MOVE "D5Q=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-STC-DEP-QUAL5 TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
  
       PROCESS-DEPEND-COMPLETE. 
  
           MOVE 1 TO DAT-SUB
           IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" ) 
           THEN 
              GO TO OUTPUT-UPDATE-TX-XIT
           END-IF 
           IF ( DATA-RETURN-CODE IS EQUAL TO "2" )
           THEN 
              GO TO PROCESS-FIELDS
           END-IF 
           MOVE SPACES TO SAVE-STC-LINES
           GO TO READ-AGAIN.
  
       PROCESS-AREA-STRUCTURE.
  
      *********************************************************** 
      *    THIS SECTION OF THE CODE MASSAGES THE AREA 
      *    STRUCTURE CATEGORY TO PROPERLY COPY THE RCVALUE. 
      ********************************************************* 
  
           IF STC-AREA-NAME IS EQUAL TO SPACES
           THEN 
              GO TO CHECK-AREA-ALIAS
           END-IF 
  
           MOVE "CAT=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE STC-AREA-NAME TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           IF (( STC-AREA-ALIAS IS EQUAL TO SPACES )
              AND ( STC-AREA-RCVAL IS EQUAL TO SPACES ) 
              AND ( STC-AREA-INC IS EQUAL TO SPACES ))
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
           ELSE 
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF.
  
       CHECK-AREA-ALIAS.
  
           IF STC-AREA-ALIAS IS EQUAL TO SPACES 
           THEN 
              GO TO CHECK-AREA-RCVAL
           END-IF 
  
           MOVE "ALI=" TO UPDATE-TX-DATA ( DAT-SUB : 4) 
           ADD 4 TO DAT-SUB 
           MOVE STC-AREA-ALIAS TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           IF (( STC-AREA-RCVAL IS EQUAL TO SPACES )
              AND ( STC-AREA-INC IS EQUAL TO SPACES ))
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
           ELSE 
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE SPACES TO DATA-LINE-NO 
              MOVE 1 TO DAT-SUB 
           END-IF.
  
       CHECK-AREA-RCVAL.
  
           IF STC-AREA-RCVAL IS EQUAL TO SPACES 
           THEN 
              GO TO CHECK-AREA-INC
           END-IF 
  
           MOVE "RCV=" TO UPDATE-TX-DATA ( DAT-SUB : 4) 
           ADD 4 TO DAT-SUB 
           IF STC-AREA-RCV-FLAG IS EQUAL TO "L" 
           THEN 
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
           MOVE STC-AREA-RCVAL TO UPDATE-TX-DATA (DAT-SUB : 30) 
           ADD 30 TO DAT-SUB
           IF STC-AREA-RCV-FLAG IS EQUAL TO "L" 
           THEN 
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
           IF ( STC-AREA-INC IS EQUAL TO SPACES ) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
           ELSE 
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF.
  
       CHECK-AREA-INC.
  
           IF (STC-AREA-INC IS EQUAL TO SPACES) 
           THEN 
              GO TO PROCESS-AREA-STC-COMPLETE 
           END-IF 
  
           MOVE "INC=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE STC-AREA-INC TO DAT-LINE (DAT-SUB)
  
       PROCESS-AREA-STC-COMPLETE. 
  
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
       PROCESS-AREAKEYS.
  
      *********************************************************** 
      *    THIS SECTION OF THE CODE MASSAGES THE AREA 
      *    AREAKEYS CATEGORY DETAIL LINES "C" AND "I".
      ********************************************************* 
  
           IF ( CTL-LINE-TYPE IS EQUAL TO "I" ) 
           THEN 
              GO TO PROCESS-I-LINE
           END-IF.
  
           IF ( AK-CON-NAME IS EQUAL TO SPACES )
           THEN 
              GO TO GET-CON-TYPE
           END-IF 
           MOVE "CKE=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE AK-CON-NAME TO UPDATE-TX-DATA ( DAT-SUB : 30) 
           ADD 30 TO DAT-SUB
           IF (( AK-CON-TYPE IS EQUAL TO SPACES ) 
              AND ( AK-CON-DUPES IS EQUAL TO SPACES ) 
              AND ( AK-CON-USING IS EQUAL TO SPACES ))
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
           MOVE "," TO DAT-LINE (DAT-SUB) 
           ADD 1 TO DAT-SUB.
  
       GET-CON-TYPE.
  
           IF ( AK-CON-TYPE IS EQUAL TO SPACES )
           THEN 
              GO TO GET-CON-DUPES 
           END-IF 
           MOVE "CTY=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE AK-CON-TYPE TO DAT-LINE (DAT-SUB) 
           ADD 1 TO DAT-SUB 
           IF (( AK-CON-DUPES IS EQUAL TO SPACES )
              AND ( AK-CON-USING IS EQUAL TO SPACES ))
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
           MOVE "," TO DAT-LINE (DAT-SUB) 
           ADD 1 TO DAT-SUB.
  
       GET-CON-DUPES. 
  
           IF ( AK-CON-DUPES IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-CON-USING 
           END-IF 
           MOVE "CDU=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE AK-CON-DUPES TO DAT-LINE (DAT-SUB)
           ADD 1 TO DAT-SUB 
           IF ( AK-CON-USING IS EQUAL TO SPACES ) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
           MOVE "," TO DAT-LINE (DAT-SUB) 
           ADD 1 TO DAT-SUB.
  
       GET-CON-USING. 
  
           IF ( AK-CON-USING IS EQUAL TO SPACES ) 
           THEN 
              GO TO AREAKEYS-COMPLETE 
           END-IF 
           MOVE "CUS=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE AK-CON-USING TO DAT-LINE (DAT-SUB)
           ADD 1 TO DAT-SUB.
  
       PROCESS-I-LINE.
  
           IF ( AK-CON-ID IS EQUAL TO SPACES )
           THEN 
              GO TO GET-CON-ALIAS 
           END-IF 
           MOVE "CID=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE AK-CON-ID TO UPDATE-TX-DATA ( DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           IF (( AK-CON-ID-ALIAS IS EQUAL TO SPACES ) 
              AND ( AK-CON-QUAL IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
           MOVE "," TO DAT-LINE (DAT-SUB) 
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE SPACES TO DATA-LINE-NO
           MOVE 1 TO DAT-SUB. 
  
       GET-CON-ALIAS. 
  
           IF ( AK-CON-ID-ALIAS IS EQUAL TO SPACES )
           THEN 
              GO TO GET-CON-QUAL
           END-IF 
           MOVE "CAL=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE AK-CON-ID-ALIAS TO UPDATE-TX-DATA (DAT-SUB : 4) 
           ADD 4 TO DAT-SUB 
           IF ( AK-CON-QUAL IS EQUAL TO SPACES )
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
           MOVE "," TO DAT-LINE (DAT-SUB) 
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE SPACES TO DATA-LINE-NO
           MOVE 1 TO DAT-SUB. 
  
       GET-CON-QUAL.
  
           IF ( AK-CON-QUAL IS EQUAL TO SPACES )
           THEN 
              GO TO AREAKEYS-COMPLETE 
           END-IF 
           MOVE "CQU=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE AK-CON-QUAL TO UPDATE-TX-DATA (DAT-SUB : 32). 
  
       AREAKEYS-COMPLETE. 
  
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
       PROCESS-RENAM-THRU.
  
      *********************************************************** 
      *    THIS SECTION OF THE CODE MASSAGES THE GROUP OR RECORD
      *    RENAMES OR THRU DETAIL LINES TO COPY THEM IN THE 
      *    CORRECT ORDER. 
      ********************************************************* 
  
           IF ( CTL-LINE-TYPE IS EQUAL TO "Q" OR "2" )
           THEN 
              MOVE DETAIL-WORK TO SAVE-STC-LINES-Q-2
              GO TO CHECK-RT-QUAL4
           END-IF 
           MOVE DETAIL-WORK TO SAVE-STC-LINES-R-T.
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
           IF ( DATA-RETURN-CODE IS NOT EQUAL TO ZERO ) 
           THEN 
              GO TO PROCESS-REN-THR-FIELDS
           END-IF 
           IF (( CAT-CATEGORY IS EQUAL TO "300" ) 
              AND ( CTL-LINE-TYPE IS EQUAL TO "Q" OR "2" )) 
           THEN 
              MOVE DETAIL-WORK TO SAVE-STC-LINES-Q-2
           END-IF 
  
       PROCESS-REN-THR-FIELDS.
  
           IF ( S-RTNAME IS EQUAL TO SPACES ) 
           THEN 
              GO TO CHECK-RT-ALIAS
           END-IF 
           IF ( LINE-RT-TYPE IS EQUAL TO "R" )
           THEN 
              MOVE "REN=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ELSE 
              MOVE "THR=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           END-IF 
           ADD 4 TO DAT-SUB 
           MOVE S-RTNAME TO UPDATE-TX-DATA ( DAT-SUB : 32 ) 
           ADD 32 TO DAT-SUB
           IF (( S-RTALIAS IS EQUAL TO SPACES ) 
              AND ( S-RTQUAL1 IS EQUAL TO SPACES )
              AND ( S-RTQUAL2 IS EQUAL TO SPACES )
              AND ( S-RTQUAL3 IS EQUAL TO SPACES )
              AND ( S-RTQUAL4 IS EQUAL TO SPACES )
              AND ( S-RTQUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       CHECK-RT-ALIAS.
  
           IF ( S-RTALIAS IS EQUAL TO SPACES  ) 
           THEN 
              GO TO CHECK-RT-QUAL1
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
           IF ( LINE-RT-TYPE IS EQUAL TO "R" )
           THEN 
              MOVE "RNA=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ELSE 
              MOVE "THA=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           END-IF 
           ADD 4 TO DAT-SUB 
           MOVE S-RTALIAS TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           IF (( S-RTQUAL1 IS EQUAL TO SPACES ) 
              AND ( S-RTQUAL2 IS EQUAL TO SPACES )
              AND ( S-RTQUAL3 IS EQUAL TO SPACES )
              AND ( S-RTQUAL4 IS EQUAL TO SPACES )
              AND ( S-RTQUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       CHECK-RT-QUAL1.
  
           IF ( S-RTQUAL1 IS EQUAL TO SPACES  ) 
           THEN 
              GO TO CHECK-RT-QUAL2
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE SPACES TO DATA-LINE-NO 
              MOVE 1 TO DAT-SUB 
           END-IF 
           IF ( LINE-RT-TYPE IS EQUAL TO "R" )
           THEN 
              MOVE "R1Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ELSE 
              MOVE "T1Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           END-IF 
           ADD 4 TO DAT-SUB 
           MOVE S-RTQUAL1 TO UPDATE-TX-DATA ( DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           IF (( S-RTQUAL2 IS EQUAL TO SPACES ) 
              AND ( S-RTQUAL3 IS EQUAL TO SPACES )
              AND ( S-RTQUAL4 IS EQUAL TO SPACES )
              AND ( S-RTQUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       CHECK-RT-QUAL2.
  
           IF ( S-RTQUAL2 IS EQUAL TO SPACES  ) 
           THEN 
              GO TO CHECK-RT-QUAL3
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE SPACES TO DATA-LINE-NO 
              MOVE 1 TO DAT-SUB 
           END-IF 
           IF ( LINE-RT-TYPE IS EQUAL TO "R" )
           THEN 
              MOVE "R2Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ELSE 
              MOVE "T2Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           END-IF 
           ADD 4 TO DAT-SUB 
           MOVE S-RTQUAL2 TO UPDATE-TX-DATA ( DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           IF (( S-RTQUAL3 IS EQUAL TO SPACES ) 
              AND ( S-RTQUAL4 IS EQUAL TO SPACES )
              AND ( S-RTQUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       CHECK-RT-QUAL3.
  
           IF ( S-RTQUAL3 IS EQUAL TO SPACES  ) 
           THEN 
              GO TO CHECK-RT-QUAL4
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE SPACES TO DATA-LINE-NO 
              MOVE 1 TO DAT-SUB 
           END-IF 
           IF ( LINE-RT-TYPE IS EQUAL TO "R" )
           THEN 
              MOVE "R3Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ELSE 
              MOVE "T3Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           END-IF 
           ADD 4 TO DAT-SUB 
           MOVE S-RTQUAL3 TO UPDATE-TX-DATA ( DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           IF (( S-RTQUAL4 IS EQUAL TO SPACES ) 
              AND ( S-RTQUAL5 IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       CHECK-RT-QUAL4.
  
           IF ( S-RTQUAL4 IS EQUAL TO SPACES  ) 
           THEN 
              GO TO CHECK-RT-QUAL5
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
  
              MOVE 1 TO DAT-SUB 
           END-IF 
           IF ( LINE-RT-TYPE IS EQUAL TO "R" )
           THEN 
              MOVE "R4Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ELSE 
              MOVE "T4Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           END-IF 
           ADD 4 TO DAT-SUB 
           MOVE S-RTQUAL4 TO UPDATE-TX-DATA ( DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           IF ( S-RTQUAL5 IS EQUAL TO SPACES )
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-STC-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       CHECK-RT-QUAL5.
  
           IF ( S-RTQUAL5 IS EQUAL TO SPACES  ) 
           THEN 
              GO TO PROCESS-RT-COMPLETE 
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE SPACES TO DATA-LINE-NO 
              MOVE 1 TO DAT-SUB 
           END-IF 
           IF ( LINE-RT-TYPE IS EQUAL TO "R" )
           THEN 
              MOVE "R5Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ELSE 
              MOVE "T5Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           END-IF 
           ADD 4 TO DAT-SUB 
           MOVE S-RTQUAL5 TO UPDATE-TX-DATA ( DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           PERFORM COPY-OUT THRU COPY-OUT-XIT.
  
       PROCESS-RT-COMPLETE. 
  
           MOVE 1 TO DAT-SUB
           IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" ) 
           THEN 
              GO TO OUTPUT-UPDATE-TX-XIT
           END-IF 
           IF ( DATA-RETURN-CODE IS EQUAL TO "2" )
           THEN 
               GO TO PROCESS-FIELDS 
           END-IF 
           MOVE SPACES TO SAVE-STC-LINES
           GO TO READ-AGAIN.
  
       PROCESS-SSREL. 
  
      ********************************************************* 
      *    THIS SECTION OF THE CODE MASSAGES THE SUBSCHEMA
      *    RELATION DETAIL LINES TO SET THEM IN THE CORRECT 
      *    INPUT ORDER. 
      ********************************************************* 
  
           IF ( CTL-LINE-TYPE IS EQUAL TO "Q" ) 
           THEN 
              MOVE DETAIL-WORK TO REL-LINEQ 
              GO TO GET-ID1-QUALIFIERS
           END-IF 
           IF ( CTL-LINE-TYPE IS EQUAL TO "2" ) 
           THEN 
              MOVE DETAIL-WORK TO REL-LINE2 
              GO TO GET-ID1-QUAL4 
           END-IF 
           IF ( CTL-LINE-TYPE IS EQUAL TO "B" ) 
           THEN 
              MOVE DETAIL-WORK TO REL-LINEB 
              GO TO GET-ID2-QUALIFIERS
           END-IF 
           IF ( CTL-LINE-TYPE IS EQUAL TO "3" ) 
           THEN 
              MOVE DETAIL-WORK TO REL-LINE3 
              GO TO GET-ID2-QUAL4 
           END-IF 
           MOVE DETAIL-WORK TO REL-LINEI. 
  
       READ-NEXT-SSREL-LINE.
  
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
           IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "2" ) 
           THEN 
              GO TO PROCESS-SSREL-FIELDS
           END-IF 
           IF ( CAT-CATEGORY IS EQUAL TO "525" )
           THEN 
              IF ( CTL-LINE-TYPE IS EQUAL TO "R" OR "I" OR "*" )
                  MOVE "4" TO DATA-RETURN-CODE
                  GO TO PROCESS-SSREL-FIELDS
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "Q" )
                  MOVE DETAIL-WORK TO REL-LINEQ 
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "2" )
                  MOVE DETAIL-WORK TO REL-LINE2 
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "B" )
                  MOVE DETAIL-WORK TO REL-LINEB 
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "3" )
                  MOVE DETAIL-WORK TO REL-LINE3 
              END-IF
              GO TO READ-NEXT-SSREL-LINE
           END-IF.
  
       PROCESS-SSREL-FIELDS.
  
           IF ( S-PRELOP IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-LEFT-PAREN
           END-IF.
           MOVE "PRE=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB.
           MOVE S-PRELOP ( 1 : 3 ) TO UPDATE-TX-DATA ( DAT-SUB : 3 )
           ADD 3 TO DAT-SUB 
           IF (( S-LEFT-PAREN IS EQUAL TO SPACES )
              AND ( S-ID1 IS EQUAL TO SPACES )
              AND ( S-ID1-ALIAS IS EQUAL TO SPACES )
              AND ( S-RELOP IS EQUAL TO SPACES )
              AND ( S-ID2 IS EQUAL TO SPACES )
              AND ( S-ID2-ALIAS IS EQUAL TO SPACES )
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO )
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID1-A1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A5QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-LEFT-PAREN.
           IF ( S-LEFT-PAREN IS NOT EQUAL TO SPACE OR ZERO )
           THEN 
              MOVE S-LEFT-PAREN TO LEFT-PAREN-COUNT 
           END-IF.
  
       MOVE-ID1-FLD.
  
      ******************************************************* 
      *           MOVE "ID1=" TO OUTPUT LINE
      ******************************************************* 
  
           IF ( S-ID1 IS EQUAL TO SPACES )
           THEN 
              GO TO GET-ALIAS 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "ID1=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB.
  
       MOVE-ID1-DATA. 
  
      ******************************************************* 
      *    MOVE MAST1 DETAIL LINE INFORMATION FOR ID1 
      *    BUT FIRST MOVE LEFT PARENTHESIS IN FRONT OF
      *    IDENTIFIER-1 IF ANY. 
      ******************************************************* 
  
           IF ( LEFT-PAREN-COUNT IS EQUAL TO ZERO ) 
           THEN 
              GO TO MOVE-ID1-DATA-CONT
           ELSE 
              MOVE "(" TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
              SUBTRACT 1 FROM LEFT-PAREN-COUNT
              GO TO MOVE-ID1-DATA 
           END-IF.
  
       MOVE-ID1-DATA-CONT.
  
      ********************************************************
      *    MOVE QUOTES AROUND ID1 IF IT IS A LITERAL
      ********************************************************
  
           IF ( S-ID1-TYPE IS EQUAL TO "L" )
           THEN 
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
  
           MOVE S-ID1 ( 1 : 32 ) TO UPDATE-TX-DATA ( DAT-SUB : 32 ) 
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF S-ID1-TYPE IS EQUAL TO "L"
           THEN 
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF.
  
       GET-SUBS.
  
           IF ( S-ID1-SUB1 IS NOT EQUAL TO SPACES AND ZERO )
           THEN 
              MOVE S-ID1-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF.
           IF (( S-ID1-ALIAS IS EQUAL TO SPACES ) 
              AND ( S-RELOP IS EQUAL TO SPACES )
              AND ( S-ID2 IS EQUAL TO SPACES )
              AND ( S-ID2-ALIAS IS EQUAL TO SPACES )
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO )
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID1-A1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A5QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ALIAS. 
  
           IF S-ID1-ALIAS IS EQUAL TO SPACES
           THEN 
              GO TO GET-ID1-QUALIFIERS
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "A1I=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID1-ALIAS ( 1 : 4 ) 
                TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ADD 4 TO DAT-SUB 
           IF (( S-RELOP IS EQUAL TO SPACES ) 
              AND ( S-ID2 IS EQUAL TO SPACES )
              AND ( S-ID2-ALIAS IS EQUAL TO SPACES )
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO )
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID1-A1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A5QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID1-QUALIFIERS.
  
           IF ( S-ID1-A1QUAL IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-ID1-QUAL2 
           END-IF.
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "A1Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID1-A1QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID1-A1Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES )
           THEN 
              MOVE S-ID1-A1Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF 
           IF (( S-RELOP IS EQUAL TO SPACES ) 
              AND ( S-ID2 IS EQUAL TO SPACES )
              AND ( S-ID2-ALIAS IS EQUAL TO SPACES )
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO )
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID1-A2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A5QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID1-QUAL2. 
  
           IF ( S-ID1-A2QUAL IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-ID1-QUAL3 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "A2Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID1-A2QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID1-A2Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES  ) 
           THEN 
              MOVE S-ID1-A2Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF 
           IF (( S-RELOP IS EQUAL TO SPACES ) 
              AND ( S-ID2 IS EQUAL TO SPACES )
              AND ( S-ID2-ALIAS IS EQUAL TO SPACES )
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO )
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID1-A3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A5QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID1-QUAL3. 
  
           IF ( S-ID1-A3QUAL IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-ID1-QUAL4 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "A3Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID1-A3QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID1-A3Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES )
           THEN 
              MOVE S-ID1-A3Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF 
           IF (( S-RELOP IS EQUAL TO SPACES ) 
              AND ( S-ID2 IS EQUAL TO SPACES )
              AND ( S-ID2-ALIAS IS EQUAL TO SPACES )
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO )
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID1-A4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID1-A5QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID1-QUAL4. 
  
           IF ( S-ID1-A4QUAL IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-ID1-QUAL5 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "A4Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID1-A4QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID1-A4Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES )
           THEN 
              MOVE S-ID1-A4Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF 
           IF (( S-RELOP IS EQUAL TO SPACES ) 
              AND ( S-ID2 IS EQUAL TO SPACES )
              AND ( S-ID2-ALIAS IS EQUAL TO SPACES )
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO )
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID1-A5QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID1-QUAL5. 
           IF ( S-ID1-A5QUAL IS EQUAL TO SPACES ) 
  
           THEN 
              GO TO GET-ROP 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "A5Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID1-A5QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID1-A5Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES )
           THEN 
              MOVE S-ID1-A5Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF 
           IF (( S-RELOP IS EQUAL TO SPACES ) 
              AND ( S-ID2 IS EQUAL TO SPACES )
              AND ( S-ID2-ALIAS IS EQUAL TO SPACES )
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO )
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
      ********************************************************
      *    GET RELATIONAL OPERATOR BEFORE ACCESSING ID2 DATA
      ********************************************************
  
       GET-ROP. 
  
           IF ( S-RELOP IS EQUAL TO SPACES )
           THEN 
              GO TO GET-ID2 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "ROP=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-RELOP TO UPDATE-TX-DATA ( DAT-SUB : 2 ) 
           ADD 2 TO DAT-SUB 
           IF (( S-ID2 IS EQUAL TO SPACES ) 
              AND ( S-ID2-ALIAS IS EQUAL TO SPACES )
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO  OR ZERO ) 
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID2. 
  
      ******************************************************* 
      *           MOVE "ID2=" TO OUTPUT LINE
      ******************************************************* 
  
           IF ( S-ID2 IS EQUAL TO SPACES )
           THEN 
              GO TO GET-ID2-ALIAS 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "ID2=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB.
  
      ******************************************************* 
      *    MOVE MAST1 DETAIL LINE INFORMATION FOR ID2 
      *    INSERT QUOTES AROUND ID2 IF IT IS A LITERAL
      ********************************************************
  
           IF S-ID2-TYPE IS EQUAL TO "L"
           THEN 
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
  
           MOVE S-ID2 ( 1 : 32 ) TO UPDATE-TX-DATA ( DAT-SUB : 32 ) 
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF S-ID2-TYPE IS EQUAL TO "L"
           THEN 
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
  
       GET-ID2-SUBS.
  
           IF ( S-ID2-SUB1 IS NOT EQUAL TO SPACES AND ZERO )
           THEN 
              MOVE S-ID2-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF 
           IF (( S-ID2-ALIAS IS EQUAL TO SPACES ) 
              AND ( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO )
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID2-ALIAS. 
  
           IF S-ID2-ALIAS IS  EQUAL TO SPACES 
           THEN 
              GO TO GET-ID2-QUALIFIERS
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "A2I=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID2-ALIAS ( 1 : 4 ) 
                TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ADD 4 TO DAT-SUB 
           IF (( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO ) 
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID2-QUALIFIERS.
  
           IF ( S-ID2-B1QUAL IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-ID2-QUAL2 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "B1Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID2-B1QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID2-B1Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES )
           THEN 
              MOVE S-ID2-B1Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF 
           IF (( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO ) 
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID2-QUAL2. 
  
           IF ( S-ID2-B2QUAL IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-ID2-QUAL3 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "B2Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID2-B2QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID2-B2Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES )
           THEN 
              MOVE S-ID2-B2Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF.
           IF (( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO ) 
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID2-QUAL3. 
  
           IF ( S-ID2-B3QUAL IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-ID2-QUAL4 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "B3Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID2-B3QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID2-B3Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES  ) 
           THEN 
              MOVE S-ID2-B3Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF.
           IF (( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO ) 
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID2-QUAL4. 
  
           IF ( S-ID2-B4QUAL IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-ID2-QUAL5 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "B4Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID2-B4QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID2-B4Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES )
           THEN 
              MOVE S-ID2-B4Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF.
           IF (( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO ) 
              AND ( S-LOP IS EQUAL TO SPACES )
              AND ( S-ID2-B5QUAL IS EQUAL TO SPACES ))
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-ID2-QUAL5. 
  
           IF ( S-ID2-B5QUAL IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-RIGHT-PAREN 
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "B5Q=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-ID2-B5QUAL ( 1 : 32)
                TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( S-ID2-B5Q-SUB1 IS NOT EQUAL TO ZERO AND SPACES )
           THEN 
              MOVE S-ID2-B5Q-SUBS TO SUBS-WAREA 
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF.
           IF (( S-RIGHT-PAREN IS EQUAL TO SPACES OR ZERO ) 
              AND ( S-LOP IS EQUAL TO SPACES )) 
           THEN 
              PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT
           END-IF 
  
       GET-RIGHT-PAREN. 
  
           IF ( S-RIGHT-PAREN IS NOT EQUAL TO SPACES AND ZERO ) 
           THEN 
              MOVE S-RIGHT-PAREN TO RIGHT-PAREN-COUNT 
              GO TO GET-RIGHT-PAREN-CONT
           ELSE 
              GO TO GET-LOP 
           END-IF.
  
       GET-RIGHT-PAREN-CONT.
  
           IF ( RIGHT-PAREN-COUNT IS EQUAL TO ZERO )
           THEN 
              GO TO GET-LOP 
           END-IF 
           MOVE ")" TO DAT-LINE (DAT-SUB) 
           ADD 1 TO DAT-SUB 
           SUBTRACT 1 FROM RIGHT-PAREN-COUNT
           GO TO GET-RIGHT-PAREN-CONT 
  
       GET-LOP. 
  
           IF S-LOP IS EQUAL TO SPACES
           THEN 
              GO TO SSREL-COMPLETE
           END-IF 
           PERFORM INIT-COPY-LINE THRU INIT-COPY-LINE-XIT 
           MOVE "LOP=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE S-LOP ( 1 : 6 ) TO UPDATE-TX-DATA ( DAT-SUB : 6 ) 
  
       SSREL-COMPLETE.
  
           PERFORM CHECK-RETURN-CODE THRU CHECK-RETURN-CODE-XIT.
  
       PROCESS-JOINS. 
  
      ********************************************************* 
      *    THIS SECTION OF THE CODE MASSAGES THE SCHEMA 
      *    JOINS DETAIL LINES TO SET THEM IN THE CORRECT
      *    INPUT ORDER. 
      ********************************************************* 
  
           IF ( CTL-LINE-TYPE IS NOT EQUAL TO "A" ) 
           THEN 
              GO TO PROCESS-JOINS-LINE-B-C
           END-IF 
           MOVE "REL=" TO UPDATE-TX-DATA ( DAT-SUB : 4 )
           ADD 4 TO DAT-SUB 
           MOVE CTL-ALY-VER TO UPDATE-TX-DATA ( DAT-SUB : 32 )
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           GO TO JOINS-COMPLETE.
  
      ******************************************************* 
      *           MOVE "IDX=" TO OUTPUT LINE
      ******************************************************* 
  
       PROCESS-JOINS-LINE-B-C.
  
           IF JOIN-ID IS EQUAL TO SPACES
           THEN 
              GO TO GET-JOINS-ID-ALIAS
           END-IF 
           IF ( CTL-LINE-TYPE IS EQUAL TO "B" ) 
           THEN 
              MOVE "ID1=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           ELSE 
              MOVE "ID2=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
           END-IF 
           ADD 4 TO DAT-SUB.
  
      ******************************************************* 
      *    MOVE MAST1 DETAIL LINE INFORMATION FOR ID1 
      ******************************************************* 
  
           MOVE JOIN-ID TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       GET-JOINS-SUBS.
  
  
           IF ( JOIN-ID-SUB1 IS NOT EQUAL TO SPACES ) 
           THEN 
              MOVE JOIN-ID-SUB TO SUBS-WAREA
              PERFORM GET-A-SUBSCRIPT THRU GET-SUBSCRIPT-XIT
           END-IF.
  
       GET-JOINS-ID-ALIAS.
  
           IF ( JOIN-ALIAS1 IS NOT EQUAL TO SPACES )
           THEN 
              IF DAT-SUB IS GREATER THAN 1
              THEN
                 MOVE SPACES TO DATA-LINE-NO
                 MOVE "," TO DAT-LINE (DAT-SUB) 
                 PERFORM COPY-OUT THRU COPY-OUT-XIT 
                 MOVE 1 TO DAT-SUB
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "B" )
              THEN
                  MOVE "I1A=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
              ELSE
                  MOVE "I2A=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
              END-IF
              ADD 4 TO DAT-SUB
              MOVE JOIN-ALIAS1 TO UPDATE-TX-DATA ( DAT-SUB : 4 )
              ADD 4 TO DAT-SUB
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
           END-IF.
  
       GET-JOINS-QUAL.
  
           IF (  JOIN-QUAL1 IS EQUAL TO SPACES )
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              GO TO JOINS-COMPLETE
           ELSE 
              IF DAT-SUB IS GREATER THAN 1
              THEN
                 MOVE "," TO DAT-LINE (DAT-SUB) 
                 PERFORM COPY-OUT THRU COPY-OUT-XIT 
                 MOVE 1 TO DAT-SUB
              END-IF
              IF ( CTL-LINE-TYPE IS EQUAL TO "B" )
              THEN
                  MOVE "I1R=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
              ELSE
                  MOVE "I2R=" TO UPDATE-TX-DATA ( DAT-SUB : 4 ) 
              END-IF
              ADD 4 TO DAT-SUB
              MOVE JOIN-QUAL1 TO UPDATE-TX-DATA ( DAT-SUB : 32 )
              ADD 32 TO DAT-SUB 
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              PERFORM COPY-OUT THRU COPY-OUT-XIT
           END-IF.
  
  
  
       JOINS-COMPLETE.
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
  
       PROCESS-CONSTRAINTS. 
  
      ****************************************************
      *    THIS SECTION OF THE CODE MASSAGES THE
      *    SCHEMA CONSTRAINTS DETAIL LINES TO SET 
      *    THEM IN THE CORRECT INPUT ORDER
      ****************************************************
  
           IF ( CTL-LINE-TYPE IS EQUAL TO "O" ) 
           THEN 
              MOVE DETAIL-WORK TO SAVE-CON-LINE-O 
              GO TO GET-DEPEND
           END-IF 
           MOVE DETAIL-WORK TO SAVE-CON-LINE-N
           PERFORM READ-NEXT-DATA THRU READ-NEXT-DATA-XIT 
           IF ( DATA-RETURN-CODE IS NOT EQUAL TO ZERO ) 
           THEN 
              GO TO PROCESS-CON-FIELDS
           END-IF 
           IF (( CAT-CATEGORY IS EQUAL TO "575" ) 
              AND ( CTL-LINE-TYPE IS EQUAL TO "O" ))
           THEN 
              MOVE DETAIL-WORK TO SAVE-CON-LINE-O 
           END-IF.
  
       PROCESS-CON-FIELDS.
  
           IF ( S-CONNAME IS EQUAL TO SPACES )
           THEN 
              GO TO GET-CON-CATNAME 
           END-IF 
           MOVE "CON=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-CONNAME TO UPDATE-TX-DATA (DAT-SUB : 30)
           ADD 30 TO DAT-SUB
           IF (( S-CATNAME IS EQUAL TO SPACES ) 
              AND ( S-CON-CAT-ALY IS EQUAL TO SPACES )
              AND ( S-AOFREC IS EQUAL TO SPACES ) 
              AND ( S-DEPEND IS EQUAL TO SPACES ) 
              AND ( S-DALIAS IS EQUAL TO SPACES ) 
              AND ( S-BOFREC IS EQUAL TO SPACES ))
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-CON-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT.
  
       GET-CON-CATNAME. 
  
           IF ( S-CATNAME IS EQUAL TO SPACES )
           THEN 
              GO TO GET-CON-CAT-ALY 
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
               MOVE "," TO DAT-LINE (DAT-SUB) 
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
               MOVE SPACES TO DATA-LINE-NO
               MOVE 1 TO DAT-SUB
           END-IF 
           MOVE "CNA=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-CATNAME TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           IF (( S-CON-CAT-ALY IS EQUAL TO SPACES ) 
              AND ( S-AOFREC IS EQUAL TO SPACES ) 
              AND ( S-DEPEND IS EQUAL TO SPACES ) 
              AND ( S-DALIAS IS EQUAL TO SPACES ) 
              AND ( S-BOFREC IS EQUAL TO SPACES ))
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-CON-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       GET-CON-CAT-ALY. 
  
           IF ( S-CON-CAT-ALY IS EQUAL TO SPACES )
           THEN 
              GO TO GET-CON-AOFREC
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
               MOVE "," TO DAT-LINE (DAT-SUB) 
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
               MOVE SPACES TO DATA-LINE-NO
               MOVE 1 TO DAT-SUB
           END-IF 
           MOVE "CAL=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           MOVE S-CON-CAT-ALY TO UPDATE-TX-DATA (DAT-SUB : 4) 
           ADD 4 TO DAT-SUB 
           IF (( S-AOFREC IS EQUAL TO SPACES )
              AND ( S-DEPEND IS EQUAL TO SPACES ) 
              AND ( S-DALIAS IS EQUAL TO SPACES ) 
              AND ( S-BOFREC IS EQUAL TO SPACES ))
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-CON-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       GET-CON-AOFREC.
  
           IF ( S-AOFREC IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-DEPEND
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
               MOVE "," TO DAT-LINE (DAT-SUB) 
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
               MOVE SPACES TO DATA-LINE-NO
               MOVE 1 TO DAT-SUB
           END-IF 
           MOVE "AOF=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-AOFREC TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           IF (( S-DEPEND IS EQUAL TO SPACES )
              AND ( S-DALIAS IS EQUAL TO SPACES ) 
              AND ( S-BOFREC IS EQUAL TO SPACES ))
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-CON-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CHECK-COMMENT 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       GET-DEPEND.
  
           IF ( S-DEPEND IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-DEP-ALIAS 
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
               MOVE "," TO DAT-LINE (DAT-SUB) 
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
               MOVE SPACES TO DATA-LINE-NO
               MOVE 1 TO DAT-SUB
           END-IF 
           MOVE "DEP=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-DEPEND TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           IF (( S-DALIAS IS EQUAL TO SPACES )
              AND ( S-BOFREC IS EQUAL TO SPACES ))
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-CON-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CONSTRAINT-COMPLETE 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       GET-DEP-ALIAS. 
  
           IF ( S-DALIAS IS EQUAL TO SPACES ) 
           THEN 
              GO TO GET-BOFREC
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
               MOVE "," TO DAT-LINE (DAT-SUB) 
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
               MOVE SPACES TO DATA-LINE-NO
               MOVE 1 TO DAT-SUB
           END-IF 
           MOVE "DAL=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-DALIAS TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           IF ( S-BOFREC IS EQUAL TO SPACES ) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO SAVE-CON-LINES 
              IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" )
              THEN
                 GO TO OUTPUT-UPDATE-TX-XIT 
              END-IF
              IF ( DATA-RETURN-CODE IS EQUAL TO "2" ) 
              THEN
                 GO TO PROCESS-FIELDS 
              END-IF
              GO TO CONSTRAINT-COMPLETE 
           END-IF 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
  
       GET-BOFREC.
  
           IF ( S-BOFREC IS EQUAL TO SPACES ) 
           THEN 
              GO TO CONSTRAINT-COMPLETE 
           END-IF 
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
               MOVE "," TO DAT-LINE (DAT-SUB) 
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
               MOVE SPACES TO DATA-LINE-NO
               MOVE 1 TO DAT-SUB
           END-IF 
           MOVE "BOF=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE S-BOFREC TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           PERFORM COPY-OUT THRU COPY-OUT-XIT.
  
       CONSTRAINT-COMPLETE. 
  
           MOVE 1 TO DAT-SUB
           IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" ) 
           THEN 
              GO TO OUTPUT-UPDATE-TX-XIT
           END-IF 
           IF ( DATA-RETURN-CODE IS EQUAL TO "2" )
           THEN 
              GO TO PROCESS-FIELDS
           END-IF 
           MOVE SPACES TO SAVE-CON-LINES
           GO TO READ-AGAIN.
  
      ***************************************************** 
      *    THIS SECTION OF THE CODE MASSAGES THE AREA 
      *    ACCESS CATEGORY "L" LINE TYPES.
      ***************************************************** 
  
       PROCESS-ACCESS.
  
           MOVE "LOC=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           IF ACC-A-TYPE IS EQUAL TO "L"
           THEN 
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
           MOVE ACC-A-LOCK (1 : 32) TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ACC-A-TYPE IS EQUAL TO "L"
           THEN 
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
      ***************************************************** 
      *    THIS SECTION OF THE CODE MASSAGES THE SCHEMA 
      *    MDINFO CATEGORY. 
      ***************************************************** 
  
       PROCESS-SCH-MDI. 
  
           IF CTL-LINE-TYPE IS NOT EQUAL TO "L" 
           THEN 
              GO TO CHECK-MDI-LINEP 
           END-IF.
           MOVE "SCH=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE CTL-ALY-VER (1 : 7) TO UPDATE-TX-DATA (DAT-SUB : 7) 
           ADD 7 TO DAT-SUB 
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
       CHECK-MDI-LINEP. 
  
           IF CTL-LINE-TYPE IS NOT EQUAL TO "P" 
           THEN 
              GO TO CHECK-MDI-LINET 
           END-IF.
           MOVE "PRO=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE CTL-ALY-VER (1 : 32) TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
       CHECK-MDI-LINET. 
  
           IF CTL-LINE-TYPE IS NOT EQUAL TO "T" 
           THEN 
              GO TO CHECK-MDI-LINER 
           END-IF.
           MOVE "TRA=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE CTL-ALY-VER (1 : 32) TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
       CHECK-MDI-LINER. 
  
           IF CTL-LINE-TYPE IS NOT EQUAL TO "R" 
           THEN 
              GO TO CHECK-MDI-LINEJ 
           END-IF.
           MOVE "RES=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE CTL-ALY-VER (1 : 32) TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
       CHECK-MDI-LINEJ. 
  
           IF CTL-LINE-TYPE IS NOT EQUAL TO "J" 
           THEN 
              GO TO CHECK-MDI-LINEQ 
           END-IF.
           MOVE "JLO=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE CTL-ALY-VER (1 : 32) TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
       CHECK-MDI-LINEQ. 
  
           MOVE "QRF=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE CTL-ALY-VER (1 : 32) TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
      ***************************************************** 
      *    THIS SECTION OF THE CODE MASSAGES THE ELEMENT
      *    VALUES CATEGORY LINE-TYPES "C" AND "P".
      ***************************************************** 
  
       PROCESS-VALUES.
  
           IF ( VAL-CHECKBY IS EQUAL TO SPACES )
           THEN 
              GO TO CHECK-CKVAL 
           END-IF.
           MOVE "CHE=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE VAL-CHECKBY (1 : 13) TO UPDATE-TX-DATA (DAT-SUB : 13) 
           ADD 13 TO DAT-SUB
           IF (( VAL-CKVAL IS EQUAL TO SPACES ) 
               AND ( VAL-THRU IS EQUAL TO SPACES )) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
            ELSE
               PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
               MOVE "," TO UPDATE-TX-DATA (DAT-SUB : 1) 
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
               MOVE 1 TO DAT-SUB
           END-IF.
  
       CHECK-CKVAL. 
  
           IF ( VAL-CKVAL IS EQUAL TO SPACES )
           THEN 
              GO TO CHECK-VALTHRU 
           END-IF.
           MOVE "CKV=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           IF CKVAL-FLAG IS EQUAL TO "L"
           THEN 
              MOVE QUOTE TO UPDATE-TX-DATA (DAT-SUB : 1)
              ADD 1 TO DAT-SUB
           END-IF 
           MOVE VAL-CKVAL (1 : 30) TO UPDATE-TX-DATA (DAT-SUB : 30) 
           ADD 30 TO DAT-SUB
           IF CKVAL-FLAG IS EQUAL TO "L"
           THEN 
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              MOVE QUOTE TO UPDATE-TX-DATA (DAT-SUB : 1)
              ADD 1 TO DAT-SUB
           END-IF 
           IF ( VAL-THRU IS EQUAL TO SPACES ) 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              GO TO READ-AGAIN
            ELSE
               PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
               MOVE "," TO UPDATE-TX-DATA (DAT-SUB : 1) 
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
               MOVE 1 TO DAT-SUB
           END-IF.
  
       CHECK-VALTHRU. 
  
           IF ( VAL-THRU IS EQUAL TO SPACES ) 
           THEN 
              GO TO PROCESS-VALUES-COMPLETE 
           END-IF 
           MOVE "THR=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           IF THRUVAL-FLAG IS EQUAL TO "L"
           THEN 
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
           MOVE VAL-THRU (1 : 30) TO UPDATE-TX-DATA (DAT-SUB : 30)
           ADD 30 TO DAT-SUB
           IF THRUVAL-FLAG IS EQUAL TO "L"
           THEN 
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              MOVE QUOTE TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF 
  
       PROCESS-VALUES-COMPLETE. 
  
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
      ***************************************************** 
      *    THIS SECTION OF THE CODE MASSAGES THE RECORD 
      *    STRUCTURE CATEGORY LINE-TYPES "B" AND "C". 
      ***************************************************** 
  
       PROCESS-TOTAL. 
  
           IF ( CTL-LINE-TYPE IS EQUAL TO "C" ) 
           THEN 
              GO TO PROCESS-LINEC 
           END-IF.
           IF ( TOT-KEY IS EQUAL TO SPACES )
           THEN 
              GO TO CHECK-LINKPATH
           END-IF.
           MOVE "TKE=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE TOT-KEY TO DAT-LINE (DAT-SUB) 
           ADD 1 TO DAT-SUB 
           IF (( TOT-LINKPATH IS EQUAL TO SPACES )
              AND (TOT-VARLEN IS EQUAL TO SPACES) 
              AND (TOT-LKFIELD IS EQUAL TO SPACES)
              AND (TOT-LKALIAS IS EQUAL TO SPACES)) 
           THEN 
              GO TO PROCESS-TOTAL-COMPLETE
            ELSE
               MOVE "," TO DAT-LINE (DAT-SUB) 
               ADD 1 TO DAT-SUB 
           END-IF.
  
       CHECK-LINKPATH.
  
           IF ( TOT-LINKPATH IS EQUAL TO SPACES ) 
           THEN 
              GO TO CHECK-VARLEN
           END-IF.
           MOVE "LIN=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE TOT-LINKPATH TO UPDATE-TX-DATA (DAT-SUB : 6)
           ADD 6 TO DAT-SUB 
           IF ((TOT-VARLEN IS EQUAL TO SPACES)
              AND (TOT-LKFIELD IS EQUAL TO SPACES)
              AND (TOT-LKALIAS IS EQUAL TO SPACES)) 
           THEN 
              GO TO PROCESS-TOTAL-COMPLETE
            ELSE
               PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
               MOVE "," TO DAT-LINE (DAT-SUB) 
               ADD 1 TO DAT-SUB 
           END-IF.
  
       CHECK-VARLEN.
  
           IF ( TOT-VARLEN IS EQUAL TO SPACES ) 
           THEN 
              GO TO CHECK-LKFIELD 
           END-IF 
           MOVE "VAR=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE TOT-VARLEN  TO UPDATE-TX-DATA (DAT-SUB : 5) 
           ADD 5 TO DAT-SUB 
           IF ((TOT-LKFIELD IS EQUAL TO SPACES) 
              AND (TOT-LKALIAS IS EQUAL TO SPACES)) 
           THEN 
              GO TO PROCESS-TOTAL-COMPLETE
           END-IF.
  
       CHECK-LKFIELD. 
  
           IF (TOT-LKFIELD IS EQUAL TO SPACES)
           THEN 
              GO TO CHECK-LKALIAS 
           END-IF 
           IF DAT-SUB IS GREATER THAN 1 
           THEN 
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACES TO DATA-LINE-NO 
           END-IF 
           MOVE "LKF=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE TOT-LKFIELD TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           IF (TOT-LKALIAS IS EQUAL TO SPACES)
           THEN 
              GO TO PROCESS-TOTAL-COMPLETE
           ELSE 
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
            END-IF. 
  
       CHECK-LKALIAS. 
  
           IF (TOT-LKALIAS IS EQUAL TO SPACES)
           THEN 
              GO TO PROCESS-TOTAL-COMPLETE
           END-IF 
           MOVE "LKA=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE TOT-LKALIAS TO UPDATE-TX-DATA (DAT-SUB : 4) 
           ADD 4 TO DAT-SUB 
           GO TO PROCESS-TOTAL-COMPLETE.
  
  
       PROCESS-LINEC. 
  
           IF ( TOT-COMPNAME IS EQUAL TO SPACES ) 
           THEN 
              GO TO CHECK-RCCODE
           END-IF.
           MOVE "COM=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE TOT-COMPNAME TO UPDATE-TX-DATA (DAT-SUB : 32) 
           ADD 32 TO DAT-SUB
           IF ((TOT-RCCODE IS EQUAL TO SPACES)
              AND (TOT-CPALIAS IS EQUAL TO SPACES)) 
           THEN 
              GO TO PROCESS-TOTAL-COMPLETE
            ELSE
               PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
               MOVE "," TO DAT-LINE (DAT-SUB) 
               ADD 1 TO DAT-SUB 
           END-IF.
  
       CHECK-RCCODE.
  
           IF ( TOT-RCCODE IS EQUAL TO SPACES ) 
           THEN 
              GO TO CHECK-CPALIAS 
           END-IF 
           MOVE "RCC=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE TOT-RCCODE  TO UPDATE-TX-DATA (DAT-SUB : 2) 
           ADD 2 TO DAT-SUB 
           IF (TOT-CPALIAS IS EQUAL TO SPACES)
           THEN 
              GO TO PROCESS-TOTAL-COMPLETE
           ELSE 
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
           END-IF.
  
       CHECK-CPALIAS. 
  
           IF (TOT-CPALIAS IS EQUAL TO SPACES)
           THEN 
              GO TO PROCESS-TOTAL-COMPLETE
           END-IF 
           MOVE "CPA=" TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           MOVE TOT-CPALIAS TO UPDATE-TX-DATA (DAT-SUB : 4) 
           ADD 4 TO DAT-SUB.
  
       PROCESS-TOTAL-COMPLETE.
  
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
       PROCESS-CONTROL. 
  
      *********************************************************** 
      *    THIS SECTION OF THE CODE MASSAGES ALL ENTITIES CONTROL 
      *    CATEGORY SO THAT THE CORRECT KEYWORD (EALIASOF OR
      *    VERSION) IS USED IN THE SYNTAX.
      ********************************************************* 
  
           IF ( DATA-HDR-ENT-ID IS LESS THAN 14 ) 
           THEN 
              MOVE "EAL=" TO UPDATE-TX-DATA (DAT-SUB : 4) 
           ELSE 
              MOVE "VER=" TO UPDATE-TX-DATA (DAT-SUB : 4) 
           END-IF 
           ADD 4 TO DAT-SUB 
           MOVE CTL-ALY-VER TO UPDATE-TX-DATA (DAT-SUB : 32)
           ADD 32 TO DAT-SUB
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( CTL-STATUS IS NOT EQUAL TO SPACES ) 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
              MOVE "EST=" TO UPDATE-TX-DATA (DAT-SUB : 4) 
              ADD 4 TO DAT-SUB
              MOVE CTL-STATUS TO DAT-LINE (DAT-SUB) 
           END-IF 
           PERFORM COPY-OUT THRU COPY-OUT-XIT 
           MOVE 1 TO DAT-SUB
           GO TO READ-AGAIN.
  
00889 **************************************************                DCUTL800
00890 *                                                                 DCUTL800
00891 *    SCAN SUBROUTINE                                              DCUTL800
00892 *                                                                 DCUTL800
00893 **************************************************                DCUTL800
00894 *   FIND A NON BLANK CHARACTER                                    DCUTL800
00895  FIND-BLANK.                                                      DCUTL800
00896      ADD 1 TO TX-SUB.                                             DCUTL800
00897      IF TX-SUB GREATER THAN MAX-POS                               DCUTL800
00898          MOVE "Y" TO END-OF-CARD                                  DCUTL800
00899          GO TO FIND-BLANK-XIT.                                    DCUTL800
00900      IF TX-CHARACTER (TX-SUB) EQUAL SPACE                            CL**2
00901          GO TO FIND-BLANK.                                        DCUTL800
00902      SUBTRACT 1 FROM TX-SUB.                                      DCUTL800
00903  FIND-BLANK-XIT.                                                  DCUTL800
00904      EXIT.                                                        DCUTL800
00905 *    FIND A PARTICULAR CHARACTER                                  DCUTL800
00906  FIND-CHAR.                                                       DCUTL800
00907      MOVE "N" TO CHAR-NOT-FOUND.                                  DCUTL800
00908      MOVE ZERO TO OPT-SUB.                                        DCUTL800
00909      ADD 1 TO TX-SUB.                                             DCUTL800
00910      MOVE SPACES TO AREA-SCAN.                                    DCUTL800
00911  FIND-CHAR-100.                                                   DCUTL800
00912      ADD 1 TO OPT-SUB.                                            DCUTL800
00913      IF TX-CHARACTER (TX-SUB) EQUAL TEST-CHAR                        CL**2
00914          MOVE "Y" TO CHAR-NOT-FOUND                               DCUTL800
00915          GO TO FIND-CHAR-XIT.                                     DCUTL800
00916      MOVE TX-CHARACTER (TX-SUB) TO SCAN-AREA (OPT-SUB).              CL**2
00917      ADD 1 TO TX-SUB.                                             DCUTL800
00918      IF TX-SUB GREATER THAN MAX-POS                               DCUTL800
00919          MOVE "Y" TO END-OF-CARD                                  DCUTL800
00920          GO TO FIND-CHAR-XIT.                                     DCUTL800
00921      GO TO FIND-CHAR-100.                                         DCUTL800
00922  FIND-CHAR-XIT.                                                   DCUTL800
00923      EXIT.                                                        DCUTL800
00925 *****************************************************                CL**2
00926 *   I/O INTERFACE ROUTINES                                           CL**2
00927 *                                                                    CL**2
00928 *     GET NEXT CARD FOR TRANSACTION                                  CL**2
00929 *                                                                    CL**2
00930 *******************************************************              CL**2
00931  GET-NEXT-CARD.                                                      CL**2
00932      MOVE "N" TO END-OF-CARD.                                        CL**2
00933      MOVE "5" TO COPY-FUNCTION-CODE.                                 CL**2
           EXIT PROGRAM.
00935  CARD-READ-RETURN.                                                   CL**2
00936      IF TX-EOF-SW EQUAL TO "Y"                                       CL**2
00937          MOVE ERROR-MSG7 TO ERROR-POS2                               CL**2
00938          GO TO PRINT-FATAL-ERROR.                                    CL**2
00939      IF CONT-COPY NOT EQUAL TO SPACES                                CL**2
00940          MOVE ERROR-MSG7 TO ERROR-POS2                               CL**2
00941          GO TO PRINT-FATAL-ERROR.                                    CL**2
00942      MOVE ZERO TO TX-SUB.                                            CL**2
00944      PERFORM FIND-BLANK THRU FIND-BLANK-XIT.                         CL**2
00945  GET-NEXT-CARD-XIT.                                                  CL**2
00946      EXIT.                                                           CL**2
00947 *********************************************************            CL**2
00948 *    COPY OUTPUT SUBROUTINE                                          CL**2
00949 *         TABLES CARD IMAGES AND PRINT LINES AND RETURNS             CL**2
00950 *         TO CONTROL WHEN THE TABLE IS FULL                          CL**2
00951 *         E=PRINT LINE                                               CL**2
00952 *         T=TARGET FILE OUTPUT                                       CL**2
00953 *         S=SOURCE FILE OUTPUT                                       CL**2
00954 **********************************************************           CL**2
00955  COPY-OUT.                                                           CL**2
00956      ADD 1 TO COPY-COUNT.                                            CL**2
00957      MOVE SPACES TO COPY-OUTPUT-ENTRY (COPY-COUNT).                  CL**2
00958      IF ERROR-MESSAGE EQUAL TO "Y"                                   CL**2
00959          MOVE ERROR-LINE TO COPY-OUTPUT-ENTRY (COPY-COUNT)           CL**2
00960          MOVE "E" TO COPY-OUTPUT-INDICATOR (COPY-COUNT)              CL**2
00961          GO TO COPY-FULL-CHECK.                                      CL**2
00962      MOVE COPY-CARD TO COPY-CARD-IMAGE (COPY-COUNT).                 CL**2
00963      MOVE SPACES TO COPY-CARD.                                       CL**2
00964      MOVE FILE-INDICATOR TO COPY-OUTPUT-INDICATOR (COPY-COUNT).      CL**2
00965  COPY-FULL-CHECK.                                                    CL**2
00966      MOVE "T" TO FILE-INDICATOR.                                     CL**2
00967      IF COPY-COUNT EQUAL 40                                          CL**2
00968          MOVE "4" TO COPY-FUNCTION-CODE                              CL**2
           EXIT PROGRAM.
00970      GO TO COPY-OUT-XIT.                                             CL**2
00971  COPY-OUT-RETURN.                                                    CL**2
00973      MOVE ZEROES TO COPY-COUNT.                                      CL**2
00974  COPY-OUT-XIT.                                                       CL**2
00975      EXIT.                                                           CL**2
00976 *                                                                    CL**2
00977 *    ERROR MESSAGES                                                  CL**2
00978 *                                                                    CL**2
00979  PRINT-FATAL-ERROR.                                                  CL**2
00980      MOVE "Y" TO ERROR-MESSAGE.                                      CL**2
00981      PERFORM COPY-OUT THRU COPY-OUT-XIT.                             CL**2
00982      MOVE "N" TO ERROR-MESSAGE.                                      CL**2
00983      GO TO ABORT-END.                                                CL**2
      *    MOVE SPACES TO COPY-CARD.
00985  MAST1-READ-ERROR.                                                   CL**2
00986      MOVE DATA-ENTRY-NAME TO MAST1-BADNAME.                          CL**2
00987      MOVE ERROR-MSG6 TO ERROR-POS2.                                  CL**2
00988      GO TO PRINT-FATAL-ERROR.                                        CL**2
00989 **********************************************************           CL**2
00990 *   READ MAST1 ROUTINE                                               CL**2
00991 *       RETURNS TO UTL CONTROL PROGRAM TO GET PHYSICAL RECORD        CL**2
00992 ***********************************************************          CL**2
00993  DATA-READ.                                                          CL**2
00994      PERFORM DATAALG THRU DATAALG-XIT.                               CL**2
00995      MOVE DATA-KEY TO MAST1-KEY.                                     CL**2
00996      MOVE "1" TO COPY-FUNCTION-CODE.                                 CL**2
           EXIT PROGRAM.
00998  DATA-READ-RETURN.                                                   CL**2
00999      IF DATA-HDR-ENT-ID EQUAL TO ZEROES                              CL**2
01000          MOVE "8" TO DATA-RETURN-CODE.                               CL**2
01001      MOVE 0 TO DATA-SUB.                                             CL**2
01003  DATA-READ-XIT.                                                      CL**2
01004      EXIT.                                                           CL**2
01005 **********************************************************           CL**2
01006 *      READ MAST3 ROUTINE                                            CL**2
01007 *         RETURNS TO UTL CONTROL TO GET PHYSICAL RECORD              CL**2
01008 **********************************************************           CL**2
01009  MAST3-READ.                                                         CL**2
01010      MOVE "3" TO COPY-FUNCTION-CODE.                                 CL**2
           EXIT PROGRAM.
01012  MAST3-READ-RETURN.                                                  CL**2
01014      MOVE ZERO TO COPY-FUNCTION-CODE.                                CL**2
01015  MAST3-READ-XIT.                                                     CL**2
01016      EXIT.                                                           CL**2
      ******************************************************************
      * 
      *   READ WORK FILE ROUTINE
      * 
      ******************************************************************
       READ-WORK-FILE.
           MOVE CURRENT-ENTRY-NAME TO WORK-KEY. 
           MOVE 0 TO WORK-KEY-FLG.
           READ WORK-FILE 
               INVALID KEY MOVE 1 TO WORK-KEY-FLG.
       READ-WORK-FILE-XIT.
           EXIT.
      ******************************************************************
      * 
      *   WRITE WORK FILE ROUTINE 
      * 
      ******************************************************************
       WRITE-WORK-FILE. 
           MOVE CURRENT-ENTRY-NAME TO WORK-KEY. 
           MOVE 0 TO WORK-KEY-FLG.
           WRITE WORK-RECORD
               INVALID KEY MOVE 1 TO WORK-KEY-FLG.
       WRITE-WORK-FILE-XIT. 
           EXIT.
      ******************************************************************
      * 
      *   DELETE WORK FILE ROUTINE
      * 
      ******************************************************************
       DELETE-WORK-FILE.
           MOVE CURRENT-ENTRY-NAME TO WORK-KEY. 
           MOVE 0 TO WORK-KEY-FLG.
           DELETE WORK-FILE 
               INVALID KEY MOVE 1 TO WORK-KEY-FLG.
       DELETE-WORK-FILE-XIT.
           EXIT.
  
       POSITION-FIELD.
           SUBTRACT 1 FROM DAT-SUB
           IF DAT-LINE (DAT-SUB) IS EQUAL TO SPACES 
           THEN 
              GO TO POSITION-FIELD
           ELSE 
              ADD 1 TO DAT-SUB
           END-IF.
       POSITION-FLD-XIT.
           EXIT.
  
       GET-A-SUBSCRIPT. 
  
           MOVE "[" TO DAT-LINE (DAT-SUB) 
           ADD 1 TO DAT-SUB 
           MOVE SUBS-WAREA (1 : 4) TO UPDATE-TX-DATA (DAT-SUB : 4)
           ADD 4 TO DAT-SUB 
           PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
           IF ( SUBS-WAREA (5 : 1) IS EQUAL TO SPACES  OR ZERO )
           THEN 
              MOVE "]" TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
              GO TO GET-SUBSCRIPT-XIT 
           ELSE 
              MOVE "," TO DAT-LINE (DAT-SUB)
              ADD 1 TO DAT-SUB
              MOVE SUBS-WAREA (5 : 4) TO UPDATE-TX-DATA (DAT-SUB : 4) 
              ADD 4 TO DAT-SUB
              PERFORM POSITION-FIELD THRU POSITION-FLD-XIT
              IF ( SUBS-WAREA (9 : 1) IS EQUAL TO SPACES OR ZERO )
              THEN
                 MOVE "]" TO DAT-LINE (DAT-SUB) 
                 ADD 1 TO DAT-SUB 
                 GO TO GET-SUBSCRIPT-XIT
              ELSE
                 MOVE "," TO DAT-LINE (DAT-SUB) 
                 ADD 1 TO DAT-SUB 
                 MOVE SUBS-WAREA (9 : 4)
                      TO UPDATE-TX-DATA (DAT-SUB : 4) 
                 ADD 4 TO DAT-SUB 
                 PERFORM POSITION-FIELD THRU POSITION-FLD-XIT 
                 MOVE "]" TO DAT-LINE (DAT-SUB) 
                 ADD 1 TO DAT-SUB 
              END-IF
           END-IF.
  
       GET-SUBSCRIPT-XIT. 
           EXIT.
  
       INIT-COPY-LINE.
  
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
              MOVE "," TO DAT-LINE (DAT-SUB)
              PERFORM COPY-OUT THRU COPY-OUT-XIT
              MOVE 1 TO DAT-SUB 
              MOVE SPACE TO DATA-LINE-NO
           END-IF.
  
       INIT-COPY-LINE-XIT.
           EXIT.
  
       CHECK-RETURN-CODE. 
  
           IF ( DAT-SUB IS GREATER THAN 1 ) 
           THEN 
               PERFORM COPY-OUT THRU COPY-OUT-XIT 
           END-IF 
           MOVE 1 TO DAT-SUB
           IF ( DATA-RETURN-CODE IS EQUAL TO "1" OR "8" ) 
           THEN 
              GO TO OUTPUT-UPDATE-TX-XIT
           END-IF 
           IF ( DATA-RETURN-CODE IS EQUAL TO "2" )
           THEN 
              GO TO PROCESS-FIELDS
           END-IF 
           IF ( DATA-RETURN-CODE IS EQUAL TO "4" )
           THEN 
              MOVE SPACES TO SAVE-SSREL-LINES 
              MOVE SPACES TO SUBS-WAREA 
              GO TO CHECK-COMMENT 
           END-IF.
  
       CHECK-RETURN-CODE-XIT. 
           EXIT.
*CALL     MAST1RFL
*CALL     MAST1RNL
*CALL     MAST1RFC
*CALL     MAST1RK 
*CALL     MAST1EXT
*CALL     MAST1ALG
