00001  IDENTIFICATION DIVISION.                                         03/18/24
00002  PROGRAM-ID.             CHGBD100.                                CHGBD100
00003 *AUTHOR.                 TRW.                                        LV076
00004 *DATE-WRITTEN.           APRIL 2001.                              CHGBD100
00005  DATE-COMPILED.                                                   CHGBD100
00006      SKIP3                                                        CHGBD100
00007 *****                                                             CHGBD100
00008 *                                                                 CHGBD100
00009 *    FUNCTION:      /**  NEW VERSION USED DAILY IN DTSCHRGD **    CHGBD100
00010 *                                                                 CHGBD100
00011 *        DAILY BENEFIT CHARGE REPORTING PROCESS STEP 1            CHGBD100
00012 *          (1) READ CHARGE RECORDS FROM DAILY BENEFITS FILE       CHGBD100
00013 *              (UI.ESP930F1.CHRG)                                 CHGBD100
00014 *          (2) PERFORM PRELIMINARY EDITS AND CREATE CHGIM001      CHGBD100
00015 *              OUTPUT RECORD.                                     CHGBD100
00016 *                                                                 CHGBD100
00017 *****                                                             CHGBD100
00018 *        ***  NOTE  NOTE  NOTE  NOTE  NOTE  NOTE  NOTE  ***       CHGBD100
00019 *        ***                                            ***       CHGBD100
00020 *        ***  IF THE BENEFITS SYSTEM BEGINS PRODUCING   ***       CHGBD100
00021 *        ***  CHARGE RECORDS FOR A NEW BENEFIT PROGRAM  ***       CHGBD100
00022 *        ***  MODIFY THE FOLLOWING CHARGE SYSTEM        ***       CHGBD100
00023 *        ***  COMPONENTS:                               ***       CHGBD100
00024 *        ***                                            ***       CHGBD100
00025 *        ***  ADD NEW LEVEL-88S TO:                     ***       CHGBD100
00026 *        ***      CHG1-CHARGE-PROGRAM IN CHGIM001       ***       CHGBD100
00027 *        ***      WRK-PROGRAM IN CHGBD100               ***       CHGBD100
00028 *        ***      CHG2-PROGRAM IN CHGIM002              ***       CHGBD100
00029 *        ***      CHG4-PROGRAM IN CHGIM004              ***       CHGBD100
00030 *        ***      CHG30-PROGRAM IN CHGIM030             ***       CHGBD100
00031 *        ***                                            ***       CHGBD100
00032 *        ***  MODIFY P1500 IN CHGBD100                  ***       CHGBD100
00033 *        ***                                            ***       CHGBD100
00034 *****                                                             CHGBD100
00035 *                                                                 CHGBD100
00036 *        INPUT:                                                   CHGBD100
00037 *                                                                 CHGBD100
00038 *            CHGFILE  - CHARGE RECORDS GENERATED BY               CHGBD100
00039 *                       BENEFITS SYSTEM.                          CHGBD100
00040 *      OUTPUT:                                                    CHGBD100
00041 *                                                                 CHGBD100
00042 *            BD100CHG - REFORMATTED CHARGE RECORD WITHIN          CHGBD100
00043 *                       REPORTING PERIOD READY FOR SORT.          CHGBD100
00044 *****                                                             CHGBD100
00045                                                                   CHGBD100
00046 ******************************************************************CHGBD100
00047 * MODIFICATION HISTORY:                                          *CHGBD100
00048 *                                                                *CHGBD100
00049 * 02-02-1999 MODIFIED FROM MT CHG100D                            *CHGBD100
00050 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD100
00051 *                                                                *CHGBD100
00052 * 04-09-2001 ELIMINATED THE CURRENT PARAMETER FILE BY USING THE  *CHGBD100
00053 *            LINKAGE SECTION TO RECEIVE THE START AND END DATES  *CHGBD100
00054 *            FROM JCL PARM.                                      *CHGBD100
00055 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1 *CHGBD100
00056 *                                                                *CHGBD100
00057 * 03-22-2002 ADDED A NEW VALUE TEUC (THE NEW FEDERAL EXTENDED    *CHGBD100
00058 *            BENEFITS PROGRAM) TO THE PROGRAM CODE DATA ELEMENT  *CHGBD100
00059 *            IN THE CHARGE SYSTEM DISTINGUISHED BENEFIT PROGRAM. *CHGBD100
00060 *            IT NOW CONTAINS VALUES ONLY FOR UI AND EB.          *CHGBD100
00061 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1 *CHGBD100
00062 *                                                                *CHGBD100
00063 * 06-29-2004 ADDED A NEW EMPLOYER TYPE (17) FOR DOMESTIC         *CHGBD100
00064 *            VIOLENCE.                                           *CHGBD100
00065 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD100
00066 *                                                                *CHGBD100
00067 * 03-05-2009 MODIFIED FOR NEW FORMAT OF PROGRAM CODE - CHANGED   *CHGBD100
00068 *            FROM NUMERIC TO CHARACTER.                          *CHGBD100
00069 *            UPDATED EMPLOYER TYPES.                             *CHGBD100
00070 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD100
00071 *                                                                *CHGBD100
00072 * 08-05-2009 ADDED NEW PROGRAM CODES TO P1500: ADDITIONAL        *CHGBD100
00073 *            BENEFITS, TRAINING, DEPENDENT ALLOWANCE.            *CHGBD100
00074 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD100
00075 *                                                                *CHGBD100
00076 * 11-17-2009 ADDED NEW PROGRAM CODES TO P1500:                   *CHGBD100
00077 *            EUC 2008 TIERS 3 AND 4.                             *CHGBD100
00078 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD100
00079 *                                                                *CHGBD100
00080 * 12-16-2009 CORRECTED INCONSISTENCY BETWEEN CHGIM001 PROG       *CHGBD100
00081 *            CODES AND CHGIM002.                                 *CHGBD100
00082 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD100
00083 *                                                                *CHGBD100
00084 * 03-31-2010 ADDED NEW PROGRAM CODE TO P1500:                    *CHGBD100
00085 *            SPECIAL PAYMENTS.                                   *CHGBD100
00086 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD100
00087 *                                                                *CHGBD100
00088 * 09-26-2014 ADDED NEW PROGRAM CODE TO P1500: U-UCPIA            *CHGBD100
00089 *            UPDATED WRK PROGRAM CODE IN WORKING STORAGE         *CHGBD100
00090 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD100
00091 *                                                                *CHGBD100
00092 * 04-12-2020 ADDED NEW PROGRAM CODE TO P1500: PUA, FPUC, AND FRUR*   CL**2
00093 *            UPDATED WRK PROGRAM CODE IN WORKING STORAGE         *   CL**2
00094 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**2
00095 *                                                                *   CL**2
00096 * 04-24-2020 ADDED NEW PROGRAM CODE TO P1500: PEUC               *   CL*10
00097 *            UPDATED WRK PROGRAM CODE IN WORKING STORAGE         *   CL*10
00098 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL*10
00099 *                                                                *   CL*10
00100 *                                                                *   CL*18
00101 * 06-24-2020 ADDED NEW PROGRAM CODE TO P1500: REUR               *   CL*18
00102 *            UPDATED WRK PROGRAM CODE IN WORKING STORAGE         *   CL*18
00103 *            CODE FROM DOCS IS COMING AS A '1' WHICH IS CAUSING  *   CL*18
00104 *            CHARGES BY SSN TO BE DOUBLED AS A RESUULT OF MOVING *   CL*18
00105 *            CHARGES FROM EMPLOYER ACCOUNT TO 5032 ACCOUNT.      *   CL*18
00106 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL*18
00107 *                                                                *   CL*18
00108 * 09-18-2020 ADDED NEW PROGRAM CODE TO P1500: LWA                *   CL*22
00109 *            UPDATED WRK PROGRAM CODE IN WORKING STORAGE         *   CL*22
00110 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL*22
00111 *                                                                *   CL*22
00112 * 12-08-2020 ADDED NEW PROGRAM CODE TO P1500: PUA STIMULUS       *   CL*24
00113 *            UPDATED WRK PROGRAM CODE IN WORKING STORAGE         *   CL*24
00114 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL*24
00115 * 12-16-2021 ADDED NEW PROGRAM CODE TO P1500: DUC                *   CL*29
00116 *            UPDATED WRK PROGRAM CODE IN WORKING STORAGE         *   CL*29
00117 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL*29
00118 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD100
00119 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD100
00120 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD100
00121 *                                                                *CHGBD100
00122 ******************************************************************CHGBD100
00123                                                                   CHGBD100
00124      SKIP3                                                        CHGBD100
00125  ENVIRONMENT DIVISION.                                            CHGBD100
00126      SKIP3                                                        CHGBD100
00127  INPUT-OUTPUT SECTION.                                            CHGBD100
00128      SKIP3                                                        CHGBD100
00129  FILE-CONTROL.                                                    CHGBD100
00130                                                                   CHGBD100
00131      SELECT CHARGE-IN-FILE ASSIGN TO CHGFILE                      CHGBD100
00132             FILE STATUS IS CHARGE-IN-STATUS.                      CHGBD100
00133                                                                   CHGBD100
00134      SELECT BD100-CHG-FILE  ASSIGN TO BD100CHG                    CHGBD100
00135             FILE STATUS IS BD100-CHG-STATUS.                      CHGBD100
00136      EJECT                                                        CHGBD100
00137  DATA DIVISION.                                                   CHGBD100
00138                                                                   CHGBD100
00139  FILE SECTION.                                                    CHGBD100
00140                                                                   CHGBD100
00141  FD  CHARGE-IN-FILE                                               CHGBD100
00142      LABEL RECORDS ARE STANDARD                                      CL*32
00143      BLOCK CONTAINS 0 CHARACTERS.                                    CL*32
00144                                                                   CHGBD100
00145  01  CHARGE-IN-REC                      PIC X(200).                  CL*37
00146                                                                   CHGBD100
00147  FD  BD100-CHG-FILE                                               CHGBD100
00148      LABEL RECORDS ARE STANDARD                                   CHGBD100
00149      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD100
00150                                                                   CHGBD100
00151  01  SORT-CHG-REC                       PIC X(104).                  CL*62
00152                                                                   CHGBD100
00153      EJECT                                                        CHGBD100
00154  WORKING-STORAGE SECTION.                                         CHGBD100
001545 77  PAN-VALET PICTURE X(24) VALUE '076CHGBD100  03/18/24'.       CHGBD100
00155  77  PAN-VALET PICTURE X(24) VALUE '141CHGBD100  10/01/14'.       CHGBD100
00156  77  PAN-VALET PICTURE X(24) VALUE '004CHGBD100  09/26/14'.       CHGBD100
00157  77  PAN-VALET PICTURE X(24) VALUE '139CHGBD100  04/01/10'.       CHGBD100
00158                                                                   CHGBD100
00159  01  WRK-AREA.                                                    CHGBD100
00160      05  AMT-DISP                PIC Z(06)9.99-.                  CHGBD100
00161      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD100
00162                                  VALUE +100.                      CHGBD100
00163      05  ABEND-MSG                   PIC  X(60).                  CHGBD100
00164      05  ABEND-MOD                   PIC  X(08) VALUE 'DTSBU999'. CHGBD100
00165                                                                   CHGBD100
00166      05  CHARGE-IN-STATUS            PIC  X(02) VALUE SPACES.     CHGBD100
00167          88  CHARGE-FILE-OK-88   VALUE ZERO.                      CHGBD100
00168          88  CHARGE-FILE-EOF-88  VALUE '10'.                      CHGBD100
00169      05  BD100-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD100
00170          88  BD100-FILE-OK-88    VALUE ZERO.                      CHGBD100
00171                                                                   CHGBD100
00172      05  WRK-CHG-LENGTH              PIC S9(05) COMP.             CHGBD100
00173                                                                   CHGBD100
00174      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD100
00175          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD100
00176          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD100
00177                                                                   CHGBD100
00178      05  WRK-EDIT-ERROR-IND          PIC  X(01).                  CHGBD100
00179          88  WRK-EDIT-ERROR-YES-88    VALUE 'Y'.                  CHGBD100
00180          88  WRK-EDIT-ERROR-NO-88     VALUE 'N'.                  CHGBD100
00181                                                                   CHGBD100
00182      05  WRK-CURR-SYS-DATE       PIC S9(09) COMP-3 VALUE +0.         CL*73
00183      05  WRK-CHARGE-PRIOR-DATE       PIC S9(09) COMP-3 VALUE +0.     CL*73
00184      05  WRK-CHARGE-DATE             PIC S9(09) COMP-3 VALUE +0.     CL*68
00185      05  WRK-BYE                     PIC S9(09) COMP-3 VALUE +0.  CHGBD100
00186      05  WRK-KEY-X                   PIC  X(10).                  CHGBD100
00187      05  WRK-KEY-N  REDEFINES WRK-KEY-X                           CHGBD100
00188                                      PIC  9(10).                  CHGBD100
00189 *                                                                 CHGBD100
00190      05  WRK-CHG-CURR-AMT          PIC S9(09)V99 VALUE +0.           CL*41
00191      05  WRK-CHG-TOT-AMT          PIC S9(09)V99 VALUE +0.            CL*63
00192      05  TOT-CHARGE-UI-AMT       PIC S9(09)V99 VALUE +0.             CL*63
00193      05  TOT-CHARGE-UI4-AMT       PIC S9(09)V99 VALUE +0.            CL*51
00194      05  TOT-CHARGE-UI3-AMT       PIC S9(09)V99 VALUE +0.            CL*51
00195      05  TOT-CHARGE-UCX-AMT       PIC S9(09)V99 VALUE +0.            CL*46
00196      05  TOT-CHARGE-UCFE-AMT       PIC S9(09)V99 VALUE +0.           CL*46
00197      05  TOT-CHARGE-SPEC-AMT       PIC S9(09)V99 VALUE +0.           CL*46
00198      05  TOT-CHARGE-CWC-AMT       PIC S9(09)V99 VALUE +0.            CL*46
00199      05  TOT-CHARGE-OTH-AMT       PIC S9(09)V99 VALUE +0.            CL*50
00200      05  TOT-CHARGE-RAT-AMT       PIC S9(09)V99 VALUE +0.            CL*53
00201      05  TOT-CHARGE-REM-AMT       PIC S9(09)V99 VALUE +0.            CL*53
00202      05  TOT-CHARGE-DCG-AMT       PIC S9(09)V99 VALUE +0.            CL*53
00203      05  TOT-CHARGE-CURR-AMT       PIC S9(09)V99 VALUE +0.           CL*46
00204      05  TOT-CHARGE-CURR-AMT-DISP  PIC ZZZ,ZZZ,ZZ9.99.            CHGBD100
00205      05  INV-EMP-NO-CURR-AMT       PIC S9(09)V99 VALUE +0.        CHGBD100
00206      05  DIS-INV-EMP-NO-CURR-AMT   PIC ZZZ,ZZZ,ZZ9.99.            CHGBD100
00207 *                                                                 CHGBD100
00208 *************************************************************     CHGBD100
00209 *  WRK-PROGRAM DEFINES VALUES FOR VALID BENEFIT PROGRAMS.         CHGBD100
00210 *  IT IS SET BASED ON CHARGE-PROG-X IN THE DUCAS ESPRPT04         CHGBD100
00211 *  RECORD.  IF AN NEW BENEFIT PROGRAM IS ESTABLISHED, ADD         CHGBD100
00212 *  AN ADDITIONAL LEVEL-88 AND MODIFY THE CODE IN P1500.           CHGBD100
00213 *************************************************************     CHGBD100
00214      05  WRK-PROGRAM                 PIC  X(01).                  CHGBD100
00215          88 WRK-PROG-UI-88          VALUE '1'.                    CHGBD100
00216          88 WRK-PROG-EB-88          VALUE '2'.                    CHGBD100
00217          88 WRK-PROG-TEUC-88        VALUE '3'.                    CHGBD100
00218          88 WRK-PROG-TEUCA-88       VALUE '4'.                    CHGBD100
00219          88 WRK-PROG-FAC-88         VALUE '5'.                    CHGBD100
00220          88 WRK-PROG-FSB-88         VALUE '6'.                    CHGBD100
00221          88 WRK-PROG-FSC-88         VALUE '7'.                    CHGBD100
00222          88 WRK-PROG-DUA-88         VALUE '8'.                    CHGBD100
00223          88 WRK-PROG-TR2-88         VALUE '9'.                    CHGBD100
00224          88 WRK-PROG-TRA-88         VALUE '0'.                    CHGBD100
00225          88 WRK-PROG-STEPLDR-88     VALUE 'A'.                    CHGBD100
00226          88 WRK-PROG-AB-88          VALUE 'B'.                    CHGBD100
00227          88 WRK-PROG-TRAINING-88    VALUE 'C'.                       CL*19
00228          88 WRK-PROG-DEPENDENTS-88  VALUE 'D'.                    CHGBD100
00229          88 WRK-PROG-EUC08-2PLUS-88 VALUE 'E'.                    CHGBD100
00230          88 WRK-PROG-EUC08-TIER3-88 VALUE 'F'.                    CHGBD100
00231          88 WRK-PROG-EUC08-TIER4-88 VALUE 'G'.                    CHGBD100
00232          88 WRK-PROG-SPECIAL-PAY-88 VALUE 'H'.                    CHGBD100
00233          88 WRK-PROG-UCPIA-88       VALUE 'I'.                    CHGBD100
00234          88 WRK-PROG-GPA-88         VALUE 'J'.                       CL**2
00235          88 WRK-PROG-PUA-88         VALUE 'U'.                       CL*13
00236          88 WRK-PROG-FPUC-88        VALUE 'L'.                       CL**2
00237          88 WRK-PROG-FRUR-88        VALUE 'M'.                       CL**2
00238          88 WRK-PROG-PEUC-88        VALUE 'N'.                       CL*19
00239          88 WRK-PROG-REUR-88        VALUE 'Y'.                       CL*18
00240          88 WRK-PROG-LWA-88         VALUE 'X'.                       CL*23
00241          88 WRK-PROG-PUA-STIM-88    VALUE 'R'.                       CL*25
00242          88 WRK-PROG-DUC-88         VALUE 'U'.                       CL*31
00243                                                                   CHGBD100
00244 *************************************************************     CHGBD100
00245 *  WRK-BEN-PROG-CODE DEFINES THE VALUES FOR THE BENEFIT           CHGBD100
00246 *  PROGRAM CODE AS USED IN THE BENEFITS SYSTEM.                   CHGBD100
00247 *************************************************************     CHGBD100
00248      05  WRK-BEN-PROG-CODE           PIC  X(02).                  CHGBD100
00249      05  FILLER REDEFINES WRK-BEN-PROG-CODE.                      CHGBD100
00250          10  WRK-BEN-PROG-CODE-PFX   PIC  X(01).                  CHGBD100
00251              88  BEN-PROG-UI-88          VALUE '0'.               CHGBD100
00252              88  BEN-PROG-EB-88          VALUE '1'.               CHGBD100
00253              88  BEN-PROG-FSB-88         VALUE '2'.               CHGBD100
00254              88  BEN-PROG-FSC-88         VALUE '3'.               CHGBD100
00255              88  BEN-PROG-DUA-88         VALUE '4'.               CHGBD100
00256              88  BEN-PROG-TR2-88         VALUE '5'.               CHGBD100
00257              88  BEN-PROG-TRA-88         VALUE '6'.               CHGBD100
00258              88  BEN-PROG-TEUC-88        VALUE '7'.               CHGBD100
00259              88  BEN-PROG-TEUCA-88       VALUE '8'.               CHGBD100
00260              88  BEN-PROG-STEPLDR-88     VALUE '9'.               CHGBD100
00261              88  BEN-PROG-FAC-88         VALUE 'F'.               CHGBD100
00262              88  BEN-PROG-AB-88          VALUE 'A'.               CHGBD100
00263              88  BEN-PROG-TRAINING-88    VALUE 'T'.               CHGBD100
00264              88  BEN-PROG-DEPENDENTS-88  VALUE 'D'.               CHGBD100
00265              88  BEN-PROG-EUC08-2PLUS-88 VALUE 'P'.               CHGBD100
00266              88  BEN-PROG-EUC08-TIER3-88 VALUE 'E'.               CHGBD100
00267              88  BEN-PROG-EUC08-TIER4-88 VALUE 'Z'.               CHGBD100
00268              88  BEN-PROG-SPECIAL-PAY-88 VALUE 'S'.               CHGBD100
00269 *            88  BEN-PROG-UCPIA-88       VALUE 'U'.                  CL*13
00270              88  BEN-PROG-PUA-88         VALUE 'U'.                  CL*13
00271              88  BEN-PROG-FPUC-88        VALUE 'V'.                  CL**2
00272              88  BEN-PROG-FRUR-88        VALUE 'W'.                  CL**2
00273              88  BEN-PROG-PEUC-88        VALUE 'C'.                  CL*14
00274              88  BEN-PROG-REUR-88        VALUE 'Y'.                  CL*18
00275              88  BEN-PROG-LWA-88         VALUE 'X'.                  CL*23
00276              88  BEN-PROG-PUA-STIM-88    VALUE 'R'.                  CL*25
00277              88  BEN-PROG-DUC-88         VALUE 'R'.                  CL*29
00278          10  WRK-BEN-PROG-CODE-SFX   PIC  X(01).                  CHGBD100
00279                                                                   CHGBD100
00280      05  WRK-CHARGE-IN-READ          PIC  9(07) COMP-3.           CHGBD100
00281      05  WRK-SORT-CHG-WRITTEN        PIC  9(07) COMP-3.           CHGBD100
00282                                                                   CHGBD100
00283      05  WRK-CHG-DT-ERR-CNT          PIC  9(07) COMP-3.           CHGBD100
00284      05  WRK-BYE-ERR-CNT             PIC  9(07) COMP-3.           CHGBD100
00285      05  WRK-EMP-TYPE-ERR-CNT        PIC  9(07) COMP-3.           CHGBD100
00286      05  WRK-CHG-AMT-ERR-CNT         PIC  9(07) COMP-3.           CHGBD100
00287      05  WRK-SUPP-CD-ERR-CNT         PIC  9(07) COMP-3.           CHGBD100
00288      05  WRK-EMP-NO-ERR-CNT          PIC  9(07) COMP-3.           CHGBD100
00289      05  WRK-SSN-ERR-CNT             PIC  9(07) COMP-3.           CHGBD100
00290                                                                   CHGBD100
00291      05  WRK-EMP-ACCT                PIC  9(06).                  CHGBD100
00292          88 WRK-EMP-ACCT-FED-88  VALUE 000001 THRU 001999.        CHGBD100
00293          88 WRK-EMP-ACCT-CWC-88  VALUE 110000 THRU 119999.        CHGBD100
00294                                                                   CHGBD100
00295      05  WRK-EMP-TYPE                PIC  9(02).                  CHGBD100
00296          88 WRK-EMP-TYPE-RATED-88     VALUE 00.                   CHGBD100
00297          88 WRK-EMP-TYPE-SELF-INS-88  VALUE 08.                   CHGBD100
00298          88 WRK-EMP-TYPE-CWC-88       VALUE 04.                   CHGBD100
00299          88 WRK-EMP-TYPE-FED-88       VALUE 01, 02.               CHGBD100
00300          88 WRK-EMP-TYPE-VALID-88     VALUE 00, 01, 02, 03        CHGBD100
00301                                             04, 05, 06            CHGBD100
00302                                             07, 08, 09            CHGBD100
00303                                             10, 11, 12            CHGBD100
00304                                             13, 15, 16, 17        CHGBD100
00305                                             18, 19, 20, 21        CHGBD100
00306                                             22, 23, 24, 25        CHGBD100
00307                                             26, 27, 28, 29           CL**3
00308                                             31, 32, 33, 34           CL*16
00309                                             35, 36, 37, 38, 39.      CL*29
00310 ** ADD ERROR MSG TABLE SET UP                                     CHGBD100
00311  01  MSG-TABLE.                                                   CHGBD100
00312      05  MSG1-EMP-TYPE-ERR.                                       CHGBD100
00313          10  MSG1-ID.                                             CHGBD100
00314              15  MSG1-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD100
00315              15  MSG1-ID2      PIC X(03)  VALUE '100'.            CHGBD100
00316          10  MSG1-SHORT-TEXT   PIC X(20)                          CHGBD100
00317                    VALUE 'INVALID EMP TYPE :  '.                  CHGBD100
00318          10  MSG1-LONG-TEXT.                                      CHGBD100
00319              15  FILLER        PIC X(29)                          CHGBD100
00320                    VALUE 'INVALID EMPLOYER TYPE        '.         CHGBD100
00321              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD100
00322              15  TBL-SSN       PIC 9(10).                         CHGBD100
00323              15  FILLER        PIC X(13)  VALUE '  EMP TYPE = '.  CHGBD100
00324              15  TBL-EMP-TYPE  PIC 9(02).                         CHGBD100
00325                                                                   CHGBD100
00326      05  MSG2-BYE-DATE-ERR.                                       CHGBD100
00327          10  MSG2-ID.                                             CHGBD100
00328              15  MSG2-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD100
00329              15  MSG2-ID2      PIC X(03)  VALUE '100'.            CHGBD100
00330          10  MSG2-SHORT-TEXT   PIC X(20)                          CHGBD100
00331                    VALUE 'INVALID BYE DATE :  '.                  CHGBD100
00332          10  MSG2-LONG-TEXT.                                      CHGBD100
00333              15  FILLER        PIC X(29)                          CHGBD100
00334                    VALUE 'INVALID BYE DATE ACCEPTED    '.         CHGBD100
00335              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD100
00336              15  TBL-SSN2      PIC 9(11).                         CHGBD100
00337              15  FILLER        PIC X(13)  VALUE '  BYE DATE = '.  CHGBD100
00338              15  TBL-BYE-DATE2 PIC 9(08).                         CHGBD100
00339                                                                   CHGBD100
00340      05  MSG3-CHARGE-DATE-ERR.                                    CHGBD100
00341          10  MSG3-ID.                                             CHGBD100
00342              15  MSG3-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD100
00343              15  MSG3-ID2      PIC X(03)  VALUE '100'.            CHGBD100
00344          10  MSG3-SHORT-TEXT   PIC X(20)                          CHGBD100
00345                    VALUE 'INVALID CHG DATE :  '.                  CHGBD100
00346          10  MSG3-LONG-TEXT.                                      CHGBD100
00347              15  FILLER        PIC X(29)                          CHGBD100
00348                    VALUE 'INVALID CHARGE DATE          '.         CHGBD100
00349              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD100
00350              15  TBL-SSN3      PIC 9(10).                         CHGBD100
00351              15  FILLER        PIC X(13)  VALUE '  CHG DATE = '.  CHGBD100
00352              15  TBL-CHG-DATE  PIC 9(08).                         CHGBD100
00353                                                                   CHGBD100
00354      05  MSG4-CHARGE-AMT-ERR.                                     CHGBD100
00355          10  MSG4-ID.                                             CHGBD100
00356              15  MSG4-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD100
00357              15  MSG4-ID2      PIC X(03)  VALUE '100'.            CHGBD100
00358          10  MSG4-SHORT-TEXT   PIC X(20)                          CHGBD100
00359                    VALUE 'INVALID CHG AMOUNT :'.                  CHGBD100
00360          10  MSG4-LONG-TEXT.                                      CHGBD100
00361              15  FILLER        PIC X(29)                          CHGBD100
00362                    VALUE 'INVALID CHARGE AMOUNT        '.         CHGBD100
00363              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD100
00364              15  TBL-SSN4      PIC 9(10).                         CHGBD100
00365              15  FILLER        PIC X(15)  VALUE '  CHG AMOUNT = '.CHGBD100
00366              15  TBL-CURR-AMT  PIC S9(08)V99.                     CHGBD100
00367                                                                   CHGBD100
00368      05  MSG5-SUPP-CODE-ERR.                                      CHGBD100
00369          10  MSG5-ID.                                             CHGBD100
00370              15  MSG5-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD100
00371              15  MSG5-ID2      PIC X(03)  VALUE '100'.            CHGBD100
00372          10  MSG5-SHORT-TEXT   PIC X(20)                          CHGBD100
00373                    VALUE 'INVALID SUPP CODE  :'.                  CHGBD100
00374          10  MSG5-LONG-TEXT.                                      CHGBD100
00375              15  FILLER        PIC X(29)                          CHGBD100
00376                    VALUE 'INVALID SUPP CODE            '.         CHGBD100
00377              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD100
00378              15  TBL-SSN5      PIC 9(10).                         CHGBD100
00379              15  FILLER        PIC X(14)  VALUE '  SUPP CODE = '. CHGBD100
00380              15  TBL-SUPP-CODE PIC X(01).                         CHGBD100
00381                                                                   CHGBD100
00382      05  MSG6-EMP-NO-ERR.                                         CHGBD100
00383          10  MSG6-ID.                                             CHGBD100
00384              15  MSG6-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD100
00385              15  MSG6-ID2      PIC X(03)  VALUE '100'.            CHGBD100
00386          10  MSG6-SHORT-TEXT   PIC X(20)                          CHGBD100
00387                    VALUE 'EMPLOYER NO = ZERO :'.                  CHGBD100
00388          10  MSG6-LONG-TEXT.                                      CHGBD100
00389              15  FILLER        PIC X(29)                          CHGBD100
00390                    VALUE 'EMPLOYER NUMBER = ZERO       '.         CHGBD100
00391              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD100
00392              15  MSG6-SSN      PIC 9(10).                         CHGBD100
00393              15  FILLER        PIC X(15)  VALUE SPACES.           CHGBD100
00394                                                                   CHGBD100
00395      05  MSG7-SSN-ERR.                                            CHGBD100
00396          10  MSG7-ID.                                             CHGBD100
00397              15  MSG7-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD100
00398              15  MSG7-ID2      PIC X(03)  VALUE '100'.            CHGBD100
00399          10  MSG7-SHORT-TEXT   PIC X(20)                          CHGBD100
00400                    VALUE 'SSN =  ZERO        :'.                  CHGBD100
00401          10  MSG7-LONG-TEXT.                                      CHGBD100
00402              15  FILLER        PIC X(29)                          CHGBD100
00403                    VALUE 'SSN = ZERO                   '.         CHGBD100
00404              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD100
00405              15  MSG7-SSN      PIC 9(10).                         CHGBD100
00406              15  FILLER        PIC X(15)  VALUE SPACES.           CHGBD100
00407                                                                   CHGBD100
00408  01  WRK-CHG-REC.                                                    CL*62
00409  ++INCLUDE CHGIM001                                                  CL*62
00410                                                                      CL*62
00411 ** ADD ERROR MSG OUTPUT RECORD.                                   CHGBD100
00412  01  R907-REC.                                                    CHGBD100
00413  ++INCLUDE DTSIR907                                               CHGBD100
00414                                                                   CHGBD100
00415 *** BENEFITS CHARGE RECORD ***                                    CHGBD100
00416  ++INCLUDE ESPRPT04                                                  CL*33
00417                                                                   CHGBD100
00418  01  FILLER REDEFINES CHARGE-REC.                                 CHGBD100
00419      05  WRK-CHARGE-REC              PIC  X(200).                    CL*32
00420                                                                   CHGBD100
00421  01  L001-LINK-AREA.                                              CHGBD100
00422  ++INCLUDE DTSIL001                                               CHGBD100
00423                                                                   CHGBD100
00424  01  L004-LINK-AREA.                                              CHGBD100
00425  ++INCLUDE DTSIL004                                               CHGBD100
00426                                                                      CL*34
00427  01  L005-LINK-AREA.                                                 CL*73
00428  ++INCLUDE DTSIL005                                                  CL*73
00429                                                                      CL*73
00430  01  L910-LINK-AREA.                                                 CL*34
00431  ++INCLUDE DTSIL910                                                  CL*34
00432                                                                      CL*34
00433  01  MSKL-REC.                                                       CL*34
00434  ++INCLUDE DTSIMSKL                                                  CL*34
00435                                                                      CL*34
00436  01  MPRF-REC.                                                       CL*34
00437  ++INCLUDE DTSIMPRF                                                  CL*34
00438                                                                      CL*34
00439  01  L921-LINK-AREA.                                                 CL*34
00440  ++INCLUDE DTSIL921                                                  CL*34
00441                                                                      CL*34
00442  01  ISKL-REC.                                                       CL*34
00443  ++INCLUDE DTSIISKL                                                  CL*34
00444                                                                   CHGBD100
00445  PROCEDURE DIVISION.                                              CHGBD100
00446      SKIP2                                                        CHGBD100
00447  CHGBD100-MAIN.                                                   CHGBD100
00448      MOVE ZERO TO  WRK-CHARGE-IN-READ                             CHGBD100
00449                    WRK-SORT-CHG-WRITTEN                           CHGBD100
00450                    WRK-CHG-DT-ERR-CNT                             CHGBD100
00451                    WRK-BYE-ERR-CNT                                CHGBD100
00452                    WRK-EMP-TYPE-ERR-CNT                           CHGBD100
00453                    WRK-CHG-AMT-ERR-CNT                            CHGBD100
00454                    WRK-SUPP-CD-ERR-CNT                            CHGBD100
00455                    WRK-EMP-NO-ERR-CNT                             CHGBD100
00456                    WRK-SSN-ERR-CNT.                               CHGBD100
00457                                                                   CHGBD100
00458      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD100
00459                                                                   CHGBD100
00460      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD100
00461      IF WRK-ERROR-YES-88                                          CHGBD100
00462         GO TO CHGBD100-EXIT.                                      CHGBD100
00463                                                                   CHGBD100
00464      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD100
00465                                                                   CHGBD100
00466      IF  RETURN-CODE NOT EQUAL 0                                     CL*66
00467      DISPLAY ' RETURM CODE NOT EQ 0-= ' RETURN-CODE                  CL*66
00468          STOP RUN.                                                   CL*66
00469      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD100
00470                                                                   CHGBD100
00471      DISPLAY ' RC --= ' RETURN-CODE.                                 CL*64
00472                                                                      CL*60
00473 *    IF WRK-EDIT-ERROR-YES-88                                        CL*67
00474 *    MOVE +05 TO RETURN-CODE.                                        CL*67
00475                                                                   CHGBD100
00476  CHGBD100-EXIT.                                                   CHGBD100
00477      STOP RUN.                                                    CHGBD100
00478      EJECT                                                        CHGBD100
00479  I0000-INITIATE.                                                  CHGBD100
00480      MOVE MSG1-ID1 TO R907-MODULE-NAME.                           CHGBD100
00481      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      CHGBD100
00482                                                                   CHGBD100
00483      PERFORM S005-FROM-SYS          THRU S005-EXIT                   CL*73
00484      MOVE L005-DATE                TO WRK-CURR-SYS-DATE              CL*73
00485      DISPLAY 'TODAYS SYSTEM DATE '  WRK-CURR-SYS-DATE.               CL*73
00486                                                                      CL*73
00487      PERFORM I2000-OPEN-FILES THRU I2000-EXIT.                    CHGBD100
00488      PERFORM I3000-VALIDATE-CHARGES THRU I3000-EXIT.                 CL*76
00489                                                                   CHGBD100
00490  I0000-EXIT.                                                      CHGBD100
00491      EXIT.                                                        CHGBD100
00492                                                                   CHGBD100
00493  I2000-OPEN-FILES.                                                CHGBD100
00494      OPEN INPUT  CHARGE-IN-FILE.                                  CHGBD100
00495      IF NOT CHARGE-FILE-OK-88                                     CHGBD100
00496         DISPLAY 'CHARGE FILE OPEN ERROR: ' CHARGE-IN-STATUS       CHGBD100
00497         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD100
00498         GO TO I2000-EXIT.                                         CHGBD100
00499                                                                   CHGBD100
00500      OPEN OUTPUT BD100-CHG-FILE.                                  CHGBD100
00501      IF NOT BD100-FILE-OK-88                                      CHGBD100
00502         DISPLAY 'SORT FILE OPEN ERROR: ' BD100-CHG-STATUS         CHGBD100
00503         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD100
00504         GO TO I2000-EXIT.                                         CHGBD100
00505                                                                      CL*34
00506      PERFORM S910-OPEN-READ THRU S910-EXIT.                          CL*34
00507      PERFORM S921-OPEN-READ THRU S921-EXIT.                          CL*34
00508                                                                      CL*34
00509                                                                   CHGBD100
00510  I2000-EXIT.                                                      CHGBD100
00511      EXIT.                                                        CHGBD100
00512                                                                   CHGBD100
00513  I3000-VALIDATE-CHARGES.                                             CL*68
00514      READ CHARGE-IN-FILE INTO WRK-CHARGE-REC                         CL*68
00515      IF NOT CHARGE-FILE-OK-88                                        CL*68
00516         DISPLAY 'CHARGE FILE EMPTY: ' CHARGE-IN-STATUS               CL*68
00517         SET WRK-ERROR-YES-88 TO TRUE                                 CL*68
00518         MOVE +03 TO RETURN-CODE                                      CL*68
00519         DISPLAY 'P0000 EMPTY: ' RETURN-CODE                          CL*68
00520         GO TO I3000-EXIT.                                            CL*68
00521                                                                      CL*70
00522      DISPLAY 'DAILY FILE CHARGE EAN  ' CHARGE-EMPL-ACCT              CL*74
00523      DISPLAY 'DAILY FILE CHARGE EAN  ' CHARGE-SSN                    CL*74
00524      DISPLAY 'DAILY FILE CHARGE EAN  ' CHARGE-BYE-DATE               CL*74
00525      DISPLAY 'DAILY FILE CHARGE DATE ' CHARGE-DATE.                  CL*74
00526      MOVE CHARGE-DATE TO L001-FED-8-DATE-X.                          CL*68
00527      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                         CL*68
00528      IF L001-VALID-DATE                                              CL*68
00529         MOVE L001-FED-8-DATE-9 TO WRK-CHARGE-DATE                    CL*68
00530         DISPLAY 'FED-8 FILE CHARGE DATE ' WRK-CHARGE-DATE            CL*72
00531      ELSE                                                            CL*68
00532         SET WRK-ERROR-YES-88 TO TRUE                                 CL*68
00533         MOVE +03 TO RETURN-CODE                                      CL*68
00534         DISPLAY 'INVALID CHARGE DATE: ' CHARGE-DATE                  CL*68
00535         GO TO I3000-EXIT.                                            CL*68
00536                                                                      CL*69
00537      MOVE WRK-CURR-SYS-DATE  TO  L001-FED-8-DATE-9                   CL*73
00538      PERFORM S001-FROM-FED-8 THRU S001-EXIT                          CL*68
00539      SUBTRACT 1 FROM L001-JUL-ABS-DAY                                CL*68
00540      PERFORM S001-FROM-ABS-DAY THRU S001-EXIT                        CL*68
00541      MOVE L001-FED-8-DATE-9  TO  WRK-CHARGE-PRIOR-DATE.              CL*68
00542      DISPLAY '************************* '                            CL*71
00543      DISPLAY '>>>>>>>>>>PRIOR WORK DATE ' WRK-CHARGE-PRIOR-DATE.     CL*71
00544      DISPLAY '>>>DAILY FILE CHARGE DATE ' WRK-CHARGE-DATE            CL*71
00545      DISPLAY '************************* '                            CL*71
00546                                                                      CL*68
00547      IF WRK-CHARGE-DATE NOT = WRK-CHARGE-PRIOR-DATE                  CL*69
00548         SET WRK-ERROR-YES-88 TO TRUE                                 CL*68
00549         MOVE +09 TO RETURN-CODE                                      CL*68
00550         DISPLAY 'INVALID CHARGE DATE: ' CHARGE-DATE                  CL*69
00551         GO TO I3000-EXIT.                                            CL*69
00552                                                                      CL*68
00553      CLOSE CHARGE-IN-FILE.                                           CL*68
00554      OPEN INPUT  CHARGE-IN-FILE.                                     CL*68
00555      IF NOT CHARGE-FILE-OK-88                                        CL*68
00556         DISPLAY 'CHARGE FILE OPEN ERROR: ' CHARGE-IN-STATUS          CL*68
00557         SET WRK-ERROR-YES-88 TO TRUE.                                CL*68
00558                                                                      CL*68
00559  I3000-EXIT.                                                         CL*68
00560      EXIT.                                                           CL*68
00561                                                                      CL*68
00562                                                                   CHGBD100
00563  P0000-PROCESS.                                                   CHGBD100
00564      READ CHARGE-IN-FILE INTO WRK-CHARGE-REC                      CHGBD100
00565      IF NOT CHARGE-FILE-OK-88                                     CHGBD100
00566         DISPLAY 'CHARGE FILE EMPTY: ' CHARGE-IN-STATUS            CHGBD100
00567         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD100
00568         MOVE +03 TO RETURN-CODE                                      CL*65
00569         DISPLAY 'P0000 EMPTY: ' RETURN-CODE                          CL*66
00570         GO TO P0000-EXIT                                          CHGBD100
00571      ELSE                                                         CHGBD100
00572         ADD 1 TO WRK-CHARGE-IN-READ.                              CHGBD100
00573                                                                   CHGBD100
00574      PERFORM P1000-SELECT-CHARGES THRU P1000-EXIT                 CHGBD100
00575         UNTIL CHARGE-FILE-EOF-88.                                 CHGBD100
00576                                                                   CHGBD100
00577  P0000-EXIT.                                                      CHGBD100
00578      EXIT.                                                        CHGBD100
00579                                                                   CHGBD100
00580  P1000-SELECT-CHARGES.                                            CHGBD100
00581      SET WRK-EDIT-ERROR-NO-88 TO TRUE.                            CHGBD100
00582      PERFORM P1100-EDIT-CHARGE-DATE THRU P1100-EXIT.              CHGBD100
00583                                                                   CHGBD100
00584      PERFORM P1200-EDIT-CWC         THRU P1200-EXIT.              CHGBD100
00585                                                                   CHGBD100
00586      PERFORM P1300-EDIT-BYE-DATE    THRU P1300-EXIT.              CHGBD100
00587                                                                   CHGBD100
00588      PERFORM P1400-EDIT-CHG-AMT     THRU P1400-EXIT.              CHGBD100
00589                                                                   CHGBD100
00590      PERFORM P1500-EDIT-SUPP-CODE   THRU P1500-EXIT.              CHGBD100
00591                                                                   CHGBD100
00592      PERFORM P1600-EDIT-EMP-NO      THRU P1600-EXIT.              CHGBD100
00593                                                                   CHGBD100
00594      PERFORM P1700-EDIT-SSN         THRU P1700-EXIT.              CHGBD100
00595                                                                   CHGBD100
00596      IF WRK-EDIT-ERROR-YES-88                                     CHGBD100
00597         DISPLAY 'CHARGE FILE DATA ERROR: ' CHARGE-IN-STATUS          CL*32
00598         SET WRK-ERROR-YES-88 TO TRUE                                 CL*32
00599         SET CHARGE-FILE-EOF-88 TO TRUE                               CL*32
00600         GO TO P1000-EXIT.                                            CL*32
00601                                                                   CHGBD100
00602      PERFORM P2000-WRITE-SORT-REC THRU P2000-EXIT.                CHGBD100
00603                                                                   CHGBD100
00604  P1000-READ-NEXT.                                                 CHGBD100
00605      READ CHARGE-IN-FILE INTO WRK-CHARGE-REC.                     CHGBD100
00606      IF CHARGE-FILE-OK-88                                         CHGBD100
00607         ADD 1 TO WRK-CHARGE-IN-READ                               CHGBD100
00608      ELSE                                                         CHGBD100
00609      IF CHARGE-FILE-EOF-88                                        CHGBD100
00610         NEXT SENTENCE                                             CHGBD100
00611      ELSE                                                         CHGBD100
00612         DISPLAY 'CHARGE FILE READ ERROR: ' CHARGE-IN-STATUS       CHGBD100
00613         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD100
00614         SET CHARGE-FILE-EOF-88 TO TRUE.                           CHGBD100
00615                                                                   CHGBD100
00616  P1000-EXIT.                                                      CHGBD100
00617      EXIT.                                                        CHGBD100
00618                                                                   CHGBD100
00619  P1100-EDIT-CHARGE-DATE.                                          CHGBD100
00620      MOVE CHARGE-DATE TO L001-FED-8-DATE-X.                       CHGBD100
00621      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      CHGBD100
00622      IF L001-VALID-DATE                                           CHGBD100
00623         MOVE L001-FED-8-DATE-9 TO WRK-CHARGE-DATE                 CHGBD100
00624      ELSE                                                         CHGBD100
00625         SET WRK-EDIT-ERROR-YES-88 TO TRUE                         CHGBD100
00626         DISPLAY 'CHARGE DATE ERROR: ' CHARGE-DATE                    CL*40
00627         ADD +1 TO WRK-CHG-DT-ERR-CNT                              CHGBD100
00628         MOVE MSG3-ID2         TO R907-MSG-ID                      CHGBD100
00629         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD100
00630         MOVE CHARGE-SSN       TO TBL-SSN3                         CHGBD100
00631         MOVE CHARGE-DATE      TO TBL-CHG-DATE                     CHGBD100
00632         MOVE MSG3-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD100
00633         PERFORM S946-R907-WRITE THRU S946-EXIT.                   CHGBD100
00634                                                                   CHGBD100
00635  P1100-EXIT.                                                      CHGBD100
00636      EXIT.                                                        CHGBD100
00637                                                                   CHGBD100
00638  P1200-EDIT-CWC.                                                  CHGBD100
00639      MOVE CHARGE-EMPL-ACCT TO WRK-EMP-ACCT.                       CHGBD100
00640      MOVE CHARGE-EMPLOYER-TYPE TO WRK-EMP-TYPE.                   CHGBD100
00641                                                                   CHGBD100
00642 ************************************************************      CHGBD100
00643 *  EMPLOYER TYPE NOT SET IN CHARGE RECORDS FOR CWC ACCOUNTS.      CHGBD100
00644 *  THE FOLLOWING CODE CORRECTS THE EMPLOYER TYPE ON THE           CHGBD100
00645 *  INPUT RECORDS.                                                 CHGBD100
00646 ************************************************************      CHGBD100
00647      MOVE LOW-VALUES TO MSKL-KEY-AREA.                               CL*35
00648                                                                      CL*35
00649      MOVE WRK-EMP-ACCT TO MSKL-EMP-NO.                               CL*54
00650                                                                      CL*35
00651      SET MSKL-PRF-88 TO TRUE.                                        CL*35
00652                                                                      CL*35
00653      PERFORM S910-READ THRU S910-EXIT.                               CL*35
00654      IF L910-OK-88                                                   CL*35
00655         MOVE MSKL-REC TO MPRF-REC                                    CL*35
00656         MOVE  MPRF-ELIGIBLE-CD TO WRK-EMP-TYPE                       CL*56
00657      ELSE                                                            CL*35
00658         DISPLAY 'MPRF NOT FOUND ' WRK-EMP-ACCT                       CL*35
00659         MOVE  'MPRF NOT FOUND ' TO MSG2-ID2                          CL*35
00660         SET WRK-EDIT-ERROR-YES-88 TO TRUE                            CL*35
00661         ADD +1                  TO WRK-BYE-ERR-CNT                   CL*35
00662         DISPLAY 'CHARGE EMP NO FOUND ERROR: ' WRK-EMP-ACCT           CL*40
00663         MOVE MSG2-ID2         TO R907-MSG-ID                         CL*35
00664         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                         CL*35
00665         MOVE CHARGE-SSN       TO TBL-SSN2                            CL*35
00666         MOVE CHARGE-BYE-DATE  TO TBL-BYE-DATE2                       CL*35
00667         MOVE MSG2-LONG-TEXT   TO R907-MSG-TEXT                       CL*35
00668         PERFORM S946-R907-WRITE THRU S946-EXIT                       CL*35
00669         MOVE ZERO               TO WRK-BYE.                          CL*35
00670                                                                      CL*35
00671      IF WRK-EMP-ACCT-CWC-88                                          CL*54
00672         IF NOT WRK-EMP-TYPE-CWC-88                                   CL*54
00673            SET WRK-EMP-TYPE-CWC-88 TO TRUE                           CL*54
00674            MOVE WRK-EMP-TYPE TO CHARGE-EMPLOYER-TYPE.                CL*54
00675                                                                      CL*35
00676 *    DISPLAY 'EMP TYPE ' WRK-EMP-ACCT ' ' WRK-EMP-TYPE               CL*58
00677 *        ' '  MPRF-ELIGIBLE-CD.                                      CL*58
00678                                                                   CHGBD100
00679      MOVE WRK-EMP-TYPE TO CHARGE-EMPLOYER-TYPE.                      CL*56
00680 *    DISPLAY ' NEW TYPE ' CHARGE-EMPLOYER-TYPE.                      CL*58
00681  P1200-EXIT.                                                      CHGBD100
00682      EXIT.                                                        CHGBD100
00683                                                                   CHGBD100
00684  P1300-EDIT-BYE-DATE.                                             CHGBD100
00685      MOVE CHARGE-BYE-DATE       TO L001-FED-8-DATE-X.             CHGBD100
00686      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      CHGBD100
00687      IF L001-VALID-DATE                                           CHGBD100
00688         MOVE L001-FED-8-DATE-9  TO WRK-BYE                        CHGBD100
00689      ELSE                                                         CHGBD100
00690         SET WRK-EDIT-ERROR-YES-88 TO TRUE                            CL*32
00691         ADD +1                  TO WRK-BYE-ERR-CNT                CHGBD100
00692         MOVE MSG2-ID2         TO R907-MSG-ID                      CHGBD100
00693         DISPLAY 'CHARGE BYE DATE ERROR: ' CHARGE-BYE-DATE            CL*40
00694         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD100
00695         MOVE CHARGE-SSN       TO TBL-SSN2                         CHGBD100
00696         MOVE CHARGE-BYE-DATE  TO TBL-BYE-DATE2                    CHGBD100
00697         MOVE MSG2-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD100
00698         PERFORM S946-R907-WRITE THRU S946-EXIT                    CHGBD100
00699         MOVE ZERO               TO WRK-BYE.                       CHGBD100
00700                                                                   CHGBD100
00701  P1300-EXIT.                                                      CHGBD100
00702      EXIT.                                                        CHGBD100
00703                                                                   CHGBD100
00704  P1400-EDIT-CHG-AMT.                                              CHGBD100
00705       MOVE CHARGE-CURR-AMT TO WRK-CHG-CURR-AMT                       CL*41
00706      IF WRK-CHG-CURR-AMT NOT NUMERIC                                 CL*41
00707         SET WRK-EDIT-ERROR-YES-88 TO TRUE                         CHGBD100
00708         DISPLAY 'CHARGE AMT ERROR: ' CHARGE-CURR-AMT                 CL*40
00709         ADD +1 TO WRK-CHG-AMT-ERR-CNT                             CHGBD100
00710         MOVE MSG4-ID2         TO R907-MSG-ID                      CHGBD100
00711         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD100
00712         MOVE CHARGE-SSN       TO TBL-SSN2                         CHGBD100
00713         MOVE CHARGE-CURR-AMT  TO TBL-CURR-AMT                     CHGBD100
00714         MOVE MSG4-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD100
00715         PERFORM S946-R907-WRITE THRU S946-EXIT.                   CHGBD100
00716                                                                   CHGBD100
00717       ADD WRK-CHG-CURR-AMT TO WRK-CHG-TOT-AMT.                       CL*63
00718      MOVE WRK-CHG-TOT-AMT TO TOT-CHARGE-CURR-AMT-DISP.               CL*63
00719      DISPLAY ' CHARGE AMOUNT ON FILER = '                            CL*63
00720         TOT-CHARGE-CURR-AMT-DISP.                                    CL*63
00721  P1400-EXIT.                                                      CHGBD100
00722      EXIT.                                                        CHGBD100
00723                                                                   CHGBD100
00724  P1500-EDIT-SUPP-CODE.                                            CHGBD100
00725 *     DISPLAY 'PRGCODE-X ' CHARGE-PROG-X                             CL*52
00726 *     MOVE CHARGE-PROG-X               TO WRK-BEN-PROG-CODE.         CL*53
00727                                                                   CHGBD100
00728           IF CHARGE-PROG-X = '01' OR CHARGE-PROG-X = '02'            CL*53
00729              OR CHARGE-PROG-X = '05' OR CHARGE-PROG-X = '07'         CL*53
00730              OR CHARGE-PROG-X = '21'                                 CL*53
00731            MOVE '01' TO WRK-BEN-PROG-CODE.                           CL*57
00732                                                                      CL*53
00733       IF CHARGE-EMPL-ACCT = 005033                                   CL*23
00734          MOVE 'X' TO WRK-BEN-PROG-CODE-PFX.                          CL*23
00735                                                                      CL*23
00736       IF CHARGE-EMPL-ACCT = 005032                                   CL*18
00737          MOVE 'Y' TO WRK-BEN-PROG-CODE-SFX                           CL*45
00738          MOVE 'Y' TO WRK-BEN-PROG-CODE-PFX.                          CL*45
00739                                                                      CL*20
00740       IF CHARGE-EMPL-ACCT = 005031                                   CL*20
00741          MOVE 'N' TO WRK-BEN-PROG-CODE-PFX.                          CL*21
00742                                                                      CL*20
00743       IF CHARGE-EMPL-ACCT = 005030                                   CL*20
00744          MOVE 'M' TO WRK-BEN-PROG-CODE-PFX.                          CL*21
00745                                                                      CL*20
00746       IF CHARGE-EMPL-ACCT = 005029                                   CL*20
00747          MOVE 'L' TO WRK-BEN-PROG-CODE-PFX.                          CL*21
00748                                                                      CL*20
00749       IF CHARGE-EMPL-ACCT = 005034                                   CL*30
00750          MOVE 'R' TO WRK-BEN-PROG-CODE-PFX.                          CL*25
00751                                                                      CL*30
00752       IF CHARGE-EMPL-ACCT = 005035                                   CL*30
00753          MOVE 'R' TO WRK-BEN-PROG-CODE-PFX.                          CL*30
00754                                                                      CL*30
00755       IF CHARGE-EMPL-ACCT = 005036                                   CL*30
00756          MOVE 'U' TO WRK-BEN-PROG-CODE-PFX.                          CL*30
00757                                                                      CL*30
00758       IF CHARGE-EMPL-ACCT = 005027                                   CL*28
00759          MOVE 'U' TO WRK-BEN-PROG-CODE-PFX.                          CL*28
00760                                                                      CL*28
00761                                                                      CL*24
00762                                                                      CL*11
00763 *     DISPLAY 'PFX ' WRK-BEN-PROG-CODE-PFX                           CL*52
00764 *     DISPLAY 'SFX ' WRK-BEN-PROG-CODE-SFX                           CL*52
00765                                                                      CL*39
00766 *     EVALUATE WRK-BEN-PROG-CODE-SFX                                 CL*48
00767       EVALUATE WRK-BEN-PROG-CODE                                     CL*48
00768                                                                   CHGBD100
00769         WHEN '01'                                                    CL*48
00770           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-UI-AMT                  CL*46
00771           SET WRK-PROG-UI-88           TO TRUE                    CHGBD100
00772                                                                   CHGBD100
00773 *       WHEN '02'                                                    CL*57
00774 *         ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-UCFE-AMT                CL*53
00775 *         SET WRK-PROG-EB-88           TO TRUE                       CL*57
00776                                                                   CHGBD100
00777 *       WHEN '2'                                                     CL*35
00778 *         SET WRK-PROG-FSB-88          TO TRUE                       CL*35
00779                                                                   CHGBD100
00780 *       WHEN '3'                                                     CL*35
00781 *         SET WRK-PROG-FSC-88          TO TRUE                       CL*35
00782                                                                   CHGBD100
00783 *       WHEN '4'                                                     CL*35
00784 *         SET WRK-PROG-DUA-88          TO TRUE                       CL*35
00785                                                                   CHGBD100
00786 *       WHEN '05'                                                    CL*57
00787 *         ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-UCX-AMT                 CL*53
00788 *         SET WRK-PROG-TR2-88          TO TRUE                       CL*57
00789                                                                   CHGBD100
00790 *       WHEN '6'                                                     CL*35
00791 *         SET WRK-PROG-TRA-88          TO TRUE                       CL*35
00792                                                                   CHGBD100
00793 *       WHEN '07'                                                    CL*57
00794 *         ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-CWC-AMT                 CL*53
00795 *         SET WRK-PROG-TEUC-88         TO TRUE                       CL*57
00796                                                                   CHGBD100
00797 *       WHEN '21'                                                    CL*57
00798 *         ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-OTH-AMT                 CL*53
00799 *         SET WRK-PROG-TEUC-88         TO TRUE                       CL*57
00800                                                                      CL*50
00801 *       WHEN '8'                                                     CL*35
00802 *         SET WRK-PROG-TEUCA-88        TO TRUE                       CL*35
00803                                                                   CHGBD100
00804 *       WHEN '9'                                                     CL*35
00805 *         SET WRK-PROG-STEPLDR-88      TO TRUE                       CL*35
00806                                                                   CHGBD100
00807 *       WHEN 'F'                                                     CL*35
00808 *         SET WRK-PROG-FAC-88          TO TRUE                       CL*35
00809                                                                   CHGBD100
00810 *       WHEN 'A'                                                     CL*35
00811 *         SET WRK-PROG-AB-88           TO TRUE                       CL*35
00812                                                                   CHGBD100
00813 *       WHEN 'T'                                                     CL*35
00814 *         SET WRK-PROG-TRAINING-88     TO TRUE                       CL*35
00815                                                                   CHGBD100
00816 *       WHEN 'D'                                                     CL*35
00817 *         SET WRK-PROG-DEPENDENTS-88   TO TRUE                       CL*35
00818                                                                   CHGBD100
00819 *       WHEN 'P'                                                     CL*35
00820 *         SET WRK-PROG-EUC08-2PLUS-88  TO TRUE                       CL*35
00821                                                                   CHGBD100
00822 *       WHEN 'E'                                                     CL*35
00823 *         SET WRK-PROG-EUC08-TIER3-88  TO TRUE                       CL*35
00824                                                                   CHGBD100
00825 *       WHEN 'Z'                                                     CL*35
00826 *         SET WRK-PROG-EUC08-TIER4-88  TO TRUE                       CL*35
00827                                                                   CHGBD100
00828 *       WHEN 'S'                                                     CL*35
00829 *         SET WRK-PROG-SPECIAL-PAY-88  TO TRUE                       CL*35
00830                                                                   CHGBD100
00831 *       WHEN 'U'                                                     CL*35
00832 *         SET WRK-PROG-PUA-88        TO TRUE                         CL*35
00833                                                                      CL**3
00834 *       WHEN 'L'                                                     CL*35
00835 *         SET WRK-PROG-FPUC-88        TO TRUE                        CL*35
00836                                                                      CL**3
00837 *       WHEN 'M'                                                     CL*35
00838 *         SET WRK-PROG-FRUR-88        TO TRUE                        CL*35
00839                                                                      CL*14
00840 *       WHEN 'N'                                                     CL*35
00841 *         SET WRK-PROG-PEUC-88        TO TRUE                        CL*35
00842                                                                      CL*18
00843         WHEN 'YY'                                                    CL*48
00844 *         ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-SPEC-AMT                CL*59
00845           SET WRK-PROG-REUR-88        TO TRUE                        CL*45
00846                                                                      CL**3
00847 *       WHEN 'X'                                                     CL*35
00848 *         SET WRK-PROG-LWA-88        TO TRUE                         CL*35
00849                                                                      CL*23
00850 *       WHEN 'R'                                                     CL*35
00851 *         SET WRK-PROG-PUA-STIM-88   TO TRUE                         CL*35
00852                                                                      CL*25
00853         WHEN OTHER                                                CHGBD100
00854           DISPLAY 'BD100 P1500 PROG CODE : '                         CL*27
00855              WRK-BEN-PROG-CODE '  ' CHARGE-EMPL-ACCT                 CL*57
00856           SET WRK-EDIT-ERROR-YES-88    TO TRUE                       CL*40
00857         DISPLAY 'CHARGE PGM CODE ERROR: ' CHARGE-PROG-X              CL*40
00858           ADD +1                       TO WRK-SUPP-CD-ERR-CNT     CHGBD100
00859           MOVE MSG5-ID2                TO R907-MSG-ID             CHGBD100
00860           MOVE CHARGE-EMPL-ACCT        TO R907-EMP-NO             CHGBD100
00861           MOVE CHARGE-SSN              TO TBL-SSN5                CHGBD100
00862           MOVE WRK-BEN-PROG-CODE-PFX   TO TBL-SUPP-CODE           CHGBD100
00863           MOVE MSG5-LONG-TEXT          TO R907-MSG-TEXT           CHGBD100
00864           PERFORM S946-R907-WRITE      THRU S946-EXIT             CHGBD100
00865                                                                   CHGBD100
00866       END-EVALUATE.                                               CHGBD100
00867                                                                   CHGBD100
00868           IF WRK-BEN-PROG-CODE = '01' AND CHARGE-CODE = '4'          CL*53
00869           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-UI4-AMT                 CL*53
00870           ELSE                                                       CL*53
00871           IF WRK-BEN-PROG-CODE = '01'                                CL*57
00872           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-UI3-AMT.                CL*53
00873                                                                      CL*53
00874      IF CHARGE-EMPLOYER-TYPE  = '00'                                 CL*53
00875           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-RAT-AMT                 CL*53
00876      ELSE                                                            CL*53
00877      IF CHARGE-EMPLOYER-TYPE  = '01'                                 CL*53
00878           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-UCFE-AMT                CL*53
00879      ELSE                                                            CL*53
00880      IF CHARGE-EMPLOYER-TYPE  = '02'                                 CL*53
00881           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-UCX-AMT                 CL*60
00882      ELSE                                                            CL*53
00883      IF CHARGE-EMPLOYER-TYPE  = '04'                                 CL*53
00884           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-CWC-AMT                 CL*53
00885      ELSE                                                            CL*53
00886      IF CHARGE-EMPLOYER-TYPE  = '08'                                 CL*53
00887           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-REM-AMT                 CL*53
00888      ELSE                                                            CL*53
00889      IF CHARGE-EMPLOYER-TYPE  = '10'                                 CL*53
00890           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-DCG-AMT                 CL*53
00891      ELSE                                                            CL*53
00892           ADD WRK-CHG-CURR-AMT TO TOT-CHARGE-SPEC-AMT                CL*59
00893       DISPLAY ' EMPLOYER TYPE ' CHARGE-EMPLOYER-TYPE.                CL*53
00894                                                                   CHGBD100
00895  P1500-EXIT.                                                      CHGBD100
00896      EXIT.                                                        CHGBD100
00897                                                                   CHGBD100
00898  P1600-EDIT-EMP-NO.                                               CHGBD100
00899      IF CHARGE-EMPL-ACCT < +1                                     CHGBD100
00900         SET WRK-EDIT-ERROR-YES-88 TO TRUE                         CHGBD100
00901         DISPLAY 'CHARGE EMP ERROR: ' CHARGE-EMPL-ACCT                CL*40
00902         ADD +1 TO WRK-EMP-NO-ERR-CNT                              CHGBD100
00903         MOVE MSG6-ID2         TO R907-MSG-ID                      CHGBD100
00904         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD100
00905         MOVE CHARGE-SSN       TO MSG6-SSN                         CHGBD100
00906         MOVE MSG6-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD100
00907         PERFORM S946-R907-WRITE THRU S946-EXIT.                   CHGBD100
00908                                                                   CHGBD100
00909  P1600-EXIT.                                                      CHGBD100
00910      EXIT.                                                        CHGBD100
00911                                                                   CHGBD100
00912                                                                   CHGBD100
00913  P1700-EDIT-SSN.                                                  CHGBD100
00914      MOVE CHARGE-KEY          TO WRK-KEY-X.                       CHGBD100
00915      IF WRK-KEY-N NUMERIC                                         CHGBD100
00916         IF WRK-KEY-N > ZERO                                       CHGBD100
00917            NEXT SENTENCE                                          CHGBD100
00918         ELSE                                                      CHGBD100
00919            PERFORM P1710-SSN-ERROR THRU P1710-EXIT                CHGBD100
00920      ELSE                                                         CHGBD100
00921         PERFORM P1710-SSN-ERROR THRU P1710-EXIT.                  CHGBD100
00922                                                                   CHGBD100
00923  P1700-EXIT.                                                      CHGBD100
00924      EXIT.                                                        CHGBD100
00925                                                                   CHGBD100
00926  P1710-SSN-ERROR.                                                 CHGBD100
00927      SET WRK-EDIT-ERROR-YES-88 TO TRUE.                           CHGBD100
00928      ADD +1 TO WRK-SSN-ERR-CNT.                                   CHGBD100
00929         DISPLAY 'CHARGE SSN ERROR: ' CHARGE-SSN                      CL*40
00930      MOVE MSG7-ID2         TO R907-MSG-ID.                        CHGBD100
00931      MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO.                        CHGBD100
00932      MOVE CHARGE-SSN       TO MSG7-SSN.                           CHGBD100
00933      MOVE MSG7-LONG-TEXT   TO R907-MSG-TEXT.                      CHGBD100
00934      PERFORM S946-R907-WRITE THRU S946-EXIT.                      CHGBD100
00935                                                                   CHGBD100
00936  P1710-EXIT.                                                      CHGBD100
00937      EXIT.                                                        CHGBD100
00938                                                                   CHGBD100
00939  P2000-WRITE-SORT-REC.                                            CHGBD100
00940      MOVE LOW-VALUES            TO CHG1-SORT-KEY-AREA.            CHGBD100
00941      MOVE WRK-KEY-N             TO CHG1-SSN.                      CHGBD100
00942      MOVE CHARGE-EMPL-ACCT      TO CHG1-EMP-NO.                   CHGBD100
00943      MOVE WRK-BYE               TO CHG1-BYE.                      CHGBD100
00944                                                                   CHGBD100
00945      MOVE WRK-CHARGE-DATE       TO CHG1-CHARGE-DATE.              CHGBD100
00946      MOVE CHARGE-CODE           TO CHG1-CHARGE-CODE.              CHGBD100
00947      MOVE WRK-PROGRAM           TO CHG1-CHARGE-PROGRAM.           CHGBD100
00948      MOVE CHARGE-PAY-TYPE       TO CHG1-CHARGE-PAY-TYPE.          CHGBD100
00949      MOVE CHARGE-NAME           TO CHG1-CHARGE-NAME.              CHGBD100
00950      MOVE CHARGE-EMPLOYER-TYPE  TO CHG1-CHARGE-EMP-TYPE.          CHGBD100
00951      MOVE CHARGE-CURR-AMT       TO CHG1-CHARGE-CURR-AMT.          CHGBD100
00952      ADD  CHG1-CHARGE-CURR-AMT  TO TOT-CHARGE-CURR-AMT.              CL*61
00953                                                                      CL*61
00954      WRITE SORT-CHG-REC FROM WRK-CHG-REC.                            CL*62
00955      ADD 1 TO WRK-SORT-CHG-WRITTEN.                               CHGBD100
00956                                                                      CL*60
00957                                                                   CHGBD100
00958  P2000-EXIT.                                                      CHGBD100
00959      EXIT.                                                        CHGBD100
00960                                                                   CHGBD100
00961  T0000-TERMINATE.                                                 CHGBD100
00962      CLOSE CHARGE-IN-FILE                                         CHGBD100
00963            BD100-CHG-FILE.                                        CHGBD100
00964       PERFORM S910-CLOSE THRU S910-EXIT.                             CL*36
00965       PERFORM S921-CLOSE THRU S921-EXIT.                             CL*36
00966                                                                   CHGBD100
00967      DISPLAY ' CHGBD100 CHARGE RECORDS READ :   '                 CHGBD100
00968         WRK-CHARGE-IN-READ.                                       CHGBD100
00969      DISPLAY '       CHARGE RECORDS WRITTEN:    '                 CHGBD100
00970         WRK-SORT-CHG-WRITTEN.                                     CHGBD100
00971      DISPLAY '       BYE DATE ERRORS ACCEPTED:  '                 CHGBD100
00972         WRK-BYE-ERR-CNT.                                          CHGBD100
00973      DISPLAY '       CHARGE DATE ERRORS:        '                 CHGBD100
00974         WRK-CHG-DT-ERR-CNT                                        CHGBD100
00975      DISPLAY '       EMPLOYER TYPE ERRORS:      '                 CHGBD100
00976         WRK-EMP-TYPE-ERR-CNT.                                     CHGBD100
00977      DISPLAY '       CHARGE AMOUNT ERRORS:      '                 CHGBD100
00978         WRK-CHG-AMT-ERR-CNT.                                      CHGBD100
00979      DISPLAY '       SUPP CODE ERRORS:          '                 CHGBD100
00980         WRK-SUPP-CD-ERR-CNT.                                      CHGBD100
00981                                                                   CHGBD100
00982      DISPLAY '       EMP NO ERRORS:             '                 CHGBD100
00983         WRK-EMP-NO-ERR-CNT.                                       CHGBD100
00984                                                                   CHGBD100
00985      DISPLAY '          SSN ERRORS:             '                 CHGBD100
00986         WRK-SSN-ERR-CNT.                                          CHGBD100
00987                                                                   CHGBD100
00988      DISPLAY '  '.                                                CHGBD100
00989      MOVE TOT-CHARGE-CURR-AMT TO TOT-CHARGE-CURR-AMT-DISP.        CHGBD100
00990      DISPLAY ' TOTAL CHARGE AMOUNT ON FILER = '                      CL*57
00991         TOT-CHARGE-CURR-AMT-DISP.                                 CHGBD100
00992 *                                                                 CHGBD100
00993      DISPLAY '  '.                                                   CL*46
00994      MOVE TOT-CHARGE-UI-AMT TO TOT-CHARGE-CURR-AMT-DISP.             CL*46
00995      DISPLAY ' UI-TOTAL CHARGE AMT ALL ACCT = '                      CL*57
00996         TOT-CHARGE-CURR-AMT-DISP.                                    CL*46
00997 *                                                                    CL*51
00998      DISPLAY '  '.                                                   CL*51
00999      MOVE TOT-CHARGE-UI4-AMT TO TOT-CHARGE-CURR-AMT-DISP.            CL*51
01000      DISPLAY '    UI BENEFITS PAID  AMOUNT = '                       CL*57
01001         TOT-CHARGE-CURR-AMT-DISP.                                    CL*51
01002 *                                                                    CL*51
01003      DISPLAY '  '.                                                   CL*51
01004      MOVE TOT-CHARGE-UI3-AMT TO TOT-CHARGE-CURR-AMT-DISP.            CL*51
01005      DISPLAY '    UI BENEFITS ADJUT AMOUNT = '                       CL*57
01006         TOT-CHARGE-CURR-AMT-DISP.                                    CL*51
01007 *                                                                    CL*46
01008      DISPLAY '  '.                                                   CL*46
01009      MOVE TOT-CHARGE-UCFE-AMT TO TOT-CHARGE-CURR-AMT-DISP.           CL*46
01010      DISPLAY ' UCFE    TOTAL CHARGE AMOUNT = '                       CL*46
01011         TOT-CHARGE-CURR-AMT-DISP.                                    CL*47
01012 *                                                                    CL*46
01013      DISPLAY '  '.                                                   CL*46
01014      MOVE TOT-CHARGE-UCX-AMT TO TOT-CHARGE-CURR-AMT-DISP.            CL*46
01015      DISPLAY ' UCX     TOTAL CHARGE AMOUNT = '                       CL*46
01016         TOT-CHARGE-CURR-AMT-DISP.                                    CL*53
01017 *                                                                    CL*46
01018      DISPLAY '  '.                                                   CL*49
01019      MOVE TOT-CHARGE-CWC-AMT TO TOT-CHARGE-CURR-AMT-DISP.            CL*49
01020      DISPLAY ' CWC     TOTAL CHARGE AMOUNT = '                       CL*49
01021         TOT-CHARGE-CURR-AMT-DISP.                                    CL*53
01022 *                                                                    CL*49
01023      DISPLAY '  '.                                                   CL*50
01024      MOVE TOT-CHARGE-RAT-AMT TO TOT-CHARGE-CURR-AMT-DISP.            CL*53
01025      DISPLAY ' RATED   TOTAL CHARGE AMOUNT = '                       CL*53
01026         TOT-CHARGE-CURR-AMT-DISP.                                    CL*53
01027 *                                                                    CL*50
01028      DISPLAY '  '.                                                   CL*53
01029      MOVE TOT-CHARGE-REM-AMT TO TOT-CHARGE-CURR-AMT-DISP.            CL*53
01030      DISPLAY ' SELF INF TOT  CHARGE AMOUNT = '                       CL*53
01031         TOT-CHARGE-CURR-AMT-DISP.                                    CL*53
01032 *                                                                    CL*53
01033      DISPLAY '  '.                                                   CL*53
01034      MOVE TOT-CHARGE-DCG-AMT TO TOT-CHARGE-CURR-AMT-DISP.            CL*53
01035      DISPLAY ' DC GOV  TOTAL CHARGE AMOUNT = '                       CL*53
01036         TOT-CHARGE-CURR-AMT-DISP.                                    CL*53
01037 *                                                                    CL*53
01038      DISPLAY '  '.                                                   CL*53
01039      MOVE TOT-CHARGE-OTH-AMT TO TOT-CHARGE-CURR-AMT-DISP.            CL*53
01040      DISPLAY ' OTH     TOTAL CHARGE AMOUNT = '                       CL*53
01041         TOT-CHARGE-CURR-AMT-DISP.                                    CL*53
01042 *                                                                    CL*53
01043      DISPLAY '  '.                                                   CL*46
01044      MOVE TOT-CHARGE-SPEC-AMT TO TOT-CHARGE-CURR-AMT-DISP.           CL*46
01045      DISPLAY ' SPECIAL TOTAL CHARGE AMOUNT = '                       CL*46
01046         TOT-CHARGE-CURR-AMT-DISP.                                    CL*46
01047  T0000-EXIT.                                                      CHGBD100
01048      EXIT.                                                        CHGBD100
01049      EJECT                                                        CHGBD100
01050                                                                   CHGBD100
01051  S001-FROM-CAL-6.                                                 CHGBD100
01052      SET L001-FROM-CAL-6 TO TRUE.                                 CHGBD100
01053      GO TO S001-DATE.                                             CHGBD100
01054                                                                   CHGBD100
01055  S001-FROM-FED-8.                                                 CHGBD100
01056      SET L001-FROM-FED-8 TO TRUE.                                 CHGBD100
01057      GO TO S001-DATE.                                             CHGBD100
01058  S001-FROM-ABS-DAY.                                                  CL*69
01059      SET L001-FROM-ABS-DAY TO TRUE.                                  CL*69
01060      GO TO S001-DATE.                                                CL*69
01061                                                                   CHGBD100
01062  S001-DATE.                                                       CHGBD100
01063      CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBD100
01064  S001-EXIT. EXIT.                                                 CHGBD100
01065                                                                   CHGBD100
01066  S004-FROM-DATE.                                                  CHGBD100
01067      SET L004-FROM-DATE TO TRUE.                                  CHGBD100
01068      GO TO S004-YRQ.                                              CHGBD100
01069                                                                   CHGBD100
01070  S004-YRQ.                                                        CHGBD100
01071      CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBD100
01072  S004-EXIT. EXIT.                                                 CHGBD100
01073  S005-FROM-SYS.                                                      CL*73
01074      SET L005-FROM-SYS   TO TRUE.                                    CL*73
01075      CALL 'DTSBU005' USING L005-LINK-AREA.                           CL*73
01076                                                                      CL*73
01077  S005-EXIT.                                                          CL*73
01078      EXIT.                                                           CL*73
01079                                                                      CL*73
01080                                                                   CHGBD100
01081 ** ADD ERROR MSG PROCESS PARA.                                    CHGBD100
01082  S910-OPEN-READ.                                                     CL*34
01083      SET L910-OPEN-READ-88 TO TRUE.                                  CL*34
01084      GO TO S910-MSTR-IO.                                             CL*34
01085                                                                      CL*34
01086  S910-READ.                                                          CL*35
01087      SET L910-READ-88 TO TRUE.                                       CL*35
01088      GO TO S910-MSTR-IO.                                             CL*35
01089                                                                      CL*34
01090  S910-CLOSE.                                                         CL*34
01091       SET L910-CLOSE-88 TO TRUE.                                     CL*34
01092       GO TO S910-MSTR-IO.                                            CL*34
01093                                                                      CL*34
01094  S910-MSTR-IO.                                                       CL*34
01095       CALL 'DTSBU910' USING L910-LINK-AREA                           CL*34
01096                             MSKL-REC.                                CL*34
01097                                                                      CL*34
01098  S910-EXIT.                                                          CL*34
01099      EXIT.                                                           CL*34
01100  S921-OPEN-READ.                                                     CL*34
01101      SET L921-OPEN-READ-88 TO TRUE.                                  CL*34
01102      GO TO S921-AIX-IO.                                              CL*34
01103                                                                      CL*34
01104  S921-CLOSE.                                                         CL*34
01105       SET L921-CLOSE-88 TO TRUE.                                     CL*34
01106       GO TO S921-AIX-IO.                                             CL*34
01107                                                                      CL*34
01108  S921-AIX-IO.                                                        CL*34
01109       CALL 'DTSBU921' USING L921-LINK-AREA                           CL*34
01110                             ISKL-REC.                                CL*34
01111                                                                      CL*34
01112  S921-EXIT.                                                          CL*34
01113      EXIT.                                                           CL*34
01114                                                                      CL*34
01115  S946-R907-WRITE.                                                 CHGBD100
01116      CALL 'DTSBU946' USING R907-REC.                              CHGBD100
01117  S946-EXIT. EXIT.                                                 CHGBD100
01118                                                                   CHGBD100
01119  S999-ABEND.                                                      CHGBD100
01120      DISPLAY '****  CHGBD100 ABENDING '                           CHGBD100
01121         ABEND-MSG.                                                CHGBD100
01122      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD100
01123                                                                   CHGBD100
01124  S999-EXIT.                                                       CHGBD100
01125      EXIT.                                                        CHGBD100
