00001  IDENTIFICATION DIVISION.                                         05/25/10
00002  PROGRAM-ID.             CHGBD110.                                CHGBD110
00003 *AUTHOR.                 TCL.                                        LV007
00004 *DATE-WRITTEN.           FEBRUARY 1999.                           CHGBD110
00005  DATE-COMPILED.                                                   CHGBD110
00006      SKIP3                                                        CHGBD110
00007 *****                                                             CHGBD110
00008 *                                                                 CHGBD110
00009 *    FUNCTION:                                                    CHGBD110
00010 *                                                                 CHGBD110
00011 *        ***  SPECIAL VERSION  ***                                CHGBD110
00012 *                                                                 CHGBD110
00013 *        DRIVER FOR BENEFIT CHARGE FUNCTIONS :                    CHGBD110
00014 *          (1) GENERATE CHARGE STATEMENTS FOR RATED AND SELF-     CHGBD110
00015 *              INSURANE EMPLOYERS                                 CHGBD110
00016 *          (2) GENERATE THE FISCAL AGENT FILES FOR FISCAL AGENTS  CHGBD110
00017 *          (3) RUN QUARTERLY/ANNUAL/SPECIAL EXTRACT CHARGE PRO-   CHGBD110
00018 *              CESSES FOR RATED, SELF-INSURANCE, CWC, AND FEDERAL.CHGBD110
00019 *                                                                 CHGBD110
00020 *****                                                             CHGBD110
00021 *        ***  NOTE  NOTE  NOTE  NOTE  NOTE  NOTE  NOTE  ***       CHGBD110
00022 *        ***                                            ***       CHGBD110
00023 *        ***  IF THE BENEFITS SYSTEM BEGINS PRODUCING   ***       CHGBD110
00024 *        ***  CHARGE RECORDS FOR A NEW BENEFIT PROGRAM  ***       CHGBD110
00025 *        ***  MODIFY THE FOLLOWING CHARGE SYSTEM        ***       CHGBD110
00026 *        ***  COMPONENTS:                               ***       CHGBD110
00027 *        ***                                            ***       CHGBD110
00028 *        ***  ADD NEW LEVEL-88S TO:                     ***       CHGBD110
00029 *        ***      CHG1-CHARGE-PROGRAM IN CHGIM001       ***       CHGBD110
00030 *        ***      WRK-PROGRAM IN CHGBD100               ***       CHGBD110
00031 *        ***      CHG2-PROGRAM IN CHGIM002              ***       CHGBD110
00032 *        ***      CHG4-PROGRAM IN CHGIM004              ***       CHGBD110
00033 *        ***      CHG30-PROGRAM IN CHGIM030             ***       CHGBD110
00034 *        ***                                            ***       CHGBD110
00035 *        ***  MODIFY P1500 IN CHGBD100                  ***       CHGBD110
00036 *        ***                                            ***       CHGBD110
00037 *****                                                             CHGBD110
00038 *                                                                 CHGBD110
00039 *        INPUT:                                                   CHGBD110
00040 *                                                                 CHGBD110
00041 *            CHGFILE  - CHARGE RECORDS GENERATED BY               CHGBD110
00042 *                       BENEFITS SYSTEM.                          CHGBD110
00043 *                                                                 CHGBD110
00044 *            SYSIN    - RUN TYPE: Q = QUARTERLY, A = ANNUAL       CHGBD110
00045 *                       S = SPECIAL                               CHGBD110
00046 *                       PERIOD BEGIN DATE (MMDDYY)                CHGBD110
00047 *                       PERIOD END DATE (MMDDYY)                  CHGBD110
00048 *                       PARM-EXP-TRN-EFF-DATE (MMDDY)             CHGBD110
00049 *                                                                 CHGBD110
00050 *            CHGPARM  - PARAMETER DATA INPUT TO CHGBD100          CHGBD110
00051 *                       AND PASSED OTHER PROGRAMS IN THE          CHGBD110
00052 *                       SYSTEM.                                   CHGBD110
00053 *                                                                 CHGBD110
00054 *      OUTPUT:                                                    CHGBD110
00055 *                                                                 CHGBD110
00056 *            BD100CHG - REFORMATTED CHARGE RECORD WITHIN          CHGBD110
00057 *                       REPORTING PERIOD READY FOR SORT.          CHGBD110
00058 *                                                                 CHGBD110
00059 *            CHGPARM  - PARAMETER DATA INPUT TO CHGBD100 AND      CHGBD110
00060 *                       PASSED TO OTHER PROGRAMS IN THE SYSTEM.   CHGBD110
00061 *****                                                             CHGBD110
00062                                                                   CHGBD110
00063 ******************************************************************CHGBD110
00064 * MODIFICATION HISTORY:                                          *CHGBD110
00065 *                                                                *CHGBD110
00066 * 02-02-1999 MODIFIED FROM MT CHG100D                            *CHGBD110
00067 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD110
00068 *                                                                *CHGBD110
00069 * 06-29-2004 ADDED EMP TYPE 17 (DOMESTIC VIOLENCE)               *CHGBD110
00070 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD110
00071 *                                                                *CHGBD110
00072 *                                                                *CHGBD110
00073 * 05-04-2010 RECOMPILED FOR NEW VERSION OF CHGIM001 COPYBOOK     *CHGBD110
00074 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD110
00075 *                                                                *CHGBD110
00076 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD110
00077 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD110
00078 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD110
00079 *                                                                *CHGBD110
00080 ******************************************************************CHGBD110
00081                                                                   CHGBD110
00082      SKIP3                                                        CHGBD110
00083  ENVIRONMENT DIVISION.                                            CHGBD110
00084      SKIP3                                                        CHGBD110
00085  INPUT-OUTPUT SECTION.                                            CHGBD110
00086      SKIP3                                                        CHGBD110
00087  FILE-CONTROL.                                                    CHGBD110
00088      SELECT PARM-FILE      ASSIGN TO SYSIN                        CHGBD110
00089             FILE STATUS IS PARM-STATUS.                           CHGBD110
00090                                                                   CHGBD110
00091 *&   SELECT CHG-PARM-FILE  ASSIGN TO CHGPARM                      CHGBD110
00092 *           FILE STATUS IS CHG-PARM-STATUS.                       CHGBD110
00093                                                                   CHGBD110
00094      SELECT CHARGE-IN-FILE ASSIGN TO CHGFILE                      CHGBD110
00095             FILE STATUS IS CHARGE-IN-STATUS.                      CHGBD110
00096                                                                   CHGBD110
00097 *&   SELECT BD100-CHG-FILE  ASSIGN TO BD100CHG                    CHGBD110
00098 *           FILE STATUS IS BD100-CHG-STATUS.                      CHGBD110
00099      EJECT                                                        CHGBD110
00100  DATA DIVISION.                                                   CHGBD110
00101      SKIP3                                                        CHGBD110
00102  FILE SECTION.                                                    CHGBD110
00103      SKIP3                                                        CHGBD110
00104 ************************************************************      CHGBD110
00105 *    PARAMETER RECORD                                             CHGBD110
00106 *       PARM-RUN-TYPE    :  Q = QUARTERLY, A = ANNUAL             CHGBD110
00107 *                        :  S = SPECIAL REPORTING PERIOD          CHGBD110
00108 *       PARM-PERIOD-BEGIN:  START OF REPORTING PERIOD MMDDYY      CHGBD110
00109 *       PARM-PERIOD-END  :  END OF REPORTING PERIOD MMDDYY        CHGBD110
00110 *                                                                 CHGBD110
00111 *       PARM-EXP-TRN-EFF-DATE                                     CHGBD110
00112 *                        :  CUTOFF DATE FOR TRANSFERS OF          CHGBD110
00113 *       EXPERIENCE. THIS DATE IS NORMALLY SET TO ALL NINES.       CHGBD110
00114 *       IT IS USED ONLY WHEN RECREATING CHARGES FOR A PAST        CHGBD110
00115 *       REPORTING PERIOD.  WHEN SET, THE SYSTEM WILL TRANSFER     CHGBD110
00116 *       CHARGES TO THE SUCCESSOR EMPLOYER ONLY WHEN THE           CHGBD110
00117 *       CHANGE OF OWNERSHIP OCCURRED PRIOR TO PARM-EXPER-EFF-DATE.CHGBD110
00118 *                                                                 CHGBD110
00119 *       EXAMPLE: Q,010199,033199,999999                           CHGBD110
00120 ************************************************************      CHGBD110
00121  FD  PARM-FILE                                                    CHGBD110
00122      RECORDING MODE IS F                                          CHGBD110
00123      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD110
00124      SKIP1                                                        CHGBD110
00125  01  PARM-REC.                                                    CHGBD110
00126      05  PARM-RUN-TYPE               PIC  X(01).                  CHGBD110
00127          88  PARM-RUN-TYPE-QTRLY-88    VALUE 'Q'.                 CHGBD110
00128          88  PARM-RUN-TYPE-ANNUAL-88   VALUE 'A'.                 CHGBD110
00129          88  PARM-RUN-TYPE-SPECIAL-88  VALUE 'S'.                 CHGBD110
00130      05  FILLER                      PIC  X(01).                  CHGBD110
00131      05  PARM-PERIOD-BEGIN           PIC  X(06).                  CHGBD110
00132      05  FILLER                      PIC  X(01).                  CHGBD110
00133      05  PARM-PERIOD-END             PIC  X(06).                  CHGBD110
00134      05  FILLER                      PIC  X(01).                  CHGBD110
00135      05  PARM-EXP-TRN-EFF-DATE       PIC  X(06).                  CHGBD110
00136      05  FILLER                      PIC  X(58).                  CHGBD110
00137                                                                   CHGBD110
00138 *FD  CHG-PARM-FILE                                                CHGBD110
00139 *    RECORDING MODE IS F                                          CHGBD110
00140 *    BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD110
00141 *    SKIP1                                                        CHGBD110
00142 *01  CHG-PARM-REC.                                                CHGBD110
00143 ***INCLUDE CHGIM003                                               CHGBD110
00144                                                                   CHGBD110
00145  FD  CHARGE-IN-FILE                                               CHGBD110
00146      RECORDING MODE IS V                                          CHGBD110
00147      LABEL RECORDS ARE STANDARD                                   CHGBD110
00148      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD110
00149      SKIP1                                                        CHGBD110
00150  01  CHARGE-IN-REC                   PIC  X(136).                 CHGBD110
00151                                                                   CHGBD110
00152 *FD  BD100-CHG-FILE                                               CHGBD110
00153 *    LABEL RECORDS ARE STANDARD                                   CHGBD110
00154 *    BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD110
00155 *    SKIP1                                                        CHGBD110
00156 *01  SORT-CHG-REC.                                                CHGBD110
00157 ***INCLUDE CHGIM001                                               CHGBD110
00158                                                                   CHGBD110
00159      EJECT                                                        CHGBD110
00160  WORKING-STORAGE SECTION.                                         CHGBD110
001605 77  PAN-VALET PICTURE X(24) VALUE '007CHGBD110  05/25/10'.       CHGBD110
00161                                                                   CHGBD110
00162  01  WRK-AREA.                                                    CHGBD110
00163      05  AMT-DISP                PIC Z(06)9.99-.                  CHGBD110
00164      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD110
00165                                  VALUE +100.                      CHGBD110
00166      05  ABEND-MSG                   PIC  X(60).                  CHGBD110
00167      05  ABEND-MOD                   PIC  X(08) VALUE 'DTSBU999'. CHGBD110
00168      05  DISP-AMT                    PIC  Z(06)9.99-.             CHGBD110
00169      05  WRK-CHG                     PIC  S9(09)V99 COMP-3        CHGBD110
00170                                        VALUE +0.                  CHGBD110
00171      05  WRK-DAILY-CHG               PIC  S9(09)V99 COMP-3        CHGBD110
00172                                        VALUE +0.                  CHGBD110
00173      05  WRK-CURR-DATE               PIC S9(09) COMP-3            CHGBD110
00174                                        VALUE +0.                  CHGBD110
00175      05  WRK-DAY-CNT                 PIC S9(04) COMP              CHGBD110
00176                                        VALUE +0.                  CHGBD110
00177      05  DISP-AMT1                   PIC  Z(08)9.99-.             CHGBD110
00178                                                                   CHGBD110
00179      05  PARM-STATUS                 PIC  X(02) VALUE SPACES.     CHGBD110
00180          88  PARM-FILE-OK-88     VALUE ZERO.                      CHGBD110
00181          88  PARM-FILE-EOF-88    VALUE '10'.                      CHGBD110
00182      05  CHG-PARM-STATUS             PIC  X(02) VALUE SPACES.     CHGBD110
00183          88  CHG-PARM-FILE-OK-88 VALUE ZERO.                      CHGBD110
00184      05  CHARGE-IN-STATUS            PIC  X(02) VALUE SPACES.     CHGBD110
00185          88  CHARGE-FILE-OK-88   VALUE ZERO.                      CHGBD110
00186          88  CHARGE-FILE-EOF-88  VALUE '10'.                      CHGBD110
00187      05  BD100-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD110
00188          88  BD100-FILE-OK-88    VALUE ZERO.                      CHGBD110
00189                                                                   CHGBD110
00190      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD110
00191          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD110
00192          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD110
00193                                                                   CHGBD110
00194      05  WRK-EDIT-ERROR-IND          PIC  X(01).                  CHGBD110
00195          88  WRK-EDIT-ERROR-YES-88    VALUE 'Y'.                  CHGBD110
00196          88  WRK-EDIT-ERROR-NO-88     VALUE 'N'.                  CHGBD110
00197                                                                   CHGBD110
00198      05  WRK-BEGIN-DATE              PIC S9(09) COMP-3.           CHGBD110
00199      05  WRK-END-DATE                PIC S9(09) COMP-3.           CHGBD110
00200      05  WRK-EXP-TRN-EFF-DATE        PIC S9(09) COMP-3.           CHGBD110
00201      05  WRK-CHARGE-DATE             PIC S9(09) COMP-3.           CHGBD110
00202      05  WRK-BYE                     PIC S9(09) COMP-3.           CHGBD110
00203 *************************************************************     CHGBD110
00204 *  WRK-PROGRAM DEFINES VALUES FOR VALID BENEFIT PROGRAMS.         CHGBD110
00205 *  IT IS SET BASED ON CHARGE-SUPP-CODE IN THE DUCAS ESPRPT04      CHGBD110
00206 *  RECORD.  IF AN NEW BENEFIT PROGRAM IS ESTABLISHED, ADD         CHGBD110
00207 *  AN ADDITIONAL LEVEL-88 AND MODIFY THE CODE IN P1500.           CHGBD110
00208 *************************************************************     CHGBD110
00209      05  WRK-PROGRAM                 PIC  9(01).                  CHGBD110
00210          88 WRK-PROG-UI-88        VALUE 1.                        CHGBD110
00211          88 WRK-PROG-EB-88        VALUE 2.                        CHGBD110
00212          88 WRK-PROG-TEUC-88      VALUE 3.                        CHGBD110
00213          88 WRK-PROG-TEUCA-88     VALUE 4.                        CHGBD110
00214      05  WRK-CHARGE-IN-READ          PIC  9(07) COMP-3.           CHGBD110
00215      05  WRK-SORT-CHG-WRITTEN        PIC  9(07) COMP-3.           CHGBD110
00216                                                                   CHGBD110
00217      05  WRK-CHG-DT-ERR-CNT          PIC  9(07) COMP-3.           CHGBD110
00218      05  WRK-BYE-ERR-CNT             PIC  9(07) COMP-3.           CHGBD110
00219      05  WRK-EMP-TYPE-ERR-CNT        PIC  9(07) COMP-3.           CHGBD110
00220      05  WRK-CHG-AMT-ERR-CNT         PIC  9(07) COMP-3.           CHGBD110
00221      05  WRK-SUPP-CD-ERR-CNT         PIC  9(07) COMP-3.           CHGBD110
00222                                                                   CHGBD110
00223      05  WRK-EMP-ACCT                PIC  9(06).                  CHGBD110
00224          88 WRK-EMP-ACCT-FED-88  VALUE 000001 THRU 001999.        CHGBD110
00225          88 WRK-EMP-ACCT-CWC-88  VALUE 110000 THRU 119999.        CHGBD110
00226                                                                   CHGBD110
00227      05  WRK-EMP-TYPE                PIC  9(02).                  CHGBD110
00228          88 WRK-EMP-TYPE-RATED-88     VALUE 00.                   CHGBD110
00229          88 WRK-EMP-TYPE-SELF-INS-88  VALUE 08.                   CHGBD110
00230          88 WRK-EMP-TYPE-CWC-88       VALUE 04.                   CHGBD110
00231          88 WRK-EMP-TYPE-FED-88       VALUE 01, 02.               CHGBD110
00232          88 WRK-EMP-TYPE-VALID-88     VALUE 00, 01, 02, 03        CHGBD110
00233                                             04, 05, 06            CHGBD110
00234                                             07, 08, 09            CHGBD110
00235                                             10, 11, 12            CHGBD110
00236                                             13, 15, 16, 17.       CHGBD110
00237 ** ADD ERROR MSG TABLE SET UP                                     CHGBD110
00238  01  MSG-TABLE.                                                   CHGBD110
00239      05  MSG1-TOT-CREDIT-AMT.                                     CHGBD110
00240          10  MSG1-ID.                                             CHGBD110
00241              15  MSG1-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD110
00242              15  MSG1-ID2      PIC X(03)  VALUE '101'.            CHGBD110
00243          10  MSG1-SHORT-TEXT   PIC X(20)                          CHGBD110
00244                    VALUE 'INVALID EMP TYPE :  '.                  CHGBD110
00245          10  MSG1-LONG-TEXT.                                      CHGBD110
00246              15  FILLER        PIC X(29)                          CHGBD110
00247                    VALUE 'INVALID EMPLOYER TYPE        '.         CHGBD110
00248              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD110
00249              15  TBL-SSN       PIC 9(09).                         CHGBD110
00250              15  FILLER        PIC X(13)  VALUE '  EMP TYPE = '.  CHGBD110
00251              15  TBL-EMP-TYPE  PIC 9(02).                         CHGBD110
00252                                                                   CHGBD110
00253      05  MSG2-TOT-CREDIT-AMT.                                     CHGBD110
00254          10  MSG2-ID.                                             CHGBD110
00255              15  MSG2-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD110
00256              15  MSG2-ID2      PIC X(03)  VALUE '101'.            CHGBD110
00257          10  MSG2-SHORT-TEXT   PIC X(20)                          CHGBD110
00258                    VALUE 'INVALID EMP TYPE :  '.                  CHGBD110
00259          10  MSG2-LONG-TEXT.                                      CHGBD110
00260              15  FILLER        PIC X(29)                          CHGBD110
00261                    VALUE 'INVALID BYE DATE ACCEPTED    '.         CHGBD110
00262              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD110
00263              15  TBL-SSN2      PIC 9(09).                         CHGBD110
00264              15  FILLER        PIC X(13)  VALUE '  BYE DATE = '.  CHGBD110
00265              15  TBL-BYE-DATE2 PIC 9(08).                         CHGBD110
00266                                                                   CHGBD110
00267      05  MSG3-TOT-CREDIT-AMT.                                     CHGBD110
00268          10  MSG3-ID.                                             CHGBD110
00269              15  MSG3-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD110
00270              15  MSG3-ID2      PIC X(03)  VALUE '101'.            CHGBD110
00271          10  MSG3-SHORT-TEXT   PIC X(20)                          CHGBD110
00272                    VALUE 'INVALID CHG DATE :  '.                  CHGBD110
00273          10  MSG3-LONG-TEXT.                                      CHGBD110
00274              15  FILLER        PIC X(29)                          CHGBD110
00275                    VALUE 'INVALID CHARGE DATE          '.         CHGBD110
00276              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD110
00277              15  TBL-SSN3      PIC 9(09).                         CHGBD110
00278              15  FILLER        PIC X(13)  VALUE '  CHG DATE = '.  CHGBD110
00279              15  TBL-CHG-DATE  PIC 9(08).                         CHGBD110
00280                                                                   CHGBD110
00281      05  MSG4-TOT-CREDIT-AMT.                                     CHGBD110
00282          10  MSG4-ID.                                             CHGBD110
00283              15  MSG4-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD110
00284              15  MSG4-ID2      PIC X(03)  VALUE '101'.            CHGBD110
00285          10  MSG4-SHORT-TEXT   PIC X(20)                          CHGBD110
00286                    VALUE 'INVALID CHG AMOUNT :'.                  CHGBD110
00287          10  MSG4-LONG-TEXT.                                      CHGBD110
00288              15  FILLER        PIC X(29)                          CHGBD110
00289                    VALUE 'INVALID CHARGE AMOUNT        '.         CHGBD110
00290              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD110
00291              15  TBL-SSN4      PIC 9(09).                         CHGBD110
00292              15  FILLER        PIC X(15)  VALUE '  CHG AMOUNT = '.CHGBD110
00293              15  TBL-CURR-AMT  PIC S9(08)V99.                     CHGBD110
00294                                                                   CHGBD110
00295      05  MSG5-TOT-CREDIT-AMT.                                     CHGBD110
00296          10  MSG5-ID.                                             CHGBD110
00297              15  MSG5-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD110
00298              15  MSG5-ID2      PIC X(03)  VALUE '101'.            CHGBD110
00299          10  MSG5-SHORT-TEXT   PIC X(20)                          CHGBD110
00300                    VALUE 'INVALID SUPP CODE  :'.                  CHGBD110
00301          10  MSG5-LONG-TEXT.                                      CHGBD110
00302              15  FILLER        PIC X(29)                          CHGBD110
00303                    VALUE 'INVALID SUPP CODE            '.         CHGBD110
00304              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD110
00305              15  TBL-SSN5      PIC 9(09).                         CHGBD110
00306              15  FILLER        PIC X(14)  VALUE '  SUPP CODE = '. CHGBD110
00307              15  TBL-SUPP-CODE PIC X(01).                         CHGBD110
00308                                                                   CHGBD110
00309      05  MSG6-NOT-LIABLE.                                         CHGBD110
00310          10  MSG6-ID.                                             CHGBD110
00311              15  MSG6-ID1      PIC X(08)  VALUE 'CHGBD100'.       CHGBD110
00312              15  MSG6-ID2      PIC X(03)  VALUE '102'.            CHGBD110
00313          10  MSG6-SHORT-TEXT   PIC X(20)                          CHGBD110
00314                    VALUE 'EMPLOYER NOT LIABLE:'.                  CHGBD110
00315          10  MSG6-LONG-TEXT.                                      CHGBD110
00316              15  FILLER        PIC X(29)                          CHGBD110
00317                    VALUE 'EMPLOYER NOT LIABLE          '.         CHGBD110
00318              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD110
00319              15  TBL-SSN6      PIC 9(09).                         CHGBD110
00320              15  FILLER        PIC X(15)  VALUE SPACES.           CHGBD110
00321                                                                   CHGBD110
00322 ** ADD ERROR MSG OUTPUT RECORD.                                   CHGBD110
00323  01  R907-REC.                                                    CHGBD110
00324  ++INCLUDE DTSIR907                                               CHGBD110
00325                                                                   CHGBD110
00326 *** BENEFITS CHARGE RECORD ***                                    CHGBD110
00327  ++INCLUDE ESPRPT04                                               CHGBD110
00328                                                                   CHGBD110
00329  01  FILLER REDEFINES CHARGE-REC.                                 CHGBD110
00330 **** 05  FILLER                      PIC  X(04).                  CHGBD110
00331      05  WRK-CHARGE-REC              PIC  X(140).                 CHGBD110
00332                                                                   CHGBD110
00333  01  L001-LINK-AREA.                                              CHGBD110
00334  ++INCLUDE DTSIL001                                               CHGBD110
00335                                                                   CHGBD110
00336  01  L004-LINK-AREA.                                              CHGBD110
00337  ++INCLUDE DTSIL004                                               CHGBD110
00338                                                                   CHGBD110
00339  01  L910-LINK-AREA.                                              CHGBD110
00340  ++INCLUDE DTSIL910                                               CHGBD110
00341                                                                   CHGBD110
00342  01  MSKL-REC.                                                    CHGBD110
00343  ++INCLUDE DTSIMSKL                                               CHGBD110
00344                                                                   CHGBD110
00345  01  MHDR-REC.                                                    CHGBD110
00346  ++INCLUDE DTSIMHDR                                               CHGBD110
00347                                                                   CHGBD110
00348  01  L921-LINK-AREA.                                              CHGBD110
00349  ++INCLUDE DTSIL921                                               CHGBD110
00350                                                                   CHGBD110
00351  01  ISKL-REC.                                                    CHGBD110
00352  ++INCLUDE DTSIISKL                                               CHGBD110
00353                                                                   CHGBD110
00354  01  L100-LINK-AREA.                                              CHGBD110
00355  ++INCLUDE CHGIL100                                               CHGBD110
00356                                                                   CHGBD110
00357      EJECT                                                        CHGBD110
00358  PROCEDURE DIVISION.                                              CHGBD110
00359      SKIP2                                                        CHGBD110
00360  CHGBD100-MAIN.                                                   CHGBD110
00361      MOVE ZERO TO  WRK-CHARGE-IN-READ                             CHGBD110
00362                    WRK-SORT-CHG-WRITTEN                           CHGBD110
00363                    WRK-CHG-DT-ERR-CNT                             CHGBD110
00364                    WRK-BYE-ERR-CNT                                CHGBD110
00365                    WRK-EMP-TYPE-ERR-CNT                           CHGBD110
00366                    WRK-CHG-AMT-ERR-CNT                            CHGBD110
00367                    WRK-SUPP-CD-ERR-CNT.                           CHGBD110
00368                                                                   CHGBD110
00369      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD110
00370                                                                   CHGBD110
00371      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD110
00372      IF WRK-ERROR-YES-88                                          CHGBD110
00373         PERFORM S910-CLOSE      THRU S910-EXIT                    CHGBD110
00374         PERFORM S921-CLOSE      THRU S921-EXIT                    CHGBD110
00375         GO TO CHGBD100-EXIT.                                      CHGBD110
00376                                                                   CHGBD110
00377      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD110
00378                                                                   CHGBD110
00379      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD110
00380                                                                   CHGBD110
00381      MOVE +0 TO RETURN-CODE.                                      CHGBD110
00382                                                                   CHGBD110
00383  CHGBD100-EXIT.                                                   CHGBD110
00384      STOP RUN.                                                    CHGBD110
00385      EJECT                                                        CHGBD110
00386  I0000-INITIATE.                                                  CHGBD110
00387      MOVE MSG1-ID1 TO R907-MODULE-NAME.                           CHGBD110
00388      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      CHGBD110
00389                                                                   CHGBD110
00390      PERFORM I0100-OPEN-MASTER   THRU I0100-EXIT.                 CHGBD110
00391                                                                   CHGBD110
00392      PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT.                 CHGBD110
00393                                                                   CHGBD110
00394      PERFORM I2000-OPEN-FILES THRU I2000-EXIT.                    CHGBD110
00395                                                                   CHGBD110
00396  I0000-EXIT.                                                      CHGBD110
00397      EXIT.                                                        CHGBD110
00398                                                                   CHGBD110
00399  I0100-OPEN-MASTER.                                               CHGBD110
00400      PERFORM S910-OPEN-READ    THRU S910-EXIT.                    CHGBD110
00401      PERFORM S921-OPEN-READ    THRU S921-EXIT.                    CHGBD110
00402                                                                   CHGBD110
00403  I0100-EXIT.                                                      CHGBD110
00404      EXIT.                                                        CHGBD110
00405                                                                   CHGBD110
00406  I1000-PROCESS-PARMS.                                             CHGBD110
00407      OPEN INPUT PARM-FILE.                                        CHGBD110
00408      IF NOT PARM-FILE-OK-88                                       CHGBD110
00409         DISPLAY 'PARM FILE OPEN ERROR: ' PARM-STATUS              CHGBD110
00410         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD110
00411         GO TO I1000-EXIT.                                         CHGBD110
00412                                                                   CHGBD110
00413      READ PARM-FILE.                                              CHGBD110
00414      IF NOT PARM-FILE-OK-88                                       CHGBD110
00415         DISPLAY 'PARM FILE READ ERROR: ' PARM-STATUS              CHGBD110
00416         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD110
00417         GO TO I1000-EXIT.                                         CHGBD110
00418                                                                   CHGBD110
00419      DISPLAY '***** CHGBD100 PARM RECORD *****'.                  CHGBD110
00420      DISPLAY PARM-REC.                                            CHGBD110
00421      DISPLAY SPACE.                                               CHGBD110
00422      DISPLAY '***** CHGBD100 EDITED PARMS ****'.                  CHGBD110
00423      DISPLAY SPACE.                                               CHGBD110
00424                                                                   CHGBD110
00425      PERFORM I1100-RUN-TYPE     THRU I1100-EXIT.                  CHGBD110
00426                                                                   CHGBD110
00427      PERFORM I1200-DATE-RANGE   THRU I1200-EXIT.                  CHGBD110
00428                                                                   CHGBD110
00429      PERFORM I1300-EXP-TRN-DATE THRU I1300-EXIT.                  CHGBD110
00430                                                                   CHGBD110
00431 *&   PERFORM I1400-WRITE-CHG-PARM THRU I1400-EXIT.                CHGBD110
00432                                                                   CHGBD110
00433      CLOSE PARM-FILE.                                             CHGBD110
00434                                                                   CHGBD110
00435  I1000-EXIT.                                                      CHGBD110
00436      EXIT.                                                        CHGBD110
00437                                                                   CHGBD110
00438  I1100-RUN-TYPE.                                                  CHGBD110
00439      IF PARM-RUN-TYPE = SPACES OR LOW-VALUES                      CHGBD110
00440         MOVE 'Q' TO PARM-RUN-TYPE                                 CHGBD110
00441      ELSE                                                         CHGBD110
00442      IF PARM-RUN-TYPE = 'Q' OR 'A' OR 'S'                         CHGBD110
00443         NEXT SENTENCE                                             CHGBD110
00444      ELSE                                                         CHGBD110
00445         MOVE 'INVALID RUN TYPE' TO ABEND-MSG                      CHGBD110
00446         PERFORM S999-ABEND THRU S999-EXIT                         CHGBD110
00447         GO TO I1100-EXIT.                                         CHGBD110
00448                                                                   CHGBD110
00449      IF PARM-RUN-TYPE = 'Q'                                       CHGBD110
00450         DISPLAY 'RUN TYPE: QUARTERLY'                             CHGBD110
00451      ELSE                                                         CHGBD110
00452         IF PARM-RUN-TYPE = 'A'                                    CHGBD110
00453            DISPLAY 'RUN TYPE: ANNUAL'                             CHGBD110
00454         ELSE                                                      CHGBD110
00455            IF PARM-RUN-TYPE = 'S'                                 CHGBD110
00456               DISPLAY 'RUN TYPE: SPECIAL'                         CHGBD110
00457            END-IF                                                 CHGBD110
00458         END-IF                                                    CHGBD110
00459      END-IF.                                                      CHGBD110
00460                                                                   CHGBD110
00461      DISPLAY SPACE.                                               CHGBD110
00462                                                                   CHGBD110
00463  I1100-EXIT.                                                      CHGBD110
00464      EXIT.                                                        CHGBD110
00465                                                                   CHGBD110
00466  I1200-DATE-RANGE.                                                CHGBD110
00467      MOVE ZERO TO WRK-BEGIN-DATE                                  CHGBD110
00468                   WRK-END-DATE.                                   CHGBD110
00469                                                                   CHGBD110
00470      IF (PARM-PERIOD-BEGIN = SPACES OR LOW-VALUES)                CHGBD110
00471      AND (PARM-PERIOD-END = SPACES OR LOW-VALUES)                 CHGBD110
00472         IF PARM-RUN-TYPE-SPECIAL-88                               CHGBD110
00473            MOVE 'DATES REQUIRED FOR SPECIAL RUN'                  CHGBD110
00474                                   TO ABEND-MSG                    CHGBD110
00475            PERFORM S999-ABEND     THRU S999-EXIT                  CHGBD110
00476         ELSE                                                      CHGBD110
00477            PERFORM I1230-DEFAULT-DATES THRU I1230-EXIT            CHGBD110
00478            GO TO I1200-DISPLAY-DATES.                             CHGBD110
00479                                                                   CHGBD110
00480      PERFORM I1210-BEGIN-DATE THRU I1210-EXIT.                    CHGBD110
00481                                                                   CHGBD110
00482      PERFORM I1220-END-DATE   THRU I1220-EXIT.                    CHGBD110
00483                                                                   CHGBD110
00484      IF WRK-END-DATE < WRK-BEGIN-DATE                             CHGBD110
00485          MOVE 'PERIOD END LESS THAN PERIOD BEGIN'                 CHGBD110
00486             TO ABEND-MSG                                          CHGBD110
00487          PERFORM S999-ABEND THRU S999-EXIT.                       CHGBD110
00488                                                                   CHGBD110
00489  I1200-DISPLAY-DATES.                                             CHGBD110
00490      DISPLAY 'START DATE : ' WRK-BEGIN-DATE.                      CHGBD110
00491      DISPLAY 'END DATE   : ' WRK-END-DATE.                        CHGBD110
00492      DISPLAY SPACE.                                               CHGBD110
00493                                                                   CHGBD110
00494  I1200-EXIT.                                                      CHGBD110
00495      EXIT.                                                        CHGBD110
00496                                                                   CHGBD110
00497  I1210-BEGIN-DATE.                                                CHGBD110
00498      MOVE PARM-PERIOD-BEGIN TO L001-CAL-6-DATE-X.                 CHGBD110
00499      PERFORM S001-FROM-CAL-6 THRU S001-EXIT.                      CHGBD110
00500      IF L001-VALID-DATE                                           CHGBD110
00501         MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE                  CHGBD110
00502      ELSE                                                         CHGBD110
00503         MOVE 'INVALID PERIOD BEGIN DATE' TO ABEND-MSG             CHGBD110
00504         PERFORM S999-ABEND THRU S999-EXIT                         CHGBD110
00505         GO TO I1210-EXIT.                                         CHGBD110
00506                                                                   CHGBD110
00507      IF PARM-RUN-TYPE-SPECIAL-88                                  CHGBD110
00508         NEXT SENTENCE                                             CHGBD110
00509      ELSE                                                         CHGBD110
00510         MOVE WRK-BEGIN-DATE TO L004-DATE                          CHGBD110
00511         PERFORM S004-FROM-DATE THRU S004-EXIT                     CHGBD110
00512         IF WRK-BEGIN-DATE NOT = L004-QTR-START-DATE               CHGBD110
00513            MOVE 'PERIOD BEGIN NOT START OF QTR'                   CHGBD110
00514                                     TO ABEND-MSG                  CHGBD110
00515            PERFORM S999-ABEND THRU S999-EXIT                      CHGBD110
00516         END-IF                                                    CHGBD110
00517      END-IF.                                                      CHGBD110
00518                                                                   CHGBD110
00519  I1210-EXIT.                                                      CHGBD110
00520      EXIT.                                                        CHGBD110
00521                                                                   CHGBD110
00522  I1220-END-DATE.                                                  CHGBD110
00523      MOVE PARM-PERIOD-END TO L001-CAL-6-DATE-X.                   CHGBD110
00524      PERFORM S001-FROM-CAL-6 THRU S001-EXIT.                      CHGBD110
00525      IF L001-VALID-DATE                                           CHGBD110
00526         MOVE L001-FED-8-DATE-9 TO WRK-END-DATE                    CHGBD110
00527      ELSE                                                         CHGBD110
00528         MOVE 'INVALID PERIOD END DATE' TO ABEND-MSG               CHGBD110
00529         PERFORM S999-ABEND THRU S999-EXIT                         CHGBD110
00530         GO TO I1220-EXIT.                                         CHGBD110
00531                                                                   CHGBD110
00532      IF PARM-RUN-TYPE-SPECIAL-88                                  CHGBD110
00533         NEXT SENTENCE                                             CHGBD110
00534      ELSE                                                         CHGBD110
00535         MOVE WRK-END-DATE TO L004-DATE                            CHGBD110
00536         PERFORM S004-FROM-DATE THRU S004-EXIT                     CHGBD110
00537         IF WRK-END-DATE NOT = L004-QTR-END-DATE                   CHGBD110
00538            MOVE 'PERIOD END NOT END OF QTR'                       CHGBD110
00539                                     TO ABEND-MSG                  CHGBD110
00540            PERFORM S999-ABEND THRU S999-EXIT                      CHGBD110
00541         END-IF                                                    CHGBD110
00542      END-IF.                                                      CHGBD110
00543                                                                   CHGBD110
00544  I1220-EXIT.                                                      CHGBD110
00545      EXIT.                                                        CHGBD110
00546                                                                   CHGBD110
00547  I1230-DEFAULT-DATES.                                             CHGBD110
00548      MOVE LOW-VALUES           TO MSKL-KEY-AREA.                  CHGBD110
00549      MOVE +0                   TO MSKL-EMP-NO.                    CHGBD110
00550      SET MSKL-HDR-88           TO TRUE.                           CHGBD110
00551      PERFORM S910-READ         THRU S910-EXIT.                    CHGBD110
00552                                                                   CHGBD110
00553      IF L910-NO-REC-88                                            CHGBD110
00554         MOVE 'MHDR RECORD IS MISSING'                             CHGBD110
00555                                TO ABEND-MSG                       CHGBD110
00556         PERFORM S999-ABEND     THRU S999-EXIT.                    CHGBD110
00557                                                                   CHGBD110
00558      MOVE MSKL-REC             TO MHDR-REC.                       CHGBD110
00559      MOVE MHDR-CMPL-QTR-BEGIN-DATE                                CHGBD110
00560                                TO WRK-BEGIN-DATE.                 CHGBD110
00561      MOVE MHDR-CMPL-QTR-END-DATE                                  CHGBD110
00562                                TO WRK-END-DATE.                   CHGBD110
00563                                                                   CHGBD110
00564                                                                   CHGBD110
00565  I1230-EXIT.                                                      CHGBD110
00566      EXIT.                                                        CHGBD110
00567                                                                   CHGBD110
00568  I1300-EXP-TRN-DATE.                                              CHGBD110
00569      IF PARM-EXP-TRN-EFF-DATE = '999999'                          CHGBD110
00570         MOVE 99999999              TO WRK-EXP-TRN-EFF-DATE        CHGBD110
00571      ELSE                                                         CHGBD110
00572         MOVE PARM-EXP-TRN-EFF-DATE TO L001-CAL-6-DATE-X           CHGBD110
00573         PERFORM S001-FROM-CAL-6    THRU S001-EXIT                 CHGBD110
00574         IF L001-VALID-DATE                                        CHGBD110
00575            MOVE L001-FED-8-DATE-9  TO WRK-EXP-TRN-EFF-DATE        CHGBD110
00576         ELSE                                                      CHGBD110
00577            MOVE 'INVALID EXP TRN EFF DATE' TO ABEND-MSG           CHGBD110
00578            PERFORM S999-ABEND      THRU S999-EXIT                 CHGBD110
00579         END-IF                                                    CHGBD110
00580      END-IF.                                                      CHGBD110
00581                                                                   CHGBD110
00582      DISPLAY 'EXPERIENCE TRANSFER CUTOFF DATE: '                  CHGBD110
00583          WRK-EXP-TRN-EFF-DATE.                                    CHGBD110
00584      DISPLAY SPACE.                                               CHGBD110
00585                                                                   CHGBD110
00586  I1300-EXIT.                                                      CHGBD110
00587      EXIT.                                                        CHGBD110
00588                                                                   CHGBD110
00589 *I1400-WRITE-CHG-PARM.                                            CHGBD110
00590 *&   OPEN I-O    CHG-PARM-FILE.                                   CHGBD110
00591 *    OPEN OUTPUT CHG-PARM-FILE.                                   CHGBD110
00592 *    IF NOT CHG-PARM-FILE-OK-88                                   CHGBD110
00593 *       DISPLAY 'CHARGE PARM FILE OPEN ERROR: ' CHG-PARM-STATUS   CHGBD110
00594 *       SET WRK-ERROR-YES-88 TO TRUE                              CHGBD110
00595 *       GO TO I1400-EXIT.                                         CHGBD110
00596 *                                                                 CHGBD110
00597 *    MOVE PARM-RUN-TYPE         TO BD100-RUN-TYPE.                CHGBD110
00598 *    MOVE WRK-BEGIN-DATE        TO BD100-PERIOD-BEGIN.            CHGBD110
00599 *    MOVE WRK-END-DATE          TO BD100-PERIOD-END.              CHGBD110
00600 *    MOVE WRK-EXP-TRN-EFF-DATE  TO BD100-EXP-TRN-EFF-DATE.        CHGBD110
00601 *                                                                 CHGBD110
00602 *    MOVE ZERO                  TO BD200-RECS-READ                CHGBD110
00603 *                                  BD200-RECS-WRITTEN             CHGBD110
00604 *                                  BD300-SELECT-EMP.              CHGBD110
00605 *                                                                 CHGBD110
00606 *    MOVE SPACES                TO BD300-RPT-TYPES                CHGBD110
00607 *                                  BD100-FILLER                   CHGBD110
00608 *                                  BD200-FILLER                   CHGBD110
00609 *                                  BD300-FILLER.                  CHGBD110
00610 *                                                                 CHGBD110
00611 *    WRITE CHG-PARM-REC.                                          CHGBD110
00612 *    CLOSE CHG-PARM-FILE.                                         CHGBD110
00613 *                                                                 CHGBD110
00614 *I1400-EXIT.                                                      CHGBD110
00615 *    EXIT.                                                        CHGBD110
00616                                                                   CHGBD110
00617  I2000-OPEN-FILES.                                                CHGBD110
00618      OPEN INPUT  CHARGE-IN-FILE.                                  CHGBD110
00619      IF NOT CHARGE-FILE-OK-88                                     CHGBD110
00620         DISPLAY 'CHARGE FILE OPEN ERROR: ' CHARGE-IN-STATUS       CHGBD110
00621         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD110
00622         GO TO I2000-EXIT.                                         CHGBD110
00623                                                                   CHGBD110
00624 *    OPEN OUTPUT BD100-CHG-FILE.                                  CHGBD110
00625 *    IF NOT BD100-FILE-OK-88                                      CHGBD110
00626 *       DISPLAY 'SORT FILE OPEN ERROR: ' BD100-CHG-STATUS         CHGBD110
00627 *       SET WRK-ERROR-YES-88 TO TRUE                              CHGBD110
00628 *       GO TO I2000-EXIT.                                         CHGBD110
00629                                                                   CHGBD110
00630  I2000-EXIT.                                                      CHGBD110
00631      EXIT.                                                        CHGBD110
00632                                                                   CHGBD110
00633                                                                   CHGBD110
00634  P0000-PROCESS.                                                   CHGBD110
00635      READ CHARGE-IN-FILE INTO WRK-CHARGE-REC                      CHGBD110
00636      IF NOT CHARGE-FILE-OK-88                                     CHGBD110
00637         DISPLAY 'CHARGE FILE EMPTY: ' CHARGE-IN-STATUS            CHGBD110
00638         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD110
00639         GO TO P0000-EXIT                                          CHGBD110
00640      ELSE                                                         CHGBD110
00641         ADD 1 TO WRK-CHARGE-IN-READ.                              CHGBD110
00642                                                                   CHGBD110
00643      PERFORM P1000-SELECT-CHARGES THRU P1000-EXIT                 CHGBD110
00644         UNTIL WRK-DAY-CNT > +1                                    CHGBD110
00645         OR CHARGE-FILE-EOF-88.                                    CHGBD110
00646                                                                   CHGBD110
00647  P0000-EXIT.                                                      CHGBD110
00648      EXIT.                                                        CHGBD110
00649                                                                   CHGBD110
00650  P1000-SELECT-CHARGES.                                            CHGBD110
00651      SET WRK-EDIT-ERROR-NO-88 TO TRUE.                            CHGBD110
00652 *****                                                             CHGBD110
00653      IF CHARGE-EMPL-ACCT < +1                                     CHGBD110
00654         IF CHARGE-SSN = 220947300                                 CHGBD110
00655             DISPLAY 'EMPL: ', CHARGE-EMPL-ACCT,                   CHGBD110
00656                     ' SSN: ', CHARGE-SSN,                         CHGBD110
00657                ' CHG-DATE: ', CHARGE-DATE,                        CHGBD110
00658                 ' TRAN-ID: ', CHARGE-TRAN-ID,                     CHGBD110
00659                 ' OPER-ID: ', CHARGE-OPER-ID.                     CHGBD110
00660 *****                                                             CHGBD110
00661      PERFORM P1100-EDIT-CHARGE-DATE THRU P1100-EXIT.              CHGBD110
00662      IF WRK-EDIT-ERROR-YES-88                                     CHGBD110
00663         GO TO P1000-READ-NEXT.                                    CHGBD110
00664                                                                   CHGBD110
00665      IF (WRK-CHARGE-DATE < WRK-BEGIN-DATE)                        CHGBD110
00666                OR                                                 CHGBD110
00667         (WRK-CHARGE-DATE > WRK-END-DATE)                          CHGBD110
00668          GO TO P1000-READ-NEXT.                                   CHGBD110
00669                                                                   CHGBD110
00670      PERFORM P1200-EDIT-CWC         THRU P1200-EXIT.              CHGBD110
00671                                                                   CHGBD110
00672      PERFORM P1300-EDIT-BYE-DATE    THRU P1300-EXIT.              CHGBD110
00673                                                                   CHGBD110
00674      PERFORM P1400-EDIT-CHG-AMT     THRU P1400-EXIT.              CHGBD110
00675                                                                   CHGBD110
00676      PERFORM P1500-EDIT-SUPP-CODE   THRU P1500-EXIT.              CHGBD110
00677                                                                   CHGBD110
00678      PERFORM P1600-CHK-EMP-MASTER   THRU P1600-EXIT.              CHGBD110
00679                                                                   CHGBD110
00680      IF WRK-EDIT-ERROR-YES-88                                     CHGBD110
00681         GO TO P1000-READ-NEXT.                                    CHGBD110
00682                                                                   CHGBD110
00683      PERFORM P2000-WRITE-SORT-REC THRU P2000-EXIT.                CHGBD110
00684                                                                   CHGBD110
00685  P1000-READ-NEXT.                                                 CHGBD110
00686      READ CHARGE-IN-FILE INTO WRK-CHARGE-REC.                     CHGBD110
00687      IF CHARGE-FILE-OK-88                                         CHGBD110
00688         ADD 1 TO WRK-CHARGE-IN-READ                               CHGBD110
00689      ELSE                                                         CHGBD110
00690      IF CHARGE-FILE-EOF-88                                        CHGBD110
00691         NEXT SENTENCE                                             CHGBD110
00692      ELSE                                                         CHGBD110
00693         DISPLAY 'CHARGE FILE READ ERROR: ' CHARGE-IN-STATUS       CHGBD110
00694         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD110
00695         SET CHARGE-FILE-EOF-88 TO TRUE.                           CHGBD110
00696                                                                   CHGBD110
00697  P1000-EXIT.                                                      CHGBD110
00698      EXIT.                                                        CHGBD110
00699                                                                   CHGBD110
00700  P1100-EDIT-CHARGE-DATE.                                          CHGBD110
00701      MOVE CHARGE-DATE TO L001-FED-8-DATE-X.                       CHGBD110
00702      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      CHGBD110
00703      IF L001-VALID-DATE                                           CHGBD110
00704         MOVE L001-FED-8-DATE-9 TO WRK-CHARGE-DATE                 CHGBD110
00705      ELSE                                                         CHGBD110
00706         SET WRK-EDIT-ERROR-YES-88 TO TRUE                         CHGBD110
00707         ADD +1 TO WRK-CHG-DT-ERR-CNT                              CHGBD110
00708         MOVE MSG3-ID2         TO R907-MSG-ID                      CHGBD110
00709         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD110
00710         MOVE CHARGE-SSN       TO TBL-SSN3                         CHGBD110
00711         MOVE CHARGE-DATE      TO TBL-CHG-DATE                     CHGBD110
00712         MOVE MSG3-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD110
00713         PERFORM S946-R907-WRITE THRU S946-EXIT.                   CHGBD110
00714                                                                   CHGBD110
00715  P1100-EXIT.                                                      CHGBD110
00716      EXIT.                                                        CHGBD110
00717                                                                   CHGBD110
00718  P1200-EDIT-CWC.                                                  CHGBD110
00719      MOVE CHARGE-EMPL-ACCT TO WRK-EMP-ACCT.                       CHGBD110
00720      MOVE CHARGE-EMPLOYER-TYPE TO WRK-EMP-TYPE.                   CHGBD110
00721                                                                   CHGBD110
00722 ************************************************************      CHGBD110
00723 *  EMPLOYER TYPE NOT SET IN CHARGE RECORDS FOR CWC ACCOUNTS.      CHGBD110
00724 *  THE FOLLOWING CODE CORRECTS THE EMPLOYER TYPE ON THE           CHGBD110
00725 *  INPUT RECORDS.                                                 CHGBD110
00726 ************************************************************      CHGBD110
00727      IF WRK-EMP-ACCT-CWC-88                                       CHGBD110
00728         IF NOT WRK-EMP-TYPE-CWC-88                                CHGBD110
00729            SET WRK-EMP-TYPE-CWC-88 TO TRUE                        CHGBD110
00730            MOVE WRK-EMP-TYPE TO CHARGE-EMPLOYER-TYPE.             CHGBD110
00731                                                                   CHGBD110
00732                                                                   CHGBD110
00733  P1200-EXIT.                                                      CHGBD110
00734      EXIT.                                                        CHGBD110
00735                                                                   CHGBD110
00736  P1300-EDIT-BYE-DATE.                                             CHGBD110
00737      MOVE CHARGE-BYE-DATE       TO L001-FED-8-DATE-X.             CHGBD110
00738      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      CHGBD110
00739      IF L001-VALID-DATE                                           CHGBD110
00740         MOVE L001-FED-8-DATE-9  TO WRK-BYE                        CHGBD110
00741      ELSE                                                         CHGBD110
00742         ADD +1                  TO WRK-BYE-ERR-CNT                CHGBD110
00743         MOVE MSG2-ID2         TO R907-MSG-ID                      CHGBD110
00744         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD110
00745         MOVE CHARGE-SSN       TO TBL-SSN2                         CHGBD110
00746         MOVE CHARGE-BYE-DATE  TO TBL-BYE-DATE2                    CHGBD110
00747         MOVE MSG2-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD110
00748         PERFORM S946-R907-WRITE THRU S946-EXIT                    CHGBD110
00749         MOVE ZERO               TO WRK-BYE.                       CHGBD110
00750                                                                   CHGBD110
00751  P1300-EXIT.                                                      CHGBD110
00752      EXIT.                                                        CHGBD110
00753                                                                   CHGBD110
00754  P1400-EDIT-CHG-AMT.                                              CHGBD110
00755      IF CHARGE-CURR-AMT NOT NUMERIC                               CHGBD110
00756         SET WRK-EDIT-ERROR-YES-88 TO TRUE                         CHGBD110
00757         ADD +1 TO WRK-CHG-AMT-ERR-CNT                             CHGBD110
00758         MOVE MSG4-ID2         TO R907-MSG-ID                      CHGBD110
00759         MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                      CHGBD110
00760         MOVE CHARGE-SSN       TO TBL-SSN2                         CHGBD110
00761         MOVE CHARGE-CURR-AMT  TO TBL-CURR-AMT                     CHGBD110
00762         MOVE MSG4-LONG-TEXT   TO R907-MSG-TEXT                    CHGBD110
00763         PERFORM S946-R907-WRITE THRU S946-EXIT.                   CHGBD110
00764                                                                   CHGBD110
00765  P1400-EXIT.                                                      CHGBD110
00766      EXIT.                                                        CHGBD110
00767                                                                   CHGBD110
00768  P1500-EDIT-SUPP-CODE.                                            CHGBD110
00769      EVALUATE CHARGE-SUPP-CODE                                    CHGBD110
00770                                                                   CHGBD110
00771        WHEN SPACE                                                 CHGBD110
00772          SET WRK-PROG-UI-88 TO TRUE                               CHGBD110
00773                                                                   CHGBD110
00774        WHEN 'T'                                                   CHGBD110
00775          SET WRK-PROG-TEUC-88 TO TRUE                             CHGBD110
00776                                                                   CHGBD110
00777        WHEN 'E'                                                   CHGBD110
00778          SET WRK-PROG-EB-88 TO TRUE                               CHGBD110
00779                                                                   CHGBD110
00780        WHEN 'A'                                                   CHGBD110
00781          SET WRK-PROG-TEUCA-88 TO TRUE                            CHGBD110
00782                                                                   CHGBD110
00783        WHEN OTHER                                                 CHGBD110
00784          SET WRK-EDIT-ERROR-YES-88 TO TRUE                        CHGBD110
00785          ADD +1 TO WRK-SUPP-CD-ERR-CNT                            CHGBD110
00786          MOVE MSG5-ID2         TO R907-MSG-ID                     CHGBD110
00787          MOVE CHARGE-EMPL-ACCT TO R907-EMP-NO                     CHGBD110
00788          MOVE CHARGE-SSN       TO TBL-SSN5                        CHGBD110
00789          MOVE CHARGE-SUPP-CODE TO TBL-SUPP-CODE                   CHGBD110
00790          MOVE MSG5-LONG-TEXT   TO R907-MSG-TEXT                   CHGBD110
00791          PERFORM S946-R907-WRITE THRU S946-EXIT                   CHGBD110
00792                                                                   CHGBD110
00793      END-EVALUATE.                                                CHGBD110
00794                                                                   CHGBD110
00795  P1500-EXIT.                                                      CHGBD110
00796      EXIT.                                                        CHGBD110
00797                                                                   CHGBD110
00798  P1600-CHK-EMP-MASTER.                                            CHGBD110
00799      MOVE CHARGE-EMPL-ACCT     TO L100-EMP-NO.                    CHGBD110
00800      MOVE WRK-EXP-TRN-EFF-DATE TO L100-EXP-TRN-EFF-DATE.          CHGBD110
00801      PERFORM S100-CALL-CHGBU100 THRU S100-EXIT.                   CHGBD110
00802      IF L100-OK-88                                                CHGBD110
00803         MOVE L100-EMP-TYPE     TO CHARGE-EMPLOYER-TYPE            CHGBD110
00804         IF L100-SUCCESSOR NOT = ZERO                              CHGBD110
00805            MOVE L100-SUCCESSOR TO CHARGE-EMPL-ACCT                CHGBD110
00806         END-IF                                                    CHGBD110
00807      END-IF.                                                      CHGBD110
00808                                                                   CHGBD110
00809                                                                   CHGBD110
00810  P1600-EXIT.                                                      CHGBD110
00811      EXIT.                                                        CHGBD110
00812                                                                   CHGBD110
00813  P2000-WRITE-SORT-REC.                                            CHGBD110
00814      IF CHARGE-SSN = 220947300                                    CHGBD110
00815         MOVE CHARGE-CURR-AMT TO DISP-AMT                          CHGBD110
00816         DISPLAY '  => ' CHARGE-EMPL-ACCT                          CHGBD110
00817            '  ' DISP-AMT                                          CHGBD110
00818            '  ' CHARGE-EMPLOYER-TYPE                              CHGBD110
00819            '  ' CHARGE-DATE                                       CHGBD110
00820            '  ' WRK-BYE                                           CHGBD110
00821            '  ' CHARGE-CODE                                       CHGBD110
00822            ADD CHARGE-CURR-AMT  TO WRK-CHG                        CHGBD110
00823            IF WRK-CURR-DATE = ZERO                                CHGBD110
00824               MOVE CHARGE-DATE TO WRK-CURR-DATE                   CHGBD110
00825               ADD CHARGE-CURR-AMT  TO WRK-DAILY-CHG               CHGBD110
00826            ELSE                                                   CHGBD110
00827            IF CHARGE-DATE = WRK-CURR-DATE                         CHGBD110
00828               ADD CHARGE-CURR-AMT  TO WRK-DAILY-CHG               CHGBD110
00829            ELSE                                                   CHGBD110
00830               ADD +1 TO WRK-DAY-CNT                               CHGBD110
00831               MOVE WRK-DAILY-CHG TO DISP-AMT                      CHGBD110
00832               MOVE ZERO TO WRK-DAILY-CHG                          CHGBD110
00833               MOVE CHARGE-DATE TO WRK-CURR-DATE                   CHGBD110
00834               DISPLAY SPACE                                       CHGBD110
00835               DISPLAY '*** CHG FOR ' WRK-CURR-DATE                CHGBD110
00836                  '  ' DISP-AMT.                                   CHGBD110
00837 *    MOVE LOW-VALUES            TO CHG1-SORT-KEY-AREA.            CHGBD110
00838 *    MOVE CHARGE-SSN            TO CHG1-SSN.                      CHGBD110
00839 *    MOVE CHARGE-EMPL-ACCT      TO CHG1-EMP-NO.                   CHGBD110
00840 *    MOVE WRK-BYE               TO CHG1-BYE.                      CHGBD110
00841 *                                                                 CHGBD110
00842 *    MOVE WRK-CHARGE-DATE       TO CHG1-CHARGE-DATE.              CHGBD110
00843 *    MOVE CHARGE-CODE           TO CHG1-CHARGE-CODE.              CHGBD110
00844 *    MOVE WRK-PROGRAM           TO CHG1-CHARGE-PROGRAM.           CHGBD110
00845 *    MOVE CHARGE-PAY-TYPE       TO CHG1-CHARGE-PAY-TYPE.          CHGBD110
00846 *    MOVE CHARGE-NAME           TO CHG1-CHARGE-NAME.              CHGBD110
00847 *    MOVE CHARGE-EMPLOYER-TYPE  TO CHG1-CHARGE-EMP-TYPE.          CHGBD110
00848 *                                                                 CHGBD110
00849 *    MOVE CHARGE-CURR-AMT       TO CHG1-CHARGE-CURR-AMT.          CHGBD110
00850                                                                   CHGBD110
00851 *&   WRITE SORT-CHG-REC.                                          CHGBD110
00852      ADD 1 TO WRK-SORT-CHG-WRITTEN.                               CHGBD110
00853                                                                   CHGBD110
00854  P2000-EXIT.                                                      CHGBD110
00855      EXIT.                                                        CHGBD110
00856                                                                   CHGBD110
00857  T0000-TERMINATE.                                                 CHGBD110
00858      CLOSE CHARGE-IN-FILE.                                        CHGBD110
00859 *&         BD100-CHG-FILE.                                        CHGBD110
00860                                                                   CHGBD110
00861      PERFORM S910-CLOSE      THRU S910-EXIT.                      CHGBD110
00862      PERFORM S921-CLOSE      THRU S921-EXIT.                      CHGBD110
00863                                                                   CHGBD110
00864      MOVE WRK-CHG TO DISP-AMT1.                                   CHGBD110
00865      DISPLAY ' TOTAL CHARGE TO 027554       :   '                 CHGBD110
00866         DISP-AMT1.                                                CHGBD110
00867      DISPLAY ' CHGBD100 CHARGE RECORDS READ :   '                 CHGBD110
00868         WRK-CHARGE-IN-READ.                                       CHGBD110
00869      DISPLAY '       CHARGE RECORDS WRITTEN:    '                 CHGBD110
00870         WRK-SORT-CHG-WRITTEN.                                     CHGBD110
00871      DISPLAY '       BYE DATE ERRORS ACCEPTED:  '                 CHGBD110
00872         WRK-BYE-ERR-CNT.                                          CHGBD110
00873      DISPLAY '       CHARGE DATE ERRORS:        '                 CHGBD110
00874         WRK-CHG-DT-ERR-CNT                                        CHGBD110
00875      DISPLAY '       EMPLOYER TYPE ERRORS:      '                 CHGBD110
00876         WRK-EMP-TYPE-ERR-CNT.                                     CHGBD110
00877      DISPLAY '       CHARGE AMOUNT ERRORS:      '                 CHGBD110
00878         WRK-CHG-AMT-ERR-CNT.                                      CHGBD110
00879      DISPLAY '       SUPP CODE ERRORS:          '                 CHGBD110
00880         WRK-SUPP-CD-ERR-CNT.                                      CHGBD110
00881  T0000-EXIT.                                                      CHGBD110
00882      EXIT.                                                        CHGBD110
00883      EJECT                                                        CHGBD110
00884                                                                   CHGBD110
00885  S001-FROM-CAL-6.                                                 CHGBD110
00886      SET L001-FROM-CAL-6 TO TRUE.                                 CHGBD110
00887      GO TO S001-DATE.                                             CHGBD110
00888                                                                   CHGBD110
00889  S001-FROM-FED-8.                                                 CHGBD110
00890      SET L001-FROM-FED-8 TO TRUE.                                 CHGBD110
00891      GO TO S001-DATE.                                             CHGBD110
00892                                                                   CHGBD110
00893  S001-DATE.                                                       CHGBD110
00894      CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBD110
00895  S001-EXIT. EXIT.                                                 CHGBD110
00896                                                                   CHGBD110
00897  S004-FROM-DATE.                                                  CHGBD110
00898      SET L004-FROM-DATE TO TRUE.                                  CHGBD110
00899      GO TO S004-YRQ.                                              CHGBD110
00900                                                                   CHGBD110
00901  S004-YRQ.                                                        CHGBD110
00902      CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBD110
00903  S004-EXIT. EXIT.                                                 CHGBD110
00904                                                                   CHGBD110
00905  S100-CALL-CHGBU100.                                              CHGBD110
00906      CALL 'CHGBU100' USING L100-LINK-AREA.                        CHGBD110
00907  S100-EXIT. EXIT.                                                 CHGBD110
00908                                                                   CHGBD110
00909  S910-OPEN-READ.                                                  CHGBD110
00910      SET L910-OPEN-READ-88 TO TRUE.                               CHGBD110
00911      GO TO S910-MSTR-IO.                                          CHGBD110
00912                                                                   CHGBD110
00913  S910-READ.                                                       CHGBD110
00914      SET L910-READ-88 TO TRUE                                     CHGBD110
00915      GO TO S910-MSTR-IO.                                          CHGBD110
00916                                                                   CHGBD110
00917  S910-CLOSE.                                                      CHGBD110
00918      SET L910-CLOSE-88 TO TRUE.                                   CHGBD110
00919      GO TO S910-MSTR-IO.                                          CHGBD110
00920                                                                   CHGBD110
00921  S910-MSTR-IO.                                                    CHGBD110
00922      CALL 'DTSBU910' USING L910-LINK-AREA                         CHGBD110
00923                            MSKL-REC.                              CHGBD110
00924                                                                   CHGBD110
00925  S910-EXIT. EXIT.                                                 CHGBD110
00926                                                                   CHGBD110
00927  S921-OPEN-READ.                                                  CHGBD110
00928      SET L921-OPEN-READ-88 TO TRUE.                               CHGBD110
00929      GO TO S921-AIX-IO.                                           CHGBD110
00930                                                                   CHGBD110
00931  S921-CLOSE.                                                      CHGBD110
00932      SET L921-CLOSE-88 TO TRUE.                                   CHGBD110
00933      GO TO S921-AIX-IO.                                           CHGBD110
00934                                                                   CHGBD110
00935  S921-AIX-IO.                                                     CHGBD110
00936      CALL 'DTSBU921' USING L921-LINK-AREA                         CHGBD110
00937                            ISKL-REC.                              CHGBD110
00938                                                                   CHGBD110
00939  S921-EXIT. EXIT.                                                 CHGBD110
00940                                                                   CHGBD110
00941 ** ADD ERROR MSG PROCESS PARA.                                    CHGBD110
00942  S946-R907-WRITE.                                                 CHGBD110
00943      CALL 'DTSBU946' USING R907-REC.                              CHGBD110
00944  S946-EXIT. EXIT.                                                 CHGBD110
00945                                                                   CHGBD110
00946  S999-ABEND.                                                      CHGBD110
00947      DISPLAY '****  CHGBD100 ABENDING '                           CHGBD110
00948         ABEND-MSG.                                                CHGBD110
00949      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD110
00950                                                                   CHGBD110
00951  S999-EXIT.                                                       CHGBD110
00952      EXIT.                                                        CHGBD110
