      ***************************************************************
       IDENTIFICATION DIVISION.
      ***************************************************************
       PROGRAM-ID.    P231F92.
       AUTHOR.        B.W. MCNULTY.
       DATE-WRITTEN.  APRIL 01, 1994.
      ***************************************************************
      *                                                             *
      *   PROGRAM:  P231F92 - LOAD/UNLOAD FDAT D231.T231ORG         *
      *                                                             *
      *   SYSTEM:   FDAT - TABLE MAINTENANCE SYSTEM                 *
      *                                                             *
      *   FUNCTION: THIS PROGRAM LOADS/UNLOADS D231.T231ORG.        *
      *                                                             *
      *   LANGUAGE: COBOL II                                        *
      *                                                             *
      *   ENTRY:    BEGINNING OF PROGRAM                            *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   DATABASE TABLES AND FILES:                                *
      *                                                             *
      *       DIST INPUT FILE - 'J112SC.FDAT.MODSTR(ORG)'           *
      *                                                             *
      *       FDAT OUTPUT FILE - 'J231SC.OUTPUT.ORG'                *
      *       FDAT ORG    FILE - 'J231SC.OUTPUT.ORGF'               *
      *                                                             *
      *       OUTPUT DB2 TABLES                                     *
      *            D231.T231ORG                                     *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   CALLED SUBROUTINES:                                       *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   MODIFICATIONS:                                            *
      *                                                             *
      *   DATE      PROGRAMMER     DESCRIPTION                      *
      *   --------  -------------  -------------------------------  *
      *   04/01/94  ABLMSC         ORIGINAL VERSION.                *
      *   --------  -------------  -------------------------------  *
      *                                                             *
      ***************************************************************

       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.

       INPUT-OUTPUT SECTION.

       FILE-CONTROL.

           SELECT  TABLE-INPUT-FILE    ASSIGN TO UT-S-INPUT.
           SELECT  TABLE-OUTPUT-FILE   ASSIGN TO UT-S-OUTPUT.
           SELECT  TABLE-FDATORG-FILE  ASSIGN TO UT-S-FDATORG.

       DATA DIVISION.

       FILE SECTION.

       FD  TABLE-INPUT-FILE
           LABEL RECORDS ARE STANDARD
           RECORDING MODE IS F
           BLOCK CONTAINS 0 RECORDS
           DATA RECORD IS TABLE-INPUT-FILE-RECORD.

       01  TABLE-INPUT-FILE-RECORD      PIC X(80).

       FD  TABLE-OUTPUT-FILE
           LABEL RECORDS ARE STANDARD
           RECORDING MODE IS F
           BLOCK CONTAINS 0 RECORDS
           DATA RECORD IS TABLE-OUTPUT-FILE-RECORD.

       01  TABLE-OUTPUT-FILE-RECORD     PIC X(80).

       FD  TABLE-FDATORG-FILE
           LABEL RECORDS ARE STANDARD
           RECORDING MODE IS F
           BLOCK CONTAINS 0 RECORDS
           DATA RECORD IS TABLE-FDATORG-FILE-RECORD.

       01  TABLE-FDATORG-FILE-RECORD     PIC X(80).

           EJECT
       WORKING-STORAGE SECTION.

       01  FILLER                       PIC X(35) VALUE
           'WORKING STORAGE BEGINS HERE ======>'.

       01  W0001-PROGRAM-INFO.
           05  W0001-PROGRAM-NAME       PIC X(08) VALUE 'P231F92'.
           05  CA-PARAGRAPH-NBR         PIC X(04) VALUE '0000'.

       01  W0000-MISCELLANEOUS-FIELDS.
           05  W0000-INPUT-CTR          PIC S9(09) VALUE ZERO.
           05  W0000-OUTPUT-CTR         PIC S9(09) VALUE ZERO.
           05  W0000-TOTAL-DOLLARS      PIC S9(13)V99 VALUE ZERO.
           05  W0000-OUTPUT-DISPLAY     PIC ZZZ,ZZZ,ZZ9.
           05  W0000-OUTPUT-DOLLARS     PIC ----,---,--9.99.

           05  W0001-A-SEQ-N            PIC S9(09) VALUE ZEROES.
           05  W0000-SEQ-NBR            PIC S9(09) VALUE ZEROES.
           05  W0000-O2-SEQ-NBR         PIC S9(09) VALUE ZEROES.
           05  W0000-PREV-ORG-ID        PIC  X(02) VALUE SPACES.
           05  W0000-PREV-BOOK-ID       PIC  X(04) VALUE SPACES.
           05  W0000-PREV-PRIME         PIC  X(04) VALUE SPACES.
           05  W0000-PREV-COL           PIC  X(03) VALUE SPACES.
           05  W0000-PREV-LINE          PIC  X(03) VALUE SPACES.
           05  W0000-F-COL-NBR          PIC  9(02) VALUE ZEROES.
           05  W0000-F-COL-N            REDEFINES
               W0000-F-COL-NBR          PIC  X(02).

           05  W0000-PREV-RPT-ID        PIC  X(04) VALUE SPACES.
           05  W0000-PARENT-SWITCH      PIC  X(01) VALUE SPACES.
               88  W0000-PARENT-FOUND              VALUE 'Y'.
               88  W0000-NO-PARENT-FOUND           VALUE 'N'.

           05  W0000-END-OF-FILE-SW     PIC  X(01) VALUE 'N'.
               88  W0000-END-OF-FILE               VALUE 'Y'.
               88  W0000-NOT-END-OF-FILE           VALUE 'N'.

           05  W0000-ONLY-PRINT-CORP-SW PIC  X(01) VALUE 'N'.
               88  W0000-ONLY-PRINT-CORP           VALUE 'Y'.
               88  W0000-NOT-CORP                  VALUE 'N'.

           05  W0000-DONT-PRINT-DC-SW   PIC  X(01) VALUE 'N'.
               88  W0000-DONT-PRINT-DC-GROUP       VALUE 'Y'.
               88  W0000-PRINT-DC-GROUP            VALUE 'N'.

           05  W0000-IX                 PIC  S9(04) COMP VALUE +1.
           05  W0000-LIMIT              PIC  S9(04) COMP VALUE +50.

           05  W0000-DFLT-ORGLVL01-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL02-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL03-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL04-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL05-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL06-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL07-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL08-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL09-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL10-C    PIC X(02) VALUE '  '.
           05  W0000-DFLT-ORGLVL11-C    PIC X(04) VALUE '  '.
           05  W0000-DFLT-AFM-C         PIC X(04) VALUE SPACES.
           05  W0000-DFLT-DIV-C1        PIC X(02) VALUE SPACES.
           05  W0000-DFLT-DIV-C2        PIC X(02) VALUE SPACES.

           05  W0000-F-ORGLVL01-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL02-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL03-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL04-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL05-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL06-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL07-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL08-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL09-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL10-C       PIC X(02) VALUE SPACES.
           05  W0000-F-ORGLVL11-C       PIC X(04) VALUE SPACES.

           05  W0000-F-ORG-C            PIC X(02) VALUE 'O1'.
           05  W0000-F-LVL01-C          PIC X(02) VALUE 'SD'.
           05  W0000-F-DIV-C            PIC X(02) VALUE '*2'.
           05  W0000-F-DIV-C2           PIC X(02) VALUE '*4'.
           05  W0000-F-DIV-C3           PIC X(02) VALUE '*5'.
           05  W0000-F-DIV-C4           PIC X(02) VALUE '*9'.
           05  W0000-F-DIV-C5           PIC X(02) VALUE '10'.

           EJECT
      ***************************************************************
      *    INPUT RECORD LAYOUTS                                     *
      ***************************************************************
       01  W0001-INPUT-RECORD                 PIC X(80).

       01  W0001-T231ORG    REDEFINES  W0001-INPUT-RECORD.
           05  W0001-F-ORGID-N                PIC X(02).
           05  FILLER                         PIC X(01).
           05  W0001-F-ORG-C                  PIC X(04).
           05  FILLER                         PIC X(08).
           05  W0001-F-ORG-X                  PIC X(30).
           05  FILLER                         PIC X(01).
           05  W0001-F-ORGID-C                PIC X(04).
           05  FILLER                         PIC X(15).
           05  W0001-F-ORGLVL-C               PIC X(02).
           05  FILLER                         PIC X(02).
           05  W0001-F-PRNT-C                 PIC X(01).

           EJECT
      ***************************************************************
      *    OUTPUT RECORD LAYOUTS                                    *
      ***************************************************************
       01  W0002-OUTPUT-RECORD                PIC X(80).

       01  W0002-T231ORG    REDEFINES  W0002-OUTPUT-RECORD.

           05  W0002-T231ORG-REC-TYPE-00.
               10  W0002-T231ORG-COMMENT-IND PIC X(01).
                   88  W0002-T231ORG-COMMENT-REC        VALUE '/'.
               10  W0002-T231ORG-COMMENT      PIC X(79).

           05  W0002-T231ORG-REC-TYPE-01      REDEFINES
               W0002-T231ORG-REC-TYPE-00.
               10  W0002-F-ORG-C              PIC X(02).
               10  W0002-F-MNEMONIC01-C       PIC X(03).
               10  W0002-F-MNEMONIC02-C       PIC X(03).
               10  W0002-F-MNEMONIC03-C       PIC X(03).
               10  W0002-F-MNEMONIC04-C       PIC X(03).
               10  W0002-F-MNEMONIC05-C       PIC X(03).
               10  W0002-F-MNEMONIC06-C       PIC X(03).
               10  W0002-F-MNEMONIC07-C       PIC X(03).
               10  W0002-F-MNEMONIC08-C       PIC X(03).
               10  W0002-F-MNEMONIC09-C       PIC X(03).
               10  W0002-F-MNEMONIC10-C       PIC X(03).
               10  W0002-F-MNEMONIC11-C       PIC X(03).
               10  FILLER                     PIC X(04).
               10  W0002-F-DFLTAFM-C          PIC X(02).
               10  FILLER                     PIC X(08).
               10  W0002-F-ORG-X              PIC X(31).

           05  W0002-T231ORG-REC-TYPE-02      REDEFINES
               W0002-T231ORG-REC-TYPE-00.
               10  W0002-F-ORG-C-02           PIC X(02).
               10  W0002-F-ORGLVL01-C         PIC X(02).
               10  W0002-ORG-RECTYP-C         PIC X(01).
                   88  W0002-T231ORG-REC-TYPE-2         VALUE ' '.
               10  W0002-F-ORGLVL02-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL03-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL04-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL05-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL06-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL07-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL08-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL09-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL10-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGLVL11-C         PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0002-F-ORGID-C.
                   15  W0002-F-DIV-C          PIC X(02).
                   15  W0002-F-AFM-C          PIC X(02).
               10  W0002-F-PRNT-C             PIC X(01).
               10  W0002-F-DIVAFM01-C.
                   15  W0002-F-DIV01-C        PIC X(02).
                   15  W0002-F-AFM01-C        PIC X(02).
               10  W0002-F-DIVAFM02-C.
                   15  W0002-F-DIV02-C        PIC X(02).
                   15  W0002-F-AFM02-C        PIC X(02).
               10  W0002-F-DIVAFM03-C.
                   15  W0002-F-DIV03-C        PIC X(02).
                   15  W0002-F-AFM03-C        PIC X(02).
               10  W0002-F-ORGLN-X            PIC X(28).

       01  W0002-COMMENT-RECORD.
           05  W0002-COMMENT                  PIC X(01) VALUE '/'.
           05  FILLER                         PIC X(69) VALUE SPACES.
           05  W0002-DATE                     PIC X(10) VALUE SPACES.

       01  W0003-FDATORG-RECORD.
           05  W0003-F-ORG-C                  PIC X(04) VALUE SPACES.
           05  FILLER                         PIC X(08) VALUE SPACES.
           05  W0003-F-ORG-X                  PIC X(30) VALUE SPACES.
           05  FILLER                         PIC X(01) VALUE SPACES.
           05  W0003-F-ORGID-C                PIC X(04) VALUE SPACES.
           05  FILLER                         PIC X(15) VALUE SPACES.
           05  W0003-F-LVL-C                  PIC X(02) VALUE SPACES.
           05  FILLER                         PIC X(15) VALUE SPACES.

       01  W0004-DATE.
           05  W0004-YY                       PIC X(02) VALUE SPACES.
           05  W0004-MM                       PIC X(02) VALUE SPACES.
           05  W0004-DD                       PIC X(02) VALUE SPACES.

       01  W0005-DATE.
           05  W0005-MM                       PIC X(02) VALUE SPACES.
           05  FILLER                         PIC X(01) VALUE '/'.
           05  W0005-DD                       PIC X(02) VALUE SPACES.
           05  FILLER                         PIC X(01) VALUE '/'.
           05  W0005-YY                       PIC X(02) VALUE SPACES.

           EJECT
      ***************************************************************
      *    DB2 ERROR ROUTINE                                        *
      ***************************************************************
           COPY C108W900.

           EJECT
      ***************************************************************
      *    DB2 INCLUDE MEMBERS                                      *
      ***************************************************************
           EXEC SQL
               INCLUDE SQLCA
           END-EXEC.

           EXEC SQL
               INCLUDE T231ORG
           END-EXEC.

           EXEC SQL
               INCLUDE T231ORGF
           END-EXEC.

           EJECT
      ***************************************************************
      *    DB2 CURSORS                                              *
      ***************************************************************

      ***************************************************************
      *    CSR_1 IS FOR ORG TABLE "O1".                             *
      ***************************************************************
           EXEC SQL
                DECLARE CSR_1 CURSOR FOR
                 SELECT F_ORG_C
                      , DB_RECTYP_C
                      , F_ORGID_C
                      , A_SEQ_N
                      , F_ORGLVL_C
                      , F_ORG_X
                      , F_PRNT_C
                   FROM D231.T231ORG
                  WHERE F_ORGID_N  = :DCLT231ORG.F-ORGID-N
                  ORDER BY
                        A_SEQ_N
           END-EXEC.

           EJECT
       LINKAGE SECTION.

       01  PASSED-DATA.
           05  LINK-LENGTH                  PIC  S9(4) COMP.
           05  LINK-ACTION-CODE             PIC  X(06).
           05  LINK-UPDATE-CODE             PIC  X(01).

           EJECT
       PROCEDURE DIVISION USING PASSED-DATA.

       A000-MAIN-LOGIC.

           PERFORM A100-INITIALIZATION.

           IF  LINK-ACTION-CODE = 'LOAD  '
               PERFORM A200-PROCESS-TABLE-INPUT-FILE
                 UNTIL W0000-END-OF-FILE
           ELSE
               IF  LINK-ACTION-CODE = 'UNLOAD'
                   MOVE 'O1' TO F-ORGID-N  IN DCLT231ORG
                   PERFORM B000-CREATE-ORG-TABLE-O1
                   MOVE 'O2' TO F-ORGID-N  IN DCLT231ORG
                   PERFORM C000-CREATE-ORG-TABLE-O2
                   MOVE 'O3' TO F-ORGID-N  IN DCLT231ORG
                   PERFORM D000-CREATE-ORG-TABLE-O3
               ELSE
                   DISPLAY ' #####################################'
                   DISPLAY ' ## INVALID PARM VALUE RECEIVED'
                   DISPLAY ' ## '
                   DISPLAY ' ## PROCESSING WAS TERMINATED'
                   DISPLAY ' ## '
                   DISPLAY ' #####################################'
                   MOVE +666 TO RETURN-CODE
               END-IF
           END-IF.

           PERFORM A300-TERMINATION.

           GOBACK.

           EJECT
       A100-INITIALIZATION.

           MOVE 'A100' TO CA-PARAGRAPH-NBR.

           DISPLAY ' **======================================**'.
           DISPLAY ' **  PROGRAM P231F92 - BEGIN EXECUTION  **'.
           DISPLAY ' **======================================**'.

           DISPLAY ' #############################################'
           DISPLAY ' ## THE PASSED PARM VALUE IS: '
           DISPLAY ' ## '
           DISPLAY ' ##    ACTION-CODE: '  LINK-ACTION-CODE
           DISPLAY ' ## '
           DISPLAY ' #############################################'

           OPEN INPUT  TABLE-INPUT-FILE
                OUTPUT TABLE-OUTPUT-FILE
                       TABLE-FDATORG-FILE.

           IF  LINK-ACTION-CODE = 'LOAD  '
               EXEC SQL
                   DELETE FROM D231.T231ORG
               END-EXEC
               PERFORM Z900-DB2-CHECK
           END-IF.

           IF  LINK-ACTION-CODE = 'UNLOAD'
           AND LINK-UPDATE-CODE = 'X'
               EXEC SQL
                   DELETE FROM D231.T231ORGF
               END-EXEC
               PERFORM Z900-DB2-CHECK
           END-IF.

           ACCEPT W0004-DATE FROM DATE.

           MOVE W0004-YY  TO W0005-YY.
           MOVE W0004-MM  TO W0005-MM.
           MOVE W0004-DD  TO W0005-DD.

           EJECT
       A200-PROCESS-TABLE-INPUT-FILE.

           MOVE 'A200' TO CA-PARAGRAPH-NBR.

           PERFORM A210-READ-DIST-INPUT-RECORD.

           IF  W0000-NOT-END-OF-FILE
               PERFORM A500-PROCESS-T231ORG-RECORD
           END-IF.

           EJECT
       A210-READ-DIST-INPUT-RECORD.

           MOVE 'A210' TO CA-PARAGRAPH-NBR.

           READ TABLE-INPUT-FILE INTO W0001-INPUT-RECORD
               AT END  SET W0000-END-OF-FILE TO TRUE.

           IF  W0000-NOT-END-OF-FILE
               DISPLAY ' INPUT=' W0001-T231ORG
               ADD +1 TO W0000-INPUT-CTR
           END-IF.

           EJECT
       A210-WRITE-OUTPUT-RECORD.

           MOVE 'A210' TO CA-PARAGRAPH-NBR.

           WRITE TABLE-OUTPUT-FILE-RECORD  FROM W0002-OUTPUT-RECORD.

           WRITE TABLE-FDATORG-FILE-RECORD FROM W0002-OUTPUT-RECORD.

      *    DISPLAY ' OUTPUT=' W0002-OUTPUT-RECORD.
           ADD +1 TO W0000-OUTPUT-CTR.

           IF  LINK-UPDATE-CODE = 'X'
               PERFORM A211-INSERT-T231ORGF
           END-IF.

           EJECT
       A211-INSERT-T231ORGF.

           MOVE 'A211' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231ORGF.

           IF  W0001-A-SEQ-N = ZEROES
               PERFORM A212-BUILD-REC-TYPE-1
           ELSE
               PERFORM A213-BUILD-REC-TYPE-2
           END-IF.

           ADD +1 TO W0001-A-SEQ-N.
           MOVE W0001-A-SEQ-N
             TO A-SEQ-N IN DCLT231ORGF

           PERFORM A214-INSERT-T231ORGF-ROW.

           EJECT
       A212-BUILD-REC-TYPE-1.

           MOVE 'A212' TO CA-PARAGRAPH-NBR.

           MOVE W0002-F-ORG-C
             TO F-ORG-C           IN DCLT231ORGF.
           MOVE '1'
             TO DB-RECTYP-C       IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC01-C
             TO F-ORGLVL01-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC02-C
             TO F-ORGLVL02-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC03-C
             TO F-ORGLVL03-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC04-C
             TO F-ORGLVL04-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC05-C
             TO F-ORGLVL05-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC06-C
             TO F-ORGLVL06-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC07-C
             TO F-ORGLVL07-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC08-C
             TO F-ORGLVL08-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC09-C
             TO F-ORGLVL09-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC10-C
             TO F-ORGLVL10-C      IN DCLT231ORGF.
           MOVE W0002-F-MNEMONIC11-C
             TO F-ORGLVL11-C      IN DCLT231ORGF.

           MOVE W0002-F-DFLTAFM-C
             TO F-DFLTAFM-C       IN DCLT231ORGF.
           MOVE W0002-F-ORG-X
             TO F-ORG-X           IN DCLT231ORGF.

           EJECT
       A213-BUILD-REC-TYPE-2.

           MOVE 'A213' TO CA-PARAGRAPH-NBR.

           MOVE W0002-F-ORG-C
             TO F-ORG-C           IN DCLT231ORGF.
           MOVE '2'
             TO DB-RECTYP-C       IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL01-C
             TO F-ORGLVL01-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL02-C
             TO F-ORGLVL02-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL03-C
             TO F-ORGLVL03-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL04-C
             TO F-ORGLVL04-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL05-C
             TO F-ORGLVL05-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL06-C
             TO F-ORGLVL06-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL07-C
             TO F-ORGLVL07-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL08-C
             TO F-ORGLVL08-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL09-C
             TO F-ORGLVL09-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL10-C
             TO F-ORGLVL10-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLVL11-C
             TO F-ORGLVL11-C      IN DCLT231ORGF.

           MOVE W0002-F-ORGID-C
             TO F-ORGID-C         IN DCLT231ORGF.
           MOVE W0002-F-PRNT-C
             TO F-PRNT-C          IN DCLT231ORGF.
           MOVE W0002-F-DIVAFM01-C
             TO F-DIVAFM01-C      IN DCLT231ORGF.
           MOVE W0002-F-DIVAFM02-C
             TO F-DIVAFM02-C      IN DCLT231ORGF.
           MOVE W0002-F-DIVAFM03-C
             TO F-DIVAFM03-C      IN DCLT231ORGF.
           MOVE W0002-F-ORGLN-X
             TO F-ORG-X           IN DCLT231ORGF.

           EJECT
       A214-INSERT-T231ORGF-ROW.

           MOVE 'A214' TO CA-PARAGRAPH-NBR.

           EXEC SQL
               INSERT INTO D231.T231ORGF
                   ( F_ORG_C
                   , DB_RECTYP_C
                   , F_ORGLVL01_C
                   , F_ORGLVL02_C
                   , F_ORGLVL03_C
                   , F_ORGLVL04_C
                   , F_ORGLVL05_C
                   , F_ORGLVL06_C
                   , F_ORGLVL07_C
                   , F_ORGLVL08_C
                   , F_ORGLVL09_C
                   , F_ORGLVL10_C
                   , F_ORGLVL11_C
                   , A_SEQ_N
                   , F_CMNT_I
                   , F_DFLTAFM_C
                   , F_ORGID_C
                   , F_PRNT_C
                   , F_DIVAFM01_C
                   , F_DIVAFM02_C
                   , F_DIVAFM03_C
                   , F_ORG_X
                   , DB_UPD_D
                   , DB_UPD_T )
               VALUES
                   ( :DCLT231ORGF.F-ORG-C
                   , :DCLT231ORGF.DB-RECTYP-C
                   , :DCLT231ORGF.F-ORGLVL01-C
                   , :DCLT231ORGF.F-ORGLVL02-C
                   , :DCLT231ORGF.F-ORGLVL03-C
                   , :DCLT231ORGF.F-ORGLVL04-C
                   , :DCLT231ORGF.F-ORGLVL05-C
                   , :DCLT231ORGF.F-ORGLVL06-C
                   , :DCLT231ORGF.F-ORGLVL07-C
                   , :DCLT231ORGF.F-ORGLVL08-C
                   , :DCLT231ORGF.F-ORGLVL09-C
                   , :DCLT231ORGF.F-ORGLVL10-C
                   , :DCLT231ORGF.F-ORGLVL11-C
                   , :DCLT231ORGF.A-SEQ-N
                   , :DCLT231ORGF.F-CMNT-I
                   , :DCLT231ORGF.F-DFLTAFM-C
                   , :DCLT231ORGF.F-ORGID-C
                   , :DCLT231ORGF.F-PRNT-C
                   , :DCLT231ORGF.F-DIVAFM01-C
                   , :DCLT231ORGF.F-DIVAFM02-C
                   , :DCLT231ORGF.F-DIVAFM03-C
                   , :DCLT231ORGF.F-ORG-X
                   , CURRENT DATE
                   , CURRENT TIME )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A211-WRITE-COMMENT-RECORD.

           MOVE 'A211' TO CA-PARAGRAPH-NBR.

           IF  W0000-NOT-CORP
               WRITE TABLE-OUTPUT-FILE-RECORD
                   FROM W0002-COMMENT-RECORD
               WRITE TABLE-FDATORG-FILE-RECORD
                   FROM W0002-COMMENT-RECORD
      *        DISPLAY ' OUTPUT=' W0002-COMMENT-RECORD
           END-IF.

           EJECT
       A300-TERMINATION.

           MOVE 'A300' TO CA-PARAGRAPH-NBR.

           CLOSE TABLE-INPUT-FILE
                 TABLE-OUTPUT-FILE
                 TABLE-FDATORG-FILE.

           MOVE W0000-INPUT-CTR TO W0000-OUTPUT-DISPLAY.
           DISPLAY '   # OF RECORDS READ    :' W0000-OUTPUT-DISPLAY.

           MOVE W0000-OUTPUT-CTR TO W0000-OUTPUT-DISPLAY.
           DISPLAY '   # OF RECORDS INSERTED:' W0000-OUTPUT-DISPLAY.

           DISPLAY ' **======================================**'.
           DISPLAY ' **  PROGRAM P231F92 - END EXECUTION     **'.
           DISPLAY ' **======================================**'.

           EJECT
       A500-PROCESS-T231ORG-RECORD.

           MOVE 'A500' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231ORG.

           PERFORM A600-BUILD-REC-TYPE-2.

           PERFORM A700-INSERT-T231ORG.

           EJECT
       A600-BUILD-REC-TYPE-2.

           MOVE 'A600' TO CA-PARAGRAPH-NBR.

           IF  W0001-F-ORGID-N NOT EQUAL W0000-PREV-ORG-ID
               MOVE ZEROES TO W0000-SEQ-NBR
           END-IF.

           MOVE W0001-F-ORGID-N
             TO F-ORGID-N         IN DCLT231ORG
                W0000-PREV-ORG-ID.
           MOVE W0001-F-ORG-C
             TO F-ORG-C           IN DCLT231ORG.
           MOVE '1'
             TO DB-RECTYP-C       IN DCLT231ORG.
           ADD +1 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231ORG.
           MOVE W0001-F-ORGID-C
             TO F-ORGID-C         IN DCLT231ORG.
           MOVE W0001-F-ORGLVL-C
             TO F-ORGLVL-C        IN DCLT231ORG.
           MOVE W0001-F-ORG-X
             TO F-ORG-X           IN DCLT231ORG.
           MOVE W0001-F-PRNT-C
             TO F-PRNT-C          IN DCLT231ORG.

           EJECT
       A700-INSERT-T231ORG.

           MOVE 'A700' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231ORG
                 ( F_ORGID_N
                 , F_ORG_C
                 , DB_RECTYP_C
                 , F_ORGID_C
                 , A_SEQ_N
                 , F_ORGLVL_C
                 , F_ORG_X
                 , F_PRNT_C
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231ORG.F-ORGID-N
                 , :DCLT231ORG.F-ORG-C
                 , :DCLT231ORG.DB-RECTYP-C
                 , :DCLT231ORG.F-ORGID-C
                 , :DCLT231ORG.A-SEQ-N
                 , :DCLT231ORG.F-ORGLVL-C
                 , :DCLT231ORG.F-ORG-X
                 , :DCLT231ORG.F-PRNT-C
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               ADD +1 TO W0000-OUTPUT-CTR
           END-IF.

           EJECT
       B000-CREATE-ORG-TABLE-O1.

           MOVE 'B000' TO CA-PARAGRAPH-NBR.

           INITIALIZE W0002-OUTPUT-RECORD.

      **************************************************************
      **   CREATE ORG HEADER                                      **
      **************************************************************
           MOVE W0005-DATE  TO W0002-DATE.
           PERFORM A211-WRITE-COMMENT-RECORD.
           MOVE SPACES      TO W0002-DATE.

           MOVE 'O1'    TO W0002-F-ORG-C
           MOVE 'TOT'   TO W0002-F-MNEMONIC01-C
           MOVE 'SDV'   TO W0002-F-MNEMONIC02-C
           MOVE 'DIV'   TO W0002-F-MNEMONIC03-C
           MOVE 'GRP'   TO W0002-F-MNEMONIC04-C
           MOVE 'SAG'   TO W0002-F-MNEMONIC05-C
           MOVE 'GAG'   TO W0002-F-MNEMONIC06-C
           MOVE 'DIR'   TO W0002-F-MNEMONIC07-C
           MOVE 'SKG'   TO W0002-F-MNEMONIC08-C
           MOVE 'KLG'   TO W0002-F-MNEMONIC09-C
           MOVE 'FKG'   TO W0002-F-MNEMONIC10-C
           MOVE 'FAM'   TO W0002-F-MNEMONIC11-C
           MOVE '99'    TO W0002-F-DFLTAFM-C
           MOVE '(O1) - O1SD AND O1TC * STANDARD'
             TO W0002-F-ORG-X

           PERFORM A210-WRITE-OUTPUT-RECORD.
           ADD +1 TO W0000-INPUT-CTR.

      **************************************************************
      **   CREATE O1 SD *2                                        **
      **************************************************************
           PERFORM A211-WRITE-COMMENT-RECORD.

           MOVE 'NSSD'  TO W0000-DFLT-AFM-C.
           MOVE 'SD'    TO W0000-F-LVL01-C.
           MOVE '01'    TO W0000-DFLT-DIV-C1
           MOVE '02'    TO W0000-DFLT-DIV-C2
           MOVE '*2'    TO W0000-F-DIV-C
           MOVE '*4'    TO W0000-F-DIV-C2
           MOVE '*5'    TO W0000-F-DIV-C3
           MOVE '*9'    TO W0000-F-DIV-C4
           MOVE '10'    TO W0000-F-DIV-C5
           PERFORM B001-PROCESS-T231ORG-CURSOR.

      **************************************************************
      **   CREATE O1 TC 01                                        **
      **************************************************************
           PERFORM A211-WRITE-COMMENT-RECORD.

           MOVE 'TOTC'  TO W0000-DFLT-AFM-C.
           MOVE 'TC'    TO W0000-F-LVL01-C.
           MOVE '01'    TO W0000-DFLT-DIV-C1
           MOVE '  '    TO W0000-DFLT-DIV-C2
           MOVE '01'    TO W0000-F-DIV-C
           MOVE '04'    TO W0000-F-DIV-C2
           MOVE '05'    TO W0000-F-DIV-C3
           MOVE '09'    TO W0000-F-DIV-C4
           MOVE '10'    TO W0000-F-DIV-C5
           SET W0000-DONT-PRINT-DC-GROUP TO TRUE.
           PERFORM B001-PROCESS-T231ORG-CURSOR.
           SET W0000-PRINT-DC-GROUP TO TRUE.

      **************************************************************
      **   CREATE O1 TC 02                                        **
      **************************************************************
           PERFORM A211-WRITE-COMMENT-RECORD.

           MOVE 'TC'    TO W0000-F-LVL01-C.
           MOVE '02'    TO W0000-DFLT-DIV-C1
           MOVE '  '    TO W0000-DFLT-DIV-C2
           MOVE '02'    TO W0000-F-DIV-C
           MOVE '04'    TO W0000-F-DIV-C2
           MOVE '05'    TO W0000-F-DIV-C3
           MOVE '09'    TO W0000-F-DIV-C4
           MOVE '11'    TO W0000-F-DIV-C5
           PERFORM B001-PROCESS-T231ORG-CURSOR.

      **************************************************************
      **   CREATE O1 TC 99                                        **
      **************************************************************
           PERFORM A211-WRITE-COMMENT-RECORD.

           SET W0000-ONLY-PRINT-CORP TO TRUE.

           MOVE 'TC'    TO W0000-F-LVL01-C.
           MOVE '99'    TO W0000-DFLT-DIV-C1
           MOVE '  '    TO W0000-DFLT-DIV-C2
           MOVE '99'    TO W0000-F-DIV-C
           MOVE '  '    TO W0000-F-DIV-C2
           MOVE '  '    TO W0000-F-DIV-C3
           MOVE '99'    TO W0000-F-DIV-C4
           MOVE '  '    TO W0000-F-DIV-C5
           PERFORM B001-PROCESS-T231ORG-CURSOR.

           SET W0000-NOT-CORP        TO TRUE.

           EJECT
       B001-PROCESS-T231ORG-CURSOR.

           MOVE 'B001' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                OPEN CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_1
                     INTO :DCLT231ORG.F-ORG-C
                        , :DCLT231ORG.DB-RECTYP-C
                        , :DCLT231ORG.F-ORGID-C
                        , :DCLT231ORG.A-SEQ-N
                        , :DCLT231ORG.F-ORGLVL-C
                        , :DCLT231ORG.F-ORG-X
                        , :DCLT231ORG.F-PRNT-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0002-OUTPUT-RECORD

                   PERFORM B100-DETERMINE-LEVEL-NBR

                   IF (F-ORGLVL-C IN DCLT231ORG  = '01'
                   AND W0000-F-DIV-C             = '02')

                   OR (W0000-ONLY-PRINT-CORP
                   AND W0002-F-ORGLVL03-C    NOT = '99')

                   OR (W0000-DONT-PRINT-DC-GROUP
                   AND W0002-F-ORGLVL03-C        = '10')

                   OR (W0002-F-ORGLVL01-C        = 'TC'
                   AND W0002-F-ORGLVL02-C        = '01'
                   AND W0002-F-ORGLVL03-C        = '09'
                   AND W0002-F-ORGLVL11-C        = 'TR')

                   OR (W0002-F-ORGLVL01-C        = 'TC'
                   AND W0002-F-ORGLVL02-C        = '02'
                   AND W0002-F-ORGLVL03-C        = '09'
                   AND W0002-F-ORGLVL11-C        = 'TR')

                   OR (W0002-F-ORGLVL01-C        = 'MI'
                   AND W0002-F-ORGLVL02-C        = '  '
                   AND W0002-F-ORGLVL03-C        = '*9'
                   AND W0002-F-ORGLVL11-C        = 'TR')

      *      THIS PART IS TO KILL THE CONTLER BASED SYS STUFF.

                   OR ((W0002-F-ORGLVL01-C        = 'TC'
                   AND  W0002-F-ORGLVL02-C        = '01'
                   AND  W0002-F-ORGLVL03-C        = '09')
                   AND (W0002-F-ORGLVL11-C        = '10'
                    OR  W0002-F-ORGLVL11-C        = '11'
                    OR  W0002-F-ORGLVL11-C        = '7A'
                    OR  W0002-F-ORGLVL11-C        = '3A'
                    OR  W0002-F-ORGLVL11-C        = '3B'
                    OR  W0002-F-ORGLVL11-C        = '3C'))

                   OR ((W0002-F-ORGLVL01-C        = 'TC'
                   AND  W0002-F-ORGLVL02-C        = '02'
                   AND  W0002-F-ORGLVL03-C        = '09')
                   AND (W0002-F-ORGLVL11-C        = '10'
                    OR  W0002-F-ORGLVL11-C        = '11'
                    OR  W0002-F-ORGLVL11-C        = '7A'
                    OR  W0002-F-ORGLVL11-C        = '3A'
                    OR  W0002-F-ORGLVL11-C        = '3B'
                    OR  W0002-F-ORGLVL11-C        = '3C'))

                       CONTINUE
                   ELSE

                       PERFORM A210-WRITE-OUTPUT-RECORD
                       ADD +1 TO W0000-INPUT-CTR
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       B100-DETERMINE-LEVEL-NBR.

           MOVE 'B100' TO CA-PARAGRAPH-NBR.

           SET W0000-NO-PARENT-FOUND TO TRUE.

           MOVE W0000-F-ORG-C
             TO W0002-F-ORG-C-02.
           MOVE F-ORG-X  IN DCLT231ORG
             TO W0002-F-ORGLN-X.
           MOVE F-PRNT-C IN DCLT231ORG
             TO W0002-F-PRNT-C.

           EVALUATE F-ORGLVL-C IN DCLT231ORG
               WHEN '01 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL01-C
                         W0002-F-ORGLVL01-C
                         W0002-F-DIV-C
                    MOVE W0000-DFLT-AFM-C
                      TO W0002-F-ORGID-C

                    IF  W0000-F-LVL01-C  = 'MI'
                        MOVE 'MIL-AERO'
                          TO W0002-F-ORGLN-X
                        MOVE '01'
                         TO W0002-F-DIV01-C
                    END-IF

                    MOVE SPACES TO
                         W0000-F-ORGLVL02-C
                         W0000-F-ORGLVL03-C
                         W0000-F-ORGLVL04-C
                         W0000-F-ORGLVL05-C
                         W0000-F-ORGLVL06-C
                         W0000-F-ORGLVL07-C
                         W0000-F-ORGLVL08-C
                         W0000-F-ORGLVL09-C
                         W0000-F-ORGLVL10-C
                         W0000-F-ORGLVL11-C
               WHEN '02 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL02-C
                         W0002-F-ORGLVL02-C
                         W0002-F-DIV-C
                    IF  F-ORG-C IN DCLT231ORG = 'CS'
                        MOVE W0000-F-DIV-C
                          TO W0002-F-ORGLVL02-C
                        IF  W0000-F-DIV-C = '01'
                            MOVE 'MIL-AERO'
                              TO W0002-F-ORGLN-X
                        END-IF
                        IF  W0000-F-DIV-C = '02'
                            MOVE 'COMMERCIAL'
                              TO W0002-F-ORGLN-X
                        END-IF
                    END-IF
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B101-CHECK-LVL-01
      *
      *       PUT OUT THE DIVISION FOR THE BALANCE SHEET REPORTS
      *
                    IF  W0000-F-DIV-C = '*2'
                        MOVE '01'
                         TO W0002-F-DIV01-C
                        MOVE '02'
                         TO W0002-F-DIV02-C
                        MOVE '99'
                         TO W0002-F-DIV03-C
                    END-IF
                    IF  W0000-F-DIV-C = '01'
                        MOVE '01'
                         TO W0002-F-DIV01-C
                    END-IF
                    IF  W0000-F-DIV-C = '02'
                        MOVE '02'
                         TO W0002-F-DIV01-C
                    END-IF
                    IF  W0000-F-DIV-C = '99'
                        MOVE '99'
                         TO W0002-F-DIV01-C
                    END-IF
               WHEN '03 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    IF  F-ORG-C IN DCLT231ORG = 'DC'
                        IF  W0000-F-DIV-C5 = '10'
                            MOVE '10'  TO W0000-F-DIV-C
                                          W0000-DFLT-DIV-C1
                        END-IF
                        IF  W0000-F-DIV-C5 = '11'
                            MOVE '11'  TO W0000-F-DIV-C
                            MOVE '10'  TO W0000-DFLT-DIV-C1
                        END-IF
                        IF  W0000-F-DIV-C5 = '1*'
                            MOVE '1*'  TO W0000-F-DIV-C
                            MOVE '10'  TO W0000-DFLT-DIV-C1
                        END-IF
                    END-IF
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL03-C
                         W0002-F-ORGLVL03-C
                         W0002-F-DIV-C

                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
      *
      *       PUT OUT THE DIVISION FOR THE BALANCE SHEET REPORTS
      *       (ONLY FOR OTHER STUFF)
      *
                    IF  W0002-F-ORGLVL02-C = SPACES
                        IF  F-ORG-C IN DCLT231ORG = 'DC'
                            MOVE '10'
                             TO W0002-F-DIV01-C
                        END-IF
                        IF  F-ORG-C IN DCLT231ORG = 'CP'
                        AND W0000-F-DIV-C         = '99'
                            MOVE '99'
                             TO W0002-F-DIV01-C
                        END-IF
                    END-IF
               WHEN '04 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL04-C
                         W0002-F-ORGLVL04-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '05 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL05-C
                         W0002-F-ORGLVL05-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '06 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL06-C
                         W0002-F-ORGLVL06-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '07 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL07-C
                         W0002-F-ORGLVL07-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '08 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL08-C
                         W0002-F-ORGLVL08-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '09 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL09-C
                         W0002-F-ORGLVL09-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B108-CHECK-LVL-08
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '10 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL10-C
                         W0002-F-ORGLVL10-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B109-CHECK-LVL-09
                    PERFORM B108-CHECK-LVL-08
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '11 '
                    IF  F-ORG-C   IN DCLT231ORG (3:2) = 'D9'
                        MOVE '99' TO F-ORG-C   IN DCLT231ORG (3:2)
                    END-IF
                    MOVE F-ORG-C   IN DCLT231ORG (3:2)
                      TO W0000-F-ORGLVL11-C
                         W0002-F-ORGLVL11-C
                         W0002-F-AFM-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-DIV-C
                    PERFORM B110-CHECK-LVL-10
                    PERFORM B109-CHECK-LVL-09
                    PERFORM B108-CHECK-LVL-08
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
           END-EVALUATE.

      *
      *      DETERMINE THE ORG LEVEL OVERRIDES
      *
           EVALUATE TRUE
               WHEN W0002-F-ORGLVL02-C  = 'CS'
                    MOVE W0000-F-DIV-C
                      TO W0002-F-ORGLVL02-C
               WHEN W0002-F-ORGLVL03-C  = 'IV'
                    MOVE W0000-F-DIV-C2
                      TO W0002-F-ORGLVL03-C
                    IF  W0000-F-DIV-C = '01' OR '02'
                        MOVE W0000-F-DIV-C
                          TO W0002-F-ORGLVL02-C
                    END-IF
               WHEN W0002-F-ORGLVL03-C  = 'CN'
                    MOVE W0000-F-DIV-C3
                      TO W0002-F-ORGLVL03-C
                    IF  W0000-F-DIV-C = '01' OR '02'
                        MOVE W0000-F-DIV-C
                          TO W0002-F-ORGLVL02-C
                    END-IF
               WHEN W0002-F-ORGLVL03-C  = 'CP'
                    MOVE W0000-F-DIV-C4
                      TO W0002-F-ORGLVL03-C
                    IF  W0000-F-DIV-C = '01' OR '02'
                        MOVE W0000-F-DIV-C
                          TO W0002-F-ORGLVL02-C
                    END-IF
               WHEN W0002-F-ORGLVL03-C  = 'DC'
                    MOVE '10'
                      TO W0002-F-ORGLVL03-C
                    MOVE SPACES
                      TO W0000-DFLT-DIV-C2
           END-EVALUATE.

           MOVE W0000-F-LVL01-C
             TO W0002-F-ORGLVL01-C.

      *
      *      DETERMINE WHICH DEFAULT FAMILIES TO PRINT
      *
           IF  W0002-F-ORGLVL11-C > SPACES
               IF  W0000-DFLT-DIV-C1 > SPACES
                   MOVE W0000-DFLT-DIV-C1
                     TO W0002-F-DIV01-C
                   MOVE W0002-F-ORGLVL11-C
                     TO W0002-F-AFM01-C
               END-IF
               IF  W0000-DFLT-DIV-C2 > SPACES
                   MOVE W0000-DFLT-DIV-C2
                     TO W0002-F-DIV02-C
                   MOVE W0002-F-ORGLVL11-C
                     TO W0002-F-AFM02-C
               END-IF
               IF  W0000-F-DIV-C = '*2'
                   IF (W0002-F-ORGLVL11-C = '99' OR '6X')
                   AND W0002-F-ORGLVL03-C = '*9'
                       MOVE '99'
                         TO W0002-F-DIV03-C
                       MOVE W0002-F-ORGLVL11-C
                         TO W0002-F-AFM03-C
                   END-IF
               END-IF
               IF  W0002-F-ORGLVL11-C = 'TR'
                   MOVE '99'
                     TO W0002-F-DIV01-C
                   MOVE W0002-F-ORGLVL11-C
                     TO W0002-F-AFM01-C
                   MOVE SPACES
                     TO W0002-F-DIV02-C
                        W0002-F-AFM02-C
                        W0002-F-DIV03-C
                        W0002-F-AFM03-C
               END-IF
           END-IF.

      *
      *      OVERRIDE THE CORPORATE DIVISION 13 CODES
      *
           IF (W0002-F-ORGLVL01-C NOT EQUAL 'MI')
           AND (W0002-F-ORGLVL03-C = '*9'
             OR W0002-F-ORGLVL03-C = '99')
               IF (W0002-F-ORGLVL11-C = '10'
               OR  W0002-F-ORGLVL11-C = '11'
               OR  W0002-F-ORGLVL11-C = '7A'
               OR  W0002-F-ORGLVL11-C = '3A'
               OR  W0002-F-ORGLVL11-C = '3B'
               OR  W0002-F-ORGLVL11-C = '3C')
               IF  W0000-DFLT-DIV-C1 > SPACES
                   MOVE '13'
                     TO W0002-F-DIV01-C
                   MOVE SPACES
                     TO W0002-F-DIV02-C
                        W0002-F-AFM02-C
               END-IF
           END-IF.

           EJECT
       B101-CHECK-LVL-01.

           MOVE 'B101' TO CA-PARAGRAPH-NBR.

           IF  W0000-F-ORGLVL01-C > SPACES
               MOVE W0000-F-ORGLVL01-C
                 TO W0002-F-ORGLVL01-C
               SET W0000-PARENT-FOUND TO TRUE
           ELSE
               MOVE W0000-DFLT-ORGLVL01-C
                 TO W0002-F-ORGLVL01-C
           END-IF.

           EJECT
       B102-CHECK-LVL-02.

           MOVE 'B102' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL02-C > SPACES
                   MOVE W0000-F-ORGLVL02-C
                     TO W0002-F-ORGLVL02-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL02-C
                     TO W0002-F-ORGLVL02-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL02-C
                   MOVE W0000-F-ORGLVL02-C
                     TO W0002-F-ORGLVL02-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL02-C
                        W0000-F-ORGLVL02-C
               END-IF
           END-IF.

           EJECT
       B103-CHECK-LVL-03.

           MOVE 'B103' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL03-C > SPACES
                   MOVE W0000-F-ORGLVL03-C
                     TO W0002-F-ORGLVL03-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL03-C
                     TO W0002-F-ORGLVL03-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL03-C
                   MOVE W0000-F-ORGLVL03-C
                     TO W0002-F-ORGLVL03-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL03-C
                        W0000-F-ORGLVL03-C
               END-IF
           END-IF.
           EJECT
       B104-CHECK-LVL-04.

           MOVE 'B104' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL04-C > SPACES
                   MOVE W0000-F-ORGLVL04-C
                     TO W0002-F-ORGLVL04-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL04-C
                     TO W0002-F-ORGLVL04-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL04-C
                   MOVE W0000-F-ORGLVL04-C
                     TO W0002-F-ORGLVL04-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL04-C
                        W0000-F-ORGLVL04-C
               END-IF
           END-IF.

           EJECT
       B105-CHECK-LVL-05.

           MOVE 'B105' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL05-C > SPACES
                   MOVE W0000-F-ORGLVL05-C
                     TO W0002-F-ORGLVL05-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL05-C
                     TO W0002-F-ORGLVL05-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL05-C
                   MOVE W0000-F-ORGLVL05-C
                     TO W0002-F-ORGLVL05-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL05-C
                        W0000-F-ORGLVL05-C
               END-IF
           END-IF.

           EJECT
       B106-CHECK-LVL-06.

           MOVE 'B106' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL06-C > SPACES
                   MOVE W0000-F-ORGLVL06-C
                     TO W0002-F-ORGLVL06-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL06-C
                     TO W0002-F-ORGLVL06-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL06-C
                   MOVE W0000-F-ORGLVL06-C
                     TO W0002-F-ORGLVL06-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL06-C
                        W0000-F-ORGLVL06-C
               END-IF
           END-IF.

           EJECT
       B107-CHECK-LVL-07.

           MOVE 'B107' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL07-C > SPACES
                   MOVE W0000-F-ORGLVL07-C
                     TO W0002-F-ORGLVL07-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL07-C
                     TO W0002-F-ORGLVL07-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL07-C
                   MOVE W0000-F-ORGLVL07-C
                     TO W0002-F-ORGLVL07-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL07-C
                        W0000-F-ORGLVL07-C
               END-IF
           END-IF.

           EJECT
       B108-CHECK-LVL-08.

           MOVE 'B108' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL08-C > SPACES
                   MOVE W0000-F-ORGLVL08-C
                     TO W0002-F-ORGLVL08-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL08-C
                     TO W0002-F-ORGLVL08-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL08-C
                   MOVE W0000-F-ORGLVL08-C
                     TO W0002-F-ORGLVL08-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL08-C
                        W0000-F-ORGLVL08-C
               END-IF
           END-IF.

           EJECT
       B109-CHECK-LVL-09.

           MOVE 'B109' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL09-C > SPACES
                   MOVE W0000-F-ORGLVL09-C
                     TO W0002-F-ORGLVL09-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL09-C
                     TO W0002-F-ORGLVL09-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL09-C
                   MOVE W0000-F-ORGLVL09-C
                     TO W0002-F-ORGLVL09-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL09-C
                        W0000-F-ORGLVL09-C
               END-IF
           END-IF.

           EJECT
       B110-CHECK-LVL-10.

           MOVE 'B110' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL10-C > SPACES
                   MOVE W0000-F-ORGLVL10-C
                     TO W0002-F-ORGLVL10-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL10-C
                     TO W0002-F-ORGLVL10-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL10-C
                   MOVE W0000-F-ORGLVL10-C
                     TO W0002-F-ORGLVL10-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL10-C
                        W0000-F-ORGLVL10-C
               END-IF
           END-IF.

           EJECT
       B111-CHECK-LVL-11.

           MOVE 'B111' TO CA-PARAGRAPH-NBR.

           IF  W0000-PARENT-FOUND
               IF  W0000-F-ORGLVL11-C > SPACES
                   MOVE W0000-F-ORGLVL11-C
                     TO W0002-F-ORGLVL11-C
               ELSE
                   MOVE W0000-DFLT-ORGLVL11-C
                     TO W0002-F-ORGLVL11-C
               END-IF
           ELSE
               IF  F-ORGID-C  IN DCLT231ORG = W0000-F-ORGLVL11-C
                   MOVE W0000-F-ORGLVL11-C
                     TO W0002-F-ORGLVL11-C
                   SET W0000-PARENT-FOUND TO TRUE
               ELSE
                   MOVE SPACES
                     TO W0002-F-ORGLVL11-C
                        W0000-F-ORGLVL11-C
               END-IF
           END-IF.

           EJECT
       C000-CREATE-ORG-TABLE-O2.

           MOVE 'C000' TO CA-PARAGRAPH-NBR.

           INITIALIZE W0002-OUTPUT-RECORD.

      **************************************************************
      **   CREATE ORG HEADER                                      **
      **************************************************************
           PERFORM A211-WRITE-COMMENT-RECORD.
           PERFORM A211-WRITE-COMMENT-RECORD.

           MOVE 'O2'    TO W0002-F-ORG-C
           MOVE 'TOT'   TO W0002-F-MNEMONIC01-C
           MOVE 'SDV'   TO W0002-F-MNEMONIC02-C
           MOVE 'DIV'   TO W0002-F-MNEMONIC03-C
           MOVE 'GRP'   TO W0002-F-MNEMONIC04-C
           MOVE 'SAG'   TO W0002-F-MNEMONIC05-C
           MOVE 'GAG'   TO W0002-F-MNEMONIC06-C
           MOVE 'DIR'   TO W0002-F-MNEMONIC07-C
           MOVE 'SKG'   TO W0002-F-MNEMONIC08-C
           MOVE 'KLG'   TO W0002-F-MNEMONIC09-C
           MOVE 'FKG'   TO W0002-F-MNEMONIC10-C
           MOVE 'FAM'   TO W0002-F-MNEMONIC11-C
           MOVE '99'    TO W0002-F-DFLTAFM-C
           MOVE '(O2) - ASIC ORGANIZATION'
             TO W0002-F-ORG-X

           PERFORM A210-WRITE-OUTPUT-RECORD.
           ADD +1 TO W0000-INPUT-CTR.

      **************************************************************
      **   CREATE O2                                              **
      **************************************************************
           PERFORM A211-WRITE-COMMENT-RECORD.

           MOVE 'O2'    TO W0000-F-ORG-C.

           MOVE 'ASIT'  TO W0000-DFLT-AFM-C.
           MOVE 'O2'    TO W0000-F-LVL01-C.
           MOVE '01'    TO W0000-DFLT-DIV-C1
           MOVE '02'    TO W0000-DFLT-DIV-C2
           MOVE '01'    TO W0000-F-DIV-C
           MOVE '  '    TO W0000-F-DIV-C2
           MOVE '  '    TO W0000-F-DIV-C3
           MOVE '  '    TO W0000-F-DIV-C4
           MOVE '  '    TO W0000-F-DIV-C5
           PERFORM C001-PROCESS-T231ORG-CURSOR.

           EJECT
       C001-PROCESS-T231ORG-CURSOR.

           MOVE 'C001' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                OPEN CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_1
                     INTO :DCLT231ORG.F-ORG-C
                        , :DCLT231ORG.DB-RECTYP-C
                        , :DCLT231ORG.F-ORGID-C
                        , :DCLT231ORG.A-SEQ-N
                        , :DCLT231ORG.F-ORGLVL-C
                        , :DCLT231ORG.F-ORG-X
                        , :DCLT231ORG.F-PRNT-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0002-OUTPUT-RECORD

                   IF  F-ORG-C    IN DCLT231ORG = 'O2'
                   AND F-ORGLVL-C IN DCLT231ORG = '01'
                       CONTINUE
                   ELSE
                       PERFORM C100-DETERMINE-LEVEL-NBR

                       PERFORM A210-WRITE-OUTPUT-RECORD
                       ADD +1 TO W0000-INPUT-CTR
                   END-IF
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       C100-DETERMINE-LEVEL-NBR.

           MOVE 'C100' TO CA-PARAGRAPH-NBR.

           SET W0000-NO-PARENT-FOUND TO TRUE.

           MOVE W0000-F-ORG-C
             TO W0002-F-ORG-C-02.
           MOVE F-ORG-X  IN DCLT231ORG
             TO W0002-F-ORGLN-X.
           MOVE F-PRNT-C IN DCLT231ORG
             TO W0002-F-PRNT-C.

           EVALUATE F-ORGLVL-C IN DCLT231ORG
               WHEN '01 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL01-C
                         W0002-F-ORGLVL01-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    MOVE W0000-DFLT-AFM-C
                      TO W0002-F-ORGID-C

                    EVALUATE TRUE
                        WHEN F-ORG-C   IN DCLT231ORG = 'BS'
                             MOVE 'ASIT'  TO W0002-F-ORGID-C
                        WHEN F-ORG-C   IN DCLT231ORG = 'L1'
                             MOVE 'LANT'  TO W0002-F-ORGID-C
                        WHEN OTHER
                             MOVE F-ORG-C   IN DCLT231ORG
                               TO W0002-F-ORGID-C(1:2)
                             MOVE F-ORG-C   IN DCLT231ORG
                               TO W0002-F-ORGID-C(3:2)
                    END-EVALUATE

                    MOVE SPACES TO
                         W0000-F-ORGLVL02-C
                         W0000-F-ORGLVL03-C
                         W0000-F-ORGLVL04-C
                         W0000-F-ORGLVL05-C
                         W0000-F-ORGLVL06-C
                         W0000-F-ORGLVL07-C
                         W0000-F-ORGLVL08-C
                         W0000-F-ORGLVL09-C
                         W0000-F-ORGLVL10-C
                         W0000-F-ORGLVL11-C
               WHEN '02 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL02-C
                         W0002-F-ORGLVL02-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C

                    PERFORM B101-CHECK-LVL-01

                    IF  W0002-F-ORGLVL01-C = 'A1'
                        IF  F-ORG-C   IN DCLT231ORG = '01'
                            MOVE 'ASEL'  TO W0002-F-ORGID-C
                        END-IF
                        IF  F-ORG-C   IN DCLT231ORG = '02'
                            MOVE 'ASOS'  TO W0002-F-ORGID-C
                        END-IF
                    END-IF
                    IF  W0002-F-ORGLVL01-C = 'L1'
                        IF  F-ORG-C   IN DCLT231ORG = '01'
                            MOVE 'LANI'  TO W0002-F-ORGID-C
                        END-IF
                        IF  F-ORG-C   IN DCLT231ORG = '02'
                            MOVE 'LANB'  TO W0002-F-ORGID-C
                        END-IF
                    END-IF
               WHEN '03 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL03-C
                         W0002-F-ORGLVL03-C
                         W0002-F-DIV-C
      *
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '04 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL04-C
                         W0002-F-ORGLVL04-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '05 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL05-C
                         W0002-F-ORGLVL05-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '06 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL06-C
                         W0002-F-ORGLVL06-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '07 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL07-C
                         W0002-F-ORGLVL07-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '08 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL08-C
                         W0002-F-ORGLVL08-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '09 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL09-C
                         W0002-F-ORGLVL09-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B108-CHECK-LVL-08
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '10 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL10-C
                         W0002-F-ORGLVL10-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B109-CHECK-LVL-09
                    PERFORM B108-CHECK-LVL-08
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '11 '
                    MOVE F-ORG-C   IN DCLT231ORG (3:2)
                      TO W0000-F-ORGLVL11-C
                         W0002-F-ORGLVL11-C
                         W0002-F-AFM-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-DIV-C
                    PERFORM B110-CHECK-LVL-10
                    PERFORM B109-CHECK-LVL-09
                    PERFORM B108-CHECK-LVL-08
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
           END-EVALUATE.


      *
      *      DETERMINE WHICH DEFAULT FAMILIES TO PRINT
      *
           IF  W0002-F-ORGLVL11-C > SPACES
               IF  W0000-DFLT-DIV-C1 > SPACES
                   MOVE W0000-DFLT-DIV-C1
                    TO W0002-F-DIV01-C
                   MOVE W0002-F-ORGLVL11-C
                     TO W0002-F-AFM01-C
               END-IF
               IF  W0000-DFLT-DIV-C2 > SPACES
                   MOVE W0000-DFLT-DIV-C2
                     TO W0002-F-DIV02-C
                   MOVE W0002-F-ORGLVL11-C
                     TO W0002-F-AFM02-C
               END-IF
           END-IF.

           EJECT
       D000-CREATE-ORG-TABLE-O3.

           MOVE 'D000' TO CA-PARAGRAPH-NBR.

           INITIALIZE W0002-OUTPUT-RECORD.

      **************************************************************
      **   CREATE ORG HEADER                                      **
      **************************************************************
           PERFORM A211-WRITE-COMMENT-RECORD.
           PERFORM A211-WRITE-COMMENT-RECORD.

           MOVE 'O3'    TO W0002-F-ORG-C
           MOVE 'TOT'   TO W0002-F-MNEMONIC01-C
           MOVE 'SDV'   TO W0002-F-MNEMONIC02-C
           MOVE 'DIV'   TO W0002-F-MNEMONIC03-C
           MOVE 'GRP'   TO W0002-F-MNEMONIC04-C
           MOVE 'SAG'   TO W0002-F-MNEMONIC05-C
           MOVE 'GAG'   TO W0002-F-MNEMONIC06-C
           MOVE 'DIR'   TO W0002-F-MNEMONIC07-C
           MOVE 'SKG'   TO W0002-F-MNEMONIC08-C
           MOVE 'KLG'   TO W0002-F-MNEMONIC09-C
           MOVE 'FKG'   TO W0002-F-MNEMONIC10-C
           MOVE 'FAM'   TO W0002-F-MNEMONIC11-C
           MOVE '99'    TO W0002-F-DFLTAFM-C
           MOVE '(O3) - SPECIAL ORGANIZATION'
             TO W0002-F-ORG-X

           PERFORM A210-WRITE-OUTPUT-RECORD.
           ADD +1 TO W0000-INPUT-CTR.

      **************************************************************
      **   CREATE O3                                              **
      **************************************************************
           PERFORM A211-WRITE-COMMENT-RECORD.

           MOVE 'O3'    TO W0000-F-ORG-C.

           MOVE 'NSO3'  TO W0000-DFLT-AFM-C.
           MOVE 'O3'    TO W0000-F-LVL01-C.
           MOVE '01'    TO W0000-DFLT-DIV-C1
           MOVE '02'    TO W0000-DFLT-DIV-C2
           MOVE '*3'    TO W0000-F-DIV-C
           MOVE '*4'    TO W0000-F-DIV-C2
           MOVE '*5'    TO W0000-F-DIV-C3
           MOVE '*9'    TO W0000-F-DIV-C4
           MOVE '10'    TO W0000-F-DIV-C5
           PERFORM D001-PROCESS-T231ORG-CURSOR.

           EJECT
       D001-PROCESS-T231ORG-CURSOR.

           MOVE 'D001' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                OPEN CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO

               EXEC SQL
                    FETCH CSR_1
                     INTO :DCLT231ORG.F-ORG-C
                        , :DCLT231ORG.DB-RECTYP-C
                        , :DCLT231ORG.F-ORGID-C
                        , :DCLT231ORG.A-SEQ-N
                        , :DCLT231ORG.F-ORGLVL-C
                        , :DCLT231ORG.F-ORG-X
                        , :DCLT231ORG.F-PRNT-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0002-OUTPUT-RECORD

                   PERFORM D100-DETERMINE-LEVEL-NBR

                   PERFORM A210-WRITE-OUTPUT-RECORD
                   ADD +1 TO W0000-INPUT-CTR
               END-IF
           END-PERFORM.

           EXEC SQL
               CLOSE CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       D100-DETERMINE-LEVEL-NBR.

           MOVE 'D100' TO CA-PARAGRAPH-NBR.

           SET W0000-NO-PARENT-FOUND TO TRUE.

           IF  F-ORG-C IN DCLT231ORG = 'DY'
               MOVE '10'   TO W0000-F-DIV-C
                              W0000-DFLT-DIV-C1
               MOVE SPACES TO W0000-DFLT-DIV-C2
           ELSE
               MOVE '*3'   TO W0000-F-DIV-C
               MOVE '01'   TO W0000-DFLT-DIV-C1
               MOVE '02'   TO W0000-DFLT-DIV-C2
           END-IF.

           MOVE W0000-F-ORG-C
             TO W0002-F-ORG-C-02.
           MOVE F-ORG-X  IN DCLT231ORG
             TO W0002-F-ORGLN-X.
           MOVE F-PRNT-C IN DCLT231ORG
             TO W0002-F-PRNT-C.

           EVALUATE F-ORGLVL-C IN DCLT231ORG
               WHEN '01 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL01-C
                         W0002-F-ORGLVL01-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    MOVE W0000-DFLT-AFM-C
                      TO W0002-F-ORGID-C
                    MOVE SPACES TO
                         W0000-F-ORGLVL02-C
                         W0000-F-ORGLVL03-C
                         W0000-F-ORGLVL04-C
                         W0000-F-ORGLVL05-C
                         W0000-F-ORGLVL06-C
                         W0000-F-ORGLVL07-C
                         W0000-F-ORGLVL08-C
                         W0000-F-ORGLVL09-C
                         W0000-F-ORGLVL10-C
                         W0000-F-ORGLVL11-C
               WHEN '02 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL02-C
                         W0002-F-ORGLVL02-C
                         W0002-F-DIV-C

                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C

                    PERFORM B101-CHECK-LVL-01

                    MOVE '01'
                      TO W0002-F-DIV01-C
                    MOVE '02'
                      TO W0002-F-DIV02-C
                    MOVE '99'
                      TO W0002-F-DIV03-C
               WHEN '03 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL03-C
                         W0002-F-ORGLVL03-C
                         W0002-F-DIV-C

                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '04 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL04-C
                         W0002-F-ORGLVL04-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '05 '
                    PERFORM A211-WRITE-COMMENT-RECORD

                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL05-C
                         W0002-F-ORGLVL05-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '06 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL06-C
                         W0002-F-ORGLVL06-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '07 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL07-C
                         W0002-F-ORGLVL07-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '08 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL08-C
                         W0002-F-ORGLVL08-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '09 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL09-C
                         W0002-F-ORGLVL09-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B108-CHECK-LVL-08
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '10 '
                    MOVE F-ORG-C   IN DCLT231ORG
                      TO W0000-F-ORGLVL10-C
                         W0002-F-ORGLVL10-C
                         W0002-F-DIV-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-AFM-C
                    PERFORM B109-CHECK-LVL-09
                    PERFORM B108-CHECK-LVL-08
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
               WHEN '11 '
                    IF  F-ORG-C   IN DCLT231ORG (3:2) = 'D9'
                        MOVE '99' TO F-ORG-C   IN DCLT231ORG (3:2)
                    END-IF
                    MOVE F-ORG-C   IN DCLT231ORG (3:2)
                      TO W0000-F-ORGLVL11-C
                         W0002-F-ORGLVL11-C
                         W0002-F-AFM-C
                    MOVE W0000-F-DIV-C
                      TO W0002-F-DIV-C
                    PERFORM B110-CHECK-LVL-10
                    PERFORM B109-CHECK-LVL-09
                    PERFORM B108-CHECK-LVL-08
                    PERFORM B107-CHECK-LVL-07
                    PERFORM B106-CHECK-LVL-06
                    PERFORM B105-CHECK-LVL-05
                    PERFORM B104-CHECK-LVL-04
                    PERFORM B103-CHECK-LVL-03
                    PERFORM B102-CHECK-LVL-02
                    PERFORM B101-CHECK-LVL-01
           END-EVALUATE.


      *
      *      DETERMINE WHICH DEFAULT FAMILIES TO PRINT
      *
           IF  W0002-F-ORGLVL11-C > SPACES
               IF  W0000-DFLT-DIV-C1 > SPACES
                   MOVE W0000-DFLT-DIV-C1
                    TO W0002-F-DIV01-C
                   MOVE W0002-F-ORGLVL11-C
                     TO W0002-F-AFM01-C
               END-IF
               IF  W0000-DFLT-DIV-C2 > SPACES
                   MOVE W0000-DFLT-DIV-C2
                     TO W0002-F-DIV02-C
                   MOVE W0002-F-ORGLVL11-C
                     TO W0002-F-AFM02-C
               END-IF
           END-IF.

           IF  W0002-F-ORGLVL04-C  = 'CP'
           AND (W0002-F-ORGLVL11-C = '99' OR '6X')
               MOVE '99'     TO W0002-F-DIV03-C
               MOVE W0002-F-ORGLVL11-C
                             TO W0002-F-AFM03-C
           END-IF.

           IF  W0002-F-ORGLVL04-C  = 'DY'
               IF  W0002-F-DIV-C = '*3'
                   MOVE '10'
                     TO W0002-F-DIV-C
               END-IF
               IF  W0002-F-AFM-C = '*3'
                   MOVE '10'
                     TO W0002-F-AFM-C
               END-IF
               MOVE '10'
                 TO W0002-F-DIV01-C
               MOVE SPACES
                 TO W0002-F-DIV02-C
                    W0002-F-AFM02-C
                    W0002-F-DIV03-C
                    W0002-F-AFM03-C
           END-IF.

           IF  W0002-F-ORGLVL04-C  = 'CP'
               IF (W0002-F-ORGLVL11-C = '10'
               OR  W0002-F-ORGLVL11-C = '11'
               OR  W0002-F-ORGLVL11-C = '7A'
               OR  W0002-F-ORGLVL11-C = '3A'
               OR  W0002-F-ORGLVL11-C = '3B'
               OR  W0002-F-ORGLVL11-C = '3C')
                   IF  W0000-DFLT-DIV-C1 > SPACES
                       MOVE '13'
                         TO W0002-F-DIV01-C
                       MOVE SPACES
                         TO W0002-F-DIV02-C
                            W0002-F-AFM02-C
                   END-IF
               END-IF
           END-IF.

           IF  W0002-F-ORGLVL11-C = 'TR'
               MOVE '99'
                 TO W0002-F-DIV01-C
               MOVE W0002-F-ORGLVL11-C
                 TO W0002-F-AFM01-C
               MOVE SPACES
                 TO W0002-F-DIV02-C
                    W0002-F-AFM02-C
                    W0002-F-DIV03-C
                    W0002-F-AFM03-C
           END-IF.


           EJECT
      **=======================================================**
      **         COPYBOOK FOR ERROR HANDLING ROUTINE           **
      **=======================================================**
           EXEC SQL
                INCLUDE C108B900
           END-EXEC.

