*DECK DCCVT2226 
       IDENTIFICATION DIVISION. 
       PROGRAM-ID. CVT2226. 
*CALL COPYRIGHT 
      *    THIS PROGRAM GENERATES TRANSACTIONS FOR THE UPDATE FROM
      *    CDCS FOR AREA, SUBSCHEMA, AND SCHEMA ENTITIES. 
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER. CYBER.
       OBJECT-COMPUTER. CYBER.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT SYSPRINT ASSIGN TO "OUTPUT".
       DATA DIVISION. 
       FILE SECTION.
*CALL SYSPRTFD
*CALL CVTCOM
       01  PRINT-AREA.
*CALL WKPRINT 
*CALL WRKFHDR 
*CALL WRKREDEF
*CALL PNCHCOM 
  
  
       WORKING-STORAGE SECTION. 
       01  ADD-LINE.
           03  FILLER                      PICTURE X(4) VALUE "ADD ". 
           03  ADD-TYPE                    PICTURE X(3).
           03  FILLER                      PICTURE X    VALUE "=".
           03  ADD-NAME                    PICTURE X(32). 
       01  DES-LINE1. 
           05  FILLER                      PICTURE X(5)   VALUE "0001 ".
           05  FILLER                      PICTURE X(51)  VALUE 
                "THIS ENTRY WAS CREATED BY THE CONVERT FACILITY ON".
           05  DES-DATE                    PICTURE X(8).
       01  CATEGORIES.
           03  ACCESS-CAT                  PICTURE XXX VALUE "ACC". 
           03  AREAKEY-CAT                 PICTURE XXX VALUE "ARE". 
           03  ATTRIBUTE-CAT               PICTURE XXX VALUE "ATT". 
           03  BOND-CAT                    PICTURE XXX VALUE "BON". 
           03  CONTROL-CAT                 PICTURE XXX VALUE "CON". 
           03  DESCRIPTION-CAT             PICTURE XXX VALUE "DES". 
           03  JOBCONTROL-CAT              PICTURE XXX VALUE "JOB". 
           03  JOIN-CAT                    PICTURE XXX VALUE "JOI". 
           03  MDINFO-CAT                  PICTURE XXX VALUE "MDI". 
           03  NAME-CAT                    PICTURE XXX VALUE "NAM". 
           03  PROCESS-CAT                 PICTURE XXX VALUE "PRO". 
           03  SSREL-CAT                   PICTURE XXX VALUE "SSR". 
           03  STRUCTURE-CAT               PICTURE XXX VALUE "STR". 
       01  CATEGORY-TYPES.
           03  ACCESS-TYPE                 PICTURE XXX VALUE "425". 
           03  AREAKEY-TYPE                PICTURE XXX VALUE "500". 
           03  ATTRIBUTE-TYPE              PICTURE XXX VALUE "210". 
           03  BOND-TYPE                   PICTURE XXX VALUE "550". 
           03  COMMENT-TYPE                PICTURE XXX VALUE "001". 
           03  JOBCONTROL-TYPE             PICTURE XXX VALUE "475". 
           03  JOIN-TYPE                   PICTURE XXX VALUE "575". 
           03  MDINFO-TYPE                 PICTURE XXX VALUE "450". 
           03  NAME-TYPE                   PICTURE XXX VALUE "000". 
           03  PROCESS-TYPE                PICTURE XXX VALUE "400". 
           03  SSREL-TYPE                  PICTURE XXX VALUE "525". 
           03  STRUCTURE-TYPE              PICTURE XXX VALUE "300". 
       01  ENTRY-BREAK-MSG. 
           03  FILLER                      PICTURE XX VALUE SPACE.
           03  DISP-COUNT                  PICTURE ZZZZZ9.
           03  FILLER                      PICTURE X VALUE SPACE. 
           03  DISP-NAME                   PICTURE X(4).
           03  FILLER                      PICTURE X(27) VALUE
           "ENTRIES HAVE BEEN GENERATED". 
       01  ENTRY-NAMES. 
           03  AREA-NAME                   PICTURE XXX VALUE "ARE". 
           03  SUBSCHEMA-NAME              PICTURE XXX VALUE "SUB". 
           03  SCHEMA-NAME                 PICTURE XXX VALUE "SCH". 
       01  ENTRY-TYPES. 
           03  AREA-TYPE                   PICTURE XX  VALUE "22".
           03  SUBSCHEMA-TYPE              PICTURE XX  VALUE "24".
           03  SCHEMA-TYPE                 PICTURE XX  VALUE "26".
       01  FIELD-AREA.
           03  FIELD-NAME                  PICTURE X(4).
           03  FIELD-VALUE                 PICTURE X(66). 
       01  FIELD-CHAR-ARRAY REDEFINES FIELD-AREA. 
           03  FIELD-CHAR                  PICTURE X OCCURS 70 TIMES. 
       01  SAVE-AREAS.
           03  SAVE-ENTRY-TYPE             PICTURE XX    VALUE SPACE. 
           03  SAVE-ENTRY-NAME             PICTURE XXX. 
           03  SAVE-CATEGORY               PICTURE XXX. 
           03  SAVE-FIELD                  PICTURE XX.
           03  SAVE-CATNAME                PICTURE X(32). 
       01  SSREL-FIELD-AREA.
           03  SSREL-FIELD-CHAR            PICTURE X OCCURS 62 TIMES. 
       01  CATEGORY-LINE                   PICTURE 9(4).
       01  DONE                            PICTURE X. 
       01  END-MSG                         PICTURE X(41) VALUE
           " *** END OF CONVERSION CONTROL REPORT ***". 
       01  ENTRY-COUNT                     PICTURE 9(6) VALUE ZERO. 
       01  MAX-FIELD-LEN                   PICTURE 99.
       01  NUM-CHARS                       PICTURE 99.
       01  RECORD-READ-AHEAD               PICTURE X VALUE "T". 
       01  START-CHAR-POS                  PICTURE 99.
       01  SSREL-START-CHAR-POS            PICTURE 99.
       PROCEDURE DIVISION.
       BEGIN-PARA.
           MOVE PRT-CURRENT-DATE TO DES-DATE. 
           OPEN OUTPUT SYSPRINT.
      ******************************************************************
      *    M A I N    L O O P 
      ******************************************************************
       MAIN-LOOP. 
           MOVE SPACES TO FIELD-AREA. 
           IF RECORD-READ-AHEAD IS EQUAL TO "T" 
               MOVE SPACE TO RECORD-READ-AHEAD
               GO TO MAIN-LOOP-10 
           END-IF.
           CALL "WRKFIO". 
           IF END-SW IS EQUAL TO "E"
               GO TO EOJ. 
       MAIN-LOOP-10.
           IF OUT-ENTRY-TYPE IS NOT EQUAL TO SAVE-ENTRY-TYPE
               PERFORM ENTRY-BREAK THRU ENTRY-BREAK-EXIT. 
           IF OUT-ENTRY-TYPE IS EQUAL TO AREA-TYPE
               PERFORM CREATE-AREA THRU CREATE-AREA-EXIT
               GO TO MAIN-LOOP
           END-IF.
           IF OUT-ENTRY-TYPE IS EQUAL TO SUBSCHEMA-TYPE 
               PERFORM CREATE-SUBSCHEMA THRU CREATE-SUBSCHEMA-EXIT
               GO TO MAIN-LOOP
           END-IF.
           IF OUT-ENTRY-TYPE IS EQUAL TO SCHEMA-TYPE
               PERFORM CREATE-SCHEMA THRU CREATE-SCHEMA-EXIT
               GO TO MAIN-LOOP
           END-IF.
       EOJ. 
           PERFORM ENTRY-BREAK THRU ENTRY-BREAK-EXIT. 
           MOVE END-MSG TO STD-REPORT-REC.
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           MOVE "C" TO WRKF-FUNCTION-CODE, PNCH-FUNCTION-CODE.
           CALL "PNCHIO". 
           CALL "WRKFIO". 
           CLOSE SYSPRINT.
           EXIT PROGRAM.
  
      ******************************************************************
      * 
      *    CREATE-ACCESS-LINE THRU CREATE-ACCESS-LINE-EXIT
      * 
      *    RECORD (22,425,YY) READ.  IF YY=05, WRITE CATEGORY LINE
      *    NNNN MOD=OUT-AREAC-MODE
      *    IF YY = "10", WRITE CATEGORY LINE
      *    NNNN LOC=OUT-AREAC-LOCK
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (22,425,YY) 
      *    CATEGORY-LINE = LAST CATEGORY LINE NUMBER
      * 
      *    ON OUTPUT
      *    PNCHFIL CONTAINS TRANSACTIONS SPECIFIED ABOVE
      *    CATEGORY-LINE UPDATED
      * 
      ******************************************************************
  
       CREATE-ACCESS-LINE.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-FIELD-TYPE IS EQUAL TO "05" 
               MOVE "MOD=" TO UPD-FIELD-NAME
               MOVE OUT-AREAC-MODE TO UPD-FIELD-VALUE 
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
               GO TO CREATE-ACCESS-LINE-EXIT
           END-IF.
           IF OUT-FIELD-TYPE IS EQUAL TO "10" 
               MOVE "LOC=" TO UPD-FIELD-NAME
               MOVE OUT-AREAC-LOCK TO UPD-FIELD-VALUE 
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
           END-IF.
       CREATE-ACCESS-LINE-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-ADD-TRANS THRU CREATE-ADD-TRANS-EXIT
      * 
      *    RECORD (XX,000,00) READ.  WRITE TRANSACTION: 
      *    ADD YYY=OUT-CATNAME
      *    IF ELEMENT IS EALIASOF ANOTHER ELEMENT, WRITE TRANSACTION: 
      *    CON
      *    0001 EAL=OUT-EALIASOF-NAME 
      *    IF CATNAME IS DIFFERENT FROM CDCS-NAME, WRITE TRANSACTION: 
      *    NAM
      *    0001 DMS=OUT-CDCS-NAME 
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (00,001,00) 
      *    ENTRY-COUNT = NUMBER OF ELEMENTS OF THIS TYPE
      * 
      *    ON OUTPUT
      *    TRANSACTIONS SPECIFIED ABOVE WRITTEN TO PNCHFIL
      *    ENTRY-COUNT UPDATED
      *    IF NAM CATEGORY INITIALIZED
      *        SAVE-CATEGORY = "001"
      *        CATEGORY-LINE = 5
      * 
      ******************************************************************
  
       CREATE-ADD-TRANS.
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           ADD 1 TO ENTRY-COUNT.
           MOVE SAVE-ENTRY-NAME TO ADD-TYPE.
           MOVE OUT-CATNAME TO ADD-NAME.
           MOVE ADD-LINE TO UPD-TRANS.
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
           MOVE DESCRIPTION-CAT TO UPD-TRANS. 
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
           MOVE DES-LINE1 TO UPD-TRANS. 
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
           IF OUT-EALIASOF-FLAG IS NOT EQUAL TO SPACE 
             AND OUT-EALIASOF-NAME IS NOT EQUAL TO SPACE
               MOVE CONTROL-CAT TO UPD-TRANS
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
               MOVE 1 TO UPD-LINE-NO
               IF OUT-ENTRY-TYPE IS LESS THAN "20"
                   MOVE "EAL=" TO UPD-FIELD-NAME
               ELSE 
                   MOVE "VER=" TO UPD-FIELD-NAME
               END-IF 
               MOVE OUT-EALIASOF-NAME TO UPD-FIELD-VALUE
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
           END-IF.
           IF OUT-CATNAME IS NOT EQUAL TO OUT-CDCS-NAME 
               MOVE NAME-CAT TO UPD-TRANS 
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
               MOVE 5 TO UPD-LINE-NO, CATEGORY-LINE 
               MOVE "DMS=" TO UPD-FIELD-NAME
               MOVE OUT-CDCS-NAME TO UPD-FIELD-VALUE
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
               MOVE "001" TO SAVE-CATEGORY
           END-IF.
       CREATE-ADD-TRANS-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    CREATE-AREA THRU CREATE-AREA-EXIT
      * 
      *    RECORD (22,XXX,YY) READ.  IF XXX=0, CALL CREATE-ADD-TRANS
      *    TO CREATE TRANSACTIONS TO ADD ENTRY AND TO INCLUDE 
      *    CONTROL AND NAMES CATEGORIES IF NECESSARY.  IF XXX IS EQUAL
      *    TO SOME OTHER CATEGORY TYPE, CALL APPROPRIATE SUBROUTINE 
      *    TO PROCESS THAT CATEGORY.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (22,XXX,YY) 
      *    SAVE-CATEGORY = LAST PROCESSED CATEGORY
      * 
      *    ON OUTPUT
      *    PNCHFIL CONTAINS APPROPRIATE TRANSACTIONS
      *    SAVE-CATEGORY = XXX
      * 
      ******************************************************************
  
       CREATE-AREA. 
           IF OUT-CATEGORY-TYPE IS EQUAL TO NAME-TYPE 
               MOVE SPACES TO SAVE-CATEGORY 
               PERFORM CREATE-ADD-TRANS THRU CREATE-ADD-TRANS-EXIT
               GO TO CREATE-AREA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS NOT EQUAL TO OUT-CATEGORY-TYPE 
               MOVE ZERO TO CATEGORY-LINE 
               MOVE OUT-CATEGORY-TYPE TO SAVE-CATEGORY
               IF SAVE-CATEGORY IS EQUAL TO COMMENT-TYPE
                   MOVE NAME-CAT TO UPD-TRANS 
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO ATTRIBUTE-TYPE
                   MOVE ATTRIBUTE-CAT TO UPD-TRANS
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO STRUCTURE-TYPE
                   MOVE STRUCTURE-CAT TO UPD-TRANS
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO PROCESS-TYPE
                   MOVE PROCESS-CAT TO UPD-TRANS
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO ACCESS-TYPE 
                   MOVE ACCESS-CAT TO UPD-TRANS 
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO MDINFO-TYPE 
                   MOVE MDINFO-CAT TO UPD-TRANS 
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO AREAKEY-TYPE
                   MOVE AREAKEY-CAT TO UPD-TRANS
               END-IF 
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO COMMENT-TYPE
               PERFORM CREATE-COMMENT-LINE THRU CREATE-COMMENT-LINE-EXIT
               GO TO CREATE-AREA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO ATTRIBUTE-TYPE
               PERFORM CREATE-AREA-ATT-LINE 
                 THRU CREATE-AREA-ATT-LINE-EXIT 
               GO TO CREATE-AREA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO STRUCTURE-TYPE
               PERFORM CREATE-AREA-STR-LINE 
                 THRU CREATE-AREA-STR-LINE-EXIT 
               GO TO CREATE-AREA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO PROCESS-TYPE
               PERFORM CREATE-PROCESS-LINE
                 THRU CREATE-PROCESS-LINE-EXIT
               GO TO CREATE-AREA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO ACCESS-TYPE 
               PERFORM CREATE-ACCESS-LINE 
                 THRU CREATE-ACCESS-LINE-EXIT 
               GO TO CREATE-AREA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO MDINFO-TYPE 
               PERFORM CREATE-AREA-MD-LINE
                 THRU CREATE-AREA-MD-LINE-EXIT
               GO TO CREATE-AREA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO AREAKEY-TYPE
               PERFORM CREATE-AREAKEY-LINE
                 THRU CREATE-AREAKEY-LINE-EXIT
               GO TO CREATE-AREA-EXIT 
           END-IF.
       CREATE-AREA-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-AREA-ATT-LINE THRU CREATE-AREA-ATT-LINE-EXIT
      * 
      *    RECORD (22,210,XX) READ. 
      *    IF XX = 01, WRITE CATEGORY LINE
      *    NNNN * COMMENT 
      *    IF XX = 05, WRITE CATEGORY LINE
      *    NNNN CL=XXX,CP=YYY,C1=ZZZ... 
      *    IF XX = 39, READ AHEAD TO DETERMINE IF NEXT RECORD IS
      *    (22,210,05)
      *    IF NOT, WRITE CATEGORY LINE
      *    NNNN SEQ=X 
      *    AND SET RECORD-READ-AHEAD = "T"
      *    IF SO, WRITE CATEGORY LINE 
      *    NNNN SEQ=X,C1=YYY,CP=ZZZ...
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (22,210,XX) 
      * 
      *    ON OUTPUT
      *    PNCHFIL CONTAINS APPROPRIATE TRANSACTION 
      *    IF RECORD READ AHEAD WAS NOT (22,210,05) 
      *        RECORD-READ-AHEAD = "T"
      * 
      ******************************************************************
  
       CREATE-AREA-ATT-LINE.
           IF OUT-FIELD-TYPE IS EQUAL TO "01" 
               PERFORM CREATE-COMMENT-LINE THRU CREATE-COMMENT-LINE-EXIT
               GO TO CREATE-AREA-ATT-LINE-EXIT
           END-IF.
           MOVE OUT-CATNAME TO SAVE-CATNAME.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-FIELD-TYPE IS EQUAL TO "05" 
               PERFORM CREATE-AREAA-FILE-LINE 
                 THRU CREATE-AREAA-FILE-LINE-EXIT 
               GO TO CREATE-AREA-ATT-LINE-30
           END-IF.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "39" 
               GO TO CREATE-AREA-ATT-LINE-EXIT. 
           MOVE "SEQ=" TO FIELD-NAME. 
           MOVE OUT-AREAA-SEQUENCE TO FIELD-VALUE.
           MOVE 5 TO MAX-FIELD-LEN. 
           PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT. 
           CALL "WRKFIO". 
           IF END-SW IS EQUAL TO "E"
               GO TO CREATE-AREA-ATT-LINE-10. 
           GO TO CREATE-AREA-ATT-LINE-20. 
       CREATE-AREA-ATT-LINE-10. 
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
           GO TO EOJ. 
       CREATE-AREA-ATT-LINE-20. 
           IF OUT-ENTRY-TYPE IS NOT EQUAL TO SAVE-ENTRY-TYPE
             OR OUT-CATNAME IS NOT EQUAL TO SAVE-CATNAME
             OR OUT-CATEGORY-TYPE IS NOT EQUAL TO SAVE-CATEGORY 
             OR OUT-FIELD-TYPE IS NOT EQUAL TO "05" 
               MOVE "T" TO RECORD-READ-AHEAD
               GO TO CREATE-AREA-ATT-LINE-30
           END-IF.
           PERFORM CREATE-AREAA-FILE-LINE 
             THRU CREATE-AREAA-FILE-LINE-EXIT.
       CREATE-AREA-ATT-LINE-30. 
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-AREA-ATT-LINE-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-AREAA-FILE-LINE THRU CREATE-AREAA-FILE-LINE-EXIT
      * 
      *    RECORD (22,210,01) READ.  CALL INSERT-FIELD FOR EACH 
      *    OF THE NONBLANK FIELDS OF OUT-AREAA-FILE-ARRAY.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (22,210,01) 
      * 
      *    ON OUTPUT
      *    EACH OF THE NONBLANK FIELDS OF OUT-AREAA-FILE-ARRAY
      *    INSERTED IN CURRENT TRANSACTION BY INSERT-FIELD
      * 
      ******************************************************************
  
       CREATE-AREAA-FILE-LINE.
           IF OUT-AREAA-BT IS NOT EQUAL TO SPACE
               MOVE "BT=" TO FIELD-NAME 
               MOVE OUT-AREAA-BT TO FIELD-AREA (4 : END)
               MOVE 4 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-CL IS NOT EQUAL TO SPACE
               MOVE "CL=" TO FIELD-NAME 
               MOVE OUT-AREAA-CL TO FIELD-AREA (4 : END)
               MOVE 9 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-CP IS NOT EQUAL TO SPACE
               MOVE "CP=" TO FIELD-NAME 
               MOVE OUT-AREAA-CP TO FIELD-AREA (4 : END)
               MOVE 9 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-C1 IS NOT EQUAL TO SPACE
               MOVE "C1=" TO FIELD-NAME 
               MOVE OUT-AREAA-C1 TO FIELD-AREA (4 : END)
               MOVE 4 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-EMK IS NOT EQUAL TO SPACE 
               MOVE "EMK=" TO FIELD-NAME
               MOVE OUT-AREAA-EMK TO FIELD-VALUE
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-FO IS NOT EQUAL TO SPACE
               MOVE "FO=" TO FIELD-NAME 
               MOVE OUT-AREAA-FO TO FIELD-AREA (4 : END)
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-HL IS NOT EQUAL TO SPACE
               MOVE "HL=" TO FIELD-NAME 
               MOVE OUT-AREAA-HL TO FIELD-AREA (4 : END)
               MOVE 9 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-HMB IS NOT EQUAL TO SPACE 
               MOVE "HMB=" TO FIELD-NAME
               MOVE OUT-AREAA-HMB TO FIELD-VALUE
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-KL IS NOT EQUAL TO SPACE
               MOVE "KL=" TO FIELD-NAME 
               MOVE OUT-AREAA-KL TO FIELD-AREA (4 : END)
               MOVE 7 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-KP IS NOT EQUAL TO SPACE
               MOVE "KP=" TO FIELD-NAME 
               MOVE OUT-AREAA-KP TO FIELD-AREA (4 : END)
               MOVE 4 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-KT IS NOT EQUAL TO SPACE
               MOVE "KT=" TO FIELD-NAME 
               MOVE OUT-AREAA-KT TO FIELD-AREA (4 : END)
               MOVE 4 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-LL IS NOT EQUAL TO SPACE
               MOVE "LL=" TO FIELD-NAME 
               MOVE OUT-AREAA-LL TO FIELD-AREA (4 : END)
               MOVE 4 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-LP IS NOT EQUAL TO SPACE
               MOVE "LP=" TO FIELD-NAME 
               MOVE OUT-AREAA-LP TO FIELD-AREA (4 : END)
               MOVE 9 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-MBL IS NOT EQUAL TO SPACE 
               MOVE "MBL=" TO FIELD-NAME
               MOVE OUT-AREAA-MBL TO FIELD-VALUE
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-MNR IS NOT EQUAL TO SPACE 
               MOVE "MNR=" TO FIELD-NAME
               MOVE OUT-AREAA-MNR TO FIELD-VALUE
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-MRL IS NOT EQUAL TO SPACE 
               MOVE "MRL=" TO FIELD-NAME
               MOVE OUT-AREAA-MRL TO FIELD-VALUE
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-ORG IS NOT EQUAL TO SPACE 
               MOVE "ORG=" TO FIELD-NAME
               MOVE OUT-AREAA-ORG TO FIELD-VALUE
               MOVE 7 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-RB IS NOT EQUAL TO SPACE
               MOVE "RB=" TO FIELD-NAME 
               MOVE OUT-AREAA-RB TO FIELD-AREA (4 : END)
               MOVE 7 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-RKP IS NOT EQUAL TO SPACE 
               MOVE "RKP=" TO FIELD-NAME
               MOVE OUT-AREAA-RKP TO FIELD-VALUE
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-RKW IS NOT EQUAL TO SPACE 
               MOVE "RKW=" TO FIELD-NAME
               MOVE OUT-AREAA-RKW TO FIELD-VALUE
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-RMK IS NOT EQUAL TO SPACE 
               MOVE "RMK=" TO FIELD-NAME
               MOVE OUT-AREAA-RMK TO FIELD-VALUE
               MOVE 14 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-RT IS NOT EQUAL TO SPACE
               MOVE "RT=" TO FIELD-NAME 
               MOVE OUT-AREAA-RT TO FIELD-AREA (4 : END)
               MOVE 4 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAA-TL IS NOT EQUAL TO SPACE
               MOVE "TL=" TO FIELD-NAME 
               MOVE OUT-AREAA-TL TO FIELD-AREA (4 : END)
               MOVE 9 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
       CREATE-AREAA-FILE-LINE-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-AREA-MD-LINE THRU CREATE-AREA-MD-LINE-EXIT
      * 
      *    RECORD (22,450,05) READ.  WRITE CATEGORY LINE
      *    NNNN PFN=XXXX,UN=YYYY,PW=ZZZZ,FAM=AAAA.... 
      *    TO PNCHFIL.  CALL INSERT-FIELD TO INSERT EACH FIELD NAME 
      *    AND VALUE SO THE FIELDS ARE INSERTED WITH NO BLANKS
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (26,450,05) 
      * 
      *    ON OUTPUT
      *    NNNN PFN=XXXX,UN=YYYY,PW=ZZZZ,FAM=AAAA.... 
      * 
      ******************************************************************
  
       CREATE-AREA-MD-LINE. 
           MOVE 6 TO START-CHAR-POS.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           IF OUT-AREAM-PFNAREA IS NOT EQUAL TO SPACE 
               MOVE "PFN=" TO FIELD-NAME
               MOVE OUT-AREAM-PFNAREA TO FIELD-VALUE
               MOVE 11 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAM-UN IS NOT EQUAL TO SPACE
               MOVE "UN=" TO FIELD-NAME 
               MOVE OUT-AREAM-UN TO FIELD-AREA (4 : END)
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAM-PW IS NOT EQUAL TO SPACE
               MOVE "PW=" TO FIELD-NAME 
               MOVE OUT-AREAM-PW TO FIELD-AREA (4 : END)
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAM-FAMILY IS NOT EQUAL TO SPACE
               MOVE "FAM=" TO FIELD-NAME
               MOVE OUT-AREAM-FAMILY TO FIELD-VALUE 
               MOVE 11 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAM-PACK IS NOT EQUAL TO SPACE
               MOVE "PAC=" TO FIELD-NAME
               MOVE OUT-AREAM-PACK TO FIELD-VALUE 
               MOVE 11 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAM-SET IS NOT EQUAL TO SPACE 
               MOVE "SET=" TO FIELD-NAME
               MOVE OUT-AREAM-SET TO FIELD-VALUE
               MOVE 11 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAM-PVOLSER IS NOT EQUAL TO SPACE 
               MOVE "PVO=" TO FIELD-NAME
               MOVE OUT-AREAM-PVOLSER TO FIELD-VALUE
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAM-PUNIT IS NOT EQUAL TO SPACE 
               MOVE "PUN=" TO FIELD-NAME
               MOVE OUT-AREAM-PUNIT TO FIELD-VALUE
               MOVE 7 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAM-LOG IS NOT EQUAL TO SPACE 
               MOVE "LOG=" TO FIELD-NAME
               MOVE OUT-AREAM-LOG TO FIELD-VALUE
               MOVE 12 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAM-INDXFIL IS NOT EQUAL TO SPACE 
               MOVE "IND=" TO FIELD-NAME
               MOVE OUT-AREAM-INDXFIL TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-AREA-MD-LINE-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-AREA-STR-LINE THRU CREATE-AREA-STR-LINE-EXIT
      * 
      *    RECORD (22,300,05) READ.  READ AHEAD TO DETERMINE
      *    IF NEXT RECORD IS (22,300,15).  IF SO, WRITE CATEGORY LINE 
      *    NNNN CAT=XXX,RCV=YYY 
      *    IF NOT, WRITE CATEGORY LINE
      *    NNNN CAT=XXX 
      *    AND SET RECORD-READ-AHEAD = "T"
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (22,300,05) 
      * 
      *    ON OUTPUT
      *    PNCHFIL CONTAINS APPROPRIATE TRANSACTION 
      *    IF RECORD READ AHEAD WAS NOT (22,300,15) 
      *        RECORD-READ-AHEAD = "T"
      * 
      ******************************************************************
  
       CREATE-AREA-STR-LINE.
           MOVE OUT-CATNAME TO SAVE-CATNAME.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "05" 
               GO TO CREATE-AREA-STR-LINE-EXIT. 
           MOVE "CAT=" TO FIELD-NAME. 
           MOVE OUT-AREAS-CATNAME TO FIELD-VALUE. 
           MOVE 36 TO MAX-FIELD-LEN.
           PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT. 
           CALL "WRKFIO". 
           IF END-SW IS EQUAL TO "E"
               GO TO CREATE-AREA-STR-LINE-10. 
           GO TO CREATE-AREA-STR-LINE-20. 
       CREATE-AREA-STR-LINE-10. 
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
           GO TO EOJ. 
       CREATE-AREA-STR-LINE-20. 
           IF OUT-ENTRY-TYPE IS NOT EQUAL TO SAVE-ENTRY-TYPE
             OR OUT-CATNAME IS NOT EQUAL TO SAVE-CATNAME
             OR OUT-CATEGORY-TYPE IS NOT EQUAL TO SAVE-CATEGORY 
             OR OUT-FIELD-TYPE IS NOT EQUAL TO "15" 
               MOVE "T" TO RECORD-READ-AHEAD
               GO TO CREATE-AREA-STR-LINE-30
           END-IF.
           MOVE "RCV=" TO FIELD-NAME. 
           MOVE OUT-AREAS-RCVALUE TO FIELD-VALUE. 
           MOVE 66 TO MAX-FIELD-LEN.
           PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT. 
       CREATE-AREA-STR-LINE-30. 
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-AREA-STR-LINE-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    CREATE-AREAKEY-LINE THRU CREATE-AREAKEY-LINE-EXIT
      * 
      *    RECORD (22,500,XX) READ. 
      *    IF XX = 05, WRITE CATEGORY LINE
      *    NNNN KEY=AAA,KAL=BBB,KOF=CCC,TYP=D,DUP=E,USI=X 
      *    IF XX = 30, WRITE CATEGORY LINE
      *    NNNN CKE=AAA,CTY=B,CDU=C,CUS=D 
      *    IF XX = 45, WRITE CATEGORY LINE
      *    NNNN CID=AAA,CAL=BBB,CQU=DDDJ
      * 
      *    ON INPUT 
      *    CATEGORY-LINE = LAST PROCESSED CATEGORY LINE NUMBER
      *    OUT-REC = RECORD (22,500,XX) 
      * 
      *    ON OUTPUT
      *    PNCHFIL CONTAINS CATEGORY LINES SPECIFIED ABOVE
      *    CATEGORY-LINE UPDATED
      * 
      ******************************************************************
  
       CREATE-AREAKEY-LINE. 
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "05" 
               GO TO CREATE-AREAKEY-LINE-30.
           IF OUT-AREAK-KEYNAME IS NOT EQUAL TO SPACE 
               MOVE "KEY=" TO FIELD-NAME
               MOVE OUT-AREAK-KEYNAME TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-KALIAS IS NOT EQUAL TO SPACE
             AND OUT-AREAK-KALIAS IS NOT EQUAL TO "0000"
               MOVE "KAL=" TO FIELD-NAME
               MOVE OUT-AREAK-KALIAS TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-KOFREC IS NOT EQUAL TO SPACE
               MOVE "KOF=" TO FIELD-NAME
               MOVE OUT-AREAK-KOFREC TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-TYPEKEY IS NOT EQUAL TO SPACE 
               MOVE "TYP=" TO FIELD-NAME
               MOVE OUT-AREAK-TYPEKEY TO FIELD-VALUE
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-DUPES IS NOT EQUAL TO SPACE 
               MOVE "DUP=" TO FIELD-NAME
               MOVE OUT-AREAK-DUPES TO FIELD-VALUE
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-USING IS NOT EQUAL TO SPACE 
               MOVE "USI=" TO FIELD-NAME
               MOVE OUT-AREAK-USING TO FIELD-VALUE
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-AREAKEY-LINE-100. 
       CREATE-AREAKEY-LINE-30.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "30" 
               GO TO CREATE-AREAKEY-LINE-45.
           IF OUT-AREAK-CKEYID IS NOT EQUAL TO SPACE
               MOVE "CKE=" TO FIELD-NAME
               MOVE OUT-AREAK-CKEYID TO FIELD-VALUE 
               MOVE 34 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-CTYPKEY IS NOT EQUAL TO SPACE 
               MOVE "CTY=" TO FIELD-NAME
               MOVE OUT-AREAK-CTYPKEY TO FIELD-VALUE
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-CDUPES IS NOT EQUAL TO SPACE
               MOVE "CDU=" TO FIELD-NAME
               MOVE OUT-AREAK-CDUPES TO FIELD-VALUE 
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-CUSING IS NOT EQUAL TO SPACE
               MOVE "CUS=" TO FIELD-NAME
               MOVE OUT-AREAK-CUSING TO FIELD-VALUE 
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-AREAKEY-LINE-100. 
       CREATE-AREAKEY-LINE-45.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "45" 
               GO TO CREATE-AREAKEY-LINE-EXIT.
           IF OUT-AREAK-CIDEN IS NOT EQUAL TO SPACE 
               MOVE "CID=" TO FIELD-NAME
               MOVE OUT-AREAK-CIDEN TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-CALIAS IS NOT EQUAL TO SPACE
             AND OUT-AREAK-CALIAS IS NOT EQUAL TO "0000"
               MOVE "CAL=" TO FIELD-NAME
               MOVE OUT-AREAK-CALIAS TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAK-CQUAL IS NOT EQUAL TO SPACE 
               MOVE "CQU=" TO FIELD-NAME
               MOVE OUT-AREAK-CQUAL TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
       CREATE-AREAKEY-LINE-100. 
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-AREAKEY-LINE-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    CREATE-BOND-LINE THRU CREATE-BOND-LINE-EXIT
      * 
      *    RECORD (26,550,XX) READ. IF XX=01, WRITE CATEGORY LINE 
      *    NNNN * COMMENT 
      *    IF XX=05, WRITE CATEGORY LINE
      *    NNNN CON=XXX,CNA=YYY,CAL=... 
      *    IF XX=10, WRITE CATEGORY LINE
      *    NNNNDEP=XXX,DAL=YYY,BOF=ZZZ
      *    TO PNCHFIL.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (26,550,XX) 
      *    CATEGORY-LINE = LAST PROCESSED CATEGORY LINE NUMBER
      * 
      *    ON OUTPUT
      *    SPECIFIED TRANSACTION WRITTEN TO PNCHFIL 
      *    CATEGORY-LINE UPDATED
      * 
      ******************************************************************
  
       CREATE-BOND-LINE.
           IF OUT-FIELD-TYPE IS EQUAL TO "01" 
               PERFORM CREATE-COMMENT-LINE THRU CREATE-COMMENT-LINE-EXIT
               GO TO CREATE-BOND-LINE-EXIT
           END-IF.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "05" 
               GO TO CREATE-BOND-LINE-10. 
           IF OUT-SCHB-CONNAME IS NOT EQUAL TO SPACE
               MOVE "CON=" TO FIELD-NAME
               MOVE OUT-SCHB-CONNAME TO FIELD-VALUE 
               MOVE 34 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHB-CNAME IS NOT EQUAL TO SPACE
               MOVE "CNA=" TO FIELD-NAME
               MOVE OUT-SCHB-CNAME TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHB-CALIAS IS NOT EQUAL TO SPACE 
             AND OUT-SCHB-CALIAS IS NOT EQUAL TO "0000" 
               MOVE "CAL=" TO FIELD-NAME
               MOVE OUT-SCHB-CALIAS TO FIELD-VALUE
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHB-AOFREC IS NOT EQUAL TO SPACE 
               MOVE "AOF=" TO FIELD-NAME
               MOVE OUT-SCHB-AOFREC TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-BOND-LINE-100.
       CREATE-BOND-LINE-10. 
           IF OUT-SCHB-DEPENDS IS NOT EQUAL TO SPACE
               MOVE "DEP=" TO FIELD-NAME
               MOVE OUT-SCHB-DEPENDS TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHB-DALIAS IS NOT EQUAL TO SPACE 
             AND OUT-SCHB-DALIAS IS NOT EQUAL TO "0000" 
               MOVE "DAL=" TO FIELD-NAME
               MOVE OUT-SCHB-DALIAS TO FIELD-VALUE
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHB-BOFREC IS NOT EQUAL TO SPACE 
               MOVE "BOF=" TO FIELD-NAME
               MOVE OUT-SCHB-BOFREC TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
       CREATE-BOND-LINE-100.
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-BOND-LINE-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-COMMENT-LINE THRU CREATE-COMMENT-LINE-EXIT
      * 
      *    RECORD (XX,001,00) READ.  WRITE CATEGORY LINE
      *    NNNN *COMMENT
      *    TO PNCHFIL.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (XX,001,00) 
      *    CATEGORY-LINE = LAST PROCESSED CATEGORY LINE NUMBER
      * 
      *    ON OUTPUT
      *    NNNN *COMMENT WRITTEN TO PNCHFIL 
      *    CATEGORY-LINE UPDATED
      * 
      ******************************************************************
  
       CREATE-COMMENT-LINE. 
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE "*" TO UPD-AST. 
           MOVE OUT-NOTE TO UPD-COMMENT.
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-COMMENT-LINE-EXIT.
           EXIT.
  
  
  
  
      ******************************************************************
      * 
      *    CREATE-JOBCONTROL-LINE THRU CREATE-JOBCONTROL-LINE-EXIT
      * 
      *    RECORD (26,475,05) READ.  WRITE CATEGORY LINE
      *    NNNN UN=YYYY,PW=ZZZZ,FAM=AAAA....
      *    TO PNCHFIL.  CALL INSERT-FIELD TO INSERT EACH FIELD NAME 
      *    AND VALUE SO THE FIELDS ARE INSERTED WITH NO BLANKS
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (26,475,05) 
      * 
      *    ON OUTPUT
      *    NNNN UN=YYYY,PW=ZZZZ,FAM=AAAA....
      * 
      ******************************************************************
  
       CREATE-JOBCONTROL-LINE.
           MOVE 6 TO START-CHAR-POS.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           IF OUT-SCHJC-UN IS NOT EQUAL TO SPACE
               MOVE "UN=" TO FIELD-NAME 
               MOVE OUT-SCHJC-UN TO FIELD-AREA (4 : END)
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJC-PW IS NOT EQUAL TO SPACE
               MOVE "PW=" TO FIELD-NAME 
               MOVE OUT-SCHJC-PW TO FIELD-AREA (4 : END)
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJC-FAMILY IS NOT EQUAL TO SPACE
               MOVE "FAM=" TO FIELD-NAME
               MOVE OUT-SCHJC-FAMILY TO FIELD-VALUE 
               MOVE 11 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJC-ACCOUNT IS NOT EQUAL TO SPACE 
               MOVE "ACC=" TO FIELD-NAME
               MOVE OUT-SCHJC-ACCOUNT TO FIELD-VALUE
               MOVE 34 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJC-CHARGE IS NOT EQUAL TO SPACE
               MOVE "CHA=" TO FIELD-NAME
               MOVE OUT-SCHJC-CHARGE TO FIELD-VALUE 
               MOVE 34 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJC-DENSITY IS NOT EQUAL TO SPACE 
               MOVE "DEN=" TO FIELD-NAME
               MOVE OUT-SCHJC-DENSITY TO FIELD-VALUE
               MOVE 6 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJC-TTYPE IS NOT EQUAL TO SPACE 
               MOVE "TTY=" TO FIELD-NAME
               MOVE OUT-SCHJC-TTYPE TO FIELD-VALUE
               MOVE 6 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-JOBCONTROL-LINE-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-JOIN-LINE THRU CREATE-JOIN-LINE-EXIT
      * 
      *    RECORD (26,575,XX) READ. 
      *    IF XX=01, WRITE CATEGORY LINE
      *    NNNN * COMMENT 
      *    IF XX=05, WRITE CATEGORY LINE
      *    NNNN REL=XXX 
      *    IF XX=10, WRITE CATAGORY LINE
      *    NNNN ID1=XXX,I1A=YYY,I1R=ZZZ 
      *    IF XX=45, WRITE CATEGORY LINE
      *    NNNN ID2=XXXX,I2A=YYY,I2R=ZZZ
      *    TO PNCHFIL.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (26,575,XX) 
      *    CATEGORY-LINE = LAST PROCESSED CATEGORY LINE NUMBER
      * 
      *    ON OUTPUT
      *    SPECIFIED TRANSACTION WRITTEN TO PNCHFIL 
      *    CATEGORY-LINE UPDATED
      * 
      ******************************************************************
  
       CREATE-JOIN-LINE.
           IF OUT-FIELD-TYPE IS EQUAL TO "01" 
               PERFORM CREATE-COMMENT-LINE THRU CREATE-COMMENT-LINE-EXIT
               GO TO CREATE-JOIN-LINE-EXIT
           END-IF.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "05" 
               GO TO CREATE-JOIN-LINE-10. 
           MOVE "REL=" TO UPD-FIELD-NAME. 
           MOVE OUT-SCHJ-RELNAME TO UPD-FIELD-VALUE.
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
           GO TO CREATE-JOIN-LINE-EXIT. 
       CREATE-JOIN-LINE-10. 
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "10" 
               GO TO CREATE-JOIN-LINE-45. 
           IF OUT-SCHJ-ID1 IS NOT EQUAL TO SPACE
               MOVE "ID1=" TO FIELD-NAME
               MOVE OUT-SCHJ-ID1 TO FIELD-VALUE 
               MOVE 52 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJ-I1ALIAS IS NOT EQUAL TO SPACE
             AND OUT-SCHJ-I1ALIAS IS NOT EQUAL TO "0000"
               MOVE "I1A=" TO FIELD-NAME
               MOVE OUT-SCHJ-I1ALIAS TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJ-I1REC IS NOT EQUAL TO SPACE
               MOVE "I1R=" TO FIELD-NAME
               MOVE OUT-SCHJ-I1REC TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-JOIN-LINE-100.
       CREATE-JOIN-LINE-45. 
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "45" 
               GO TO CREATE-JOIN-LINE-EXIT. 
           IF OUT-SCHJ-ID1 IS NOT EQUAL TO SPACE
               MOVE "ID2=" TO FIELD-NAME
               MOVE OUT-SCHJ-ID1 TO FIELD-VALUE 
               MOVE 52 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJ-I1ALIAS IS NOT EQUAL TO SPACE
             AND OUT-SCHJ-I1ALIAS IS NOT EQUAL TO "0000"
               MOVE "I2A=" TO FIELD-NAME
               MOVE OUT-SCHJ-I1ALIAS TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHJ-I1REC IS NOT EQUAL TO SPACE
               MOVE "I2R=" TO FIELD-NAME
               MOVE OUT-SCHJ-I1REC TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
       CREATE-JOIN-LINE-100.
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-JOIN-LINE-EXIT. 
           EXIT.
  
  
      ******************************************************************
      * 
      *    CREATE-PROCESS-LINE THRU CREATE-PROCESS-LINE-EXIT
      * 
      *    RECORD (XX,400,YY) READ.  IF YY=5, WRITE CATEGORY LINE 
      *    NNNN DBP=AAA,TYP=BB,TIM=CC,OPT=DDD 
      *    TO PNCHFIL.
      *    IF YY=25, WRITE CATEGORY LINE
      *    NNNN RCD=AAA,RCA=BBB,RCQ=CCC 
      * 
      *    ON INPUT 
      *    CATEGORY-LINE = LAST PROCESSED CATEGORY LINE NUMBER
      *    OUT-REC = RECORD (XX,400,YY) 
      * 
      *    ON OUTPUT
      *    SPECIFIED TRANSACTIONS WRITTEN TO PNCHFIL
      *    CATEGORY-LINE UPDATED
      * 
      ******************************************************************
  
       CREATE-PROCESS-LINE. 
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "05" 
               GO TO CREATE-PROCESS-LINE-25.
           IF OUT-ELEP-DBPROC IS NOT EQUAL TO SPACE 
               MOVE "DBP=" TO FIELD-NAME
               MOVE OUT-ELEP-DBPROC TO FIELD-VALUE
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-ELEP-TYPEPROC IS NOT EQUAL TO SPACE 
               MOVE "TYP=" TO FIELD-NAME
               MOVE OUT-ELEP-TYPEPROC TO FIELD-VALUE
               MOVE 6 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-ELEP-TIME IS NOT EQUAL TO SPACE 
               MOVE "TIM=" TO FIELD-NAME
               MOVE OUT-ELEP-TIME TO FIELD-VALUE
               MOVE 9 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-ELEP-OPTION IS NOT EQUAL TO SPACE 
               MOVE "OPT=" TO FIELD-NAME
               MOVE OUT-ELEP-OPTION TO FIELD-VALUE
               MOVE 13 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-PROCESS-LINE-100. 
       CREATE-PROCESS-LINE-25.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "25" 
             OR OUT-ENTRY-TYPE IS NOT EQUAL TO "22" 
               GO TO CREATE-PROCESS-LINE-EXIT.
           IF OUT-AREAP-RCDATA IS NOT EQUAL TO SPACE
               MOVE "RCD=" TO FIELD-NAME
               MOVE OUT-AREAP-RCDATA TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAP-RCALIAS IS NOT EQUAL TO SPACE 
             AND OUT-AREAP-RCALIAS IS NOT EQUAL TO "0000" 
               MOVE "RCA=" TO FIELD-NAME
               MOVE OUT-AREAP-RCALIAS TO FIELD-VALUE
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-AREAP-RCQUAL IS NOT EQUAL TO SPACE
               MOVE "RCQ=" TO FIELD-NAME
               MOVE OUT-AREAP-RCQUAL TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
       CREATE-PROCESS-LINE-100. 
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-PROCESS-LINE-EXIT.
           EXIT.
  
  
      ******************************************************************
      * 
      *    CREATE-SCHEMA THRU CREATE-SCHEMA-EXIT
      * 
      *    RECORD (26,XXX,YY) READ.  IF XXX=0, CALL CREATE-ADD-TRANS
      *    TO CREATE TRANSACTIONS TO ADD ENTRY AND TO INCLUDE 
      *    CONTROL AND NAMES CATEGORIES IF NECESSARY.  IF XXX IS EQUAL
      *    TO SOME OTHER CATEGORY TYPE, CALL APPROPRIATE SUBROUTINE 
      *    TO PROCESS THAT CATEGORY.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (26,XXX,YY) 
      *    SAVE-CATEGORY = LAST PROCESSED CATEGORY
      * 
      *    ON OUTPUT
      *    PNCHFIL CONTAINS APPROPRIATE TRANSACTIONS
      *    SAVE-CATEGORY = XXX
      * 
      ******************************************************************
  
       CREATE-SCHEMA. 
           IF OUT-CATEGORY-TYPE IS EQUAL TO NAME-TYPE 
               MOVE SPACES TO SAVE-CATEGORY 
               PERFORM CREATE-ADD-TRANS THRU CREATE-ADD-TRANS-EXIT
               GO TO CREATE-SCHEMA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS NOT EQUAL TO OUT-CATEGORY-TYPE 
               MOVE ZERO TO CATEGORY-LINE 
               MOVE OUT-CATEGORY-TYPE TO SAVE-CATEGORY
               IF SAVE-CATEGORY IS EQUAL TO COMMENT-TYPE
                   MOVE NAME-CAT TO UPD-TRANS 
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO STRUCTURE-TYPE
                   MOVE STRUCTURE-CAT TO UPD-TRANS
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO MDINFO-TYPE 
                   MOVE MDINFO-CAT TO UPD-TRANS 
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO JOBCONTROL-TYPE 
                   MOVE JOBCONTROL-CAT TO UPD-TRANS 
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO BOND-TYPE 
                   MOVE BOND-CAT TO UPD-TRANS 
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO JOIN-TYPE 
                   MOVE JOIN-CAT TO UPD-TRANS 
               END-IF 
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO COMMENT-TYPE
               PERFORM CREATE-COMMENT-LINE THRU CREATE-COMMENT-LINE-EXIT
               GO TO CREATE-SCHEMA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO STRUCTURE-TYPE
               PERFORM CREATE-SCHEMA-STR-LINE 
                 THRU CREATE-SCHEMA-STR-LINE-EXIT 
               GO TO CREATE-SCHEMA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO MDINFO-TYPE 
               PERFORM CREATE-SCHEMA-MD-LINE
                 THRU CREATE-SCHEMA-MD-LINE-EXIT
               GO TO CREATE-SCHEMA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO JOBCONTROL-TYPE 
               PERFORM CREATE-JOBCONTROL-LINE 
                 THRU CREATE-JOBCONTROL-LINE-EXIT 
               GO TO CREATE-SCHEMA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO BOND-TYPE 
               PERFORM CREATE-BOND-LINE 
                 THRU CREATE-BOND-LINE-EXIT 
               GO TO CREATE-SCHEMA-EXIT 
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO JOIN-TYPE 
               PERFORM CREATE-JOIN-LINE 
                 THRU CREATE-JOIN-LINE-EXIT 
               GO TO CREATE-SCHEMA-EXIT 
           END-IF.
       CREATE-SCHEMA-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-SCHEMA-MD-LINE THRU CREATE-SCHEMA-MD-LINE-EXIT
      * 
      *    RECORD (26,450,YY) READ.  IF YY=05, WRITE CATEGORY LINE
      *    NNNN SCH=OUT-SCHM-SCHLFN 
      *    IF YY = "10", WRITE CATEGORY LINE
      *    NNNN ZZZ=OUT-SCHM-FILE-CATNAME 
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (26,450,YY) 
      *    CATEGORY-LINE = LAST CATEGORY LINE NUMBER
      * 
      *    ON OUTPUT
      *    PNCHFIL CONTAINS TRANSACTIONS SPECIFIED ABOVE
      *    CATEGORY-LINE UPDATED
      * 
      ******************************************************************
  
       CREATE-SCHEMA-MD-LINE. 
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-FIELD-TYPE IS EQUAL TO "05" 
               MOVE "SCH=" TO UPD-FIELD-NAME
               MOVE OUT-SCHM-SCHLFN TO UPD-FIELD-VALUE
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
               GO TO CREATE-SCHEMA-MD-LINE-EXIT 
           END-IF.
           IF OUT-FIELD-TYPE IS EQUAL TO "10" 
               MOVE OUT-SCHM-FILE-TYPE TO UPD-FIELD-NAME
               MOVE "=" TO UPD-FIELD-NAME (4 : 1) 
               MOVE OUT-SCHM-FILE-CATNAME TO UPD-FIELD-VALUE
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
           END-IF.
       CREATE-SCHEMA-MD-LINE-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-SCHEMA-STR-LINE THRU CREATE-SCHEMA-STR-LINE-EXIT
      * 
      *    RECORD (26,300,05) READ.  WRITE CATEGORY LINE
      *    NNNN CAT=XXX,CTY=YYY,AVE=ZZZ 
      *    TO PNCHFIL.  CALL INSERT-FIELD TO INSERT EACH FIELD NAME 
      *    AND VALUE SO THE FIELDS ARE INSERTED WITH NO BLANKS
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (26,300,05) 
      * 
      *    ON OUTPUT
      *    NNNN CAT=XXX,CTY=YYY,AVE=ZZZ WRITTEN TO PNCHFIL
      * 
      ******************************************************************
  
       CREATE-SCHEMA-STR-LINE.
           MOVE 6 TO START-CHAR-POS.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           IF OUT-SCHS-CATNAME IS NOT EQUAL TO SPACE
               MOVE "CAT=" TO FIELD-NAME
               MOVE OUT-SCHS-CATNAME TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHS-CTYPE IS NOT EQUAL TO SPACE
               MOVE "CTY=" TO FIELD-NAME
               MOVE OUT-SCHS-CTYPE TO FIELD-VALUE 
               MOVE 5 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SCHS-AVERS IS NOT EQUAL TO SPACE
               MOVE "AVE=" TO FIELD-NAME
               MOVE OUT-SCHS-AVERS TO FIELD-VALUE 
               MOVE 11 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-SCHEMA-STR-LINE-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-SSREL-LINE THRU CREATE-SSREL-LINE-EXIT
      * 
      *    RECORD (24,525,XX) READ. 
      *    IF XX=01, WRITE CATEGORY LINE
      *    NNNN * COMMENT 
      *    IF XX=02, WRITE CATEGORY LINE
      *    NNNN RNA=XXX,RES=YYY 
      *    IF XX=05, WRITE CATAGORY LINE
      *    NNNN PRE=WWW,ID1=XXX,I1A=YYY...
      *    TO PNCHFIL.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (24,525,XX) 
      *    CATEGORY-LINE = LAST PROCESSED CATEGORY LINE NUMBER
      * 
      *    ON OUTPUT
      *    SPECIFIED TRANSACTION WRITTEN TO PNCHFIL 
      *    CATEGORY-LINE UPDATED
      * 
      ******************************************************************
  
       CREATE-SSREL-LINE. 
           IF OUT-FIELD-TYPE IS EQUAL TO "01" 
               PERFORM CREATE-COMMENT-LINE THRU CREATE-COMMENT-LINE-EXIT
               GO TO CREATE-SSREL-LINE-EXIT 
           END-IF.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE 6 TO START-CHAR-POS.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "02" 
               GO TO CREATE-SSREL-LINE-05.
           IF OUT-SSCHR-RNAME IS NOT EQUAL TO SPACE 
               MOVE "RNA=" TO FIELD-NAME
               MOVE OUT-SSCHR-RNAME TO FIELD-VALUE
               MOVE 34 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SSCHR-RESTRICT IS NOT EQUAL TO SPACE
               MOVE "RES=" TO FIELD-NAME
               MOVE OUT-SSCHR-RESTRICT TO FIELD-VALUE 
               MOVE 36 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           GO TO CREATE-SSREL-LINE-100. 
       CREATE-SSREL-LINE-05.
           IF OUT-FIELD-TYPE IS NOT EQUAL TO "05" 
               GO TO CREATE-SSREL-LINE-EXIT.
           IF OUT-SSCHR-PRELOP IS NOT EQUAL TO SPACE
               MOVE "PRE=" TO FIELD-NAME
               MOVE OUT-SSCHR-PRELOP TO FIELD-VALUE 
               MOVE 7 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           MOVE "ID1=" TO FIELD-NAME. 
           MOVE 5 TO SSREL-START-CHAR-POS.
           IF OUT-SSCHR-LEFT-PAREN IS NOT EQUAL TO ZERO 
               MOVE "(" TO SSREL-FIELD-AREA 
               MOVE 1 TO MAX-FIELD-LEN
               PERFORM VARYING OUT-SSCHR-LEFT-PAREN 
                 FROM OUT-SSCHR-LEFT-PAREN BY -1
                 UNTIL OUT-SSCHR-LEFT-PAREN IS EQUAL TO ZERO
                   PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
               END-PERFORM
           END-IF.
           MOVE OUT-SSCHR-ID1 TO SSREL-FIELD-AREA.
           MOVE 32 TO MAX-FIELD-LEN.
           PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT. 
           IF OUT-SSCHR-A1QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-10 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "A1Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-A1QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           IF OUT-SSCHR-A2QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-10 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "A2Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-A2QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           IF OUT-SSCHR-A3QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-10 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "A3Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-A3QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           IF OUT-SSCHR-A4QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-10 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "A4Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-A4QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           IF OUT-SSCHR-A5QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-10 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "A5Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-A5QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
       CREATE-SSREL-LINE-10.
           IF OUT-SSCHR-SUBSCRIPT1 IS NOT EQUAL TO SPACE
               MOVE OUT-SSCHR-SUBSCRIPT1 TO SSREL-FIELD-AREA
               MOVE 16 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN.
           PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT. 
           IF OUT-SSCHR-A1ID IS NOT EQUAL TO SPACE
             AND OUT-SSCHR-A1ID IS NOT EQUAL TO "0000"
               MOVE "A1I=" TO FIELD-NAME
               MOVE OUT-SSCHR-A1ID TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           MOVE "ID2=" TO FIELD-NAME. 
           MOVE 5 TO SSREL-START-CHAR-POS.
           MOVE OUT-SSCHR-ID2 TO SSREL-FIELD-AREA.
           MOVE 32 TO MAX-FIELD-LEN.
           PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT. 
           IF OUT-SSCHR-B1QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-20 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "B1Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-B1QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           IF OUT-SSCHR-B2QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-20 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "B2Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-B2QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           IF OUT-SSCHR-B3QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-20 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "B3Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-B3QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           IF OUT-SSCHR-B4QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-20 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "B4Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-B4QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           IF OUT-SSCHR-B5QUAL IS EQUAL TO SPACE
               GO TO CREATE-SSREL-LINE-20 
           ELSE 
               MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
               MOVE "B5Q=" TO FIELD-NAME
               MOVE 5 TO SSREL-START-CHAR-POS 
               MOVE OUT-SSCHR-B5QUAL TO SSREL-FIELD-AREA
               MOVE 32 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
       CREATE-SSREL-LINE-20.
           IF OUT-SSCHR-SUBSCRIPT2 IS NOT EQUAL TO SPACE
               MOVE OUT-SSCHR-SUBSCRIPT2 TO SSREL-FIELD-AREA
               MOVE 16 TO MAX-FIELD-LEN 
               PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
           END-IF.
           IF OUT-SSCHR-RIGHT-PAREN IS NOT EQUAL TO ZERO
               MOVE ")" TO SSREL-FIELD-AREA 
               MOVE 1 TO MAX-FIELD-LEN
               PERFORM VARYING OUT-SSCHR-RIGHT-PAREN
                 FROM OUT-SSCHR-RIGHT-PAREN BY -1 
                 UNTIL OUT-SSCHR-RIGHT-PAREN IS EQUAL TO ZERO 
                   PERFORM INSERT-SSREL THRU INSERT-SSREL-EXIT
               END-PERFORM
           END-IF.
           MOVE SSREL-START-CHAR-POS TO MAX-FIELD-LEN.
           PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT. 
           IF OUT-SSCHR-A2ID IS NOT EQUAL TO SPACE
             AND OUT-SSCHR-A2ID IS NOT EQUAL TO "0000"
               MOVE "A2I=" TO FIELD-NAME
               MOVE OUT-SSCHR-A2ID TO FIELD-VALUE 
               MOVE 8 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SSCHR-ROP IS NOT EQUAL TO SPACE 
               MOVE "ROP=" TO FIELD-NAME
               MOVE OUT-SSCHR-ROP TO FIELD-VALUE
               MOVE 6 TO MAX-FIELD-LEN
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
           IF OUT-SSCHR-LOP IS NOT EQUAL TO SPACE 
               MOVE "LOP=" TO FIELD-NAME
               MOVE OUT-SSCHR-LOP TO FIELD-VALUE
               MOVE 10 TO MAX-FIELD-LEN 
               PERFORM INSERT-FIELD THRU INSERT-FIELD-EXIT
           END-IF.
       CREATE-SSREL-LINE-100. 
           SUBTRACT 1 FROM START-CHAR-POS.
           MOVE SPACE TO UPD-TRANS (START-CHAR-POS : 1).
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-SSREL-LINE-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-SS-MD-LINE THRU CREATE-SS-MD-LINE-EXIT
      * 
      *    RECORD (24,450,05) READ.  WRITE CATEGORY LINE
      *    NNNN SSL=XXX 
      *    TO PNCHFIL.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (24,450,05) 
      * 
      *    ON OUTPUT
      *    NNNN SSL=XXX WRITTEN TO PNCHFIL
      * 
      ******************************************************************
  
       CREATE-SS-MD-LINE. 
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE "SSL=" TO UPD-FIELD-NAME. 
           MOVE OUT-SSCHM-SSLFN TO UPD-FIELD-VALUE. 
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-SS-MD-LINE-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-SUBSCHEMA THRU CREATE-SUBSCHEMA-EXIT
      * 
      *    RECORD (24,XXX,YY) READ.  IF XXX=0, CALL CREATE-ADD-TRANS
      *    TO CREATE TRANSACTIONS TO ADD ENTRY AND TO INCLUDE 
      *    CONTROL AND NAMES CATEGORIES IF NECESSARY.  IF XXX IS EQUAL
      *    TO SOME OTHER CATEGORY TYPE, CALL APPROPRIATE SUBROUTINE 
      *    TO PROCESS THAT CATEGORY.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (24,XXX,YY) 
      *    SAVE-CATEGORY = LAST PROCESSED CATEGORY
      * 
      *    ON OUTPUT
      *    PNCHFIL CONTAINS APPROPRIATE TRANSACTIONS
      *    SAVE-CATEGORY = XXX
      * 
      ******************************************************************
  
       CREATE-SUBSCHEMA.
           IF OUT-CATEGORY-TYPE IS EQUAL TO NAME-TYPE 
               MOVE SPACES TO SAVE-CATEGORY 
               PERFORM CREATE-ADD-TRANS THRU CREATE-ADD-TRANS-EXIT
               GO TO CREATE-SUBSCHEMA-EXIT
           END-IF.
           IF SAVE-CATEGORY IS NOT EQUAL TO OUT-CATEGORY-TYPE 
               MOVE ZERO TO CATEGORY-LINE 
               MOVE OUT-CATEGORY-TYPE TO SAVE-CATEGORY
               IF SAVE-CATEGORY IS EQUAL TO COMMENT-TYPE
                   MOVE NAME-CAT TO UPD-TRANS 
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO STRUCTURE-TYPE
                   MOVE STRUCTURE-CAT TO UPD-TRANS
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO MDINFO-TYPE 
                   MOVE MDINFO-CAT TO UPD-TRANS 
               END-IF 
               IF SAVE-CATEGORY IS EQUAL TO SSREL-TYPE
                   MOVE SSREL-CAT TO UPD-TRANS
               END-IF 
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO COMMENT-TYPE
               PERFORM CREATE-COMMENT-LINE THRU CREATE-COMMENT-LINE-EXIT
               GO TO CREATE-SUBSCHEMA-EXIT
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO STRUCTURE-TYPE
               PERFORM CREATE-SUBSCHEMA-STR-LINE
                 THRU CREATE-SUBSCHEMA-STR-LINE-EXIT
               GO TO CREATE-SUBSCHEMA-EXIT
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO MDINFO-TYPE 
               PERFORM CREATE-SS-MD-LINE THRU CREATE-SS-MD-LINE-EXIT
               GO TO CREATE-SUBSCHEMA-EXIT
           END-IF.
           IF SAVE-CATEGORY IS EQUAL TO SSREL-TYPE
               PERFORM CREATE-SSREL-LINE THRU CREATE-SSREL-LINE-EXIT
               GO TO CREATE-SUBSCHEMA-EXIT
           END-IF.
       CREATE-SUBSCHEMA-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    CREATE-SUBSCHEMA-STR-LINE THRU 
      *      CREATE-SUBSCHEMA-STR-LINE-EXIT 
      * 
      *    RECORD (24,300,05) READ.  WRITE CATEGORY LINE
      *    NNNN CAT=XXX 
      *    TO PNCHFIL.
      * 
      *    ON INPUT 
      *    OUT-REC = RECORD (24,300,05) 
      * 
      *    ON OUTPUT
      *    NNNN CAT=XXX WRITTEN TO PNCHFIL
      * 
      ******************************************************************
  
       CREATE-SUBSCHEMA-STR-LINE. 
           MOVE 6 TO START-CHAR-POS.
           ADD 5 TO CATEGORY-LINE.
           MOVE CATEGORY-LINE TO UPD-LINE-NO. 
           MOVE "CAT=" TO UPD-FIELD-NAME. 
           MOVE OUT-SSCHS-CATNAME TO UPD-FIELD-VALUE. 
           PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT. 
       CREATE-SUBSCHEMA-STR-LINE-EXIT.
           EXIT.
  
  
  
*CALL DISPLAYLN 
*CALL WRITELN 
*CALL USERROUT
  
      ******************************************************************
      * 
      *    ENTRY-BREAK THRU ENTRY-BREAK-EXIT
      * 
      *    A BREAK IN ENTRY TYPE HAS OCCURRED.  FORMAT AND PRINT
      *    MESSAGE SPECIFYING COUNT OF PREVIOUS ENTRY TYPE. 
      * 
      *    ON INPUT 
      *    SAVE-ENTRY-TYPE = PREVIOUS ENTRY TYPE
      *    SAVE-ENTRY-NAME = NAME OF PREVIOUS ENTRY TYPE
      *    ENTRY-COUNT = NUMBER OF PREVIOUS ENTRY TYPE ENTITIES 
      * 
      *    ON OUTPUT
      *    SAVE-ENTRY-TYPE = CURRENT ENTRY TYPE 
      *    ENTRY-COUNT = ZERO 
      * 
      ******************************************************************
  
       ENTRY-BREAK. 
           IF SAVE-ENTRY-TYPE IS EQUAL TO SPACE 
               GO TO ENTRY-BREAK-10.
           MOVE SAVE-ENTRY-NAME TO DISP-NAME. 
           MOVE ENTRY-COUNT TO DISP-COUNT.
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           MOVE ENTRY-BREAK-MSG TO STD-REPORT-REC.
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           MOVE MAX-LINES TO LINE-CT. 
       ENTRY-BREAK-10.
           MOVE OUT-ENTRY-TYPE TO SAVE-ENTRY-TYPE.
           MOVE ZERO TO ENTRY-COUNT.
           IF SAVE-ENTRY-TYPE IS EQUAL TO AREA-TYPE 
               MOVE AREA-NAME TO SAVE-ENTRY-NAME. 
           IF SAVE-ENTRY-TYPE IS EQUAL TO SUBSCHEMA-TYPE
               MOVE SUBSCHEMA-NAME TO SAVE-ENTRY-NAME.
           IF SAVE-ENTRY-TYPE IS EQUAL TO SCHEMA-TYPE 
               MOVE SCHEMA-NAME TO SAVE-ENTRY-NAME. 
       ENTRY-BREAK-EXIT.
           EXIT.
  
      ******************************************************************
      * 
      *    INSERT-FIELD THRU INSERT-FIELD-EXIT
      * 
      *    DETERMINE HOW MANY CHARACTERS IN FIELD-AREA TO MOVE BY 
      *    SEARCHING BACKWARDS FROM (MAX-FIELD-LEN)TH CHARACTER UNTIL 
      *    FIRST NONBLANK CHARACTER IS ENCOUNTERED. APPEND COMMA. 
      *    COPY "FIELD-NAME=FIELD-VALUE," FROM FIELD-AREA TO NEXT 
      *    AVAILABLE CHARACTER POSITIONS IN UPD-TRANS.  IF IT 
      *    WILL NOT FIT ON CURRENT LINE, TERMINATE CURRENT LINE WITH
      *    A COMMA, WRITE CURRENT LINE, AND START NEW LINE. 
      * 
      *    ON INPUT 
      *    FIELD-AREA = "FIELD-NAME=FIELD-VALUE"
      *    MAX-FIELD-LEN = MAXIMUM NUMBER OF CHARACTERS TO BE COPIED
      *      FROM FIELD-AREA
      *    START-CHAR-POS = NEXT AVAILABLE CHARACTER POSITION WITHIN
      *      UPD-TRANS
      * 
      *    ON OUTPUT
      *    START-CHAR-POS UPDATED 
      *    FIELD-AREA COPIED TO UPD-TRANS 
      * 
      ******************************************************************
  
       INSERT-FIELD.
           MOVE SPACE TO DONE.
           PERFORM VARYING NUM-CHARS FROM MAX-FIELD-LEN BY -1 
             UNTIL DONE IS EQUAL TO "T" 
               IF FIELD-CHAR (NUM-CHARS) IS NOT EQUAL TO SPACE
                   MOVE "T" TO DONE 
               END-IF 
           END-PERFORM. 
           ADD 2 TO NUM-CHARS.
           MOVE "," TO FIELD-CHAR (NUM-CHARS).
           IF NUM-CHARS + START-CHAR-POS IS GREATER THAN 73 
               PERFORM WRITE-TRANS THRU WRITE-TRANS-EXIT
               MOVE 2 TO START-CHAR-POS 
           END-IF.
           MOVE FIELD-AREA (1 : NUM-CHARS)
             TO UPD-TRANS (START-CHAR-POS : NUM-CHARS). 
           ADD NUM-CHARS, START-CHAR-POS GIVING START-CHAR-POS. 
       INSERT-FIELD-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    INSERT-SSREL THRU INSERT-SSREL-EXIT
      * 
      *    DETERMINE HOW MANY CHARACTERS IN SSREL-FIELD-AREA TO MOVE BY 
      *    SEARCHING BACKWARDS FROM (MAX-FIELD-LEN)TH CHARACTER UNTIL 
      *    FIRST NONBLANK CHARACTER IS ENCOUNTERED. 
      *    COPY SSREL-FIELD-AREA TO NEXT AVAILABLE CHARACTER POSITIONS
      *    IN FIELD-AREA. 
      * 
      *    ON INPUT 
      *    SSREL-FIELD-AREA = FIELD-VALUE 
      *    MAX-FIELD-LEN = MAXIMUM NUMBER OF CHARACTERS TO BE COPIED
      *      FROM SSREL-FIELD-AREA
      *      SSREL-START-CHAR-POS = NEXT AVAILABLE CHARACTER POSITION 
      *      WITHIN FIELD-AREA
      * 
      *    ON OUTPUT
      *    SSREL-START-CHAR-POS UPDATED 
      *    SSREL-FIELD-AREA COPIED TO FIELD-AREA
      * 
      ******************************************************************
  
       INSERT-SSREL.
           MOVE SPACE TO DONE.
           PERFORM VARYING NUM-CHARS FROM MAX-FIELD-LEN BY -1 
             UNTIL DONE IS EQUAL TO "T" 
               IF SSREL-FIELD-CHAR (NUM-CHARS) IS NOT EQUAL TO SPACE
                   MOVE "T" TO DONE 
               END-IF 
           END-PERFORM. 
           ADD 1 TO NUM-CHARS.
           MOVE SSREL-FIELD-AREA (1 : NUM-CHARS)
             TO FIELD-AREA (SSREL-START-CHAR-POS : END).
           ADD NUM-CHARS TO SSREL-START-CHAR-POS. 
       INSERT-SSREL-EXIT. 
           EXIT.
  
      ******************************************************************
      * 
      *    WRITE-TRANS THRU WRITE-TRANS-EXIT
      * 
      *    WRITE UPD-TRANS TO SYSPRINT AND PUNCH-FILE 
      * 
      *    ON OUTPUT
      *    UPD-TRANS = SPACES 
      * 
      ******************************************************************
  
       WRITE-TRANS. 
           MOVE UPD-TRANS TO STD-REPORT-REC.
           PERFORM DISPLAY-LINE THRU DISPLAY-LINE-XIT.
           CALL "PNCHIO". 
           MOVE SPACES TO UPD-TRANS.
       WRITE-TRANS-EXIT.
           EXIT.
