00001  IDENTIFICATION DIVISION.                                         12/08/20
00002  PROGRAM-ID.             CHGBD231.                                CHGBD231
00003 *AUTHOR.                 TRW.                                        LV005
00004 *DATE-WRITTEN.           SEPTEMBER 2002.                          CHGBD231
00005  DATE-COMPILED.                                                   CHGBD231
00006      SKIP3                                                        CHGBD231
00007 *****                                                             CHGBD231
00008 *                                                                 CHGBD231
00009 *    FUNCTION:                                                    CHGBD231
00010 *                                                                 CHGBD231
00011 *        DAILY TOTAL BENEFIT CHARGE DATA CONTAIN TOTAL            CHGBD231
00012 *        CHARGE AMOUNTS FROM CHGBD230 OUTPUT FILE TO              CHGBD231
00013 *        UPDATE THE CHGM030 VSAM FILE.                            CHGBD231
00014 *                                                                 CHGBD231
00015 *        INPUT:                                                   CHGBD231
00016 *                                                                 CHGBD231
00017 *            BD230CHG - CHARGE RECORDS GENERATED BY               CHGBD231
00018 *                       CHGBD230.                                 CHGBD231
00019 *                                                                 CHGBD231
00020 *       OUTPUT:                                                   CHGBD231
00021 *                                                                 CHGBD231
00022 *            BE231CHG - DAILY CHARGE RECORDS UPDATE CHGM030.      CHGBD231
00023 *                                                                 CHGBD231
00024 *****                                                             CHGBD231
00025                                                                   CHGBD231
00026 ******************************************************************CHGBD231
00027 * MODIFICATION HISTORY:                                          *CHGBD231
00028 *                                                                *CHGBD231
00029 * 09-24-2002 INITIAL DEVELOPMENT                                 *CHGBD231
00030 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW1 *CHGBD231
00031 *                                                                *CHGBD231
00032 * 03-06-2009 RECOMPLIED FOR NEW VERSION OF CHGIM030 - PROGRAM    *CHGBD231
00033 *            CODE CHANGED FROM NUMERIC TO CHARACTER.             *CHGBD231
00034 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD231
00035 *                                                                *CHGBD231
00036 * 03-31-2010 RECOMPLIED FOR NEW VERSION OF CHGIM030 - NEW        *CHGBD231
00037 *            PROGRAM CODES.                                      *CHGBD231
00038 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD231
00039 *                                                                *CHGBD231
00040 * 08-26-2014 RECOMPLIED FOR NEW VERSION OF CHGIM030 - NEW        *CHGBD231
00041 *            PROGRAM CODES UCPIA.                                *CHGBD231
00042 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD231
00043 *                                                                *CHGBD231
00044 * 04-15-2020 RECOMPLIED FOR NEW VERSION OF CHGIM030 - NEW        *   CL**2
00045 *            PROGRAM CODES PUA FPUC FRUR                         *   CL**2
00046 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**2
00047 *                                                                *   CL**2
00048 * 04-24-2020 RECOMPLIED FOR NEW VERSION OF CHGIM030 - NEW        *   CL**3
00049 *            PROGRAM CODES PEUC                                  *   CL**3
00050 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**3
00051 *                                                                *   CL**4
00052 * 09-18-2020 RECOMPLIED FOR NEW VERSION OF CHGIM030 - NEW        *   CL**4
00053 *            PROGRAM CODES LWA                                   *   CL**4
00054 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**4
00055 *                                                                *   CL**3
00056 * 12-08-2020 RECOMPLIED FOR NEW VERSION OF CHGIM030 - NEW        *   CL**5
00057 *            PROGRAM CODES PUA STIMULUS                          *   CL**5
00058 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**5
00059 *                                                                *   CL**5
00060 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD231
00061 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD231
00062 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *CHGBD231
00063 ******************************************************************CHGBD231
00064                                                                   CHGBD231
00065      SKIP3                                                        CHGBD231
00066  ENVIRONMENT DIVISION.                                            CHGBD231
00067      SKIP3                                                        CHGBD231
00068  INPUT-OUTPUT SECTION.                                            CHGBD231
00069      SKIP3                                                        CHGBD231
00070  FILE-CONTROL.                                                    CHGBD231
00071                                                                   CHGBD231
00072      SELECT BD230-CHG-FILE  ASSIGN TO BD230CHG                    CHGBD231
00073             FILE STATUS IS BD230-CHG-STATUS.                      CHGBD231
00074                                                                   CHGBD231
00075      SELECT BD231-CHG-FILE  ASSIGN TO BD231CHG                    CHGBD231
00076             ORGANIZATION IS INDEXED                               CHGBD231
00077             ACCESS IS DYNAMIC                                     CHGBD231
00078             RECORD KEY IS BD231-CHG-REC-KEY                       CHGBD231
00079             FILE STATUS IS BD231-CHG-STATUS.                      CHGBD231
00080                                                                   CHGBD231
00081      EJECT                                                        CHGBD231
00082  DATA DIVISION.                                                   CHGBD231
00083      SKIP3                                                        CHGBD231
00084  FILE SECTION.                                                    CHGBD231
00085      SKIP3                                                        CHGBD231
00086 ************************************************************      CHGBD231
00087 *    FILES DESCRIPTION                                            CHGBD231
00088 ************************************************************      CHGBD231
00089                                                                   CHGBD231
00090  FD  BD230-CHG-FILE                                               CHGBD231
00091      LABEL RECORDS ARE STANDARD                                   CHGBD231
00092      RECORDING MODE IS F                                          CHGBD231
00093      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD231
00094      SKIP1                                                        CHGBD231
00095  01  BD230-CHG-REC.                                               CHGBD231
00096  ++INCLUDE CHGIM030                                               CHGBD231
00097                                                                   CHGBD231
00098  FD  BD231-CHG-FILE                                               CHGBD231
00099      RECORD CONTAINS 22 CHARACTERS                                CHGBD231
00100      DATA RECORD IS BD231-CHG-REC.                                CHGBD231
00101      SKIP1                                                        CHGBD231
00102  01  BD231-CHG-REC.                                               CHGBD231
00103      05  BD231-CHG-REC-KEY           PIC  X(16).                  CHGBD231
00104      05  BD231-CHG-REC-DATA          PIC  X(06).                  CHGBD231
00105                                                                   CHGBD231
00106  WORKING-STORAGE SECTION.                                         CHGBD231
001065 77  PAN-VALET PICTURE X(24) VALUE '005CHGBD231  12/08/20'.       CHGBD231
00107  77  PAN-VALET PICTURE X(24) VALUE '013CHGBD231  10/01/14'.       CHGBD231
00108  77  PAN-VALET PICTURE X(24) VALUE '002CHGBD231  09/26/14'.       CHGBD231
00109  77  PAN-VALET PICTURE X(24) VALUE '011CHGBD231  05/25/10'.       CHGBD231
00110                                                                   CHGBD231
00111  01  WRK-AREA.                                                    CHGBD231
00112      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD231
00113                                     VALUE +231.                   CHGBD231
00114      05  ABEND-MSG                   PIC  X(60).                  CHGBD231
00115      05  FILLER REDEFINES ABEND-MSG.                              CHGBD231
00116          10  ABEND-MSG-TEXT          PIC X(59).                   CHGBD231
00117          10  ABEND-MSG-PROG-CODE     PIC X(01).                   CHGBD231
00118                                                                   CHGBD231
00119      05  ABEND-MOD                   PIC  X(08)                   CHGBD231
00120                                     VALUE 'DTSBU999'.             CHGBD231
00121                                                                   CHGBD231
00122      05  BD230-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD231
00123          88  BD230-FILE-OK-88       VALUE ZERO.                   CHGBD231
00124          88  BD230-FILE-EOF-88      VALUE '10'.                   CHGBD231
00125                                                                   CHGBD231
00126      05  BD231-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD231
00127          88  BD231-FILE-OK-88       VALUE ZERO.                   CHGBD231
00128          88  BD231-FILE-DUP-88      VALUE '22'.                   CHGBD231
00129                                                                   CHGBD231
00130      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD231
00131          88  WRK-ERROR-YES-88       VALUE 'Y'.                    CHGBD231
00132          88  WRK-ERROR-NO-88        VALUE 'N'.                    CHGBD231
00133                                                                   CHGBD231
00134      05  WRK-BD230-READ              PIC  9(07) COMP-3.           CHGBD231
00135      05  WRK-BD231-CHG-WRITTEN       PIC  9(07) COMP-3.           CHGBD231
00136      05  WRK-BD231-CHG-DUP           PIC  9(07) COMP-3.           CHGBD231
00137      05  WRK-TOT-CHG-AMT             PIC S9(09)V99 VALUE +0.      CHGBD231
00138      05  WRK-TOT-CHG-AMT-DISP        PIC  ZZZ,ZZZ,ZZ9.99.         CHGBD231
00139                                                                   CHGBD231
00140  01  WK-DISP-AREA1.                                               CHGBD231
00141      05 FILLER      PIC X(12) VALUE '  CHG2-SSN: '.               CHGBD231
00142      05 WK-DISP-SSN PIC 9(09).                                    CHGBD231
00143      05 FILLER      PIC X(12) VALUE '  CHG-DATE: '.               CHGBD231
00144      05 WK-DISP-CGD PIC 9(09).                                    CHGBD231
00145      05 FILLER      PIC X(12) VALUE '  CHG2-BYE: '.               CHGBD231
00146      05 WK-DISP-BYE PIC 9(09).                                    CHGBD231
00147      05 FILLER      PIC X(11) VALUE '  EMP-PGM: '.                CHGBD231
00148      05 WK-DISP-PGM PIC X(01).                                    CHGBD231
00149                                                                   CHGBD231
00150  PROCEDURE DIVISION.                                              CHGBD231
00151      SKIP2                                                        CHGBD231
00152  CHGBD231-MAIN.                                                   CHGBD231
00153      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD231
00154      IF WRK-ERROR-YES-88                                          CHGBD231
00155         PERFORM S999-ABEND  THRU S999-EXIT.                       CHGBD231
00156                                                                   CHGBD231
00157      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD231
00158                                                                   CHGBD231
00159      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD231
00160                                                                   CHGBD231
00161  CHGBD231-EXIT.                                                   CHGBD231
00162      STOP RUN.                                                    CHGBD231
00163      EJECT                                                        CHGBD231
00164  I0000-INITIATE.                                                  CHGBD231
00165                                                                   CHGBD231
00166      PERFORM I1000-INIT-WRK-DATA THRU I1000-EXIT.                 CHGBD231
00167                                                                   CHGBD231
00168      PERFORM I2000-OPEN-FILES THRU I2000-EXIT.                    CHGBD231
00169                                                                   CHGBD231
00170  I0000-EXIT.                                                      CHGBD231
00171      EXIT.                                                        CHGBD231
00172                                                                   CHGBD231
00173  I1000-INIT-WRK-DATA.                                             CHGBD231
00174      MOVE ZERO TO  WRK-BD230-READ,                                CHGBD231
00175                    WRK-BD231-CHG-WRITTEN,                         CHGBD231
00176                    WRK-BD231-CHG-DUP.                             CHGBD231
00177                                                                   CHGBD231
00178      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD231
00179                                                                   CHGBD231
00180  I1000-EXIT.                                                      CHGBD231
00181      EXIT.                                                        CHGBD231
00182                                                                   CHGBD231
00183  I2000-OPEN-FILES.                                                CHGBD231
00184      OPEN INPUT BD230-CHG-FILE.                                   CHGBD231
00185      IF NOT BD230-FILE-OK-88                                      CHGBD231
00186         DISPLAY 'INPUT FILE OPEN ERROR: ' BD230-CHG-STATUS        CHGBD231
00187         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD231
00188         GO TO I2000-EXIT.                                         CHGBD231
00189                                                                   CHGBD231
00190      OPEN I-O    BD231-CHG-FILE.                                  CHGBD231
00191      IF NOT BD231-FILE-OK-88                                      CHGBD231
00192         DISPLAY 'BD231 FILE OPEN ERROR: ' BD231-CHG-STATUS        CHGBD231
00193         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD231
00194         GO TO I2000-EXIT.                                         CHGBD231
00195                                                                   CHGBD231
00196  I2000-EXIT.                                                      CHGBD231
00197      EXIT.                                                        CHGBD231
00198                                                                   CHGBD231
00199  P0000-PROCESS.                                                   CHGBD231
00200      READ BD230-CHG-FILE.                                         CHGBD231
00201      IF NOT BD230-FILE-OK-88                                      CHGBD231
00202         MOVE    'INPUT FILE READ ERROR: ' TO  ABEND-MSG           CHGBD231
00203         DISPLAY ' INPUT FILE STATUS IS: ' BD230-CHG-STATUS        CHGBD231
00204         SET WRK-ERROR-YES-88 TO TRUE                              CHGBD231
00205         PERFORM S999-ABEND  THRU S999-EXIT                        CHGBD231
00206      ELSE                                                         CHGBD231
00207         ADD 1 TO WRK-BD230-READ.                                  CHGBD231
00208                                                                   CHGBD231
00209      PERFORM P1000-READ-CHARGES THRU P1000-EXIT                   CHGBD231
00210        UNTIL BD230-FILE-EOF-88                                    CHGBD231
00211           OR WRK-ERROR-YES-88.                                    CHGBD231
00212                                                                   CHGBD231
00213  P0000-EXIT.                                                      CHGBD231
00214      EXIT.                                                        CHGBD231
00215                                                                   CHGBD231
00216  P1000-READ-CHARGES.                                              CHGBD231
00217                                                                   CHGBD231
00218      PERFORM S200-WRITE-CHGM030 THRU S200-EXIT.                   CHGBD231
00219                                                                   CHGBD231
00220      ADD CHG30-TOT-CHG-AMT TO  WRK-TOT-CHG-AMT.                   CHGBD231
00221                                                                   CHGBD231
00222      READ BD230-CHG-FILE.                                         CHGBD231
00223                                                                   CHGBD231
00224      IF BD230-FILE-EOF-88                                         CHGBD231
00225         GO TO P1000-EXIT                                          CHGBD231
00226      ELSE                                                         CHGBD231
00227         IF BD230-FILE-OK-88                                       CHGBD231
00228            ADD 1 TO WRK-BD230-READ                                CHGBD231
00229         ELSE                                                      CHGBD231
00230           MOVE    'INPUT FILE READ ERROR: ' TO  ABEND-MSG         CHGBD231
00231           DISPLAY ' INPUT FILE STATUS IS: ' BD230-CHG-STATUS      CHGBD231
00232           SET WRK-ERROR-YES-88 TO TRUE                            CHGBD231
00233           PERFORM S999-ABEND  THRU S999-EXIT                      CHGBD231
00234         END-IF                                                    CHGBD231
00235      END-IF.                                                      CHGBD231
00236                                                                   CHGBD231
00237  P1000-EXIT.                                                      CHGBD231
00238      EXIT.                                                        CHGBD231
00239                                                                   CHGBD231
00240  T0000-TERMINATE.                                                 CHGBD231
00241      CLOSE BD230-CHG-FILE                                         CHGBD231
00242            BD231-CHG-FILE.                                        CHGBD231
00243                                                                   CHGBD231
00244      DISPLAY '     CHGBD231 CHARGE RECORDS READ: '                CHGBD231
00245         WRK-BD230-READ.                                           CHGBD231
00246      DISPLAY '   CHGM030 CHARGE RECORDS WRITTEN: '                CHGBD231
00247         WRK-BD231-CHG-WRITTEN.                                    CHGBD231
00248      DISPLAY 'CHGM030 CHARGE RECORDS DUPLICATED: '                CHGBD231
00249         WRK-BD231-CHG-DUP.                                        CHGBD231
00250                                                                   CHGBD231
00251      MOVE WRK-TOT-CHG-AMT TO WRK-TOT-CHG-AMT-DISP.                CHGBD231
00252      DISPLAY '  '.                                                CHGBD231
00253      DISPLAY ' TOTAL BENEFIT CHARGE AMT = '                       CHGBD231
00254         WRK-TOT-CHG-AMT-DISP.                                     CHGBD231
00255  T0000-EXIT.                                                      CHGBD231
00256      EXIT.                                                        CHGBD231
00257      EJECT                                                        CHGBD231
00258                                                                   CHGBD231
00259  S200-WRITE-CHGM030.                                              CHGBD231
00260                                                                   CHGBD231
00261      WRITE BD231-CHG-REC                                          CHGBD231
00262         FROM BD230-CHG-REC.                                       CHGBD231
00263      IF BD231-FILE-DUP-88                                         CHGBD231
00264         MOVE CHG30-SSN            TO WK-DISP-SSN                  CHGBD231
00265         MOVE CHG30-CHARGE-DATE    TO WK-DISP-CGD                  CHGBD231
00266         MOVE CHG30-BYE            TO WK-DISP-BYE                  CHGBD231
00267         MOVE CHG30-PROGRAM        TO WK-DISP-PGM                  CHGBD231
00268 **      DISPLAY 'BD231-CHG-REC-KEY = ' WK-DISP-AREA1              CHGBD231
00269         ADD +1 TO WRK-BD231-CHG-DUP                               CHGBD231
00270      ELSE                                                         CHGBD231
00271         ADD +1 TO WRK-BD231-CHG-WRITTEN.                          CHGBD231
00272                                                                   CHGBD231
00273  S200-EXIT.                                                       CHGBD231
00274      EXIT.                                                        CHGBD231
00275                                                                   CHGBD231
00276  S999-ABEND.                                                      CHGBD231
00277      DISPLAY '****  CHGBD231 ABENDING '                           CHGBD231
00278         ABEND-MSG.                                                CHGBD231
00279      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD231
00280  S999-EXIT.                                                       CHGBD231
00281      EXIT.                                                        CHGBD231
