00001  IDENTIFICATION DIVISION.                                         09/16/22
00002  PROGRAM-ID.             CHGBD300.                                CHGBD300
00003 *AUTHOR.                 TCL.                                        LV016
00004 *DATE-WRITTEN.           FEBRUARY 1999.                           CHGBD300
00005  DATE-COMPILED.                                                   CHGBD300
00006      SKIP3                                                        CHGBD300
00007 *****                                                             CHGBD300
00008 *                                                                 CHGBD300
00009 * FUNCTION:                                                       CHGBD300
00010 *                                                                 CHGBD300
00011 *        CHARGE PRINT DRIVER                                      CHGBD300
00012 *                                                                 CHGBD300
00013 *****                                                             CHGBD300
00014 *                                                                 CHGBD300
00015 * DESCRIPTION:                                                    CHGBD300
00016 *                                                                 CHGBD300
00017 *    DRIVER FOR BENEFIT CHARGE REPORTING PRINT PROCESS.           CHGBD300
00018 *    CHGBD300 READS RECORDS SELECTED BY CHGBD210 AND              CHGBD300
00019 *    BD220, AND CALLS THE APPROPRIATE REPORT PROGRAM.             CHGBD300
00020 *                                                                 CHGBD300
00021 *****                                                             CHGBD300
00022 *                                                                 CHGBD300
00023 * INPUT:                                                          CHGBD300
00024 *                                                                 CHGBD300
00025 *   BD220CHG - CHARGE RECORDS GENERATED BY CHGBD220.              CHGBD300
00026 *                                                                 CHGBD300
00027 *   CHGPARM  - PARAMETER DATA INPUT FROM CHGBD210                 CHGBD300
00028 *                                                                 CHGBD300
00029 ******                                                            CHGBD300
00030 *                                                                 CHGBD300
00031 * OUTPUT:                                                         CHGBD300
00032 *                                                                 CHGBD300
00033 *   RPC100R1 - PRINT RATED NOTICES.                               CHGBD300
00034 *   RPC100R3 - PRINT RATED BENEFIT CHARGE SPECIAL REPORT          CHGBD300
00035 *   RPC110R1 - PRINT SELF-INSURED BILLS                           CHGBD300
00036 *   RPC110R2 - SELF-INSURED QUARTERLY/ANNUAL CHARGE SUMMARY REPORTCHGBD300
00037 *              AND BENEFIT CHARGE SPECIAL REPORT                  CHGBD300
00038 *   RPC120R1 - CWC QUARTERLY/ANNUAL CHARGE SUMMARY REPORT         CHGBD300
00039 *              AND BENEFIT CHARGE SPECIAL REPORT                  CHGBD300
00040 *   RPC130R1 - FEDERAL QUARTERLY/ANNUAL CHARGE SUMMARY REPORT     CHGBD300
00041 *              AND BENEFIT CHARGE SPECIAL REPORT                  CHGBD300
00042 *   RPC150R1 - TEUC QUARTERLY/ANNUAL CHARGE SUMMARY REPORT        CHGBD300
00043 *              AND BENEFIT CHARGE SPECIAL REPORT                  CHGBD300
00044 *   RPC160R1 - DC GOVERNMENT CHARGE SUMMARY REPORT                CHGBD300
00045 *   RPC170R1 - PANDEMIC REPORTS FOR PUA, FPUC, FRUR, PEUC            CL*14
00046 *                                                                 CHGBD300
00047 *****                                                             CHGBD300
00048 ***************************************************************** CHGBD300
00049 *                                                               * CHGBD300
00050 * MODIFICATION HISTORY:                                         * CHGBD300
00051 *                                                               * CHGBD300
00052 * 05-05-1999 NEW DEVELOPMENT                                    * CHGBD300
00053 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD * CHGBD300
00054 *                                                               * CHGBD300
00055 * 06-25-2001 MODIFIED FOR NEW REPORTING PROCESS.                * CHGBD300
00056 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD * CHGBD300
00057 *                                                               * CHGBD300
00058 * 06-25-2001 MODIFIED TO OUTPUT TEUC RPC150R1 REPORT.           * CHGBD300
00059 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1* CHGBD300
00060 *                                                               * CHGBD300
00061 * 09-04-2003 MODIFIED TO OUTPUT DC RPC160R1 REPORT.             * CHGBD300
00062 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD * CHGBD300
00063 *                                                               * CHGBD300
00064 * 04-15-2004 MODIFIED TO PRINT SELF-INSURED BILLS AFTER         * CHGBD300
00065 *            THE DAILY UPDATE IN ORDER TO CORRECTLY ACCOUNT     * CHGBD300
00066 *            FOR CREDITS.                                         CHGBD300
00067 *            STEP 1 OF THE CHARGE REPORTING PROCESS RUNS        * CHGBD300
00068 *            PRIOR TO THE DAILY UPDATE, GENERATING ACCOUNTING   * CHGBD300
00069 *            TRANSACTION WITH THE SELF-INS CHARGES. THIS STEP   * CHGBD300
00070 *            PRINTS ALL REPORTS EXCEPT FOR THE SELF INS EMPS.   * CHGBD300
00071 *            STEP 2 RUNS FOLLOWING THE DAILY UPDATE, AND        * CHGBD300
00072 *            EXECUTES THE PRINT PROCESS (CHGBD300) TO PRODUCE   * CHGBD300
00073 *            THE SELF-INSURED REPORTS. THIS PROCESS CHECKS THE  * CHGBD300
00074 *            ACTUAL BALANCE DUE ON THE TAX FILE AND PRINTS THIS * CHGBD300
00075 *            AMOUNT ON THE BILL.                                * CHGBD300
00076 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD * CHGBD300
00077 *                                                               * CHGBD300
00078 * 07-15-2004 CORRECTED PROBLEM IN I2000 EDITS - FQTR NOT        * CHGBD300
00079 *            YET UPDATED WHEN STEP 2 BEGINS. P1000 NOW          * CHGBD300
00080 *            VERIFIES THAT STEP 1 HAS BEEN RUN.                 * CHGBD300
00081 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD * CHGBD300
00082 *                                                               * CHGBD300
00083 * 12-06-2007 MODIFIED FOR NEW PROCESS INVOLVING PARTIAL         * CHGBD300
00084 *            TRANSFERS OF EXPERIENCE, AND FOR NEW VERSION       * CHGBD300
00085 *            OF CHGIM004.                                       * CHGBD300
00086 *            THIS PROGRAM NO LONGER PROCESSES CHARGES FOR       * CHGBD300
00087 *            RATED EMPLOYERS.  THE PRINT DRIVER FOR RATED       * CHGBD300
00088 *            CHARGES IS CHGBD301.                                 CHGBD300
00089 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD * CHGBD300
00090 *                                                               * CHGBD300
00091 * 04-03-2009 RECOMPILED FOR NEW VERSION OF CHGIM004.            * CHGBD300
00092 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD * CHGBD300
00093 *                                                               * CHGBD300
00094 *                                                               * CHGBD300
00095 * 04-04-2010 RECOMPILED FOR NEW VERSION OF CHGIM004.            * CHGBD300
00096 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1* CHGBD300
00097 *                                                               * CHGBD300
00098 *                                                               *    CL**2
00099 * 10-04-2014 RECOMPILED FOR NEW VERSION OF CHGIM004.            *    CL**2
00100 *            REFERENCE RFP # UCPIA        AUTHOR OF CHANGE - ZL1*    CL**2
00101 *                                                               *    CL**2
00102 *                                                               *    CL**4
00103 * 04-14-2020 RECOMPILED FOR NEW VERSION OF CHGIM004.            *    CL**4
00104 *            REFERENCE PUA FPUC FRUR      AUTHOR OF CHANGE - ZL1*    CL**4
00105 *                                                               *    CL**4
00106 *                                                               *    CL*14
00107 * 05-04-2020 RECOMPILED FOR NEW VERSION OF CHGIM004.            *    CL*14
00108 *            REFERENCE PUA FPUC FRUR PEUC AUTHOR OF CHANGE - ZL1*    CL*14
00109 *                                                               *    CL*14
00110 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * CHGBD300
00111 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * CHGBD300
00112 *            REFERENCE RFP #****         AUTHOR OF CHANGE - *** * CHGBD300
00113 ***************************************************************** CHGBD300
00114                                                                   CHGBD300
00115      SKIP3                                                        CHGBD300
00116  ENVIRONMENT DIVISION.                                            CHGBD300
00117      SKIP3                                                        CHGBD300
00118  INPUT-OUTPUT SECTION.                                            CHGBD300
00119      SKIP3                                                        CHGBD300
00120  FILE-CONTROL.                                                    CHGBD300
00121                                                                   CHGBD300
00122      SELECT CHG-PARM-FILE  ASSIGN TO CHGPARM                      CHGBD300
00123             FILE STATUS IS CHG-PARM-STATUS.                       CHGBD300
00124                                                                   CHGBD300
00125      SELECT BD220-CHG-FILE ASSIGN TO BD220CHG                     CHGBD300
00126             FILE STATUS IS BD220-CHG-STATUS.                      CHGBD300
00127      EJECT                                                        CHGBD300
00128  DATA DIVISION.                                                   CHGBD300
00129      SKIP3                                                        CHGBD300
00130  FILE SECTION.                                                    CHGBD300
00131      SKIP3                                                        CHGBD300
00132                                                                   CHGBD300
00133  FD  CHG-PARM-FILE                                                CHGBD300
00134      RECORDING MODE IS F                                          CHGBD300
00135      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD300
00136      SKIP1                                                        CHGBD300
00137  01  CHG-PARM-REC.                                                CHGBD300
00138  ++INCLUDE CHGIM003                                               CHGBD300
00139                                                                   CHGBD300
00140  FD  BD220-CHG-FILE                                               CHGBD300
00141      LABEL RECORDS ARE STANDARD                                   CHGBD300
00142      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD300
00143      SKIP1                                                        CHGBD300
00144  01  BD220-CHG-REC.                                               CHGBD300
00145  ++INCLUDE CHGIM004                                               CHGBD300
00146      EJECT                                                        CHGBD300
00147  WORKING-STORAGE SECTION.                                         CHGBD300
001475 77  PAN-VALET PICTURE X(24) VALUE '016CHGBD300  09/16/22'.       CHGBD300
00148  77  PAN-VALET PICTURE X(24) VALUE '160CHGBD300  05/25/10'.       CHGBD300
00149                                                                   CHGBD300
00150  01  WRK-AREA.                                                    CHGBD300
00151 *&                                                                CHGBD300
00152      05  WRK-EMP-NO                  PIC S9(07) COMP-3 VALUE +0.  CHGBD300
00153      05  WRK-EMP-TOT                 PIC S9(08)V99 COMP-3         CHGBD300
00154                                  VALUE +0.                        CHGBD300
00155      05  WRK-RATED-TOT               PIC S9(09)V99 COMP-3         CHGBD300
00156                                  VALUE +0.                        CHGBD300
00157      05  WRK-EMP-TOT-DISP            PIC Z9(07)9.99-.             CHGBD300
00158      05  WRK-RATED-TOT-DISP          PIC Z9(08)9.99-.             CHGBD300
00159                                                                   CHGBD300
00160 **   05  WRK-RPT-TYPE-RATED         PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300
00161 **   05  WRK-RPT-TYPE-RATED-DISP    PIC Z9(08)9.99-.              CHGBD300
00162      05  WRK-RPT-TYPE-SELF-INS      PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300
00163      05  WRK-RPT-TYPE-SELF-INS-DISP PIC Z9(08)9.99-.              CHGBD300
00164      05  WRK-RPT-TYPE-CWC           PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300
00165      05  WRK-RPT-TYPE-CWC-DISP      PIC Z9(08)9.99-.              CHGBD300
00166      05  WRK-RPT-TYPE-FED           PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300
00167      05  WRK-RPT-TYPE-FED-DISP      PIC Z9(08)9.99-.              CHGBD300
00168      05  WRK-RPT-TYPE-TEUC          PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300
00169      05  WRK-RPT-TYPE-TEUC-DISP     PIC Z9(08)9.99-.              CHGBD300
00170      05  WRK-RPT-TYPE-DC-GOV        PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300
00171      05  WRK-RPT-TYPE-DC-GOV-DISP   PIC Z9(08)9.99-.              CHGBD300
00172      05  WRK-RPT-TYPE-FPUC          PIC S9(09)V99 COMP-3 VALUE +0.   CL**6
00173      05  WRK-RPT-TYPE-FPUC-DISP   PIC Z9(08)9.99-.                   CL**6
00174                                                                      CL**6
00175      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD300
00176                                  VALUE +300.                      CHGBD300
00177      05  ABEND-MSG                   PIC  X(60).                  CHGBD300
00178                                                                   CHGBD300
00179      05  CHG-PARM-STATUS             PIC  X(02) VALUE SPACES.     CHGBD300
00180          88  CHG-PARM-FILE-OK-88       VALUE ZERO.                CHGBD300
00181          88  CHG-PARM-FILE-EOF-88      VALUE '10'.                CHGBD300
00182      05  BD220-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD300
00183          88  BD220-FILE-OK-88    VALUE ZERO.                      CHGBD300
00184          88  BD220-FILE-EOF-88   VALUE '10'.                      CHGBD300
00185                                                                   CHGBD300
00186      05  WRK-SELF-INS-STEP     PIC  X(01).                        CHGBD300
00187          88  WRK-SELF-INS-STEP1-88  VALUE '1'.                    CHGBD300
00188          88  WRK-SELF-INS-STEP2-88  VALUE '2'.                    CHGBD300
00189                                                                   CHGBD300
00190      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD300
00191          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD300
00192          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD300
00193                                                                   CHGBD300
00194      05  WRK-EMP-FOUND-IND           PIC  X(01).                  CHGBD300
00195          88  WRK-EMP-FOUND-YES-88      VALUE 'Y'.                 CHGBD300
00196          88  WRK-EMP-FOUND-NO-88       VALUE 'N'.                 CHGBD300
00197                                                                   CHGBD300
00198      05  WRK-REPORT-MOD              PIC X(08).                   CHGBD300
00199 **       88  RATED-MOD                 VALUE 'CHGBR100'.          CHGBD300
00200          88  SELF-INS-MOD              VALUE 'CHGBR110'.          CHGBD300
00201          88  TPS-UNIV-MOD              VALUE 'CHGBR111'.          CHGBD300
00202          88  T026-TAX-MOD              VALUE 'CHGBR112'.          CHGBD300
00203          88  CWC-MOD                   VALUE 'CHGBR120'.          CHGBD300
00204          88  FEDERAL-MOD               VALUE 'CHGBR130'.          CHGBD300
00205          88  PGM-NULL-MOD              VALUE 'CHGBR140'.          CHGBD300
00206          88  TEUC-MOD                  VALUE 'CHGBR150'.          CHGBD300
00207          88  DC-GOV-MOD                VALUE 'CHGBR160'.          CHGBD300
00208          88  FPUC-MOD                  VALUE 'CHGBR170'.             CL**5
00209                                                                   CHGBD300
00210                                                                   CHGBD300
00211      05  WRK-BD220-CHG-READ          PIC  9(07) COMP-3 VALUE 0.   CHGBD300
00212      05  WRK-BD220-CHG-SELECTED      PIC  9(07) COMP-3 VALUE 0.   CHGBD300
00213 **   05  WRK-RATED-READ              PIC  9(07) COMP-3 VALUE 0.   CHGBD300
00214      05  WRK-SELF-INS-READ           PIC  9(07) COMP-3 VALUE 0.   CHGBD300
00215      05  WRK-FED-READ                PIC  9(07) COMP-3 VALUE 0.   CHGBD300
00216      05  WRK-TEUC-READ               PIC  9(07) COMP-3 VALUE 0.   CHGBD300
00217      05  WRK-FPUC-READ               PIC  9(07) COMP-3 VALUE 0.      CL**6
00218      05  WRK-CWC-READ                PIC  9(07) COMP-3 VALUE 0.   CHGBD300
00219      05  WRK-DC-GOV-READ             PIC  9(07) COMP-3 VALUE 0.   CHGBD300
00220                                                                   CHGBD300
00221  01  REPORT-LINK-AREA.                                            CHGBD300
00222  ++INCLUDE CHGIL001                                               CHGBD300
00223                                                                   CHGBD300
00224  01  L001-LINK-AREA.                                              CHGBD300
00225  ++INCLUDE DTSIL001                                               CHGBD300
00226      EJECT                                                        CHGBD300
00227  01  L003-LINK-AREA.                                              CHGBD300
00228  ++INCLUDE DTSIL003                                               CHGBD300
00229      EJECT                                                        CHGBD300
00230  01  L004-LINK-AREA.                                              CHGBD300
00231  ++INCLUDE DTSIL004                                               CHGBD300
00232      EJECT                                                        CHGBD300
00233  01  L005-LINK-AREA.                                              CHGBD300
00234  ++INCLUDE DTSIL005                                               CHGBD300
00235      EJECT                                                        CHGBD300
00236  01  L931-LINK-AREA.                                              CHGBD300
00237  ++INCLUDE DTSIL931                                               CHGBD300
00238      SKIP3                                                        CHGBD300
00239  01  FSKL-REC.                                                    CHGBD300
00240  ++INCLUDE DTSIFSKL                                               CHGBD300
00241      SKIP3                                                        CHGBD300
00242  01  FQTR-REC.                                                    CHGBD300
00243  ++INCLUDE DTSIFQTR                                               CHGBD300
00244      EJECT                                                        CHGBD300
00245  LINKAGE SECTION.                                                 CHGBD300
00246      SKIP3                                                        CHGBD300
00247  01  PARM-AREA.                                                   CHGBD300
00248      05  PARM-LENGTH                PIC S9(04)  COMP.             CHGBD300
00249      05  PARM-DATA.                                               CHGBD300
00250          10  PARM-SELF-INS-STEP     PIC  X(01).                   CHGBD300
00251              88  PARM-SELF-INS-STEP1-88  VALUE '1'.               CHGBD300
00252              88  PARM-SELF-INS-STEP2-88  VALUE '2'.               CHGBD300
00253              88  PARM-SELF-INS-VALID-88  VALUE '1' '2'.           CHGBD300
00254      SKIP2                                                        CHGBD300
00255  PROCEDURE DIVISION USING PARM-AREA.                              CHGBD300
00256  CHGBD300-MAIN.                                                   CHGBD300
00257      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD300
00258      IF WRK-ERROR-YES-88                                          CHGBD300
00259         DISPLAY '*** JOB CANCELLED DUE TO ERRORS ***'             CHGBD300
00260         GO TO CHGBD300-EXIT.                                      CHGBD300
00261                                                                   CHGBD300
00262      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD300
00263                                                                   CHGBD300
00264      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD300
00265                                                                   CHGBD300
00266  CHGBD300-EXIT.                                                   CHGBD300
00267      STOP RUN.                                                    CHGBD300
00268      EJECT                                                        CHGBD300
00269  I0000-INITIATE.                                                  CHGBD300
00270      MOVE ZERO TO  WRK-BD220-CHG-READ                             CHGBD300
00271                    WRK-BD220-CHG-SELECTED                         CHGBD300
00272 **                 WRK-RATED-READ                                 CHGBD300
00273                    WRK-SELF-INS-READ                              CHGBD300
00274                    WRK-FED-READ                                   CHGBD300
00275                    WRK-TEUC-READ                                  CHGBD300
00276                    WRK-FPUC-READ                                     CL**7
00277                    WRK-CWC-READ                                   CHGBD300
00278                    WRK-DC-GOV-READ.                               CHGBD300
00279                                                                   CHGBD300
00280      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD300
00281                                                                   CHGBD300
00282      PERFORM I0100-INPUT-PARM           THRU I0100-EXIT.          CHGBD300
00283                                                                   CHGBD300
00284      PERFORM I1000-READ-BD100-PARMS     THRU I1000-EXIT.          CHGBD300
00285                                                                   CHGBD300
00286      IF CHG3-RUN-TYPE-QTRLY-88                                    CHGBD300
00287         PERFORM I2000-CHK-QTR-STATUS    THRU I2000-EXIT.          CHGBD300
00288                                                                   CHGBD300
00289      PERFORM I4000-OPEN-CHARGE-FILE     THRU I4000-EXIT.          CHGBD300
00290                                                                   CHGBD300
00291      PERFORM I6000-INIT-REPORTS         THRU I6000-EXIT.          CHGBD300
00292                                                                   CHGBD300
00293  I0000-EXIT.                                                      CHGBD300
00294      EXIT.                                                        CHGBD300
00295                                                                   CHGBD300
00296  I0100-INPUT-PARM.                                                CHGBD300
00297      IF PARM-LENGTH = +1                                          CHGBD300
00298          NEXT SENTENCE                                            CHGBD300
00299      ELSE                                                         CHGBD300
00300          MOVE 'PARM-LENGTH NOT EQUAL TO 1'                        CHGBD300
00301            TO ABEND-MSG                                           CHGBD300
00302          PERFORM S999-ABEND THRU S999-EXIT                        CHGBD300
00303      END-IF.                                                      CHGBD300
00304                                                                   CHGBD300
00305      IF PARM-SELF-INS-VALID-88                                    CHGBD300
00306          MOVE PARM-SELF-INS-STEP TO WRK-SELF-INS-STEP             CHGBD300
00307          DISPLAY 'SELF INSURED JOB STEP ' WRK-SELF-INS-STEP       CHGBD300
00308      ELSE                                                         CHGBD300
00309          STRING 'INVALID PARM ' PARM-SELF-INS-STEP                CHGBD300
00310            DELIMITED BY SIZE                                      CHGBD300
00311            INTO ABEND-MSG                                         CHGBD300
00312          PERFORM S999-ABEND THRU S999-EXIT                        CHGBD300
00313      END-IF.                                                      CHGBD300
00314  I0100-EXIT.                                                      CHGBD300
00315      EXIT.                                                        CHGBD300
00316                                                                   CHGBD300
00317  I1000-READ-BD100-PARMS.                                          CHGBD300
00318      OPEN INPUT CHG-PARM-FILE.                                    CHGBD300
00319      IF NOT CHG-PARM-FILE-OK-88                                   CHGBD300
00320         DISPLAY 'CHG PARM FILE OPEN ERROR: ' CHG-PARM-STATUS      CHGBD300
00321         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD300
00322         GO TO I1000-EXIT.                                         CHGBD300
00323                                                                   CHGBD300
00324      READ CHG-PARM-FILE.                                          CHGBD300
00325      IF NOT CHG-PARM-FILE-OK-88                                   CHGBD300
00326         DISPLAY 'CHG-PARM READ ERROR: ' CHG-PARM-STATUS           CHGBD300
00327         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD300
00328         GO TO I1000-EXIT.                                         CHGBD300
00329                                                                   CHGBD300
00330      IF WRK-SELF-INS-STEP2-88                                     CHGBD300
00331         IF CHG3-RUN-TYPE-QTRLY-88                                 CHGBD300
00332            NEXT SENTENCE                                          CHGBD300
00333         ELSE                                                      CHGBD300
00334            DISPLAY 'STEP 1 NOT YET RUN FOR THIS QTR '             CHGBD300
00335            PERFORM S999-ABEND  THRU S999-EXIT                     CHGBD300
00336         END-IF                                                    CHGBD300
00337      END-IF.                                                      CHGBD300
00338                                                                   CHGBD300
00339  I1000-EXIT.                                                      CHGBD300
00340      EXIT.                                                        CHGBD300
00341                                                                   CHGBD300
00342  I2000-CHK-QTR-STATUS.                                            CHGBD300
00343      MOVE SPACE           TO L931-TRACE-IND.                      CHGBD300
00344      MOVE 'CHGBD300'      TO L931-MOD-NAME.                       CHGBD300
00345                                                                   CHGBD300
00346      PERFORM S931-OPEN-READ    THRU S931-EXIT.                    CHGBD300
00347      IF L931-OK-88                                                CHGBD300
00348         NEXT SENTENCE                                             CHGBD300
00349      ELSE                                                         CHGBD300
00350         DISPLAY 'CANNOT OPEN REF FILE '                           CHGBD300
00351         PERFORM S999-ABEND  THRU S999-EXIT.                       CHGBD300
00352                                                                   CHGBD300
00353      MOVE LOW-VALUES TO FQTR-KEY-AREA.                            CHGBD300
00354                                                                   CHGBD300
00355      SET FQTR-QTR-88 TO TRUE.                                     CHGBD300
00356                                                                   CHGBD300
00357      MOVE CHG3-BEGIN-DATE TO L004-DATE.                           CHGBD300
00358      PERFORM S004-FROM-DATE THRU S004-EXIT.                       CHGBD300
00359      MOVE L004-QTR-5-9 TO FQTR-YRQ.                               CHGBD300
00360                                                                   CHGBD300
00361      MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA.                         CHGBD300
00362                                                                   CHGBD300
00363      PERFORM S931-READ THRU S931-EXIT.                            CHGBD300
00364                                                                   CHGBD300
00365      IF L931-NO-REC-88                                            CHGBD300
00366         PERFORM S931-CLOSE        THRU S931-EXIT                  CHGBD300
00367         GO TO I2000-EXIT                                          CHGBD300
00368      END-IF.                                                      CHGBD300
00369                                                                   CHGBD300
00370      MOVE FSKL-REC      TO FQTR-REC.                              CHGBD300
00371                                                                   CHGBD300
00372      PERFORM S931-CLOSE        THRU S931-EXIT.                    CHGBD300
00373                                                                   CHGBD300
00374         MOVE ZERO TO FQTR-SELF-INS-CHG-RUN-DATE.                     CL**3
00375      IF FQTR-SELF-INS-CHG-RUN-DATE NOT NUMERIC                    CHGBD300
00376         MOVE ZERO TO FQTR-SELF-INS-CHG-RUN-DATE.                  CHGBD300
00377                                                                   CHGBD300
00378      IF WRK-SELF-INS-STEP1-88                                     CHGBD300
00379         IF FQTR-SELF-INS-CHG-RUN-DATE = ZERO                      CHGBD300
00380            NEXT SENTENCE                                          CHGBD300
00381         ELSE                                                      CHGBD300
00382            DISPLAY 'CHARGES ALREADY RUN FOR THIS QTR ' FQTR-YRQ   CHGBD300
00383            PERFORM S999-ABEND  THRU S999-EXIT                     CHGBD300
00384         END-IF                                                    CHGBD300
00385      END-IF.                                                      CHGBD300
00386                                                                   CHGBD300
00387  I2000-EXIT.                                                      CHGBD300
00388      EXIT.                                                        CHGBD300
00389                                                                   CHGBD300
00390  I4000-OPEN-CHARGE-FILE.                                          CHGBD300
00391      OPEN INPUT BD220-CHG-FILE.                                   CHGBD300
00392      IF NOT BD220-FILE-OK-88                                      CHGBD300
00393         DISPLAY 'BD220 FILE OPEN ERROR: ' BD220-CHG-STATUS        CHGBD300
00394         SET WRK-ERROR-YES-88 TO TRUE.                             CHGBD300
00395                                                                   CHGBD300
00396  I4000-EXIT.                                                      CHGBD300
00397      EXIT.                                                        CHGBD300
00398                                                                   CHGBD300
00399  I6000-INIT-REPORTS.                                              CHGBD300
00400      MOVE CHG3-BEGIN-DATE       TO CHG-LINK1-PERIOD-BEGIN.        CHGBD300
00401      MOVE CHG3-END-DATE         TO CHG-LINK1-PERIOD-END.          CHGBD300
00402      MOVE CHG3-RUN-TYPE         TO CHG-LINK1-RUN-TYPE.            CHGBD300
00403                                                                   CHGBD300
00404      SET CHG-LINK1-CMD-INIT-88  TO TRUE.                          CHGBD300
00405                                                                   CHGBD300
00406      IF WRK-SELF-INS-STEP1-88                                     CHGBD300
00407         SET CHG-LINK1-SELF-INS-STEP1-88  TO TRUE                  CHGBD300
00408      ELSE                                                         CHGBD300
00409         SET CHG-LINK1-SELF-INS-STEP2-88  TO TRUE                  CHGBD300
00410      END-IF.                                                      CHGBD300
00411                                                                   CHGBD300
00412 *&                                                                CHGBD300
00413      DISPLAY 'BD300 RUN/REPORT TYPE: ' CHG-LINK1-RUN-TYPE            CL*15
00414          ' ' CHG3-RPT-TYPES.                                         CL*15
00415                                                                      CL*15
00416      DISPLAY 'BD300 I6 LINK1 SI STEP '                               CL*15
00417         CHG-LINK1-SELF-INS-STEP.                                  CHGBD300
00418      DISPLAY '   WRK STEP ' WRK-SELF-INS-STEP.                    CHGBD300
00419 *&                                                                CHGBD300
00420 ***  IF CHG3-RPT-TYPE-RATED-88                                    CHGBD300
00421 *       SET RATED-MOD             TO TRUE                         CHGBD300
00422 ***     PERFORM S2000-CALL  THRU S2000-EXIT.                      CHGBD300
00423                                                                   CHGBD300
00424      IF CHG3-RPT-TYPE-SELF-INS-88                                    CL**7
00425         SET SELF-INS-MOD          TO TRUE                         CHGBD300
00426         PERFORM S2000-CALL  THRU S2000-EXIT.                      CHGBD300
00427                                                                   CHGBD300
00428      IF CHG3-RUN-TYPE-QTRLY-88                                       CL**7
00429         SET TPS-UNIV-MOD          TO TRUE                         CHGBD300
00430         PERFORM S2000-CALL  THRU S2000-EXIT                       CHGBD300
00431         SET T026-TAX-MOD          TO TRUE                         CHGBD300
00432         PERFORM S2000-CALL  THRU S2000-EXIT                       CHGBD300
00433      END-IF.                                                      CHGBD300
00434                                                                   CHGBD300
00435      IF CHG3-RPT-TYPE-CWC-88                                         CL**7
00436      DISPLAY ' CHG3 REPORT CWC   ' CHG3-RPT-TYPES                    CL**8
00437         SET CWC-MOD               TO TRUE                         CHGBD300
00438         PERFORM S2000-CALL  THRU S2000-EXIT.                      CHGBD300
00439                                                                   CHGBD300
00440      IF CHG3-RPT-TYPE-FED-88                                      CHGBD300
00441      DISPLAY ' CHG3 REPORT FED   ' CHG3-RPT-TYPES                    CL**8
00442         SET FEDERAL-MOD           TO TRUE                         CHGBD300
00443         PERFORM S2000-CALL  THRU S2000-EXIT.                      CHGBD300
00444                                                                   CHGBD300
00445      IF CHG3-RPT-TYPE-TEUC-88                                     CHGBD300
00446      DISPLAY ' CHG3 REPORT TECU  ' CHG3-RPT-TYPES                    CL**8
00447         SET TEUC-MOD              TO TRUE                         CHGBD300
00448         PERFORM S2000-CALL  THRU S2000-EXIT.                      CHGBD300
00449                                                                      CL**6
00450 *    IF CHG3-RPT-TYPE-FPUC-88                                        CL*16
00451 *    DISPLAY ' CHG3 REPORT FPUC  ' CHG3-RPT-TYPES                    CL*16
00452 *       SET FPUC-MOD              TO TRUE                            CL*16
00453 *       PERFORM S2000-CALL  THRU S2000-EXIT.                         CL*16
00454                                                                   CHGBD300
00455      IF CHG3-RPT-TYPE-DC-88                                       CHGBD300
00456      DISPLAY ' CHG3 REPORT DC    ' CHG3-RPT-TYPES                    CL**8
00457         SET DC-GOV-MOD            TO TRUE                         CHGBD300
00458         PERFORM S2000-CALL  THRU S2000-EXIT.                      CHGBD300
00459                                                                   CHGBD300
00460  I6000-EXIT.                                                      CHGBD300
00461      EXIT.                                                        CHGBD300
00462                                                                   CHGBD300
00463                                                                   CHGBD300
00464  P0000-PROCESS.                                                   CHGBD300
00465      PERFORM P1000-READ-CHARGES THRU P1000-EXIT                   CHGBD300
00466         UNTIL BD220-FILE-EOF-88                                   CHGBD300
00467         OR WRK-ERROR-YES-88.                                      CHGBD300
00468                                                                   CHGBD300
00469  P0000-EXIT.                                                      CHGBD300
00470      EXIT.                                                        CHGBD300
00471                                                                   CHGBD300
00472  P1000-READ-CHARGES.                                              CHGBD300
00473      PERFORM S1000-READ-CHG-FILE THRU S1000-EXIT.                 CHGBD300
00474      IF BD220-FILE-EOF-88                                         CHGBD300
00475      OR WRK-ERROR-YES-88                                          CHGBD300
00476         GO TO P1000-EXIT.                                         CHGBD300
00477                                                                   CHGBD300
00478      PERFORM P2000-CALL-REPORT THRU P2000-EXIT.                   CHGBD300
00479                                                                   CHGBD300
00480  P1000-EXIT.                                                      CHGBD300
00481      EXIT.                                                        CHGBD300
00482                                                                   CHGBD300
00483  P2000-CALL-REPORT.                                               CHGBD300
00484      SET CHG-LINK1-CMD-PROCESS-88 TO TRUE.                        CHGBD300
00485                                                                   CHGBD300
00486      IF WRK-SELF-INS-STEP1-88                                     CHGBD300
00487         PERFORM P2100-STEP1  THRU P2100-EXIT                      CHGBD300
00488      ELSE                                                         CHGBD300
00489         PERFORM P2200-STEP2  THRU P2200-EXIT                      CHGBD300
00490      END-IF.                                                      CHGBD300
00491                                                                   CHGBD300
00492  P2000-EXIT.                                                      CHGBD300
00493      EXIT.                                                        CHGBD300
00494                                                                   CHGBD300
00495  P2100-STEP1.                                                     CHGBD300
00496      EVALUATE TRUE                                                CHGBD300
00497        WHEN CHG4-RPT-TYPE-SELF-INS-88                             CHGBD300
00498           IF (CHG3-RUN-TYPE-QTRLY-88                              CHGBD300
00499           AND CHG4-EMP-TYPE = 08)                                 CHGBD300
00500              SET TPS-UNIV-MOD TO TRUE                             CHGBD300
00501              PERFORM S2000-CALL  THRU S2000-EXIT                  CHGBD300
00502              SET T026-TAX-MOD TO TRUE                             CHGBD300
00503              PERFORM S2000-CALL  THRU S2000-EXIT                  CHGBD300
00504           ELSE                                                    CHGBD300
00505              SET SELF-INS-MOD TO TRUE                             CHGBD300
00506              PERFORM S2000-CALL  THRU S2000-EXIT                  CHGBD300
00507           END-IF                                                  CHGBD300
00508                                                                   CHGBD300
00509        WHEN CHG4-RPT-TYPE-CWC-88                                  CHGBD300
00510           ADD +1 TO WRK-CWC-READ                                  CHGBD300
00511           SET CWC-MOD      TO TRUE                                CHGBD300
00512           PERFORM S2000-CALL  THRU S2000-EXIT                     CHGBD300
00513                                                                   CHGBD300
00514 ***    WHEN CHG4-RPT-TYPE-RATED-88                                CHGBD300
00515 *         ADD +1 TO WRK-RATED-READ                                CHGBD300
00516 *         SET RATED-MOD    TO TRUE                                CHGBD300
00517 ***       PERFORM S2000-CALL  THRU S2000-EXIT                     CHGBD300
00518                                                                   CHGBD300
00519        WHEN CHG4-RPT-TYPE-FED-88                                  CHGBD300
00520           IF CHG4-PROG-UI                                         CHGBD300
00521              ADD +1 TO WRK-FED-READ                               CHGBD300
00522              SET FEDERAL-MOD  TO TRUE                             CHGBD300
00523              PERFORM S2000-CALL  THRU S2000-EXIT                  CHGBD300
00524           END-IF                                                  CHGBD300
00525                                                                   CHGBD300
00526        WHEN CHG4-RPT-TYPE-TEUC-88                                 CHGBD300
00527           ADD +1 TO WRK-TEUC-READ                                 CHGBD300
00528           SET TEUC-MOD     TO TRUE                                CHGBD300
00529           PERFORM S2000-CALL  THRU S2000-EXIT                     CHGBD300
00530                                                                   CHGBD300
00531        WHEN CHG4-RPT-TYPE-DC-88                                   CHGBD300
00532           ADD +1 TO WRK-DC-GOV-READ                               CHGBD300
00533           SET DC-GOV-MOD   TO TRUE                                CHGBD300
00534           PERFORM S2000-CALL  THRU S2000-EXIT                     CHGBD300
00535                                                                      CL**6
00536 *      WHEN CHG4-RPT-TYPE-FPUC-88                                    CL*16
00537 *         ADD +1 TO WRK-FPUC-READ                                    CL*16
00538 *         SET FPUC-MOD     TO TRUE                                   CL*16
00539 *         DISPLAY 'FPUC REPORT TYPE CALLED: ' CHG4-REPORT-TYPE       CL*16
00540 *         PERFORM S2000-CALL  THRU S2000-EXIT                        CL*16
00541                                                                   CHGBD300
00542        WHEN CHG4-RPT-TYPE-NULL-88                                 CHGBD300
00543           SET PGM-NULL-MOD  TO TRUE                               CHGBD300
00544           PERFORM S2000-CALL  THRU S2000-EXIT                     CHGBD300
00545                                                                   CHGBD300
00546        WHEN OTHER                                                 CHGBD300
00547           DISPLAY 'INVALID REPORT TYPE ' CHG4-REPORT-TYPE         CHGBD300
00548           GO TO P2000-EXIT                                        CHGBD300
00549                                                                   CHGBD300
00550      END-EVALUATE.                                                CHGBD300
00551                                                                   CHGBD300
00552      ADD 1 TO WRK-BD220-CHG-SELECTED.                             CHGBD300
00553                                                                   CHGBD300
00554  P2100-EXIT.                                                      CHGBD300
00555      EXIT.                                                        CHGBD300
00556                                                                   CHGBD300
00557  P2200-STEP2.                                                     CHGBD300
00558      IF CHG4-RPT-TYPE-SELF-INS-88                                 CHGBD300
00559         IF (CHG3-RUN-TYPE-QTRLY-88                                CHGBD300
00560         AND CHG4-EMP-TYPE = 08)                                   CHGBD300
00561            ADD +1 TO WRK-SELF-INS-READ                            CHGBD300
00562            SET SELF-INS-MOD TO TRUE                               CHGBD300
00563            PERFORM S2000-CALL  THRU S2000-EXIT                    CHGBD300
00564         END-IF                                                    CHGBD300
00565      END-IF.                                                      CHGBD300
00566                                                                   CHGBD300
00567  P2200-EXIT.                                                      CHGBD300
00568      EXIT.                                                        CHGBD300
00569                                                                   CHGBD300
00570  P2110-SELF-INS.                                                  CHGBD300
00571      ADD +1 TO WRK-SELF-INS-READ.                                 CHGBD300
00572      IF (CHG3-RUN-TYPE-QTRLY-88                                   CHGBD300
00573      AND CHG4-EMP-TYPE = 08)                                      CHGBD300
00574         IF WRK-SELF-INS-STEP1-88                                  CHGBD300
00575            SET TPS-UNIV-MOD TO TRUE                               CHGBD300
00576            PERFORM S2000-CALL  THRU S2000-EXIT                    CHGBD300
00577            SET T026-TAX-MOD TO TRUE                               CHGBD300
00578            PERFORM S2000-CALL  THRU S2000-EXIT                    CHGBD300
00579         ELSE                                                      CHGBD300
00580            SET SELF-INS-MOD TO TRUE                               CHGBD300
00581            PERFORM S2000-CALL  THRU S2000-EXIT                    CHGBD300
00582         END-IF                                                    CHGBD300
00583      ELSE                                                         CHGBD300
00584         SET SELF-INS-MOD TO TRUE                                  CHGBD300
00585         PERFORM S2000-CALL  THRU S2000-EXIT                       CHGBD300
00586      END-IF.                                                      CHGBD300
00587                                                                   CHGBD300
00588  P2110-EXIT.                                                      CHGBD300
00589      EXIT.                                                        CHGBD300
00590                                                                   CHGBD300
00591  T0000-TERMINATE.                                                 CHGBD300
00592      PERFORM T1000-CLOSE-REPORTS    THRU T1000-EXIT.              CHGBD300
00593                                                                   CHGBD300
00594      PERFORM T3000-CLOSE-FILES      THRU T3000-EXIT.              CHGBD300
00595                                                                   CHGBD300
00596      DISPLAY '*********************************************'.     CHGBD300
00597      DISPLAY '**           BD300 COUNTS                  **'.     CHGBD300
00598      DISPLAY SPACE.                                               CHGBD300
00599      DISPLAY ' CHGBD220 CHARGE RECORDS READ:     '                CHGBD300
00600         WRK-BD220-CHG-READ.                                       CHGBD300
00601      DISPLAY ' CHGBD220 CHARGE RECORDS SELECTED: '                CHGBD300
00602         WRK-BD220-CHG-SELECTED.                                   CHGBD300
00603 **   DISPLAY ' RATED RECORDS PASSED            : '                CHGBD300
00604 **      WRK-RATED-READ.                                           CHGBD300
00605      DISPLAY ' SELF INSURED RECORDS PASSED     : '                CHGBD300
00606         WRK-SELF-INS-READ.                                        CHGBD300
00607      DISPLAY ' CWC RECORDS PASSED              : '                CHGBD300
00608         WRK-CWC-READ.                                             CHGBD300
00609      DISPLAY ' FEDERAL RECORDS PASSED          : '                CHGBD300
00610         WRK-FED-READ.                                             CHGBD300
00611      DISPLAY ' TEUC RECORDS PASSED             : '                CHGBD300
00612         WRK-TEUC-READ.                                            CHGBD300
00613      DISPLAY ' DC GOV RECORDS PASSED           : '                CHGBD300
00614         WRK-DC-GOV-READ.                                          CHGBD300
00615      DISPLAY ' FPUC RECORDS PASSED             : '                   CL**9
00616         WRK-FPUC-READ.                                               CL*10
00617                                                                   CHGBD300
00618 **   DISPLAY SPACE.                                               CHGBD300
00619 *    MOVE WRK-RPT-TYPE-RATED TO WRK-RPT-TYPE-RATED-DISP.          CHGBD300
00620 *    DISPLAY 'TOTAL REPORT TYPE RATED          : '                CHGBD300
00621 **      WRK-RPT-TYPE-RATED-DISP.                                  CHGBD300
00622                                                                   CHGBD300
00623      DISPLAY SPACE.                                               CHGBD300
00624      MOVE WRK-RPT-TYPE-SELF-INS TO WRK-RPT-TYPE-SELF-INS-DISP.    CHGBD300
00625      DISPLAY 'TOTAL REPORT TYPE SELF-INS       : '                CHGBD300
00626         WRK-RPT-TYPE-SELF-INS-DISP.                               CHGBD300
00627                                                                   CHGBD300
00628      DISPLAY SPACE.                                               CHGBD300
00629      MOVE WRK-RPT-TYPE-CWC TO WRK-RPT-TYPE-CWC-DISP.              CHGBD300
00630      DISPLAY 'TOTAL REPORT TYPE CWC            : '                CHGBD300
00631         WRK-RPT-TYPE-CWC-DISP.                                    CHGBD300
00632                                                                   CHGBD300
00633      DISPLAY SPACE.                                               CHGBD300
00634      MOVE WRK-RPT-TYPE-FED TO WRK-RPT-TYPE-FED-DISP.              CHGBD300
00635      DISPLAY 'TOTAL REPORT TYPE FED            : '                CHGBD300
00636         WRK-RPT-TYPE-FED-DISP.                                    CHGBD300
00637                                                                   CHGBD300
00638      DISPLAY SPACE.                                               CHGBD300
00639      MOVE WRK-RPT-TYPE-TEUC TO WRK-RPT-TYPE-TEUC-DISP.            CHGBD300
00640      DISPLAY 'TOTAL REPORT TYPE TEUC           : '                CHGBD300
00641         WRK-RPT-TYPE-TEUC-DISP.                                   CHGBD300
00642                                                                   CHGBD300
00643      DISPLAY SPACE.                                               CHGBD300
00644      MOVE WRK-RPT-TYPE-DC-GOV                                     CHGBD300
00645                             TO WRK-RPT-TYPE-DC-GOV-DISP.          CHGBD300
00646      DISPLAY 'TOTAL DC GOVERNMENT              : '                CHGBD300
00647         WRK-RPT-TYPE-DC-GOV-DISP.                                 CHGBD300
00648                                                                   CHGBD300
00649      DISPLAY SPACE.                                                  CL**6
00650      MOVE WRK-RPT-TYPE-FPUC TO WRK-RPT-TYPE-FPUC-DISP.               CL**6
00651      DISPLAY 'TOTAL REPORT TYPE FPUC           : '                   CL**6
00652         WRK-RPT-TYPE-FPUC-DISP.                                      CL**6
00653                                                                      CL**6
00654 **   DISPLAY SPACE.                                               CHGBD300
00655 **   MOVE WRK-RATED-TOT                                           CHGBD300
00656 **                          TO WRK-RATED-TOT-DISP.                CHGBD300
00657 **   DISPLAY 'TOTAL CHARGE                     : '                CHGBD300
00658 **      WRK-RATED-TOT-DISP.                                       CHGBD300
00659                                                                   CHGBD300
00660  T0000-EXIT.                                                      CHGBD300
00661      EXIT.                                                        CHGBD300
00662                                                                   CHGBD300
00663  T1000-CLOSE-REPORTS.                                             CHGBD300
00664      SET CHG-LINK1-CMD-CLOSE-88 TO TRUE.                          CHGBD300
00665                                                                   CHGBD300
00666 ***  IF CHG3-RPT-TYPE-RATED-88                                    CHGBD300
00667 *       SET RATED-MOD          TO TRUE                            CHGBD300
00668 ***     PERFORM S2000-CALL     THRU S2000-EXIT.                   CHGBD300
00669                                                                   CHGBD300
00670      IF CHG3-RPT-TYPE-SELF-INS-88                                 CHGBD300
00671         SET SELF-INS-MOD       TO TRUE                            CHGBD300
00672         PERFORM S2000-CALL     THRU S2000-EXIT                    CHGBD300
00673         IF CHG3-RUN-TYPE-QTRLY-88                                 CHGBD300
00674            SET TPS-UNIV-MOD    TO TRUE                            CHGBD300
00675            PERFORM S2000-CALL  THRU S2000-EXIT                    CHGBD300
00676            SET T026-TAX-MOD    TO TRUE                            CHGBD300
00677            PERFORM S2000-CALL  THRU S2000-EXIT.                   CHGBD300
00678                                                                   CHGBD300
00679      IF CHG3-RPT-TYPE-CWC-88                                      CHGBD300
00680         SET CWC-MOD            TO TRUE                            CHGBD300
00681         PERFORM S2000-CALL     THRU S2000-EXIT.                   CHGBD300
00682                                                                   CHGBD300
00683      IF CHG3-RPT-TYPE-FED-88                                      CHGBD300
00684         SET FEDERAL-MOD        TO TRUE                            CHGBD300
00685         PERFORM S2000-CALL     THRU S2000-EXIT.                   CHGBD300
00686                                                                   CHGBD300
00687      IF CHG3-RPT-TYPE-TEUC-88                                     CHGBD300
00688         SET TEUC-MOD           TO TRUE                            CHGBD300
00689         PERFORM S2000-CALL     THRU S2000-EXIT.                   CHGBD300
00690                                                                   CHGBD300
00691      IF CHG3-RPT-TYPE-DC-88                                       CHGBD300
00692         SET DC-GOV-MOD         TO TRUE                            CHGBD300
00693         PERFORM S2000-CALL     THRU S2000-EXIT.                   CHGBD300
00694                                                                   CHGBD300
00695      IF CHG3-RPT-TYPE-FPUC-88                                        CL**6
00696         SET FPUC-MOD           TO TRUE                               CL**6
00697         DISPLAY 'REPORT TYPE TEUC CLOSED: '                          CL**9
00698         PERFORM S2000-CALL     THRU S2000-EXIT.                      CL**6
00699                                                                      CL**6
00700  T1000-EXIT.                                                      CHGBD300
00701      EXIT.                                                        CHGBD300
00702      EJECT                                                        CHGBD300
00703      EJECT                                                        CHGBD300
00704  T3000-CLOSE-FILES.                                               CHGBD300
00705      CLOSE BD220-CHG-FILE.                                        CHGBD300
00706                                                                   CHGBD300
00707      CLOSE CHG-PARM-FILE.                                         CHGBD300
00708                                                                   CHGBD300
00709  T3000-EXIT.                                                      CHGBD300
00710      EXIT.                                                        CHGBD300
00711                                                                   CHGBD300
00712  S001-FROM-FED-8.                                                 CHGBD300
00713      SET L001-FROM-FED-8 TO TRUE.                                 CHGBD300
00714      GO TO S001-DATE.                                             CHGBD300
00715                                                                   CHGBD300
00716  S001-FROM-ABS.                                                   CHGBD300
00717      SET L001-FROM-ABS-DAY TO TRUE.                               CHGBD300
00718      GO TO S001-DATE.                                             CHGBD300
00719                                                                   CHGBD300
00720  S001-DATE.                                                       CHGBD300
00721      CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBD300
00722  S001-EXIT.                                                       CHGBD300
00723      EXIT.                                                        CHGBD300
00724                                                                   CHGBD300
00725  S003-AGENCY-DAY.                                                 CHGBD300
00726      SET L003-AGENCY-DAY TO TRUE.                                 CHGBD300
00727      GO TO S003-WORK-DAY.                                         CHGBD300
00728                                                                   CHGBD300
00729  S003-WORK-DAY.                                                   CHGBD300
00730      CALL 'DTSBU003' USING L003-LINK-AREA.                        CHGBD300
00731  S003-EXIT.                                                       CHGBD300
00732      EXIT.                                                        CHGBD300
00733                                                                   CHGBD300
00734  S004-FROM-DATE.                                                  CHGBD300
00735      SET L004-FROM-DATE TO TRUE.                                  CHGBD300
00736      GO TO S004-YRQ.                                              CHGBD300
00737                                                                   CHGBD300
00738  S004-YRQ.                                                        CHGBD300
00739      CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBD300
00740  S004-EXIT.                                                       CHGBD300
00741      EXIT.                                                        CHGBD300
00742                                                                   CHGBD300
00743  S005-FROM-SYS.                                                   CHGBD300
00744      SET L005-FROM-SYS TO TRUE.                                   CHGBD300
00745      GO TO S005-ABSTIME.                                          CHGBD300
00746                                                                   CHGBD300
00747  S005-ABSTIME.                                                    CHGBD300
00748      CALL 'DTSBU005' USING L005-LINK-AREA.                        CHGBD300
00749  S005-EXIT.                                                       CHGBD300
00750      EXIT.                                                        CHGBD300
00751                                                                   CHGBD300
00752  S931-OPEN-READ.                                                  CHGBD300
00753      SET L931-OPEN-READ-88   TO TRUE.                             CHGBD300
00754      GO TO S931-REF-I.                                            CHGBD300
00755                                                                   CHGBD300
00756  S931-READ.                                                       CHGBD300
00757      SET L931-READ-88        TO TRUE.                             CHGBD300
00758      GO TO S931-REF-I.                                            CHGBD300
00759                                                                   CHGBD300
00760  S931-CLOSE.                                                      CHGBD300
00761      SET L931-CLOSE-88 TO TRUE.                                   CHGBD300
00762      GO TO S931-REF-I.                                            CHGBD300
00763                                                                   CHGBD300
00764  S931-REF-I.                                                      CHGBD300
00765      CALL 'DTSBU931' USING L931-LINK-AREA                         CHGBD300
00766                            FSKL-REC.                              CHGBD300
00767  S931-EXIT.                                                       CHGBD300
00768      EXIT.                                                        CHGBD300
00769                                                                   CHGBD300
00770  S1000-READ-CHG-FILE.                                             CHGBD300
00771      READ BD220-CHG-FILE.                                         CHGBD300
00772      IF BD220-FILE-OK-88                                          CHGBD300
00773         ADD 1 TO WRK-BD220-CHG-READ                               CHGBD300
00774         PERFORM S1200-TEST-TOTALS THRU S1200-EXIT                 CHGBD300
00775      ELSE                                                         CHGBD300
00776         IF BD220-FILE-EOF-88                                      CHGBD300
00777            NEXT SENTENCE                                          CHGBD300
00778         ELSE                                                      CHGBD300
00779            DISPLAY 'BD220 FILE READ ERROR: ' BD220-CHG-STATUS     CHGBD300
00780            SET WRK-ERROR-YES-88 TO TRUE                           CHGBD300
00781         END-IF                                                    CHGBD300
00782      END-IF.                                                      CHGBD300
00783                                                                   CHGBD300
00784  S1000-EXIT.                                                      CHGBD300
00785      EXIT.                                                        CHGBD300
00786                                                                   CHGBD300
00787  S1200-TEST-TOTALS.                                               CHGBD300
00788                                                                   CHGBD300
00789      EVALUATE TRUE                                                CHGBD300
00790 **     WHEN CHG4-RPT-TYPE-RATED-88                                CHGBD300
00791 *         COMPUTE WRK-RPT-TYPE-RATED = WRK-RPT-TYPE-RATED         CHGBD300
00792 *                + CHG4-CURR-BEN-AMT                              CHGBD300
00793 **               + CHG4-CURR-ADJ-AMT                              CHGBD300
00794                                                                   CHGBD300
00795        WHEN CHG4-RPT-TYPE-SELF-INS-88                             CHGBD300
00796           COMPUTE WRK-RPT-TYPE-SELF-INS = WRK-RPT-TYPE-SELF-INS   CHGBD300
00797                  + CHG4-CURR-BEN-AMT                              CHGBD300
00798                  + CHG4-CURR-ADJ-AMT                              CHGBD300
00799                                                                   CHGBD300
00800        WHEN CHG4-RPT-TYPE-CWC-88                                  CHGBD300
00801           COMPUTE WRK-RPT-TYPE-CWC = WRK-RPT-TYPE-CWC             CHGBD300
00802                  + CHG4-CURR-BEN-AMT                              CHGBD300
00803                  + CHG4-CURR-ADJ-AMT                              CHGBD300
00804                                                                   CHGBD300
00805        WHEN CHG4-RPT-TYPE-FED-88                                  CHGBD300
00806            COMPUTE WRK-RPT-TYPE-FED = WRK-RPT-TYPE-FED            CHGBD300
00807                  + CHG4-CURR-BEN-AMT                              CHGBD300
00808                  + CHG4-CURR-ADJ-AMT                              CHGBD300
00809                                                                   CHGBD300
00810        WHEN CHG4-RPT-TYPE-TEUC-88                                 CHGBD300
00811            COMPUTE WRK-RPT-TYPE-TEUC = WRK-RPT-TYPE-TEUC          CHGBD300
00812                  + CHG4-CURR-BEN-AMT                              CHGBD300
00813                  + CHG4-CURR-ADJ-AMT                              CHGBD300
00814                                                                      CL**6
00815        WHEN CHG4-RPT-TYPE-FPUC-88                                    CL**6
00816            COMPUTE WRK-RPT-TYPE-FPUC = WRK-RPT-TYPE-FPUC             CL**6
00817                  + CHG4-CURR-BEN-AMT                                 CL**6
00818                  + CHG4-CURR-ADJ-AMT                                 CL**6
00819                                                                   CHGBD300
00820        WHEN CHG4-RPT-TYPE-DC-88                                   CHGBD300
00821            COMPUTE WRK-RPT-TYPE-DC-GOV = WRK-RPT-TYPE-DC-GOV      CHGBD300
00822                  + CHG4-CURR-BEN-AMT                              CHGBD300
00823                  + CHG4-CURR-ADJ-AMT                              CHGBD300
00824                                                                   CHGBD300
00825      END-EVALUATE.                                                CHGBD300
00826                                                                   CHGBD300
00827 **      COMPUTE WRK-RATED-TOT = WRK-RATED-TOT                     CHGBD300
00828 *                + CHG4-CURR-BEN-AMT                              CHGBD300
00829 **               + CHG4-CURR-ADJ-AMT.                             CHGBD300
00830                                                                   CHGBD300
00831         IF WRK-EMP-NO = ZERO                                      CHGBD300
00832            MOVE CHG4-EMP-NO TO WRK-EMP-NO                         CHGBD300
00833            COMPUTE WRK-EMP-TOT =                                  CHGBD300
00834                 CHG4-CURR-BEN-AMT                                 CHGBD300
00835               + CHG4-CURR-ADJ-AMT                                 CHGBD300
00836         ELSE                                                      CHGBD300
00837            IF CHG4-EMP-NO NOT = WRK-EMP-NO                        CHGBD300
00838               MOVE WRK-EMP-TOT TO WRK-EMP-TOT-DISP                CHGBD300
00839 *&            DISPLAY 'CHGBD300 TOT ' WRK-EMP-NO                  CHGBD300
00840 *&               '  ' WRK-EMP-TOT-DISP                            CHGBD300
00841               MOVE CHG4-EMP-NO TO WRK-EMP-NO                      CHGBD300
00842               COMPUTE WRK-EMP-TOT =                               CHGBD300
00843                  CHG4-CURR-BEN-AMT                                CHGBD300
00844                + CHG4-CURR-ADJ-AMT                                CHGBD300
00845            ELSE                                                   CHGBD300
00846               COMPUTE WRK-EMP-TOT = WRK-EMP-TOT                   CHGBD300
00847                  + CHG4-CURR-BEN-AMT                              CHGBD300
00848                  + CHG4-CURR-ADJ-AMT                              CHGBD300
00849            END-IF                                                 CHGBD300
00850         END-IF.                                                   CHGBD300
00851  S1200-EXIT.                                                      CHGBD300
00852      EXIT.                                                        CHGBD300
00853                                                                   CHGBD300
00854  S2000-CALL.                                                      CHGBD300
00855 *&                                                                CHGBD300
00856 *    IF CHG-LINK1-CMD-PROCESS-88                                  CHGBD300
00857 *       COMPUTE WRK-EMP-TOT =                                     CHGBD300
00858 *          CHG4-CURR-BEN-AMT                                      CHGBD300
00859 *        + CHG4-CURR-ADJ-AMT.                                     CHGBD300
00860 *       MOVE WRK-EMP-TOT TO WRK-EMP-TOT-DISP                      CHGBD300
00861 *    IF CHG4-SSN = 002545648                                      CHGBD300
00862 *       DISPLAY 'BD300 ' WRK-REPORT-MOD                              CL*12
00863 *          '  ' CHG4-REPORT-TYPE                                     CL*12
00864 *          '  ' CHG4-EMP-NO                                          CL*12
00865 *          '  ' CHG4-SSN                                             CL*12
00866 *          '  ' WRK-EMP-TOT-DISP.                                    CL*12
00867 *&                                                                CHGBD300
00868      DISPLAY ' REPORT BEING CALLED:' WRK-REPORT-MOD                  CL*13
00869 *&                                                                   CL*10
00870      CALL WRK-REPORT-MOD USING REPORT-LINK-AREA                   CHGBD300
00871                                BD220-CHG-REC.                     CHGBD300
00872  S2000-EXIT.                                                      CHGBD300
00873      EXIT.                                                        CHGBD300
00874                                                                   CHGBD300
00875  S999-ABEND.                                                      CHGBD300
00876      DISPLAY '****  CHGBD300 ABENDING '                           CHGBD300
00877         ABEND-MSG.                                                CHGBD300
00878      CALL 'DTSBU999' USING ABEND-CODE.                            CHGBD300
00879  S999-EXIT.                                                       CHGBD300
00880      EXIT.                                                        CHGBD300
