00001  IDENTIFICATION DIVISION.                                         12/08/20
00002  PROGRAM-ID.             CHGBD207.                                CHGBD207
00003 *AUTHOR.                 TRW.                                        LV005
00004 *DATE-WRITTEN.           AUGUST 2002.                             CHGBD207
00005  DATE-COMPILED.                                                   CHGBD207
00006      SKIP3                                                        CHGBD207
00007 *****                                                             CHGBD207
00008 *                                                                 CHGBD207
00009 *    FUNCTION:                                                    CHGBD207
00010 *                                                                 CHGBD207
00011 *           READ NEW BENEFIT CHARGE FILE CREATED FROM PROGRAM     CHGBD207
00012 *           CHGBD200, LISTING CHARGES TO EACH CLAIMANT BY THE     CHGBD207
00013 *           BENEFIT YEAR AND DATE OF PAYMENT OR ADJUSTMENT.       CHGBD207
00014 *                                                                 CHGBD207
00015 *           WRITE BD207CHG  OUTPUT RECORD.                        CHGBD207
00016 *                                                                 CHGBD207
00017 *           ***  IF NO OUTPUT RECORDS WRITTEN, SET RETURN-CODE    CHGBD207
00018 *           ***  TO +1. THIS WILL BYPASS ALL REMAINING JOB STEPS. CHGBD207
00019 *                                                                 CHGBD207
00020 *        INPUT:                                                   CHGBD207
00021 *                                                                 CHGBD207
00022 *            BD200DAY - DAILY CHARGE RECORDS GENERATED BY         CHGBD207
00023 *                       CHGBD200.                                 CHGBD207
00024 *                                                                 CHGBD207
00025 *        OUTPUT:                                                  CHGBD207
00026 *                                                                 CHGBD207
00027 *            BD207CHG - CHARGE RECORDS SELECTED IN                CHGBD207
00028 *                       CHGBD207.                                 CHGBD207
00029 *****                                                             CHGBD207
00030                                                                   CHGBD207
00031 ******************************************************************CHGBD207
00032 * MODIFICATION HISTORY:                                          *CHGBD207
00033 *                                                                *CHGBD207
00034 * 08-07-2002 INITIAL DEVELOPMENT                                  CHGBD207
00035 *            REFERENCE RFP #****          AUTHOR OF CHANGE - RW1 *CHGBD207
00036 *                                                                *CHGBD207
00037 * 02-10-2003 ADD TEST FOR RECORDS WRITTEN = ZERO.                 CHGBD207
00038 *            REFERENCE RFP #****          AUTHOR OF CHANGE - GD  *CHGBD207
00039 *                                                                *CHGBD207
00040 * 06-29-2004 ADDED EMP-TYPE 17 - DOMESTIC VIOLENCE.               CHGBD207
00041 *            REFERENCE RFP #****          AUTHOR OF CHANGE - GD  *CHGBD207
00042 *                                                                *CHGBD207
00043 * 01-11-2006 REMOVE CODE IN P1000 THAT EXCLUDED POTENTIALLY       CHGBD207
00044 *            INCORRECT CHARGES. THE PROBLEM IN THE BENEFITS       CHGBD207
00045 *            SYSTEM HAS BEEN FIXED.                               CHGBD207
00046 *            REFERENCE:                   AUTHOR OF CHANGE - GD  *CHGBD207
00047 *                                                                 CHGBD207
00048 * 03-06-2009 MODIFIED FOR NEW FORMAT OF PROGRAM CODE - CHANGED   *CHGBD207
00049 *            FROM NUMERIC TO CHARACTER.                          *CHGBD207
00050 *            UPDATED EMPLOYER TYPES.                             *CHGBD207
00051 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD207
00052 *                                                                 CHGBD207
00053 * 12-03-2009 MODIFIED FOR NEW FORMAT OF PROGRAM CODE - CHANGED   *CHGBD207
00054 *            REMOVED WORKING-STORAGE WRK-AREA AND CHANGE CODE    *CHGBD207
00055 *            TO USE CHGIM002 COPYBOOK FIELDS.                    *CHGBD207
00056 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD207
00057 *                                                                 CHGBD207
00058 * 09-26-2014 RECOMPILED FOR NEW PROGRAM CODE UCPIA               *CHGBD207
00059 *            CHGIM002 COPYBOOK FIELDS.                           *CHGBD207
00060 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD207
00061 *                                                                 CHGBD207
00062 * 04-13-2020 RECOMPILED FOR NEW PROGRAM CODE PUA FPUC FRUR       *   CL**2
00063 *            CHGIM002 COPYBOOK FIELDS.                           *   CL**2
00064 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**2
00065 *                                                                    CL**2
00066 * 04-24-2020 RECOMPILED FOR NEW PROGRAM CODE PEUC                *   CL**3
00067 *            CHGIM002 COPYBOOK FIELDS.                           *   CL**3
00068 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**3
00069 *                                                                    CL**3
00070 * 08-18-2020 RECOMPILED FOR NEW PROGRAM CODE LWA                 *   CL**4
00071 *            CHGIM002 COPYBOOK FIELDS.                           *   CL**4
00072 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**4
00073 *                                                                    CL**5
00074 * 12-08-2020 RECOMPILED FOR NEW PROGRAM CODE PUA STIMULUS        *   CL**5
00075 *            CHGIM002 COPYBOOK FIELDS.                           *   CL**5
00076 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**5
00077 *                                                                    CL**4
00078 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD207
00079 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD207
00080 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD207
00081 ******************************************************************CHGBD207
00082                                                                   CHGBD207
00083      SKIP3                                                        CHGBD207
00084  ENVIRONMENT DIVISION.                                            CHGBD207
00085      SKIP3                                                        CHGBD207
00086  INPUT-OUTPUT SECTION.                                            CHGBD207
00087      SKIP3                                                        CHGBD207
00088  FILE-CONTROL.                                                    CHGBD207
00089                                                                   CHGBD207
00090      SELECT BD200-CHG-FILE-IN ASSIGN TO BD200DAY                  CHGBD207
00091             FILE STATUS IS BD200-CHG-STATUS.                      CHGBD207
00092                                                                   CHGBD207
00093      SELECT BD207-CHG-FILE-OUT   ASSIGN TO BD207CHG               CHGBD207
00094             FILE STATUS IS BD207-CHG-STATUS.                      CHGBD207
00095                                                                   CHGBD207
00096  DATA DIVISION.                                                   CHGBD207
00097                                                                   CHGBD207
00098  FILE SECTION.                                                    CHGBD207
00099                                                                   CHGBD207
00100  FD  BD200-CHG-FILE-IN                                            CHGBD207
00101      RECORDING MODE IS F                                          CHGBD207
00102      RECORD CONTAINS 64 CHARACTERS                                CHGBD207
00103      DATA RECORD IS BD200-CHG-REC.                                CHGBD207
00104  01  BD200-CHRG-REC            PIC X(64).                         CHGBD207
00105                                                                   CHGBD207
00106  FD  BD207-CHG-FILE-OUT                                           CHGBD207
00107      RECORDING MODE IS F                                          CHGBD207
00108      LABEL RECORDS ARE STANDARD                                   CHGBD207
00109      RECORD CONTAINS 64 CHARACTERS                                CHGBD207
00110      BLOCK CONTAINS 0 CHARACTERS                                  CHGBD207
00111      DATA RECORD IS BD207-CHG-REC.                                CHGBD207
00112      SKIP1                                                        CHGBD207
00113  01  BD207-CHG-REC                   PIC X(64).                   CHGBD207
00114                                                                   CHGBD207
00115      EJECT                                                        CHGBD207
00116  WORKING-STORAGE SECTION.                                         CHGBD207
001165 77  PAN-VALET PICTURE X(24) VALUE '005CHGBD207  12/08/20'.       CHGBD207
00117  77  PAN-VALET PICTURE X(24) VALUE '016CHGBD207  10/01/14'.       CHGBD207
00118  77  PAN-VALET PICTURE X(24) VALUE '002CHGBD207  09/26/14'.       CHGBD207
00119  77  PAN-VALET PICTURE X(24) VALUE '014CHGBD207  04/01/10'.       CHGBD207
00120                                                                   CHGBD207
00121  01  WRK-AREA.                                                    CHGBD207
00122                                                                   CHGBD207
00123      05  WRK-DISP-AREA.                                           CHGBD207
00124          10  WRK-DATE                PIC 9999B99B99.              CHGBD207
00125          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD207
00126          10  WRK-EMP-DISP            PIC 9(06).                   CHGBD207
00127          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD207
00128          10  WRK-SSN-DISP            PIC 9(10).                   CHGBD207
00129          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD207
00130          10  WRK-CHG-AMT-DISP        PIC  Z(07)9.99-.             CHGBD207
00131                                                                   CHGBD207
00132      05  WRK-SSN                 PIC 9(10).                       CHGBD207
00133      05  FILLER REDEFINES WRK-SSN.                                CHGBD207
00134          10  WRK-SSN9            PIC 9(09).                       CHGBD207
00135          10  WRK-SSN0            PIC 9(01).                       CHGBD207
00136                                                                   CHGBD207
00137      05  WRK-TOT-CHG                 PIC S9(08)V99 COMP-3         CHGBD207
00138                                  VALUE +0.                        CHGBD207
00139      05  WRK-TOT-CHG-DISP            PIC  ZZ,ZZZ,ZZ9.99-.         CHGBD207
00140      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD207
00141                                  VALUE +207.                      CHGBD207
00142      05  ABEND-MOD                   PIC  X(08)                   CHGBD207
00143                                  VALUE 'DTSBU999'.                CHGBD207
00144      05  ABEND-MSG                   PIC  X(60).                  CHGBD207
00145                                                                   CHGBD207
00146      05  BD200-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD207
00147          88  BD200-FILE-OK-88    VALUE ZERO.                      CHGBD207
00148          88  BD200-FILE-EOF-88   VALUE '10'.                      CHGBD207
00149                                                                   CHGBD207
00150      05  BD207-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD207
00151          88  BD207-FILE-OK-88    VALUE ZERO.                      CHGBD207
00152          88  BD207-FILE-EOF-88   VALUE '10'.                      CHGBD207
00153                                                                   CHGBD207
00154      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD207
00155          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD207
00156          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD207
00157                                                                   CHGBD207
00158      05  WRK-EMP-VALID-IND           PIC  X(01).                  CHGBD207
00159          88  WRK-EMP-VALID-YES-88  VALUE 'Y'.                     CHGBD207
00160          88  WRK-EMP-VALID-NO-88   VALUE 'N'.                     CHGBD207
00161                                                                   CHGBD207
00162      05  WRK-BEGIN-DATE              PIC S9(09) COMP-3.           CHGBD207
00163      05  WRK-END-DATE                PIC S9(09) COMP-3.           CHGBD207
00164                                                                   CHGBD207
00165      05  WRK-BEGIN-DATE-DISP         PIC  9(08).                  CHGBD207
00166      05  FILLER REDEFINES WRK-BEGIN-DATE-DISP.                    CHGBD207
00167          10  WRK-BEGIN-YR            PIC  9(04).                  CHGBD207
00168          10  WRK-BEGIN-MO            PIC  9(02).                  CHGBD207
00169          10  WRK-BEGIN-DA            PIC  9(02).                  CHGBD207
00170                                                                   CHGBD207
00171      05  WRK-END-DATE-DISP           PIC  9(08).                  CHGBD207
00172      05  FILLER REDEFINES WRK-END-DATE-DISP.                      CHGBD207
00173          10  WRK-END-YR              PIC  9(04).                  CHGBD207
00174          10  WRK-END-MO              PIC  9(02).                  CHGBD207
00175          10  WRK-END-DA              PIC  9(02).                  CHGBD207
00176                                                                   CHGBD207
00177      05  WRK-EMP-NO                  PIC S9(07) COMP-3.           CHGBD207
00178          88  WRK-POOL-ACCT-88   VALUE +028411,                    CHGBD207
00179                          +999000 THRU +999992.                    CHGBD207
00180          88  WRK-FED-ACCT-88    VALUE +1 THRU +1999.              CHGBD207
00181                                                                   CHGBD207
00182                                                                   CHGBD207
00183      05  WRK-RPT-TYPE                PIC  9(02) VALUE ZERO.       CHGBD207
00184          88  WRK-RPT-TYPE-RATED-88     VALUE 00.                  CHGBD207
00185          88  WRK-RPT-TYPE-FED-88       VALUE 01, 02.              CHGBD207
00186          88  WRK-RPT-TYPE-CWC-88       VALUE 04.                  CHGBD207
00187          88  WRK-RPT-TYPE-SELF-INS-88  VALUE 08, 10.              CHGBD207
00188          88  WRK-RPT-TYPE-EMP-88       VALUE 00, 01, 02,          CHGBD207
00189                                              04, 08, 10.          CHGBD207
00190                                                                   CHGBD207
00191      05  WRK-REC-SELECTED-IND        PIC  X(01) VALUE SPACE.      CHGBD207
00192          88  WRK-REC-SELECTED-YES  VALUE 'Y'.                     CHGBD207
00193          88  WRK-REC-SELECTED-NO   VALUE 'N'.                     CHGBD207
00194                                                                   CHGBD207
00195      05  WRK-BD200-CHG-READ        PIC  9(09) COMP-3 VALUE 0.     CHGBD207
00196      05  WRK-BD207-WRITE           PIC  9(09) COMP-3 VALUE 0.     CHGBD207
00197      05  WRK-BD200-CHG-DELETE      PIC  9(09) COMP-3 VALUE 0.     CHGBD207
00198      05  WRK-CHG-DELETE-AMT        PIC S9(08)V99 COMP-3           CHGBD207
00199                                                      VALUE +0.    CHGBD207
00200      05  WRK-BD200-NOT-LIAB-CNT    PIC  9(09) COMP-3 VALUE 0.     CHGBD207
00201      05  WRK-INV-CHRG-ERR-CNT      PIC  9(09) COMP-3 VALUE 0.     CHGBD207
00202      05  WRK-INV-CHRG-AMT          PIC S9(08)V99 COMP-3           CHGBD207
00203                                                      VALUE +0.    CHGBD207
00204      05  WRK-CNT-DISP              PIC  Z(08)9.                   CHGBD207
00205  01  BD200-CHG-REC.                                               CHGBD207
00206  ++INCLUDE CHGIM002                                               CHGBD207
00207                                                                   CHGBD207
00208  01  L001-LINK-AREA.                                              CHGBD207
00209  ++INCLUDE DTSIL001                                               CHGBD207
00210                                                                   CHGBD207
00211  01  L004-LINK-AREA.                                              CHGBD207
00212  ++INCLUDE DTSIL004                                               CHGBD207
00213                                                                   CHGBD207
00214      EJECT                                                        CHGBD207
00215  PROCEDURE DIVISION.                                              CHGBD207
00216      SKIP2                                                        CHGBD207
00217  CHGBD207-MAIN.                                                   CHGBD207
00218      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD207
00219      IF WRK-ERROR-YES-88                                          CHGBD207
00220         GO TO CHGBD207-EXIT.                                      CHGBD207
00221                                                                   CHGBD207
00222      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD207
00223                                                                   CHGBD207
00224      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD207
00225                                                                   CHGBD207
00226  CHGBD207-EXIT.                                                   CHGBD207
00227      STOP RUN.                                                    CHGBD207
00228      EJECT                                                        CHGBD207
00229  I0000-INITIATE.                                                  CHGBD207
00230                                                                   CHGBD207
00231      MOVE ZERO TO  WRK-BD200-CHG-READ                             CHGBD207
00232                    WRK-BD200-NOT-LIAB-CNT                         CHGBD207
00233                    WRK-BD207-WRITE                                CHGBD207
00234                    WRK-BD200-CHG-DELETE.                          CHGBD207
00235                                                                   CHGBD207
00236      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD207
00237                                                                   CHGBD207
00238      PERFORM I1000-OPEN-FILES THRU I1000-EXIT.                    CHGBD207
00239                                                                   CHGBD207
00240  I0000-EXIT.                                                      CHGBD207
00241      EXIT.                                                        CHGBD207
00242                                                                   CHGBD207
00243  I1000-OPEN-FILES.                                                CHGBD207
00244                                                                   CHGBD207
00245      OPEN INPUT BD200-CHG-FILE-IN.                                CHGBD207
00246      IF NOT BD200-FILE-OK-88                                      CHGBD207
00247         DISPLAY 'BD200 FILE OPEN ERROR: ' BD200-CHG-STATUS        CHGBD207
00248         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD207
00249                                                                   CHGBD207
00250      OPEN OUTPUT BD207-CHG-FILE-OUT.                              CHGBD207
00251      IF NOT BD207-FILE-OK-88                                      CHGBD207
00252         DISPLAY 'BD207 FILE OPEN ERROR: ' BD207-CHG-STATUS        CHGBD207
00253         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD207
00254                                                                   CHGBD207
00255  I1000-EXIT.                                                      CHGBD207
00256      EXIT.                                                        CHGBD207
00257                                                                   CHGBD207
00258  P0000-PROCESS.                                                   CHGBD207
00259                                                                   CHGBD207
00260      PERFORM P1000-READ-CHARGES THRU P1000-EXIT                   CHGBD207
00261         UNTIL BD200-FILE-EOF-88                                   CHGBD207
00262         OR    WRK-ERROR-YES-88.                                   CHGBD207
00263                                                                   CHGBD207
00264  P0000-EXIT.                                                      CHGBD207
00265      EXIT.                                                        CHGBD207
00266                                                                   CHGBD207
00267  P1000-READ-CHARGES.                                              CHGBD207
00268      READ BD200-CHG-FILE-IN INTO BD200-CHG-REC.                   CHGBD207
00269                                                                   CHGBD207
00270      IF BD200-FILE-EOF-88                                         CHGBD207
00271         GO TO P1000-EXIT                                          CHGBD207
00272      ELSE                                                         CHGBD207
00273         IF NOT BD200-FILE-OK-88                                   CHGBD207
00274            DISPLAY 'BD200 FILE READ ERROR: ' BD200-CHG-STATUS     CHGBD207
00275            SET WRK-ERROR-YES-88 TO TRUE                           CHGBD207
00276            GO TO P1000-EXIT.                                      CHGBD207
00277                                                                   CHGBD207
00278      ADD 1 TO WRK-BD200-CHG-READ.                                 CHGBD207
00279                                                                   CHGBD207
00280 **   MOVE CHG2-EMP-TYPE  TO WRK-EMP-TYPE.                         CHGBD207
00281 ***  IF WRK-EMP-TYPE-POOL-88                                      CHGBD207
00282 ***     ADD +1 TO WRK-BD200-CHG-DELETE                            CHGBD207
00283 ***     COMPUTE WRK-CHG-DELETE-AMT = WRK-CHG-DELETE-AMT +         CHGBD207
00284 ***       (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)                 CHGBD207
00285 ***     GO TO P1000-EXIT.                                         CHGBD207
00286                                                                   CHGBD207
00287      MOVE CHG2-EMP-NO    TO WRK-EMP-NO.                           CHGBD207
00288 ***  IF WRK-POOL-ACCT-88                                          CHGBD207
00289 ***     ADD +1 TO WRK-BD200-CHG-DELETE                            CHGBD207
00290 ***     COMPUTE WRK-CHG-DELETE-AMT = WRK-CHG-DELETE-AMT +         CHGBD207
00291 ***       (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)                 CHGBD207
00292 ***     GO TO P1000-EXIT.                                         CHGBD207
00293                                                                   CHGBD207
00294 *&   EXCLUDE RECORDS WITH BYE PRIOR TO 1/1/2001                   CHGBD207
00295 *&   FOR EMPLOYER TYPE = UCX, UCFE, SELF-INSURED,                 CHGBD207
00296 *&   DC GOVERNMENT.  PER FRANK ORLANDO 2/21/2002 - GD.            CHGBD207
00297 *                                                                 CHGBD207
00298 **   THERE IS NO LONGER ANY NEED TO BYPASS THE CHARGE             CHGBD207
00299 **   DATA - THE PROBLEM IN THE BENEFITS PROCESS HAS               CHGBD207
00300 **   BEEN FIXED PER BRUCE.  3/31/2010  GD                         CHGBD207
00301 **   IF (CHG2-BYE = ZERO) OR (CHG2-CHARGE-DATE < 20010101)        CHGBD207
00302 *       NEXT SENTENCE                                             CHGBD207
00303 *    ELSE                                                         CHGBD207
00304 *      IF CHG2-BYE < 20010101                                     CHGBD207
00305 *         IF CHG2-EMP-TYPE-UCX-88                                 CHGBD207
00306 *         OR CHG2-EMP-TYPE-UCFE-88                                CHGBD207
00307 *         OR CHG2-EMP-TYPE-SELF-INS-88                            CHGBD207
00308 *         OR CHG2-EMP-TYPE-DC-GOV-88                              CHGBD207
00309 *         OR (CHG2-EMP-TYPE-CWC-88 AND WRK-FED-ACCT-88)           CHGBD207
00310 *            ADD +1                 TO WRK-INV-CHRG-ERR-CNT       CHGBD207
00311 *            COMPUTE WRK-INV-CHRG-AMT = WRK-INV-CHRG-AMT +        CHGBD207
00312 *              (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)            CHGBD207
00313 **           GO TO P1000-EXIT.                                    CHGBD207
00314                                                                   CHGBD207
00315      PERFORM S1100-WRITE-BD207  THRU S1100-EXIT                   CHGBD207
00316      COMPUTE WRK-TOT-CHG = WRK-TOT-CHG +                          CHGBD207
00317        (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT).                   CHGBD207
00318                                                                   CHGBD207
00319  P1000-EXIT.                                                      CHGBD207
00320      EXIT.                                                        CHGBD207
00321                                                                   CHGBD207
00322  S1100-WRITE-BD207.                                               CHGBD207
00323      WRITE BD207-CHG-REC FROM BD200-CHG-REC.                      CHGBD207
00324      IF BD207-FILE-OK-88                                          CHGBD207
00325         ADD 1 TO WRK-BD207-WRITE.                                 CHGBD207
00326                                                                   CHGBD207
00327  S1100-EXIT.                                                      CHGBD207
00328      EXIT.                                                        CHGBD207
00329                                                                   CHGBD207
00330 *S001-FROM-CAL-6.                                                 CHGBD207
00331 **   SET L001-FROM-CAL-6 TO TRUE.                                 CHGBD207
00332 **   GO TO S001-DATE.                                             CHGBD207
00333                                                                   CHGBD207
00334 *S001-FROM-FED-8.                                                 CHGBD207
00335 **   SET L001-FROM-FED-8 TO TRUE.                                 CHGBD207
00336 **   GO TO S001-DATE.                                             CHGBD207
00337                                                                   CHGBD207
00338 *S001-FROM-ABS.                                                   CHGBD207
00339 **   SET L001-FROM-ABS-DAY  TO TRUE.                              CHGBD207
00340 **   GO TO S001-DATE.                                             CHGBD207
00341                                                                   CHGBD207
00342 *S001-DATE.                                                       CHGBD207
00343 **   CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBD207
00344 *S001-EXIT. EXIT.                                                 CHGBD207
00345                                                                   CHGBD207
00346 *S004-FROM-DATE.                                                  CHGBD207
00347 **   SET L004-FROM-DATE TO TRUE.                                  CHGBD207
00348 **   GO TO S004-YRQ.                                              CHGBD207
00349                                                                   CHGBD207
00350 *S004-YRQ.                                                        CHGBD207
00351 *    CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBD207
00352 *S004-EXIT. EXIT.                                                 CHGBD207
00353                                                                   CHGBD207
00354  T0000-TERMINATE.                                                 CHGBD207
00355      CLOSE BD200-CHG-FILE-IN                                      CHGBD207
00356            BD207-CHG-FILE-OUT.                                    CHGBD207
00357                                                                   CHGBD207
00358      DISPLAY '**************  CHGBD207 COUNTS  **************'.   CHGBD207
00359      DISPLAY '***                                         ***'.   CHGBD207
00360                                                                   CHGBD207
00361      MOVE WRK-BD200-CHG-READ TO WRK-CNT-DISP.                     CHGBD207
00362      DISPLAY 'CHARGE RECORDS READ:     '                          CHGBD207
00363         WRK-CNT-DISP.                                             CHGBD207
00364                                                                   CHGBD207
00365      MOVE WRK-BD207-WRITE TO WRK-CNT-DISP.                        CHGBD207
00366      DISPLAY 'CHARGE RECORDS WRITTEN:  '                          CHGBD207
00367         WRK-CNT-DISP.                                             CHGBD207
00368                                                                   CHGBD207
00369 ******************************************************************CHGBD207
00370 * IF NO CHARGE RECORDS WRITTEN, SET RETURN CODE TO +1 TO BYPASS   CHGBD207
00371 * REMAINING JOB STEPS.                                            CHGBD207
00372 ******************************************************************CHGBD207
00373      IF WRK-BD207-WRITE = ZERO                                    CHGBD207
00374         MOVE +1 TO RETURN-CODE                                    CHGBD207
00375         DISPLAY '>>> NO CHARGES: REMAINING JOB STEPS IGNORED <<<'.CHGBD207
00376                                                                   CHGBD207
00377      DISPLAY SPACE.                                               CHGBD207
00378                                                                   CHGBD207
00379      MOVE WRK-BD200-CHG-DELETE TO WRK-CNT-DISP.                   CHGBD207
00380      MOVE WRK-CHG-DELETE-AMT   TO WRK-TOT-CHG-DISP.               CHGBD207
00381      DISPLAY 'POOL ACCOUNTS EXCLUDED:  '                          CHGBD207
00382         WRK-CNT-DISP '  ' WRK-TOT-CHG-DISP.                       CHGBD207
00383                                                                   CHGBD207
00384      MOVE WRK-INV-CHRG-ERR-CNT TO WRK-CNT-DISP.                   CHGBD207
00385      MOVE WRK-INV-CHRG-AMT     TO WRK-TOT-CHG-DISP.               CHGBD207
00386      DISPLAY 'PRE-2001 CHRG EXCLUDED:  '                          CHGBD207
00387               WRK-CNT-DISP '  ' WRK-TOT-CHG-DISP.                 CHGBD207
00388                                                                   CHGBD207
00389      DISPLAY SPACE.                                               CHGBD207
00390                                                                   CHGBD207
00391      MOVE WRK-TOT-CHG   TO WRK-TOT-CHG-DISP.                      CHGBD207
00392      DISPLAY 'CHGBD207 TOTAL CHARGE:              '               CHGBD207
00393         WRK-TOT-CHG-DISP.                                         CHGBD207
00394                                                                   CHGBD207
00395      DISPLAY '***********************************************'.   CHGBD207
00396                                                                   CHGBD207
00397  T0000-EXIT.                                                      CHGBD207
00398      EXIT.                                                        CHGBD207
00399      EJECT                                                        CHGBD207
00400                                                                   CHGBD207
00401  S999-ABEND.                                                      CHGBD207
00402      DISPLAY '****  CHGBD207 ABENDING '                           CHGBD207
00403         ABEND-MSG.                                                CHGBD207
00404      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD207
00405                                                                   CHGBD207
00406  S999-EXIT.                                                       CHGBD207
00407      EXIT.                                                        CHGBD207
00408                                                                   CHGBD207
