00001  IDENTIFICATION DIVISION.                                         05/25/10
00002  PROGRAM-ID.             CHGBD201.                                CHGBD201
00003 *AUTHOR.                 TRW.                                        LV009
00004 *DATE-WRITTEN.           APRIL 2001.                              CHGBD201
00005  DATE-COMPILED.                                                   CHGBD201
00006      SKIP3                                                        CHGBD201
00007 *****                                                             CHGBD201
00008 *                                                                 CHGBD201
00009 *    FUNCTION:                                                    CHGBD201
00010 *                                                                 CHGBD201
00011 *        BENEFIT CHARGE CONVERSION PROCESS STEP 2                 CHGBD201
00012 *          (1) READ CHGIM002 RECORDS CREATED BY CHGBD101          CHGBD201
00013 *          (2) ACCUMULATE CHARGES BY DATE/EMPLOYER/SSN/BYE        CHGBD201
00014 *          (3) WRITE CHGIM002 RECORDS TO VSAM FILE                CHGBD201
00015 *                                                                 CHGBD201
00016 *        INPUT:                                                   CHGBD201
00017 *                                                                 CHGBD201
00018 *            BD100CHG - CHARGE RECORDS GENERATED BY               CHGBD201
00019 *                       CHGBD100.                                 CHGBD201
00020 *             CHGPARM - PARAMETER DATA INPUT FROM CHGBD100        CHGBD201
00021 *                                                                 CHGBD201
00022 *       OUTPUT:                                                   CHGBD201
00023 *                                                                 CHGBD201
00024 *            BE200CHG - CHARGE REPORT RECORDS                     CHGBD201
00025 *                                                                 CHGBD201
00026 *****                                                             CHGBD201
00027                                                                   CHGBD201
00028 ******************************************************************CHGBD201
00029 * MODIFICATION HISTORY:                                          *CHGBD201
00030 *                                                                *CHGBD201
00031 * 02-02-1999 INITIAL DEVELOPMENT                                 *CHGBD201
00032 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD201
00033 *                                                                *CHGBD201
00034 * 04-09-2001 ELIMINATED THE CHG-PARM-FILE AND CHANGED CHGIM002   *CHGBD201
00035 *            TO PRODUCE A NEW VERSION OF OUTPUT PERMANENT VSAM   *CHGBD201
00036 *            FILE WITHOUT THE EMPLOYEE NAME.                     *CHGBD201
00037 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1 *CHGBD201
00038 *                                                                *CHGBD201
00039 * 06-29-2004 ADDED EMP-TYPE 17 - DOMESTIC VIOLENCE.              *CHGBD201
00040 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD201
00041 *                                                                *CHGBD201
00042 *                                                                *CHGBD201
00043 * 12-03-2009 REMOVED WRK-EMP-TYPE FROM WORKING STORAGE CHANGED   *CHGBD201
00044 *            CODE TO USE CHG2 COPYBOOK VALUES.                    CHGBD201
00045 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD201
00046 *                                                                *CHGBD201
00047 *                                                                *CHGBD201
00048 * 05-04-2010 RECOMPILED FOR NEW VERSION OF COPYBOOK CHGIM002     *CHGBD201
00049 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD201
00050 *                                                                *CHGBD201
00051 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD201
00052 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD201
00053 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD201
00054 ******************************************************************CHGBD201
00055                                                                   CHGBD201
00056      SKIP3                                                        CHGBD201
00057  ENVIRONMENT DIVISION.                                            CHGBD201
00058      SKIP3                                                        CHGBD201
00059  INPUT-OUTPUT SECTION.                                            CHGBD201
00060      SKIP3                                                        CHGBD201
00061  FILE-CONTROL.                                                    CHGBD201
00062                                                                   CHGBD201
00063      SELECT BD100-CHG-FILE  ASSIGN TO BD100CHG                    CHGBD201
00064             FILE STATUS IS BD100-CHG-STATUS.                      CHGBD201
00065                                                                   CHGBD201
00066      SELECT BD200-CHG-FILE  ASSIGN TO BD200CHG                    CHGBD201
00067             FILE STATUS IS BD200-CHG-STATUS.                      CHGBD201
00068      EJECT                                                        CHGBD201
00069  DATA DIVISION.                                                   CHGBD201
00070      SKIP3                                                        CHGBD201
00071  FILE SECTION.                                                    CHGBD201
00072      SKIP3                                                        CHGBD201
00073 ************************************************************      CHGBD201
00074 *    PARAMETER RECORD PASSED FROM CHGBD100.                       CHGBD201
00075 ************************************************************      CHGBD201
00076                                                                   CHGBD201
00077  FD  BD100-CHG-FILE                                               CHGBD201
00078      LABEL RECORDS ARE STANDARD                                   CHGBD201
00079      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD201
00080      SKIP1                                                        CHGBD201
00081  01  BD100-CHG-REC.                                               CHGBD201
00082  ++INCLUDE CHGIM001                                               CHGBD201
00083                                                                   CHGBD201
00084  FD  BD200-CHG-FILE                                               CHGBD201
00085      LABEL RECORDS ARE STANDARD                                   CHGBD201
00086      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD201
00087      SKIP1                                                        CHGBD201
00088  01  BD200-CHG-REC                   PIC X(064).                  CHGBD201
00089                                                                   CHGBD201
00090  WORKING-STORAGE SECTION.                                         CHGBD201
000905 77  PAN-VALET PICTURE X(24) VALUE '009CHGBD201  05/25/10'.       CHGBD201
00091                                                                   CHGBD201
00092  01  WRK-AREA.                                                    CHGBD201
00093      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD201
00094                                  VALUE +202.                      CHGBD201
00095      05  ABEND-MSG                   PIC  X(60).                  CHGBD201
00096      05  FILLER REDEFINES ABEND-MSG.                              CHGBD201
00097          10  ABEND-MSG-TEXT          PIC X(59).                   CHGBD201
00098          10  ABEND-MSG-PROG-CODE     PIC X(01).                   CHGBD201
00099                                                                   CHGBD201
00100      05  ABEND-MOD                   PIC  X(08)                   CHGBD201
00101                                  VALUE 'DTSBU999'.                CHGBD201
00102                                                                   CHGBD201
00103      05  BD100-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD201
00104          88  BD100-FILE-OK-88    VALUE ZERO.                      CHGBD201
00105          88  BD100-FILE-EOF-88   VALUE '10'.                      CHGBD201
00106      05  BD200-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD201
00107          88  BD200-FILE-OK-88    VALUE ZERO.                      CHGBD201
00108 **       88  BD200-FILE-DUP-88   VALUE '22'.                      CHGBD201
00109                                                                   CHGBD201
00110      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD201
00111          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD201
00112          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD201
00113                                                                   CHGBD201
00114      05  WRK-CHG-REC-IND             PIC  X(01).                  CHGBD201
00115          88  WRK-CHG-REC-OK-88      VALUE 'Y'.                    CHGBD201
00116          88  WRK-CHG-REC-INVALID-88 VALUE 'N'.                    CHGBD201
00117                                                                   CHGBD201
00118      05  WRK-REPORT-TYPE             PIC  X(01).                  CHGBD201
00119          88  WRK-RPT-TYPE-RATED-88    VALUE '1'.                  CHGBD201
00120          88  WRK-RPT-TYPE-SELF-INS-88 VALUE '2'.                  CHGBD201
00121          88  WRK-RPT-TYPE-CWC-88      VALUE '3'.                  CHGBD201
00122          88  WRK-RPT-TYPE-FED-88      VALUE '4'.                  CHGBD201
00123          88  WRK-RPT-TYPE-UNKNOWN-88  VALUE '5'.                  CHGBD201
00124          88  WRK-RPT-TYPE-NOT-LIAB-88 VALUE '6'.                  CHGBD201
00125          88  WRK-NO-RPT-88            VALUE '0'.                  CHGBD201
00126                                                                   CHGBD201
00127                                                                   CHGBD201
00128      05  WRK-BD100-READ              PIC  9(09) COMP-3.           CHGBD201
00129      05  WRK-BD200-CHG-WRITTEN       PIC  9(09) COMP-3.           CHGBD201
00130      05  TOT-BEN-ADJ-AMT           PIC S9(09)V99 COMP-3 VALUE +0. CHGBD201
00131      05  TOT-BEN-ADJ-AMT-DISP      PIC  ZZZ,ZZZ,ZZ9.99.           CHGBD201
00132 *RW                                                               CHGBD201
00133 *    05  TOT-BEN-AMT               PIC S9(09)V99 COMP-3 VALUE +0. CHGBD201
00134 *    05  TOT-BEN-AMT-DISP          PIC  ZZZ,ZZZ,ZZ9.99.           CHGBD201
00135 *    05  TOT-ADJ-AMT               PIC S9(09)V99 COMP-3 VALUE +0. CHGBD201
00136 *    05  TOT-ADJ-AMT-DISP          PIC  ZZZ,ZZZ,ZZ9.99.           CHGBD201
00137 *    05  TOT-RECOUP-AMT            PIC S9(09)V99 COMP-3 VALUE +0. CHGBD201
00138 *    05  TOT-RECOUP-AMT-DISP       PIC  ZZZ,ZZZ,ZZ9.99.           CHGBD201
00139      05  WRK-DATE-DISP             PIC  9(08).                    CHGBD201
00140      05  WRK-SSN-AREA              PIC  9(10).                    CHGBD201
00141      05  FILLER REDEFINES WRK-SSN-AREA.                           CHGBD201
00142          10  WRK-SSN-9             PIC  9(09).                    CHGBD201
00143          10  FILLER                PIC  X(01).                    CHGBD201
00144                                                                   CHGBD201
00145 ***************************************************************   CHGBD201
00146 *  WORKING STORAGE AND ACCUMULATOR FIELDS FOR CURRENT SSN/BYE.    CHGBD201
00147 *  CHARGES FOR INDIVIDUAL EMPLOYERS ARE IN THE TABLE BELOW.       CHGBD201
00148 ***************************************************************   CHGBD201
00149      05  WRK-CHARGE-DATE             PIC  S9(09) COMP-3 VALUE +0. CHGBD201
00150      05  WRK-CURR-SSN                PIC S9(10) COMP-3.           CHGBD201
00151      05  WRK-CLMNT-NAME              PIC  X(32).                  CHGBD201
00152      05  WRK-CURR-BYE                PIC S9(09) COMP-3.           CHGBD201
00153      05  WRK-CURR-EMP                PIC S9(07) COMP-3.           CHGBD201
00154      05  WRK-PROGRAM-TOTALS OCCURS 4 TIMES.                       CHGBD201
00155          10  WRK-TOT-BEN             PIC S9(07)V99 COMP-3.        CHGBD201
00156          10  WRK-TOT-ADJ             PIC S9(07)V99 COMP-3.        CHGBD201
00157                                                                   CHGBD201
00158 ***************************************************************   CHGBD201
00159 *  THE TABLE BELOW RECORDS CHARGE DATA FOR EACH EMPLOYER WITHIN   CHGBD201
00160 *  A GIVEN SSN/BYE.  WITHIN EACH TABLE ENTRY, A SEPARATE TABLE    CHGBD201
00161 *  DISTINGUISHES CHARGE AMOUNTS BY BENEFIT PROGRAM.               CHGBD201
00162 *  PROG-SUB-MAX INDICATES THE MAXIMUM NUMBER OF PROGRAMS THE      CHGBD201
00163 *  CHARGE AMOUNT TABLE MAY CONTAIN.                               CHGBD201
00164 *  EMP-ENTRY-MAX INDICATES THE MAXIMUM NUMBER OF EMPLOYERS THE    CHGBD201
00165 *  EMPLOYER TABLE MAY CONTAIN.                                    CHGBD201
00166 ***************************************************************   CHGBD201
00167      05  EMP-SUB                     PIC S9(04)    COMP.          CHGBD201
00168      05  PROG-SUB                    PIC S9(04)    COMP.          CHGBD201
00169          88  PROG-SUB-UI          VALUE +1.                       CHGBD201
00170          88  PROG-SUB-EB          VALUE +2.                       CHGBD201
00171          88  PROG-SUB-TEUC        VALUE +3.                       CHGBD201
00172          88  PROG-SUB-TEUCA       VALUE +4.                       CHGBD201
00173          88  PROG-SUB-VALID       VALUE +1, +2, +3, +4.           CHGBD201
00174      05  PROG-SUB-MAX                PIC S9(04)    COMP           CHGBD201
00175                                   VALUE +4.                       CHGBD201
00176      05  EMP-ENTRY-MAX               PIC S9(04)    COMP           CHGBD201
00177                                   VALUE +100.                     CHGBD201
00178      05  EMP-CNT                     PIC S9(04)    COMP.          CHGBD201
00179                                                                   CHGBD201
00180      05  EMP-TABLE.                                               CHGBD201
00181          10  EMP-TABLE-ENTRY OCCURS 100 TIMES.                    CHGBD201
00182              15  TAB-EMP-ACCT            PIC  9(06).              CHGBD201
00183                  88  TAB-POOL-ACCT-YES-88                         CHGBD201
00184                                      VALUE 028411,                CHGBD201
00185                                            999000 THRU 999992.    CHGBD201
00186              15  TAB-EMP-TYPE            PIC  9(02).              CHGBD201
00187 ***************************************************************   CHGBD201
00188 *  THE TABLE BELOW RECORDS AMOUNTS CHARGED FOR EACH BENEFIT       CHGBD201
00189 *  PROGRAM.  THE FIRST OCCURRENCE IS FOR REGULAR UI AND THE       CHGBD201
00190 *  SECOND FOR EB.  ADD ADDITIONAL OCCURRENCES AS REQUIRED.        CHGBD201
00191 ***************************************************************   CHGBD201
00192              15  TAB-EMP-CHARGE-AMTS                              CHGBD201
00193                                 OCCURS 4 TIMES.                   CHGBD201
00194                 20  TAB-BEN-CHG          PIC S9(07)V99 COMP-3.    CHGBD201
00195                 20  TAB-ADJ-CHG          PIC S9(07)V99 COMP-3.    CHGBD201
00196                 20  TAB-OP-RECOVER       PIC S9(07)V99 COMP-3.    CHGBD201
00197                                                                   CHGBD201
00198 ****                                                              CHGBD201
00199  01  WRK-AMT-DISP            PIC  Z(06)9.99-.                     CHGBD201
00200  01  WRK-TEST-AMT-OUT        PIC S9(07)V99 COMP-3 VALUE ZERO.     CHGBD201
00201  01  WRK-TEST-TOT-OUT        PIC S9(07)V99 COMP-3 VALUE ZERO.     CHGBD201
00202  01  WRK-AMT-DISP-OUT        PIC  Z(06)9.99-.                     CHGBD201
00203 ****                                                              CHGBD201
00204  01  WK-DISP-AREA1.                                               CHGBD201
00205      05 FILLER      PIC X(10) VALUE 'CHG1-SSN: '.                 CHGBD201
00206      05 WK-DISP-SSN PIC 9(10).                                    CHGBD201
00207      05 FILLER      PIC X(12) VALUE '  CHG1-BYE: '.               CHGBD201
00208      05 WK-DISP-BYE PIC 9(09).                                    CHGBD201
00209      05 FILLER      PIC X(12) VALUE '  CHG1-EMP: '.               CHGBD201
00210      05 WK-DISP-EMP PIC 9(07).                                    CHGBD201
00211      05 FILLER      PIC X(11) VALUE '  EMP-CNT: '.                CHGBD201
00212      05 WK-DISP-CNT PIC 9(04).                                    CHGBD201
00213 ****                                                              CHGBD201
00214  01  WRK-BD200-CHG-REC.                                           CHGBD201
00215  ++INCLUDE CHGIM002                                               CHGBD201
00216                                                                   CHGBD201
00217  01  L001-LINK-AREA.                                              CHGBD201
00218  ++INCLUDE DTSIL001                                               CHGBD201
00219                                                                   CHGBD201
00220  01  L004-LINK-AREA.                                              CHGBD201
00221  ++INCLUDE DTSIL004                                               CHGBD201
00222      EJECT                                                        CHGBD201
00223  01  L100-LINK-AREA.                                              CHGBD201
00224  ++INCLUDE CHGIL100                                               CHGBD201
00225      EJECT                                                        CHGBD201
00226                                                                   CHGBD201
00227  01  L910-LINK-AREA.                                              CHGBD201
00228  ++INCLUDE DTSIL910                                               CHGBD201
00229                                                                   CHGBD201
00230  01  MSKL-REC.                                                    CHGBD201
00231  ++INCLUDE DTSIMSKL                                               CHGBD201
00232                                                                   CHGBD201
00233  01  L921-LINK-AREA.                                              CHGBD201
00234  ++INCLUDE DTSIL921                                               CHGBD201
00235                                                                   CHGBD201
00236  01  ISKL-REC.                                                    CHGBD201
00237  ++INCLUDE DTSIISKL                                               CHGBD201
00238                                                                   CHGBD201
00239  PROCEDURE DIVISION.                                              CHGBD201
00240      SKIP2                                                        CHGBD201
00241  CHGBD202-MAIN.                                                   CHGBD201
00242      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD201
00243      IF WRK-ERROR-YES-88                                          CHGBD201
00244         GO TO CHGBD202-EXIT.                                      CHGBD201
00245                                                                   CHGBD201
00246      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD201
00247                                                                   CHGBD201
00248      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD201
00249                                                                   CHGBD201
00250  CHGBD202-EXIT.                                                   CHGBD201
00251 *    STOP RUN.                                                    CHGBD201
00252      GOBACK.                                                      CHGBD201
00253      EJECT                                                        CHGBD201
00254  I0000-INITIATE.                                                  CHGBD201
00255                                                                   CHGBD201
00256      PERFORM I1000-INIT-WRK-DATA THRU I1000-EXIT.                 CHGBD201
00257                                                                   CHGBD201
00258      PERFORM I2000-OPEN-FILES THRU I2000-EXIT.                    CHGBD201
00259                                                                   CHGBD201
00260  I0000-EXIT.                                                      CHGBD201
00261      EXIT.                                                        CHGBD201
00262                                                                   CHGBD201
00263  I1000-INIT-WRK-DATA.                                             CHGBD201
00264      MOVE ZERO TO  WRK-BD100-READ,                                CHGBD201
00265                    WRK-BD200-CHG-WRITTEN,                         CHGBD201
00266                    EMP-CNT.                                       CHGBD201
00267                                                                   CHGBD201
00268      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD201
00269                                                                   CHGBD201
00270  I1000-EXIT.                                                      CHGBD201
00271      EXIT.                                                        CHGBD201
00272                                                                   CHGBD201
00273  I2000-OPEN-FILES.                                                CHGBD201
00274      OPEN INPUT BD100-CHG-FILE.                                   CHGBD201
00275      IF NOT BD100-FILE-OK-88                                      CHGBD201
00276         DISPLAY 'SORT FILE OPEN ERROR: ' BD100-CHG-STATUS         CHGBD201
00277         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD201
00278         GO TO I2000-EXIT.                                         CHGBD201
00279                                                                   CHGBD201
00280      OPEN OUTPUT BD200-CHG-FILE.                                  CHGBD201
00281      IF NOT BD200-FILE-OK-88                                      CHGBD201
00282         DISPLAY 'BD200 FILE OPEN ERROR: ' BD200-CHG-STATUS        CHGBD201
00283         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD201
00284         GO TO I2000-EXIT.                                         CHGBD201
00285                                                                   CHGBD201
00286      PERFORM S910-OPEN-READ THRU S910-EXIT.                       CHGBD201
00287                                                                   CHGBD201
00288      PERFORM S921-OPEN-READ THRU S921-EXIT.                       CHGBD201
00289                                                                   CHGBD201
00290  I2000-EXIT.                                                      CHGBD201
00291      EXIT.                                                        CHGBD201
00292                                                                   CHGBD201
00293  P0000-PROCESS.                                                   CHGBD201
00294      READ BD100-CHG-FILE.                                         CHGBD201
00295      IF NOT BD100-FILE-OK-88                                      CHGBD201
00296         DISPLAY 'SORT FILE EMPTY: ' BD100-CHG-STATUS              CHGBD201
00297         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD201
00298         GO TO P0000-EXIT                                          CHGBD201
00299      ELSE                                                         CHGBD201
00300         ADD 1 TO WRK-BD100-READ.                                  CHGBD201
00301                                                                   CHGBD201
00302      PERFORM P2000-INIT-EMP-DATA THRU P2000-EXIT.                 CHGBD201
00303                                                                   CHGBD201
00304      PERFORM P1000-READ-CHARGES THRU P1000-EXIT                   CHGBD201
00305        UNTIL BD100-FILE-EOF-88                                    CHGBD201
00306           OR WRK-ERROR-YES-88.                                    CHGBD201
00307                                                                   CHGBD201
00308  P0000-EXIT.                                                      CHGBD201
00309      EXIT.                                                        CHGBD201
00310                                                                   CHGBD201
00311  P1000-READ-CHARGES.                                              CHGBD201
00312 *&                                                                CHGBD201
00313 *    MOVE CHG1-SSN TO WRK-SSN-AREA.                               CHGBD201
00314 *    IF WRK-SSN-9 = 578946150                                     CHGBD201
00315 *    OR WRK-SSN-9 = 135345144                                     CHGBD201
00316 *       MOVE CHG1-CHARGE-CURR-AMT TO WRK-AMT-DISP                 CHGBD201
00317 *       DISPLAY '>> EMP ' CHG1-EMP-NO                             CHGBD201
00318 *          '  SSN ' CHG1-SSN                                      CHGBD201
00319 *          '  DATE ' CHG1-CHARGE-DATE                             CHGBD201
00320 *          '  AMT ' WRK-AMT-DISP                                  CHGBD201
00321 *          '  BYE ' CHG1-BYE.                                     CHGBD201
00322 *&                                                                CHGBD201
00323                                                                   CHGBD201
00324      IF CHG1-CHARGE-DATE = WRK-CHARGE-DATE                        CHGBD201
00325      AND CHG1-SSN        = WRK-CURR-SSN                           CHGBD201
00326      AND CHG1-BYE        = WRK-CURR-BYE                           CHGBD201
00327         PERFORM P1200-ACCUM-CHARGES  THRU P1200-EXIT              CHGBD201
00328      ELSE                                                         CHGBD201
00329         PERFORM P1400-WRITE-CHG-RECS THRU P1400-EXIT              CHGBD201
00330            VARYING EMP-SUB FROM +1 BY +1                          CHGBD201
00331            UNTIL EMP-SUB > EMP-CNT                                CHGBD201
00332         PERFORM P2000-INIT-EMP-DATA THRU P2000-EXIT               CHGBD201
00333         PERFORM P1200-ACCUM-CHARGES  THRU P1200-EXIT.             CHGBD201
00334                                                                   CHGBD201
00335      PERFORM P1010-READ-NEXT-REC THRU P1010-EXIT.                 CHGBD201
00336                                                                   CHGBD201
00337  P1000-EXIT.                                                      CHGBD201
00338      EXIT.                                                        CHGBD201
00339                                                                   CHGBD201
00340  P1010-READ-NEXT-REC.                                             CHGBD201
00341      READ BD100-CHG-FILE.                                         CHGBD201
00342                                                                   CHGBD201
00343      IF BD100-FILE-EOF-88                                         CHGBD201
00344         PERFORM P1400-WRITE-CHG-RECS THRU P1400-EXIT              CHGBD201
00345            VARYING EMP-SUB FROM +1 BY +1                          CHGBD201
00346              UNTIL EMP-SUB > EMP-CNT                              CHGBD201
00347      ELSE                                                         CHGBD201
00348         IF BD100-FILE-OK-88                                       CHGBD201
00349            ADD 1 TO WRK-BD100-READ                                CHGBD201
00350         ELSE                                                      CHGBD201
00351           DISPLAY 'SORT FILE READ ERROR: ' BD100-CHG-STATUS       CHGBD201
00352           SET WRK-ERROR-YES-88 TO TRUE                            CHGBD201
00353         END-IF                                                    CHGBD201
00354      END-IF.                                                      CHGBD201
00355                                                                   CHGBD201
00356  P1010-EXIT.                                                      CHGBD201
00357      EXIT.                                                        CHGBD201
00358                                                                   CHGBD201
00359  P1200-ACCUM-CHARGES.                                             CHGBD201
00360      IF CHG1-EMP-NO NOT = WRK-CURR-EMP                            CHGBD201
00361         PERFORM P1210-NEW-EMP THRU P1210-EXIT.                    CHGBD201
00362                                                                   CHGBD201
00363      PERFORM P1220-UPDATE-EMP-TABLE THRU P1220-EXIT.              CHGBD201
00364                                                                   CHGBD201
00365  P1200-EXIT.                                                      CHGBD201
00366      EXIT.                                                        CHGBD201
00367                                                                   CHGBD201
00368 ****************************************************************  CHGBD201
00369 *  CHARGE RECORDS ARRIVE IN EMPLOYER NUMBER ORDER (WITHIN         CHGBD201
00370 *  SSN/BYE).  ALL CHARGE RECORDS FOR A GIVEN EMPLOYER WILL BE     CHGBD201
00371 *  GROUPED TOGETHER BY THE SORT.                                  CHGBD201
00372 ****************************************************************  CHGBD201
00373  P1210-NEW-EMP.                                                   CHGBD201
00374      ADD +1 TO EMP-SUB                                            CHGBD201
00375                EMP-CNT.                                           CHGBD201
00376      IF EMP-SUB > EMP-ENTRY-MAX                                   CHGBD201
00377         MOVE    'EMPLOYER TABLE LENGTH EXCEEDED'                  CHGBD201
00378                               TO ABEND-MSG                        CHGBD201
00379         PERFORM S999-ABEND THRU S999-EXIT                         CHGBD201
00380         GO TO P1210-EXIT                                          CHGBD201
00381      ELSE                                                         CHGBD201
00382         MOVE CHG1-EMP-NO      TO WRK-CURR-EMP                     CHGBD201
00383                                  TAB-EMP-ACCT (EMP-SUB)           CHGBD201
00384         MOVE CHG1-CHARGE-EMP-TYPE                                 CHGBD201
00385                               TO TAB-EMP-TYPE (EMP-SUB).          CHGBD201
00386  P1210-EXIT.                                                      CHGBD201
00387      EXIT.                                                        CHGBD201
00388                                                                   CHGBD201
00389 ****************************************************************  CHGBD201
00390 *  TOTAL REGULAR CHARGES AND ADJUSTMENTS SEPARATELY.              CHGBD201
00391 *  CHG1-CHARGE-PAY-OP-RECOUP IS SET FOR OVERPAYMENT RECOVERIES    CHGBD201
00392 *  DIRECTED TO A CWC ACCOUNT AND ARE TOTALLED SEPARATELY.         CHGBD201
00393 ****************************************************************  CHGBD201
00394  P1220-UPDATE-EMP-TABLE.                                          CHGBD201
00395      PERFORM P1229-EDIT-PROG-CODE THRU P1229-EXIT.                CHGBD201
00396                                                                   CHGBD201
00397      IF CHG1-CHARGE-BEN                                           CHGBD201
00398         PERFORM P1221-BEN-CHARGE THRU P1221-EXIT                  CHGBD201
00399      ELSE                                                         CHGBD201
00400      IF CHG1-CHARGE-ALL-ADJ                                       CHGBD201
00401         PERFORM P1222-ADJ-CHARGE THRU P1222-EXIT.                 CHGBD201
00402                                                                   CHGBD201
00403  P1220-EXIT.                                                      CHGBD201
00404      EXIT.                                                        CHGBD201
00405                                                                   CHGBD201
00406  P1221-BEN-CHARGE.                                                CHGBD201
00407      ADD CHG1-CHARGE-CURR-AMT TO                                  CHGBD201
00408                           TAB-BEN-CHG (EMP-SUB, PROG-SUB),        CHGBD201
00409                           WRK-TOT-BEN (PROG-SUB).                 CHGBD201
00410  P1221-EXIT.                                                      CHGBD201
00411      EXIT.                                                        CHGBD201
00412                                                                   CHGBD201
00413  P1222-ADJ-CHARGE.                                                CHGBD201
00414      ADD CHG1-CHARGE-CURR-AMT TO                                  CHGBD201
00415                           TAB-ADJ-CHG (EMP-SUB, PROG-SUB)         CHGBD201
00416                           WRK-TOT-ADJ (PROG-SUB).                 CHGBD201
00417                                                                   CHGBD201
00418      IF CHG1-CHARGE-PAY-OP-RECOUP                                 CHGBD201
00419         ADD CHG1-CHARGE-CURR-AMT TO                               CHGBD201
00420                           TAB-OP-RECOVER (EMP-SUB, PROG-SUB).     CHGBD201
00421                                                                   CHGBD201
00422  P1222-EXIT.                                                      CHGBD201
00423      EXIT.                                                        CHGBD201
00424                                                                   CHGBD201
00425  P1229-EDIT-PROG-CODE.                                            CHGBD201
00426      MOVE CHG1-CHARGE-PROGRAM TO PROG-SUB.                        CHGBD201
00427      IF NOT PROG-SUB-VALID                                        CHGBD201
00428         MOVE    'INVALID PROGRAM CODE'                            CHGBD201
00429                               TO ABEND-MSG-TEXT                   CHGBD201
00430         MOVE CHG1-CHARGE-PROGRAM                                  CHGBD201
00431                               TO ABEND-MSG-PROG-CODE              CHGBD201
00432         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD201
00433                                                                   CHGBD201
00434  P1229-EXIT.                                                      CHGBD201
00435      EXIT.                                                        CHGBD201
00436                                                                   CHGBD201
00437  P1400-WRITE-CHG-RECS.                                            CHGBD201
00438      MOVE WRK-CHARGE-DATE        TO CHG2-CHARGE-DATE.             CHGBD201
00439      MOVE TAB-EMP-ACCT (EMP-SUB) TO CHG2-EMP-NO.                  CHGBD201
00440      MOVE WRK-CURR-SSN           TO CHG2-SSN.                     CHGBD201
00441      MOVE WRK-CURR-BYE           TO CHG2-BYE.                     CHGBD201
00442                                                                   CHGBD201
00443      PERFORM P1410-EMP-TYPE      THRU P1410-EXIT.                 CHGBD201
00444 *    MOVE WRK-EMP-TYPE           TO CHG2-EMP-TYPE.                CHGBD201
00445                                                                   CHGBD201
00446      PERFORM P1420-CHARGE-AMOUNTS THRU P1420-EXIT                 CHGBD201
00447         VARYING PROG-SUB FROM +1 BY +1                            CHGBD201
00448         UNTIL PROG-SUB > PROG-SUB-MAX.                            CHGBD201
00449                                                                   CHGBD201
00450  P1400-EXIT.                                                      CHGBD201
00451      EXIT.                                                        CHGBD201
00452                                                                   CHGBD201
00453 ***************************************************************   CHGBD201
00454 *  READ THE EMPLOYER PROFILE RECORD TO FIND THE                   CHGBD201
00455 *  CORRECT EMPLOYER TYPE.  THE EMPLOYER TYPE IS NEEDED TO         CHGBD201
00456 *  DETERMINE IN WHICH REPORT TO INCLUDE THE EMPLOYER'S CHARGES.   CHGBD201
00457 ***************************************************************   CHGBD201
00458  P1410-EMP-TYPE.                                                  CHGBD201
00459      MOVE CHG2-EMP-NO            TO L100-EMP-NO.                  CHGBD201
00460      PERFORM S100-CALL-CHGBU100  THRU S100-EXIT.                  CHGBD201
00461      IF L100-OK-88                                                CHGBD201
00462 *&      DISPLAY 'EMP-TYPE ' CHG2-EMP-NO                           CHGBD201
00463 *          '  OLD ' WRK-EMP-TYPE                                  CHGBD201
00464 *&         '  NEW ' L100-EMP-TYPE                                 CHGBD201
00465         MOVE L100-EMP-TYPE       TO CHG2-EMP-TYPE                 CHGBD201
00466      ELSE                                                         CHGBD201
00467         MOVE TAB-EMP-TYPE (EMP-SUB)  TO CHG2-EMP-TYPE.            CHGBD201
00468                                                                   CHGBD201
00469  P1410-EXIT.                                                      CHGBD201
00470      EXIT.                                                        CHGBD201
00471                                                                   CHGBD201
00472  P1420-CHARGE-AMOUNTS.                                            CHGBD201
00473                                                                   CHGBD201
00474      MOVE PROG-SUB TO CHG2-PROGRAM.                               CHGBD201
00475                                                                   CHGBD201
00476      IF (TAB-BEN-CHG (EMP-SUB, PROG-SUB) +                        CHGBD201
00477          TAB-ADJ-CHG (EMP-SUB, PROG-SUB)) NOT = ZERO              CHGBD201
00478         MOVE TAB-BEN-CHG (EMP-SUB, PROG-SUB)                      CHGBD201
00479                                     TO CHG2-CURR-BEN-AMT          CHGBD201
00480         MOVE TAB-ADJ-CHG (EMP-SUB, PROG-SUB)                      CHGBD201
00481                                     TO CHG2-CURR-ADJ-AMT          CHGBD201
00482         MOVE WRK-TOT-BEN (PROG-SUB) TO CHG2-TOT-BEN-AMT           CHGBD201
00483         MOVE WRK-TOT-ADJ (PROG-SUB) TO CHG2-TOT-ADJ-AMT           CHGBD201
00484         MOVE TAB-OP-RECOVER (EMP-SUB, PROG-SUB)                   CHGBD201
00485                                     TO CHG2-OP-RECOVER-AMT        CHGBD201
00486         PERFORM S200-WRITE-CHG2 THRU S200-EXIT                    CHGBD201
00487 *&                                                                CHGBD201
00488 *       MOVE CHG2-SSN TO WRK-SSN-AREA                             CHGBD201
00489 *       IF  WRK-SSN-9 = 578946150                                 CHGBD201
00490 *       OR  WRK-SSN-9 = 135345144                                 CHGBD201
00491 *          COMPUTE WRK-AMT-DISP =                                 CHGBD201
00492 *             (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)             CHGBD201
00493 *          COMPUTE WRK-AMT-DISP-OUT =                             CHGBD201
00494 *             (CHG2-TOT-BEN-AMT + CHG2-TOT-ADJ-AMT)               CHGBD201
00495 *          DISPLAY 'DATE ' CHG2-CHARGE-DATE                       CHGBD201
00496 *             '  EMP ' CHG2-EMP-NO                                CHGBD201
00497 *             '  SSN ' CHG2-SSN                                   CHGBD201
00498 *             '  AMT ' WRK-AMT-DISP                               CHGBD201
00499 *             '  TOT ' WRK-AMT-DISP-OUT                           CHGBD201
00500 *       END-IF                                                    CHGBD201
00501 *&                                                                CHGBD201
00502      COMPUTE TOT-BEN-ADJ-AMT = TOT-BEN-ADJ-AMT +                  CHGBD201
00503         (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT).                  CHGBD201
00504                                                                   CHGBD201
00505  P1420-EXIT.                                                      CHGBD201
00506      EXIT.                                                        CHGBD201
00507      EJECT                                                        CHGBD201
00508  P2000-INIT-EMP-DATA.                                             CHGBD201
00509      MOVE CHG1-CHARGE-DATE TO WRK-CHARGE-DATE.                    CHGBD201
00510      MOVE CHG1-SSN     TO WRK-CURR-SSN.                           CHGBD201
00511      MOVE CHG1-BYE     TO WRK-CURR-BYE.                           CHGBD201
00512      MOVE CHG1-CHARGE-NAME                                        CHGBD201
00513                        TO WRK-CLMNT-NAME.                         CHGBD201
00514                                                                   CHGBD201
00515      MOVE ZERO         TO WRK-CURR-EMP.                           CHGBD201
00516                                                                   CHGBD201
00517      PERFORM                                                      CHGBD201
00518         VARYING PROG-SUB FROM +1 BY +1                            CHGBD201
00519         UNTIL PROG-SUB > PROG-SUB-MAX                             CHGBD201
00520            MOVE ZERO TO WRK-TOT-BEN (PROG-SUB),                   CHGBD201
00521                         WRK-TOT-ADJ (PROG-SUB)                    CHGBD201
00522      END-PERFORM.                                                 CHGBD201
00523                                                                   CHGBD201
00524      PERFORM P2100-INIT-EMP-TABLE THRU P2100-EXIT                 CHGBD201
00525         VARYING EMP-SUB FROM +1 BY +1                             CHGBD201
00526         UNTIL EMP-SUB > EMP-ENTRY-MAX.                            CHGBD201
00527                                                                   CHGBD201
00528      MOVE +0    TO EMP-SUB,                                       CHGBD201
00529                    EMP-CNT.                                       CHGBD201
00530                                                                   CHGBD201
00531  P2000-EXIT.                                                      CHGBD201
00532      EXIT.                                                        CHGBD201
00533                                                                   CHGBD201
00534  P2100-INIT-EMP-TABLE.                                            CHGBD201
00535      MOVE ZERO TO TAB-EMP-ACCT (EMP-SUB),                         CHGBD201
00536                   TAB-EMP-TYPE (EMP-SUB).                         CHGBD201
00537                                                                   CHGBD201
00538      PERFORM P2110-INIT-AMT-TABLE THRU P2110-EXIT                 CHGBD201
00539         VARYING PROG-SUB FROM +1 BY +1                            CHGBD201
00540         UNTIL PROG-SUB > PROG-SUB-MAX.                            CHGBD201
00541  P2100-EXIT.                                                      CHGBD201
00542      EXIT.                                                        CHGBD201
00543                                                                   CHGBD201
00544  P2110-INIT-AMT-TABLE.                                            CHGBD201
00545      MOVE ZERO TO TAB-BEN-CHG    (EMP-SUB, PROG-SUB),             CHGBD201
00546                   TAB-ADJ-CHG    (EMP-SUB, PROG-SUB),             CHGBD201
00547                   TAB-OP-RECOVER (EMP-SUB, PROG-SUB).             CHGBD201
00548  P2110-EXIT.                                                      CHGBD201
00549      EXIT.                                                        CHGBD201
00550                                                                   CHGBD201
00551  T0000-TERMINATE.                                                 CHGBD201
00552      CLOSE BD100-CHG-FILE                                         CHGBD201
00553            BD200-CHG-FILE.                                        CHGBD201
00554                                                                   CHGBD201
00555      PERFORM S910-CLOSE            THRU S910-EXIT.                CHGBD201
00556                                                                   CHGBD201
00557      PERFORM S921-CLOSE            THRU S921-EXIT.                CHGBD201
00558                                                                   CHGBD201
00559      DISPLAY ' CHGBD201 CHARGE RECORDS READ :   '                 CHGBD201
00560         WRK-BD100-READ.                                           CHGBD201
00561      DISPLAY '          CHARGE RECORDS WRITTEN: '                 CHGBD201
00562         WRK-BD200-CHG-WRITTEN.                                    CHGBD201
00563      MOVE TOT-BEN-ADJ-AMT TO TOT-BEN-ADJ-AMT-DISP.                CHGBD201
00564      DISPLAY '  '.                                                CHGBD201
00565      DISPLAY ' TOTAL BENEFIT AND ADJ AMT = '                      CHGBD201
00566         TOT-BEN-ADJ-AMT-DISP.                                     CHGBD201
00567  T0000-EXIT.                                                      CHGBD201
00568      EXIT.                                                        CHGBD201
00569      EJECT                                                        CHGBD201
00570                                                                   CHGBD201
00571  S100-CALL-CHGBU100.                                              CHGBD201
00572      CALL 'CHGBU100' USING L100-LINK-AREA.                        CHGBD201
00573                                                                   CHGBD201
00574  S100-EXIT.                                                       CHGBD201
00575      EXIT.                                                        CHGBD201
00576                                                                   CHGBD201
00577  S200-WRITE-CHG2.                                                 CHGBD201
00578      WRITE BD200-CHG-REC                                          CHGBD201
00579         FROM WRK-BD200-CHG-REC.                                   CHGBD201
00580      ADD +1 TO WRK-BD200-CHG-WRITTEN.                             CHGBD201
00581                                                                   CHGBD201
00582  S200-EXIT.                                                       CHGBD201
00583      EXIT.                                                        CHGBD201
00584                                                                   CHGBD201
00585  S910-OPEN-READ.                                                  CHGBD201
00586      SET L910-OPEN-READ-88 TO TRUE.                               CHGBD201
00587      GO TO S910-MSTR-IO.                                          CHGBD201
00588                                                                   CHGBD201
00589  S910-CLOSE.                                                      CHGBD201
00590      SET L910-CLOSE-88     TO TRUE.                               CHGBD201
00591      GO TO S910-MSTR-IO.                                          CHGBD201
00592                                                                   CHGBD201
00593  S910-MSTR-IO.                                                    CHGBD201
00594      CALL 'DTSBU910' USING L910-LINK-AREA                         CHGBD201
00595                            MSKL-REC.                              CHGBD201
00596                                                                   CHGBD201
00597  S910-EXIT.                                                       CHGBD201
00598      EXIT.                                                        CHGBD201
00599                                                                   CHGBD201
00600  S921-OPEN-READ.                                                  CHGBD201
00601      SET L921-OPEN-READ-88 TO TRUE.                               CHGBD201
00602      GO TO S921-AIX-IO.                                           CHGBD201
00603                                                                   CHGBD201
00604  S921-CLOSE.                                                      CHGBD201
00605      SET L921-CLOSE-88     TO TRUE.                               CHGBD201
00606      GO TO S921-AIX-IO.                                           CHGBD201
00607                                                                   CHGBD201
00608  S921-AIX-IO.                                                     CHGBD201
00609      CALL 'DTSBU921' USING L921-LINK-AREA                         CHGBD201
00610                            ISKL-REC.                              CHGBD201
00611                                                                   CHGBD201
00612  S921-EXIT.                                                       CHGBD201
00613      EXIT.                                                        CHGBD201
00614                                                                   CHGBD201
00615  S999-ABEND.                                                      CHGBD201
00616      DISPLAY '****  CHGBD201 ABENDING '                           CHGBD201
00617         ABEND-MSG.                                                CHGBD201
00618      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD201
00619  S999-EXIT.                                                       CHGBD201
00620      EXIT.                                                        CHGBD201
