00001  IDENTIFICATION DIVISION.                                         05/25/10
00002  PROGRAM-ID.             CHGBD101.                                CHGBD101
00003 *AUTHOR.                 TCL.                                        LV009
00004 *DATE-WRITTEN.           FEBRUARY 1999.                           CHGBD101
00005  DATE-COMPILED.                                                   CHGBD101
00006      SKIP3                                                        CHGBD101
00007 *****                                                             CHGBD101
00008 *                                                                 CHGBD101
00009 *    FUNCTION:                                                    CHGBD101
00010 *                                                                 CHGBD101
00011 *        BENEFIT CHARGE CONVERSION STEP 1                         CHGBD101
00012 *          (1) READ DATA FROM TAPE AND CREATE CHGIM001 RECORDS    CHGBD101
00013 *                                                                 CHGBD101
00014 *****                                                             CHGBD101
00015 *        ***  NOTE  NOTE  NOTE  NOTE  NOTE  NOTE  NOTE  ***       CHGBD101
00016 *        ***                                            ***       CHGBD101
00017 *        ***  IF THE BENEFITS SYSTEM BEGINS PRODUCING   ***       CHGBD101
00018 *        ***  CHARGE RECORDS FOR A NEW BENEFIT PROGRAM  ***       CHGBD101
00019 *        ***  MODIFY THE FOLLOWING CHARGE SYSTEM        ***       CHGBD101
00020 *        ***  COMPONENTS:                               ***       CHGBD101
00021 *        ***                                            ***       CHGBD101
00022 *        ***  ADD NEW LEVEL-88S TO:                     ***       CHGBD101
00023 *        ***      CHG1-CHARGE-PROGRAM IN CHGIM001       ***       CHGBD101
00024 *        ***      WRK-PROGRAM IN CHGBD101               ***       CHGBD101
00025 *        ***      CHG2-PROGRAM IN CHGIM002              ***       CHGBD101
00026 *        ***      CHG4-PROGRAM IN CHGIM004              ***       CHGBD101
00027 *        ***      CHG30-PROGRAM IN CHGIM030             ***       CHGBD101
00028 *        ***                                            ***       CHGBD101
00029 *        ***  MODIFY P1500 IN CHGBD101                  ***       CHGBD101
00030 *        ***                                            ***       CHGBD101
00031 *****                                                             CHGBD101
00032 *                                                                 CHGBD101
00033 *        INPUT:                                                   CHGBD101
00034 *                                                                 CHGBD101
00035 *            CHGFILE  - CHARGE RECORDS GENERATED BY               CHGBD101
00036 *                       BENEFITS SYSTEM.                          CHGBD101
00037 *                                                                 CHGBD101
00038 *      OUTPUT:                                                    CHGBD101
00039 *                                                                 CHGBD101
00040 *            BD100CHG - REFORMATTED CHARGE RECORD WITHIN          CHGBD101
00041 *                       REPORTING PERIOD READY FOR SORT.          CHGBD101
00042 *****                                                             CHGBD101
00043                                                                   CHGBD101
00044 ******************************************************************CHGBD101
00045 * MODIFICATION HISTORY:                                          *CHGBD101
00046 *                                                                *CHGBD101
00047 * 02-02-1999 MODIFIED FROM MT CHG100D                            *CHGBD101
00048 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD101
00049 *                                                                *CHGBD101
00050 * 04-09-2001 ELIMINATED THE CURRENT PARAMETER FILE BY USING THE  *CHGBD101
00051 *            LINKAGE SECTION TO RECEIVE THE START AND END DATES  *CHGBD101
00052 *            FROM JCL PARM.                                      *CHGBD101
00053 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1 *CHGBD101
00054 *                                                                *CHGBD101
00055 * 02-24-2002 ELIMINATED THE LINKAGE-SECTION TO RECEIVE THE START *CHGBD101
00056 *            AND END DATES FROM JCL PARM. THE CONVRSION SHOULD   *CHGBD101
00057 *            NOT HAVE ANY DATE PARAMETERS. IT HAS TO CONVERT ALL *CHGBD101
00058 *            RECORDS ON EACH TAPE REGARLESS OF DATE.             *CHGBD101
00059 *            FOR THOSE EMPLOYERS WITH ACCOUNT NUMBER < 1, WRITE  *CHGBD101
00060 *            THE CHARGE RECORDS TO A SEPERATE OUTPUT FILE.       *CHGBD101
00061 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1 *CHGBD101
00062 *                                                                *CHGBD101
00063 * 06-29-2004 ADD EMP-TYPE 17 - DOMESTIC VIOLENCE.                *CHGBD101
00064 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD101
00065 *                                                                *CHGBD101
00066 *                                                                *CHGBD101
00067 * 05-04-2010 RECOMPILE NEW VERSION OF CHGIM001                   *CHGBD101
00068 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD101
00069 *                                                                *CHGBD101
00070 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD101
00071 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD101
00072 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD101
00073 *                                                                *CHGBD101
00074 ******************************************************************CHGBD101
00075                                                                   CHGBD101
00076      SKIP3                                                        CHGBD101
00077  ENVIRONMENT DIVISION.                                            CHGBD101
00078      SKIP3                                                        CHGBD101
00079  INPUT-OUTPUT SECTION.                                            CHGBD101
00080      SKIP3                                                        CHGBD101
00081  FILE-CONTROL.                                                    CHGBD101
00082                                                                   CHGBD101
00083      SELECT CHARGE-IN-FILE ASSIGN TO CHGFILE                      CHGBD101
00084             FILE STATUS IS CHARGE-IN-STATUS.                      CHGBD101
00085                                                                   CHGBD101
00086 *&   SELECT BD100-CHG-FILE  ASSIGN TO BD100CHG                    CHGBD101
00087 *           FILE STATUS IS BD100-CHG-STATUS.                      CHGBD101
00088                                                                   CHGBD101
00089 *&   SELECT BD100-EMPL-ZERO-FILE ASSIGN TO BD100ZRO               CHGBD101
00090 *           FILE STATUS IS BD100-ZRO-STATUS.                      CHGBD101
00091                                                                   CHGBD101
00092      EJECT                                                        CHGBD101
00093  DATA DIVISION.                                                   CHGBD101
00094      SKIP3                                                        CHGBD101
00095  FILE SECTION.                                                    CHGBD101
00096      SKIP3                                                        CHGBD101
00097  FD  CHARGE-IN-FILE                                               CHGBD101
00098      RECORDING MODE IS V                                          CHGBD101
00099      BLOCK CONTAINS 0 CHARACTERS                                  CHGBD101
00100      LABEL RECORDS ARE STANDARD.                                  CHGBD101
00101                                                                   CHGBD101
00102  01  CHARGE-IN-REC             PIC X(136).                        CHGBD101
00103                                                                   CHGBD101
00104 *FD  BD100-CHG-FILE                                               CHGBD101
00105 *    LABEL RECORDS ARE STANDARD                                   CHGBD101
00106 *    RECORDING MODE IS F                                          CHGBD101
00107 *    BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD101
00108 *                                                                 CHGBD101
00109 *01  SORT-CHG-REC.                                                CHGBD101
00110 ***INCLUDE CHGIM001                                               CHGBD101
00111                                                                   CHGBD101
00112 *FD  BD100-EMPL-ZERO-FILE                                         CHGBD101
00113 *    RECORDING MODE IS V                                          CHGBD101
00114 *    BLOCK CONTAINS 0 CHARACTERS                                  CHGBD101
00115 *    LABEL RECORDS ARE STANDARD.                                  CHGBD101
00116 *                                                                 CHGBD101
00117 *01  ZERO-CHG-REC                PIC X(136).                      CHGBD101
00118                                                                   CHGBD101
00119      EJECT                                                        CHGBD101
00120  WORKING-STORAGE SECTION.                                         CHGBD101
001205 77  PAN-VALET PICTURE X(24) VALUE '009CHGBD101  05/25/10'.       CHGBD101
00121                                                                   CHGBD101
00122  01  SORT-CHG-REC.                                                CHGBD101
00123  ++INCLUDE CHGIM001                                               CHGBD101
00124                                                                   CHGBD101
00125  01  WRK-AREA.                                                    CHGBD101
00126      05  AMT-DISP                PIC Z(06)9.99-.                  CHGBD101
00127      05  AMT-DISP1               PIC Z(06)9.99-.                  CHGBD101
00128      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD101
00129                                  VALUE +100.                      CHGBD101
00130      05  ABEND-MSG                   PIC  X(60).                  CHGBD101
00131      05  ABEND-MOD                   PIC  X(08) VALUE 'DTSBU999'. CHGBD101
00132                                                                   CHGBD101
00133      05  CHARGE-IN-STATUS            PIC  X(02) VALUE SPACES.     CHGBD101
00134          88  CHARGE-FILE-OK-88   VALUE ZERO.                      CHGBD101
00135          88  CHARGE-FILE-EOF-88  VALUE '10'.                      CHGBD101
00136                                                                   CHGBD101
00137      05  BD100-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD101
00138          88  BD100-FILE-OK-88    VALUE ZERO.                      CHGBD101
00139                                                                   CHGBD101
00140      05  BD100-ZRO-STATUS            PIC  X(02) VALUE SPACES.     CHGBD101
00141          88  BD100-ZERO-OK-88    VALUE ZERO.                      CHGBD101
00142                                                                   CHGBD101
00143      05  WRK-CHG-LENGTH              PIC S9(05) COMP.             CHGBD101
00144                                                                   CHGBD101
00145      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD101
00146          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD101
00147          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD101
00148                                                                   CHGBD101
00149      05  WRK-EDIT-ERROR-IND          PIC  X(01).                  CHGBD101
00150          88  WRK-EDIT-ERROR-YES-88    VALUE 'Y'.                  CHGBD101
00151          88  WRK-EDIT-ERROR-NO-88     VALUE 'N'.                  CHGBD101
00152                                                                   CHGBD101
00153      05  WRK-START-DATE              PIC S9(09) COMP-3.           CHGBD101
00154      05  WRK-END-DATE                PIC S9(09) COMP-3.           CHGBD101
00155      05  WRK-CHARGE-DATE             PIC S9(09) COMP-3.           CHGBD101
00156      05  WRK-BYE                     PIC S9(09) COMP-3.           CHGBD101
00157      05  WRK-KEY-X                   PIC  X(10).                  CHGBD101
00158      05  WRK-KEY-N REDEFINES WRK-KEY-X                            CHGBD101
00159                                      PIC  9(10).                  CHGBD101
00160      05  WRK-EMP-NO-TOT-AMT          PIC S9(9)V99 VALUE +0.       CHGBD101
00161      05  WRK-AMT-DISP                PIC ZZZ,ZZZ,ZZ9.99-.         CHGBD101
00162      05  TOT-CHARGE-CURR-AMT         PIC S9(9)V99 VALUE +0.       CHGBD101
00163      05  DIS-CHARGE-CURR-AMT         PIC ZZZ,ZZZ,ZZZ.99.          CHGBD101
00164      05  INV-EMP-NO-CURR-AMT         PIC S9(9)V99 VALUE +0.       CHGBD101
00165      05  DIS-INV-EMP-NO-CURR-AMT     PIC ZZZ,ZZZ,ZZZ.99.          CHGBD101
00166 *************************************************************     CHGBD101
00167 *  WRK-PROGRAM DEFINES VALUES FOR VALID BENEFIT PROGRAMS.         CHGBD101
00168 *  IT IS SET BASED ON CHARGE-SUPP-CODE IN THE DUCAS ESPRPT04      CHGBD101
00169 *  RECORD.  IF AN NEW BENEFIT PROGRAM IS ESTABLISHED, ADD         CHGBD101
00170 *  AN ADDITIONAL LEVEL-88 AND MODIFY THE CODE IN P1500.           CHGBD101
00171 *************************************************************     CHGBD101
00172      05  WRK-PROGRAM                 PIC  9(01).                  CHGBD101
00173          88 WRK-PROG-UI-88        VALUE 1.                        CHGBD101
00174          88 WRK-PROG-EB-88        VALUE 2.                        CHGBD101
00175          88 WRK-PROG-TEUC-88      VALUE 3.                        CHGBD101
00176          88 WRK-PROG-TEUCA-88     VALUE 4.                        CHGBD101
00177 *RW1                                                              CHGBD101
00178      05  WRK-CHARGE-IN-READ          PIC  9(09) COMP-3.           CHGBD101
00179      05  WRK-SORT-CHG-WRITTEN        PIC  9(09) COMP-3.           CHGBD101
00180                                                                   CHGBD101
00181      05  WRK-CHG-DT-ERR-CNT          PIC  9(09) COMP-3.           CHGBD101
00182      05  WRK-BYE-ERR-CNT             PIC  9(09) COMP-3.           CHGBD101
00183      05  WRK-EMP-TYPE-ERR-CNT        PIC  9(09) COMP-3.           CHGBD101
00184      05  WRK-CHG-AMT-ERR-CNT         PIC  9(09) COMP-3.           CHGBD101
00185      05  WRK-SUPP-CD-ERR-CNT         PIC  9(09) COMP-3.           CHGBD101
00186      05  WRK-EMP-NO-ERR-CNT          PIC  9(09) COMP-3.           CHGBD101
00187      05  WRK-SSN-ERR-CNT             PIC  9(09) COMP-3.           CHGBD101
00188                                                                   CHGBD101
00189      05  WRK-EMP-ACCT                PIC  9(06).                  CHGBD101
00190          88 WRK-EMP-ACCT-FED-88  VALUE 000001 THRU 001999.        CHGBD101
00191          88 WRK-EMP-ACCT-CWC-88  VALUE 110000 THRU 119999.        CHGBD101
00192                                                                   CHGBD101
00193      05  WRK-EMP-TYPE                PIC  9(02).                  CHGBD101
00194          88 WRK-EMP-TYPE-RATED-88     VALUE 00.                   CHGBD101
00195          88 WRK-EMP-TYPE-SELF-INS-88  VALUE 08.                   CHGBD101
00196          88 WRK-EMP-TYPE-CWC-88       VALUE 04.                   CHGBD101
00197          88 WRK-EMP-TYPE-FED-88       VALUE 01, 02.               CHGBD101
00198          88 WRK-EMP-TYPE-VALID-88     VALUE 00, 01, 02, 03        CHGBD101
00199                                             04, 05, 06            CHGBD101
00200                                             07, 08, 09            CHGBD101
00201                                             10, 11, 12, 26        CHGBD101
00202                                             13, 15, 16, 17        CHGBD101
00203                                             18, 19, 20, 21        CHGBD101
00204                                             22, 23, 24, 25        CHGBD101
00205                                             26, 27.               CHGBD101
00206 ** ADD ERROR MSG TABLE SET UP                                     CHGBD101
00207  01  MSG-TABLE.                                                   CHGBD101
00208      05  MSG1-EMP-TYPE.                                           CHGBD101
00209          10  MSG1-ID.                                             CHGBD101
00210              15  MSG1-ID1      PIC X(08)  VALUE 'CHGBD101'.       CHGBD101
00211              15  MSG1-ID2      PIC X(03)  VALUE '101'.            CHGBD101
00212          10  MSG1-SHORT-TEXT   PIC X(20)                          CHGBD101
00213                    VALUE 'INVALID EMP TYPE :  '.                  CHGBD101
00214          10  MSG1-LONG-TEXT.                                      CHGBD101
00215              15  FILLER        PIC X(29)                          CHGBD101
00216                    VALUE 'INVALID EMPLOYER TYPE        '.         CHGBD101
00217              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD101
00218              15  MSG1-SSN      PIC 9(10).                         CHGBD101
00219              15  FILLER        PIC X(13)  VALUE '  EMP TYPE = '.  CHGBD101
00220              15  MSG1-EMP-TYPE PIC 9(02).                         CHGBD101
00221                                                                   CHGBD101
00222      05  MSG2-BYE-DATE.                                           CHGBD101
00223          10  MSG2-ID.                                             CHGBD101
00224              15  MSG2-ID1      PIC X(08)  VALUE 'CHGBD101'.       CHGBD101
00225              15  MSG2-ID2      PIC X(03)  VALUE '101'.            CHGBD101
00226          10  MSG2-SHORT-TEXT   PIC X(20)                          CHGBD101
00227                    VALUE 'INVALID BYE DATE :  '.                  CHGBD101
00228          10  MSG2-LONG-TEXT.                                      CHGBD101
00229              15  FILLER        PIC X(29)                          CHGBD101
00230                    VALUE 'INVALID BYE DATE ACCEPTED    '.         CHGBD101
00231              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD101
00232              15  MSG2-SSN      PIC 9(10).                         CHGBD101
00233              15  FILLER        PIC X(13)  VALUE '  BYE DATE = '.  CHGBD101
00234              15  MSG2-BYE      PIC 9(08).                         CHGBD101
00235                                                                   CHGBD101
00236      05  MSG3-CHARGE-DATE.                                        CHGBD101
00237          10  MSG3-ID.                                             CHGBD101
00238              15  MSG3-ID1      PIC X(08)  VALUE 'CHGBD101'.       CHGBD101
00239              15  MSG3-ID2      PIC X(03)  VALUE '101'.            CHGBD101
00240          10  MSG3-SHORT-TEXT   PIC X(20)                          CHGBD101
00241                    VALUE 'INVALID CHG DATE :  '.                  CHGBD101
00242          10  MSG3-LONG-TEXT.                                      CHGBD101
00243              15  FILLER        PIC X(29)                          CHGBD101
00244                    VALUE 'INVALID CHARGE DATE          '.         CHGBD101
00245              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD101
00246              15  MSG3-SSN      PIC 9(10).                         CHGBD101
00247              15  FILLER        PIC X(13)  VALUE '  CHG DATE = '.  CHGBD101
00248              15  MSG3-CHG-DATE PIC 9(08).                         CHGBD101
00249                                                                   CHGBD101
00250      05  MSG4-CHARGE-AMT.                                         CHGBD101
00251          10  MSG4-ID.                                             CHGBD101
00252              15  MSG4-ID1      PIC X(08)  VALUE 'CHGBD101'.       CHGBD101
00253              15  MSG4-ID2      PIC X(03)  VALUE '101'.            CHGBD101
00254          10  MSG4-SHORT-TEXT   PIC X(20)                          CHGBD101
00255                    VALUE 'INVALID CHG AMOUNT :'.                  CHGBD101
00256          10  MSG4-LONG-TEXT.                                      CHGBD101
00257              15  FILLER        PIC X(29)                          CHGBD101
00258                    VALUE 'INVALID CHARGE AMOUNT        '.         CHGBD101
00259              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD101
00260              15  MSG4-SSN      PIC 9(10).                         CHGBD101
00261              15  FILLER        PIC X(15)  VALUE '  CHG AMOUNT = '.CHGBD101
00262              15  MSG4-CURR-AMT PIC S9(08)V99.                     CHGBD101
00263                                                                   CHGBD101
00264      05  MSG5-SUPP-CODE.                                          CHGBD101
00265          10  MSG5-ID.                                             CHGBD101
00266              15  MSG5-ID1      PIC X(08)  VALUE 'CHGBD101'.       CHGBD101
00267              15  MSG5-ID2      PIC X(03)  VALUE '101'.            CHGBD101
00268          10  MSG5-SHORT-TEXT   PIC X(20)                          CHGBD101
00269                    VALUE 'INVALID SUPP CODE  :'.                  CHGBD101
00270          10  MSG5-LONG-TEXT.                                      CHGBD101
00271              15  FILLER        PIC X(29)                          CHGBD101
00272                    VALUE 'INVALID SUPP CODE            '.         CHGBD101
00273              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD101
00274              15  MSG5-SSN      PIC 9(10).                         CHGBD101
00275              15  FILLER        PIC X(14)  VALUE '  SUPP CODE = '. CHGBD101
00276              15  MSG5-SUPP-CD  PIC X(01).                         CHGBD101
00277                                                                   CHGBD101
00278      05  MSG6-EMP-NO.                                             CHGBD101
00279          10  MSG6-ID.                                             CHGBD101
00280              15  MSG6-ID1      PIC X(08)  VALUE 'CHGBD101'.       CHGBD101
00281              15  MSG6-ID2      PIC X(03)  VALUE '101'.            CHGBD101
00282          10  MSG6-SHORT-TEXT   PIC X(20)                          CHGBD101
00283                    VALUE 'EMP NUMBER = ZERO  :'.                  CHGBD101
00284          10  MSG6-LONG-TEXT.                                      CHGBD101
00285              15  FILLER        PIC X(29)                          CHGBD101
00286                    VALUE 'EMPLOYER NUMBER = ZERO       '.         CHGBD101
00287              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD101
00288              15  MSG6-SSN      PIC 9(10).                         CHGBD101
00289              15  FILLER        PIC X(15)  VALUE SPACES.           CHGBD101
00290                                                                   CHGBD101
00291      05  MSG7-SSN-ERR.                                            CHGBD101
00292          10  MSG6-ID.                                             CHGBD101
00293              15  MSG7-ID1      PIC X(08)  VALUE 'CHGBD101'.       CHGBD101
00294              15  MSG7-ID2      PIC X(03)  VALUE '101'.            CHGBD101
00295          10  MSG7-SHORT-TEXT   PIC X(20)                          CHGBD101
00296                    VALUE 'SSN = ZERO         :'.                  CHGBD101
00297          10  MSG7-LONG-TEXT.                                      CHGBD101
00298              15  FILLER        PIC X(29)                          CHGBD101
00299                    VALUE 'SSN = ZERT                   '.         CHGBD101
00300              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD101
00301              15  MSG7-SSN      PIC 9(10).                         CHGBD101
00302              15  FILLER        PIC X(15)  VALUE SPACES.           CHGBD101
00303                                                                   CHGBD101
00304 ** ADD ERROR MSG OUTPUT RECORD.                                   CHGBD101
00305  01  R907-REC.                                                    CHGBD101
00306  ++INCLUDE DTSIR907                                               CHGBD101
00307                                                                   CHGBD101
00308 *** BENEFITS CHARGE RECORD ***                                    CHGBD101
00309  ++INCLUDE ESPRPT04                                               CHGBD101
00310                                                                   CHGBD101
00311  01  FILLER REDEFINES CHARGE-REC.                                 CHGBD101
00312 **** 05  FILLER                      PIC  X(04).                  CHGBD101
00313      05  WRK-CHARGE-REC              PIC  X(140).                 CHGBD101
00314                                                                   CHGBD101
00315  01  L001-LINK-AREA.                                              CHGBD101
00316  ++INCLUDE DTSIL001                                               CHGBD101
00317                                                                   CHGBD101
00318  01  L004-LINK-AREA.                                              CHGBD101
00319  ++INCLUDE DTSIL004                                               CHGBD101
00320                                                                   CHGBD101
00321 *LINKAGE SECTION.                                                 CHGBD101
00322 *01  PARM-AREA.                                                   CHGBD101
00323 *    05  PARM-LENGTH                    PIC S9(04) COMP.          CHGBD101
00324 *    05  PARM-START-DATE                PIC  X(06).               CHGBD101
00325 *    05  FILLER                         PIC  X(01).               CHGBD101
00326 *    05  PARM-END-DATE                  PIC  X(06).               CHGBD101
00327      EJECT                                                        CHGBD101
00328  PROCEDURE DIVISION.                                              CHGBD101
00329      SKIP2                                                        CHGBD101
00330  CHGBD101-MAIN.                                                   CHGBD101
00331      MOVE ZERO TO  WRK-CHARGE-IN-READ                             CHGBD101
00332                    WRK-SORT-CHG-WRITTEN                           CHGBD101
00333                    WRK-CHG-DT-ERR-CNT                             CHGBD101
00334                    WRK-BYE-ERR-CNT                                CHGBD101
00335                    WRK-EMP-TYPE-ERR-CNT                           CHGBD101
00336                    WRK-CHG-AMT-ERR-CNT                            CHGBD101
00337                    WRK-SUPP-CD-ERR-CNT                            CHGBD101
00338                    WRK-EMP-NO-ERR-CNT                             CHGBD101
00339                    WRK-SSN-ERR-CNT.                               CHGBD101
00340                                                                   CHGBD101
00341      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD101
00342                                                                   CHGBD101
00343      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD101
00344      IF WRK-ERROR-YES-88                                          CHGBD101
00345         GO TO CHGBD101-EXIT.                                      CHGBD101
00346                                                                   CHGBD101
00347      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD101
00348                                                                   CHGBD101
00349      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD101
00350                                                                   CHGBD101
00351      MOVE +0 TO RETURN-CODE.                                      CHGBD101
00352                                                                   CHGBD101
00353  CHGBD101-EXIT.                                                   CHGBD101
00354      STOP RUN.                                                    CHGBD101
00355      EJECT                                                        CHGBD101
00356  I0000-INITIATE.                                                  CHGBD101
00357      MOVE MSG1-ID1 TO R907-MODULE-NAME.                           CHGBD101
00358      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      CHGBD101
00359                                                                   CHGBD101
00360 *    PERFORM I1000-READ-PARM  THRU I1000-EXIT.                    CHGBD101
00361                                                                   CHGBD101
00362      PERFORM I2000-OPEN-FILES THRU I2000-EXIT.                    CHGBD101
00363                                                                   CHGBD101
00364  I0000-EXIT.                                                      CHGBD101
00365      EXIT.                                                        CHGBD101
00366                                                                   CHGBD101
00367 *I1000-READ-PARM.                                                 CHGBD101
00368 *    IF PARM-LENGTH NOT = +13                                     CHGBD101
00369 *       DISPLAY 'INVALID PARM LENGTH'                             CHGBD101
00370 *       PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD101
00371 *                                                                 CHGBD101
00372 *    IF PARM-START-DATE NOT NUMERIC                               CHGBD101
00373 *       DISPLAY 'START DATE NOT NUMERIC'                          CHGBD101
00374 *       PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD101
00375 *                                                                 CHGBD101
00376 *    MOVE PARM-START-DATE   TO L001-CAL-6-DATE-X.                 CHGBD101
00377 *    PERFORM S001-FROM-CAL-6    THRU S001-EXIT.                   CHGBD101
00378 *    IF L001-VALID-DATE                                           CHGBD101
00379 *       MOVE L001-FED-8-DATE-9 TO WRK-START-DATE                  CHGBD101
00380 *    ELSE                                                         CHGBD101
00381 *       DISPLAY 'INVALID-START-DATE'                              CHGBD101
00382 *       PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD101
00383 *                                                                 CHGBD101
00384 *    IF PARM-END-DATE NOT NUMERIC                                 CHGBD101
00385 *       DISPLAY 'END DATE NOT NUMERIC'                            CHGBD101
00386 *       PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD101
00387 *                                                                 CHGBD101
00388 *    MOVE PARM-END-DATE     TO L001-CAL-6-DATE-X.                 CHGBD101
00389 *    PERFORM S001-FROM-CAL-6    THRU S001-EXIT.                   CHGBD101
00390 *    IF L001-VALID-DATE                                           CHGBD101
00391 *       MOVE L001-FED-8-DATE-9 TO WRK-END-DATE                    CHGBD101
00392 *    ELSE                                                         CHGBD101
00393 *       DISPLAY 'INVALID-END-DATE'                                CHGBD101
00394 *       PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD101
00395 *                                                                 CHGBD101
00396 *    DISPLAY '****************************************'.          CHGBD101
00397 *    DISPLAY '**                                    **'.          CHGBD101
00398 *    DISPLAY '**  START DATE ' WRK-START-DATE                     CHGBD101
00399 *       '             **'.                                        CHGBD101
00400 *    DISPLAY '**                                    **'.          CHGBD101
00401 *    DISPLAY '**  END DATE ' WRK-END-DATE                         CHGBD101
00402 *       '               **'.                                      CHGBD101
00403 *    DISPLAY '****************************************'.          CHGBD101
00404 *                                                                 CHGBD101
00405 *I1000-EXIT.                                                      CHGBD101
00406 *    EXIT.                                                        CHGBD101
00407                                                                   CHGBD101
00408  I2000-OPEN-FILES.                                                CHGBD101
00409      OPEN INPUT  CHARGE-IN-FILE.                                  CHGBD101
00410      IF NOT CHARGE-FILE-OK-88                                     CHGBD101
00411         DISPLAY 'CHARGE FILE OPEN ERROR: ' CHARGE-IN-STATUS       CHGBD101
00412         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD101
00413         GO TO I2000-EXIT.                                         CHGBD101
00414                                                                   CHGBD101
00415 *&   OPEN OUTPUT BD100-CHG-FILE.                                  CHGBD101
00416 *    IF NOT BD100-FILE-OK-88                                      CHGBD101
00417 *       DISPLAY 'SORT FILE OPEN ERROR: ' BD100-CHG-STATUS         CHGBD101
00418 *       SET WRK-ERROR-YES-88 TO TRUE                              CHGBD101
00419 *       GO TO I2000-EXIT.                                         CHGBD101
00420                                                                   CHGBD101
00421 *&   OPEN OUTPUT BD100-EMPL-ZERO-FILE.                            CHGBD101
00422 *    IF NOT BD100-ZERO-OK-88                                      CHGBD101
00423 *       DISPLAY 'EMPL-ZERO-FILE OPEN ERROR: ' BD100-ZRO-STATUS    CHGBD101
00424 *       SET WRK-ERROR-YES-88 TO TRUE                              CHGBD101
00425 *       GO TO I2000-EXIT.                                         CHGBD101
00426                                                                   CHGBD101
00427  I2000-EXIT.                                                      CHGBD101
00428      EXIT.                                                        CHGBD101
00429                                                                   CHGBD101
00430  P0000-PROCESS.                                                   CHGBD101
00431      READ CHARGE-IN-FILE INTO WRK-CHARGE-REC                      CHGBD101
00432      IF NOT CHARGE-FILE-OK-88                                     CHGBD101
00433         DISPLAY 'CHARGE FILE EMPTY: ' CHARGE-IN-STATUS            CHGBD101
00434         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD101
00435         GO TO P0000-EXIT                                          CHGBD101
00436      ELSE                                                         CHGBD101
00437         ADD 1 TO WRK-CHARGE-IN-READ.                              CHGBD101
00438                                                                   CHGBD101
00439      PERFORM P1000-SELECT-CHARGES THRU P1000-EXIT                 CHGBD101
00440 ****    UNTIL WRK-SORT-CHG-WRITTEN > 1000.                        CHGBD101
00441         UNTIL CHARGE-FILE-EOF-88.                                 CHGBD101
00442                                                                   CHGBD101
00443  P0000-EXIT.                                                      CHGBD101
00444      EXIT.                                                        CHGBD101
00445                                                                   CHGBD101
00446  P1000-SELECT-CHARGES.                                            CHGBD101
00447      SET WRK-EDIT-ERROR-NO-88 TO TRUE.                            CHGBD101
00448 *****                                                             CHGBD101
00449 *****                                                             CHGBD101
00450      PERFORM P1100-EDIT-CHARGE-DATE THRU P1100-EXIT.              CHGBD101
00451      IF WRK-EDIT-ERROR-YES-88                                     CHGBD101
00452         GO TO P1000-READ-NEXT.                                    CHGBD101
00453                                                                   CHGBD101
00454      PERFORM P1200-EDIT-CWC         THRU P1200-EXIT.              CHGBD101
00455                                                                   CHGBD101
00456      PERFORM P1300-EDIT-BYE-DATE    THRU P1300-EXIT.              CHGBD101
00457                                                                   CHGBD101
00458      PERFORM P1400-EDIT-CHG-AMT     THRU P1400-EXIT.              CHGBD101
00459                                                                   CHGBD101
00460      PERFORM P1500-EDIT-SUPP-CODE   THRU P1500-EXIT.              CHGBD101
00461                                                                   CHGBD101
00462      PERFORM P1600-EDIT-EMP-NO      THRU P1600-EXIT.              CHGBD101
00463                                                                   CHGBD101
00464      PERFORM P1700-EDIT-SSN         THRU P1700-EXIT.              CHGBD101
00465                                                                   CHGBD101
00466      IF WRK-EDIT-ERROR-YES-88                                     CHGBD101
00467         GO TO P1000-READ-NEXT.                                    CHGBD101
00468                                                                   CHGBD101
00469      PERFORM P2000-WRITE-SORT-REC THRU P2000-EXIT.                CHGBD101
00470                                                                   CHGBD101
00471  P1000-READ-NEXT.                                                 CHGBD101
00472      READ CHARGE-IN-FILE INTO WRK-CHARGE-REC.                     CHGBD101
00473      IF CHARGE-FILE-OK-88                                         CHGBD101
00474         ADD 1 TO WRK-CHARGE-IN-READ                               CHGBD101
00475      ELSE                                                         CHGBD101
00476      IF CHARGE-FILE-EOF-88                                        CHGBD101
00477         NEXT SENTENCE                                             CHGBD101
00478      ELSE                                                         CHGBD101
00479         DISPLAY 'CHARGE FILE READ ERROR: ' CHARGE-IN-STATUS       CHGBD101
00480         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD101
00481         SET CHARGE-FILE-EOF-88 TO TRUE.                           CHGBD101
00482                                                                   CHGBD101
00483  P1000-EXIT.                                                      CHGBD101
00484      EXIT.                                                        CHGBD101
00485                                                                   CHGBD101
00486  P1100-EDIT-CHARGE-DATE.                                          CHGBD101
00487      MOVE CHARGE-DATE TO L001-FED-8-DATE-X.                       CHGBD101
00488      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      CHGBD101
00489      IF L001-VALID-DATE                                           CHGBD101
00490         MOVE L001-FED-8-DATE-9 TO WRK-CHARGE-DATE                 CHGBD101
00491      ELSE                                                         CHGBD101
00492         SET WRK-EDIT-ERROR-YES-88 TO TRUE                         CHGBD101
00493         ADD +1 TO WRK-CHG-DT-ERR-CNT                              CHGBD101
00494         MOVE MSG3-ID2         TO R907-MSG-ID                      CHGBD101
00495         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD101
00496         MOVE CHARGE-SSN       TO MSG3-SSN                         CHGBD101
00497         MOVE CHARGE-DATE      TO MSG3-CHG-DATE                    CHGBD101
00498         MOVE MSG3-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD101
00499         PERFORM S946-R907-WRITE THRU S946-EXIT.                   CHGBD101
00500                                                                   CHGBD101
00501  P1100-EXIT.                                                      CHGBD101
00502      EXIT.                                                        CHGBD101
00503                                                                   CHGBD101
00504  P1200-EDIT-CWC.                                                  CHGBD101
00505      MOVE CHARGE-EMPL-ACCT TO WRK-EMP-ACCT.                       CHGBD101
00506      MOVE CHARGE-EMPLOYER-TYPE TO WRK-EMP-TYPE.                   CHGBD101
00507                                                                   CHGBD101
00508 ************************************************************      CHGBD101
00509 *  EMPLOYER TYPE NOT SET IN CHARGE RECORDS FOR CWC ACCOUNTS.      CHGBD101
00510 *  THE FOLLOWING CODE CORRECTS THE EMPLOYER TYPE ON THE           CHGBD101
00511 *  INPUT RECORDS.                                                 CHGBD101
00512 ************************************************************      CHGBD101
00513      IF WRK-EMP-ACCT-CWC-88                                       CHGBD101
00514         IF NOT WRK-EMP-TYPE-CWC-88                                CHGBD101
00515            SET WRK-EMP-TYPE-CWC-88 TO TRUE                        CHGBD101
00516            MOVE WRK-EMP-TYPE TO CHARGE-EMPLOYER-TYPE.             CHGBD101
00517                                                                   CHGBD101
00518  P1200-EXIT.                                                      CHGBD101
00519      EXIT.                                                        CHGBD101
00520                                                                   CHGBD101
00521  P1300-EDIT-BYE-DATE.                                             CHGBD101
00522      MOVE CHARGE-BYE-DATE       TO L001-FED-8-DATE-X.             CHGBD101
00523      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      CHGBD101
00524      IF L001-VALID-DATE                                           CHGBD101
00525         MOVE L001-FED-8-DATE-9  TO WRK-BYE                        CHGBD101
00526      ELSE                                                         CHGBD101
00527 **                                                                CHGBD101
00528 *       SET WRK-EDIT-ERROR-YES-88 TO TRUE                         CHGBD101
00529 **                                                                CHGBD101
00530         ADD +1                  TO WRK-BYE-ERR-CNT                CHGBD101
00531         MOVE MSG2-ID2         TO R907-MSG-ID                      CHGBD101
00532         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD101
00533         MOVE CHARGE-SSN       TO MSG2-SSN                         CHGBD101
00534         MOVE CHARGE-BYE-DATE  TO MSG2-BYE                         CHGBD101
00535         MOVE MSG2-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD101
00536         PERFORM S946-R907-WRITE THRU S946-EXIT                    CHGBD101
00537         MOVE ZERO               TO WRK-BYE.                       CHGBD101
00538                                                                   CHGBD101
00539  P1300-EXIT.                                                      CHGBD101
00540      EXIT.                                                        CHGBD101
00541                                                                   CHGBD101
00542  P1400-EDIT-CHG-AMT.                                              CHGBD101
00543      IF CHARGE-CURR-AMT NOT NUMERIC                               CHGBD101
00544         SET WRK-EDIT-ERROR-YES-88 TO TRUE                         CHGBD101
00545         ADD +1 TO WRK-CHG-AMT-ERR-CNT                             CHGBD101
00546         MOVE MSG4-ID2         TO R907-MSG-ID                      CHGBD101
00547         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD101
00548         MOVE CHARGE-SSN       TO MSG4-SSN                         CHGBD101
00549         MOVE CHARGE-CURR-AMT  TO MSG4-CURR-AMT                    CHGBD101
00550         MOVE MSG4-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD101
00551         PERFORM S946-R907-WRITE THRU S946-EXIT.                   CHGBD101
00552                                                                   CHGBD101
00553  P1400-EXIT.                                                      CHGBD101
00554      EXIT.                                                        CHGBD101
00555                                                                   CHGBD101
00556  P1500-EDIT-SUPP-CODE.                                            CHGBD101
00557       EVALUATE CHARGE-SUPP-CODE                                   CHGBD101
00558                                                                   CHGBD101
00559         WHEN SPACE                                                CHGBD101
00560           SET WRK-PROG-UI-88 TO TRUE                              CHGBD101
00561                                                                   CHGBD101
00562         WHEN 'T'                                                  CHGBD101
00563           SET WRK-PROG-TEUC-88 TO TRUE                            CHGBD101
00564                                                                   CHGBD101
00565         WHEN 'E'                                                  CHGBD101
00566           SET WRK-PROG-EB-88 TO TRUE                              CHGBD101
00567                                                                   CHGBD101
00568         WHEN 'A'                                                  CHGBD101
00569           SET WRK-PROG-TEUCA-88 TO TRUE                           CHGBD101
00570                                                                   CHGBD101
00571         WHEN OTHER                                                CHGBD101
00572           SET WRK-EDIT-ERROR-YES-88 TO TRUE                       CHGBD101
00573           ADD +1 TO WRK-SUPP-CD-ERR-CNT                           CHGBD101
00574           MOVE MSG5-ID2         TO R907-MSG-ID                    CHGBD101
00575           MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                    CHGBD101
00576           MOVE CHARGE-SSN       TO MSG5-SSN                       CHGBD101
00577           MOVE CHARGE-SUPP-CODE TO MSG5-SUPP-CODE                 CHGBD101
00578           MOVE MSG5-LONG-TEXT   TO R907-MSG-TEXT                  CHGBD101
00579           PERFORM S946-R907-WRITE THRU S946-EXIT                  CHGBD101
00580                                                                   CHGBD101
00581       END-EVALUATE.                                               CHGBD101
00582                                                                   CHGBD101
00583  P1500-EXIT.                                                      CHGBD101
00584      EXIT.                                                        CHGBD101
00585                                                                   CHGBD101
00586  P1600-EDIT-EMP-NO.                                               CHGBD101
00587      IF CHARGE-EMPL-ACCT < +1                                     CHGBD101
00588         SET WRK-EDIT-ERROR-YES-88 TO TRUE                         CHGBD101
00589         ADD CHARGE-CURR-AMT TO WRK-EMP-NO-TOT-AMT                 CHGBD101
00590 *&      WRITE ZERO-CHG-REC FROM WRK-CHARGE-REC                    CHGBD101
00591         ADD +1 TO WRK-EMP-NO-ERR-CNT.                             CHGBD101
00592                                                                   CHGBD101
00593 *       MOVE MSG6-ID2         TO R907-MSG-ID                      CHGBD101
00594 *       MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD101
00595 *       MOVE CHARGE-SSN       TO MSG6-SSN                         CHGBD101
00596 *       MOVE MSG6-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD101
00597 *       PERFORM S946-R907-WRITE THRU S946-EXIT.                   CHGBD101
00598                                                                   CHGBD101
00599  P1600-EXIT.                                                      CHGBD101
00600      EXIT.                                                        CHGBD101
00601                                                                   CHGBD101
00602  P1700-EDIT-SSN.                                                  CHGBD101
00603      MOVE CHARGE-KEY          TO WRK-KEY-X.                       CHGBD101
00604      IF WRK-KEY-N NUMERIC                                         CHGBD101
00605         IF WRK-KEY-N > ZERO                                       CHGBD101
00606            NEXT SENTENCE                                          CHGBD101
00607         ELSE                                                      CHGBD101
00608            PERFORM P1710-SSN-ERROR  THRU P1710-EXIT               CHGBD101
00609      ELSE                                                         CHGBD101
00610         PERFORM P1710-SSN-ERROR  THRU P1710-EXIT.                 CHGBD101
00611                                                                   CHGBD101
00612  P1700-EXIT.                                                      CHGBD101
00613      EXIT.                                                        CHGBD101
00614                                                                   CHGBD101
00615  P1710-SSN-ERROR.                                                 CHGBD101
00616      SET WRK-EDIT-ERROR-YES-88 TO TRUE.                           CHGBD101
00617      ADD +1 TO WRK-SSN-ERR-CNT.                                   CHGBD101
00618      MOVE MSG7-ID2         TO R907-MSG-ID.                        CHGBD101
00619      MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO.                        CHGBD101
00620      MOVE CHARGE-SSN       TO MSG7-SSN.                           CHGBD101
00621      MOVE MSG7-LONG-TEXT   TO R907-MSG-TEXT.                      CHGBD101
00622      PERFORM S946-R907-WRITE THRU S946-EXIT.                      CHGBD101
00623                                                                   CHGBD101
00624  P1710-EXIT.                                                      CHGBD101
00625      EXIT.                                                        CHGBD101
00626                                                                   CHGBD101
00627  P2000-WRITE-SORT-REC.                                            CHGBD101
00628 *&                                                                CHGBD101
00629      IF CHARGE-SSN = 269700223                                    CHGBD101
00630            MOVE CHARGE-CURR-AMT TO AMT-DISP                       CHGBD101
00631            MOVE CHARGE-TOT-AMT TO AMT-DISP1                       CHGBD101
00632         IF (WRK-CHARGE-DATE >= 20020501                           CHGBD101
00633         AND WRK-CHARGE-DATE <= 20020531)                          CHGBD101
00634            DISPLAY SPACE                                          CHGBD101
00635            DISPLAY '>> EMP ' CHARGE-EMPL-ACCT                     CHGBD101
00636               '  TYPE ' CHARGE-EMPLOYER-TYPE                      CHGBD101
00637               '  SSN ' CHARGE-KEY                                 CHGBD101
00638               '  CD ' CHARGE-CODE                                 CHGBD101
00639               '  DATE ' WRK-CHARGE-DATE                           CHGBD101
00640            DISPLAY '   BWE ' CHARGE-BWE-DATE                      CHGBD101
00641               '  BYE ' WRK-BYE                                    CHGBD101
00642               '  AMT ' AMT-DISP                                   CHGBD101
00643               '  TOT ' AMT-DISP1                                  CHGBD101
00644         ELSE                                                      CHGBD101
00645            DISPLAY SPACE                                          CHGBD101
00646            DISPLAY '   EMP ' CHARGE-EMPL-ACCT                     CHGBD101
00647               '  TYPE ' CHARGE-EMPLOYER-TYPE                      CHGBD101
00648               '  SSN ' CHARGE-KEY                                 CHGBD101
00649               '  CD ' CHARGE-CODE                                 CHGBD101
00650               '  DATE ' WRK-CHARGE-DATE                           CHGBD101
00651            DISPLAY '   BWE ' CHARGE-BWE-DATE                      CHGBD101
00652               '  BYE ' WRK-BYE                                    CHGBD101
00653               '  AMT ' AMT-DISP                                   CHGBD101
00654               '  TOT ' AMT-DISP1.                                 CHGBD101
00655 *&                                                                CHGBD101
00656      MOVE LOW-VALUES            TO CHG1-SORT-KEY-AREA.            CHGBD101
00657      MOVE WRK-KEY-N             TO CHG1-SSN.                      CHGBD101
00658      MOVE CHARGE-EMPL-ACCT      TO CHG1-EMP-NO.                   CHGBD101
00659      MOVE WRK-BYE               TO CHG1-BYE.                      CHGBD101
00660                                                                   CHGBD101
00661      MOVE WRK-CHARGE-DATE       TO CHG1-CHARGE-DATE.              CHGBD101
00662      MOVE CHARGE-CODE           TO CHG1-CHARGE-CODE.              CHGBD101
00663      MOVE WRK-PROGRAM           TO CHG1-CHARGE-PROGRAM.           CHGBD101
00664      MOVE CHARGE-PAY-TYPE       TO CHG1-CHARGE-PAY-TYPE.          CHGBD101
00665      MOVE CHARGE-NAME           TO CHG1-CHARGE-NAME.              CHGBD101
00666      MOVE CHARGE-EMPLOYER-TYPE  TO CHG1-CHARGE-EMP-TYPE.          CHGBD101
00667                                                                   CHGBD101
00668      MOVE CHARGE-CURR-AMT       TO CHG1-CHARGE-CURR-AMT.          CHGBD101
00669      ADD  CHARGE-CURR-AMT       TO TOT-CHARGE-CURR-AMT.           CHGBD101
00670                                                                   CHGBD101
00671 *&   WRITE SORT-CHG-REC.                                          CHGBD101
00672      ADD 1 TO WRK-SORT-CHG-WRITTEN.                               CHGBD101
00673                                                                   CHGBD101
00674  P2000-EXIT.                                                      CHGBD101
00675      EXIT.                                                        CHGBD101
00676                                                                   CHGBD101
00677  T0000-TERMINATE.                                                 CHGBD101
00678      CLOSE CHARGE-IN-FILE.                                        CHGBD101
00679 *&         BD100-CHG-FILE.                                        CHGBD101
00680 *&         BD100-EMPL-ZERO-FILE.                                  CHGBD101
00681                                                                   CHGBD101
00682      DISPLAY ' CHGBD101 CHARGE RECORDS READ :   '                 CHGBD101
00683         WRK-CHARGE-IN-READ.                                       CHGBD101
00684      DISPLAY '       CHARGE RECORDS WRITTEN:    '                 CHGBD101
00685         WRK-SORT-CHG-WRITTEN.                                     CHGBD101
00686      DISPLAY '       BYE DATE ERRORS ACCEPTED:  '                 CHGBD101
00687         WRK-BYE-ERR-CNT.                                          CHGBD101
00688      DISPLAY '       CHARGE DATE ERRORS:        '                 CHGBD101
00689         WRK-CHG-DT-ERR-CNT                                        CHGBD101
00690      DISPLAY '       EMPLOYER TYPE ERRORS:      '                 CHGBD101
00691         WRK-EMP-TYPE-ERR-CNT.                                     CHGBD101
00692      DISPLAY '       CHARGE AMOUNT ERRORS:      '                 CHGBD101
00693         WRK-CHG-AMT-ERR-CNT.                                      CHGBD101
00694      DISPLAY '       SUPP CODE ERRORS:          '                 CHGBD101
00695         WRK-SUPP-CD-ERR-CNT.                                      CHGBD101
00696                                                                   CHGBD101
00697      MOVE WRK-EMP-NO-TOT-AMT   TO WRK-AMT-DISP.                   CHGBD101
00698      DISPLAY ' EMP NO ERRORS AND TOTAL AMOUNT:  '                 CHGBD101
00699         WRK-EMP-NO-ERR-CNT '  ' WRK-AMT-DISP.                     CHGBD101
00700                                                                   CHGBD101
00701      DISPLAY '             SSN ERRORS:          '                 CHGBD101
00702         WRK-SSN-ERR-CNT.                                          CHGBD101
00703                                                                   CHGBD101
00704      DISPLAY '                                  '.                CHGBD101
00705      MOVE INV-EMP-NO-CURR-AMT TO DIS-INV-EMP-NO-CURR-AMT.         CHGBD101
00706      DISPLAY ' INVALID EMP-NO CHARGE-CURR AMTS: '                 CHGBD101
00707         DIS-INV-EMP-NO-CURR-AMT.                                  CHGBD101
00708                                                                   CHGBD101
00709      DISPLAY '                                  '.                CHGBD101
00710      MOVE TOT-CHARGE-CURR-AMT TO DIS-CHARGE-CURR-AMT.             CHGBD101
00711      DISPLAY '       TOTAL CHARGE CURRENT AMTS: '                 CHGBD101
00712         DIS-CHARGE-CURR-AMT.                                      CHGBD101
00713                                                                   CHGBD101
00714  T0000-EXIT.                                                      CHGBD101
00715      EXIT.                                                        CHGBD101
00716      EJECT                                                        CHGBD101
00717                                                                   CHGBD101
00718  S001-FROM-CAL-6.                                                 CHGBD101
00719      SET L001-FROM-CAL-6 TO TRUE.                                 CHGBD101
00720      GO TO S001-DATE.                                             CHGBD101
00721                                                                   CHGBD101
00722  S001-FROM-FED-8.                                                 CHGBD101
00723      SET L001-FROM-FED-8 TO TRUE.                                 CHGBD101
00724      GO TO S001-DATE.                                             CHGBD101
00725                                                                   CHGBD101
00726  S001-DATE.                                                       CHGBD101
00727      CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBD101
00728  S001-EXIT. EXIT.                                                 CHGBD101
00729                                                                   CHGBD101
00730  S004-FROM-DATE.                                                  CHGBD101
00731      SET L004-FROM-DATE TO TRUE.                                  CHGBD101
00732      GO TO S004-YRQ.                                              CHGBD101
00733                                                                   CHGBD101
00734  S004-YRQ.                                                        CHGBD101
00735      CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBD101
00736  S004-EXIT. EXIT.                                                 CHGBD101
00737                                                                   CHGBD101
00738 ** ADD ERROR MSG PROCESS PARA.                                    CHGBD101
00739  S946-R907-WRITE.                                                 CHGBD101
00740      CALL 'DTSBU946' USING R907-REC.                              CHGBD101
00741  S946-EXIT. EXIT.                                                 CHGBD101
00742                                                                   CHGBD101
00743  S999-ABEND.                                                      CHGBD101
00744      DISPLAY '****  CHGBD101 ABENDING '                           CHGBD101
00745         ABEND-MSG.                                                CHGBD101
00746      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD101
00747                                                                   CHGBD101
00748  S999-EXIT.                                                       CHGBD101
00749      EXIT.                                                        CHGBD101
