00001  IDENTIFICATION DIVISION.                                         12/08/20
00002  PROGRAM-ID.             CHGBD230.                                CHGBD230
00003 *AUTHOR.                 TRW.                                        LV005
00004 *DATE-WRITTEN.           JUNE 2001.                               CHGBD230
00005  DATE-COMPILED.                                                   CHGBD230
00006      SKIP3                                                        CHGBD230
00007 *****                                                             CHGBD230
00008 *                                                                 CHGBD230
00009 *    FUNCTION:                                                    CHGBD230
00010 *                                                                 CHGBD230
00011 *           EXTRACT BENEFIT CHARGE RECORDS FROM SUMMARY CHARGE    CHGBD230
00012 *           FILE, BASED ON SELECTION PARAMETERS.                  CHGBD230
00013 *                                                                 CHGBD230
00014 *           WRITE CHG2 OUTPUT RECORD.                             CHGBD230
00015 *                                                                 CHGBD230
00016 *        INPUT:                                                   CHGBD230
00017 *                                                                 CHGBD230
00018 *            BD200CHG - CHARGE REPORT RECORDS GENERATED BY        CHGBD230
00019 *                       CHGBD200.                                 CHGBD230
00020 *             CHGPARM - EXTRACT PARAMETERS                        CHGBD230
00021 *                                                                 CHGBD230
00022 *        OUTPUT:                                                  CHGBD230
00023 *                                                                 CHGBD230
00024 *            BD2-5CHG - CHARGE RECORDS SELECTED IN                CHGBD230
00025 *                       CHGBD205.                                 CHGBD230
00026 *                                                                 CHGBD230
00027 *                                                                 CHGBD230
00028 *        PARAMETERS:                                              CHGBD230
00029 *                                                                 CHGBD230
00030 *            RUN TYPE -                                           CHGBD230
00031 *               QUARTERLY ('QTR') - REGULAR QUARTERLY REPORTING   CHGBD230
00032 *               ANNUAL    ('ANN') - ANNUAL REPORTING              CHGBD230
00033 *               EMPLOYER  ('EMP') - SPECIAL REPORT FOR A SINGLE   CHGBD230
00034 *                                   EMPLOYER                      CHGBD230
00035 *               REPORTS   ('RPT') - SPECIAL REPORT TO REPRINT     CHGBD230
00036 *                                   REPORTS. USE THE REPORT TYPE  CHGBD230
00037 *                                   PARM TO INDICATE WHICH TYPES  CHGBD230
00038 *                                   OF REPORTS TO INCLUDE.        CHGBD230
00039 *               FISCAL AGENTS                                     CHGBD230
00040 *                         ('AGT') - RERUN FISCAL AGENT TAPES.     CHGBD230
00041 *                                                                 CHGBD230
00042 *                  >> WHEN RUN TYPE IS 'QTR' THE SYSTEM WILL      CHGBD230
00043 *                  >> GENERATE T026 BENEFIT CHARGE ACCOUNTING     CHGBD230
00044 *                  >> TRANSACTIONS AND TPS RECORDS.               CHGBD230
00045 *                                                                 CHGBD230
00046 *            BEGIN DATE - DATE FROM WHICH TO BEGIN SELECTION      CHGBD230
00047 *                         OF CHARGE RECORDS.                      CHGBD230
00048 *                         REQUIRED FOR ALL RUN TYPES.             CHGBD230
00049 *                                                                 CHGBD230
00050 *            END DATE   - DATE AT WHICH TO END SELECTION          CHGBD230
00051 *                         OF CHARGE RECORDS.                      CHGBD230
00052 *                         REQUIRED FOR ALL RUN TYPES.             CHGBD230
00053 *                                                                 CHGBD230
00054 *            REPORT TYPES - YES/NO INDICATORS TO SPECIFY          CHGBD230
00055 *                           WHICH TYPES OF REPORTS TO INCLUDE.    CHGBD230
00056 *                           VALID ONLY WHEN THE RUN TYPE IS       CHGBD230
00057 *                           'RPT'.                                CHGBD230
00058 *                           THE INDICATORS ARE IN THE FOLLOWING   CHGBD230
00059 *                           ORDER:                                CHGBD230
00060 *                              RATED                              CHGBD230
00061 *                              SELF-INSURED                       CHGBD230
00062 *                              CWC                                CHGBD230
00063 *                              FEDERAL                            CHGBD230
00064 *                              TEUC                               CHGBD230
00065 *                                                                 CHGBD230
00066 *            EMPLOYER     - THE EMPLOYER ACCOUNT NUMBER TO        CHGBD230
00067 *                           INCLUDE IN THE SELECTION.             CHGBD230
00068 *                           VALID ONLY WHEN RUN TYPE IS 'EMP'.    CHGBD230
00069 *                                                                 CHGBD230
00070 *****                                                             CHGBD230
00071                                                                   CHGBD230
00072 ******************************************************************CHGBD230
00073 * MODIFICATION HISTORY:                                          *CHGBD230
00074 *                                                                *CHGBD230
00075 * 02-02-1999 INITIAL DEVELOPMENT                                 *CHGBD230
00076 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD230
00077 *                                                                *CHGBD230
00078 * 06-21-2001 MODIFIED FOR NEW CHARGE PROCESS                      CHGBD230
00079 *            REFERENCE RFP #****          AUTHOR OF CHANGE - GD  *CHGBD230
00080 *                                                                *CHGBD230
00081 * 04-23-2002 MODIFIED TO OUTPUT TEUC RPC150R1 REPORT              CHGBD230
00082 *            REFERENCE RFP #****          AUTHOR OF CHANGE - RW1 *CHGBD230
00083 *                                                                *CHGBD230
00084 * 03-06-2009 MODIFIED FOR NEW FORMAT OF PROGRAM CODE - CHANGED   *CHGBD230
00085 *            FROM NUMERIC TO CHARACTER.                          *CHGBD230
00086 *            UPDATED EMPLOYER TYPES.                             *CHGBD230
00087 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD230
00088 *                                                                 CHGBD230
00089 *                                                                *CHGBD230
00090 * 05-04-2010 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND       *CHGBD230
00091 *            CHGIM004                                            *CHGBD230
00092 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD230
00093 *                                                                 CHGBD230
00094 * 07-07-2014 MODIFIED TO ADD CHECK FOR EMPLOYER NUMBER IN THE    *CHGBD230
00095 *            P1000-READ-CHARGES  PARAGRAPH                      * CHGBD230
00096 *            REFERENCE RFP #              AUTHOR OF CHANGE - GD  *CHGBD230
00097 *                                                                *CHGBD230
00098 * 09-26-2014 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND       *CHGBD230
00099 *            CHGIM004                                            *CHGBD230
00100 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *CHGBD230
00101 * 04-15-2020 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND       *   CL**2
00102 *            CHGIM004 (PUA, FPUC,FRUR)                           *   CL**2
00103 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**2
00104 *                                                                    CL**3
00105 * 04-24-2020 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND       *   CL**3
00106 *            CHGIM004 (PEUC)                                     *   CL**3
00107 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**3
00108 *                                                                    CL**4
00109 * 09-18-2020 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND       *   CL**4
00110 *            CHGIM004 (LWA)                                      *   CL**4
00111 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**4
00112 *                                                                    CL**5
00113 * 12-08-2020 MODIFIED FOR NEW PROGRAM CODE IN CHGIM002 AND       *   CL**5
00114 *            CHGIM004 (PUA)                                      *   CL**5
00115 *            REFERENCE RFP #              AUTHOR OF CHANGE - ZL1 *   CL**5
00116 *                                                                 CHGBD230
00117 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD230
00118 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD230
00119 ******************************************************************CHGBD230
00120                                                                   CHGBD230
00121      SKIP3                                                        CHGBD230
00122  ENVIRONMENT DIVISION.                                            CHGBD230
00123      SKIP3                                                        CHGBD230
00124  INPUT-OUTPUT SECTION.                                            CHGBD230
00125      SKIP3                                                        CHGBD230
00126  FILE-CONTROL.                                                    CHGBD230
00127      SELECT BD200-CHG-FILE-IN ASSIGN TO BD200CHG                  CHGBD230
00128             FILE STATUS IS BD200-CHG-STATUS.                      CHGBD230
00129                                                                   CHGBD230
00130      SELECT BD230-CHG-FILE-OUT   ASSIGN TO BD230CHG               CHGBD230
00131             FILE STATUS IS BD230-CHG-STATUS.                      CHGBD230
00132                                                                   CHGBD230
00133      EJECT                                                        CHGBD230
00134  DATA DIVISION.                                                   CHGBD230
00135                                                                   CHGBD230
00136  FILE SECTION.                                                    CHGBD230
00137  FD  BD200-CHG-FILE-IN                                            CHGBD230
00138      LABEL RECORDS ARE STANDARD                                   CHGBD230
00139      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD230
00140  01  BD200-CHG-REC.                                               CHGBD230
00141  ++INCLUDE CHGIM002                                               CHGBD230
00142                                                                   CHGBD230
00143  FD  BD230-CHG-FILE-OUT                                           CHGBD230
00144      LABEL RECORDS ARE STANDARD                                   CHGBD230
00145      BLOCK CONTAINS 0 CHARACTERS.                                 CHGBD230
00146      SKIP1                                                        CHGBD230
00147  01  BD230-CHG-REC.                                               CHGBD230
00148  ++INCLUDE CHGIM030                                               CHGBD230
00149                                                                   CHGBD230
00150      EJECT                                                        CHGBD230
00151  WORKING-STORAGE SECTION.                                         CHGBD230
001515 77  PAN-VALET PICTURE X(24) VALUE '005CHGBD230  12/08/20'.       CHGBD230
00152  77  PAN-VALET PICTURE X(24) VALUE '019CHGBD230  10/01/14'.       CHGBD230
00153  77  PAN-VALET PICTURE X(24) VALUE '002CHGBD230  09/26/14'.       CHGBD230
00154  77  PAN-VALET PICTURE X(24) VALUE '017CHGBD230  07/07/14'.       CHGBD230
00155  77  PAN-VALET PICTURE X(24) VALUE '018CHGBD230  07/07/14'.       CHGBD230
00156  77  PAN-VALET PICTURE X(24) VALUE '015CHGBD230  05/25/10'.       CHGBD230
00157                                                                   CHGBD230
00158  01  WRK-AREA.                                                    CHGBD230
00159 *&                                                                CHGBD230
00160      05  WRK-DISP-AREA.                                           CHGBD230
00161          10  WRK-DATE                PIC 9999B99B99.              CHGBD230
00162          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD230
00163          10  WRK-BYE-DISP            PIC 9999B99B99.              CHGBD230
00164          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD230
00165          10  WRK-SSN-DISP            PIC 9(10).                   CHGBD230
00166          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD230
00167          10  WRK-CHG-AMT-DISP        PIC  Z(07)9.99-.             CHGBD230
00168          10  FILLER                  PIC X(02) VALUE SPACES.      CHGBD230
00169          10  WRK-PROG                PIC X(01).                   CHGBD230
00170                                                                   CHGBD230
00171      05  WRK-SSN                 PIC 9(10).                       CHGBD230
00172      05  FILLER REDEFINES WRK-SSN.                                CHGBD230
00173          10  WRK-SSN9            PIC 9(09).                       CHGBD230
00174          10  WRK-SSN0            PIC 9(01).                       CHGBD230
00175                                                                   CHGBD230
00176      05  WRK-TOT-CHG                 PIC S9(09)V99 COMP-3         CHGBD230
00177                                  VALUE +0.                        CHGBD230
00178      05  WRK-TOT-CHG-DISP            PIC S9(09)V99 COMP-3.        CHGBD230
00179      05  WRK-CHG-DISP                PIC S9(09)V99 COMP-3         CHGBD230
00180                                  VALUE +0.                        CHGBD230
00181      05  WRK-CURR-DATE               PIC S9(09)    COMP-3.        CHGBD230
00182      05  WRK-CURR-SSN                PIC  9(10).                  CHGBD230
00183      05  FILLER REDEFINES WRK-CURR-SSN.                           CHGBD230
00184          10  WRK-CURR-SSN9           PIC 9(09).                   CHGBD230
00185          10  WRK-CURR-SSN0           PIC 9(01).                   CHGBD230
00186      05  WRK-CURR-BYE                PIC S9(09)    COMP-3.        CHGBD230
00187      05  WRK-CURR-PROGRAM            PIC  X(01).                  CHGBD230
00188      05  WRK-CURR-EMP-NO             PIC S9(07) COMP-3.           CHGBD230
00189      05  WRK-TOT-BEN                 PIC S9(09)V99 COMP-3         CHGBD230
00190                                  VALUE +0.                        CHGBD230
00191      05  WRK-TOT-BEN-DISP            PIC  Z(08)9.99-.             CHGBD230
00192 *                                                                 CHGBD230
00193      05  ABEND-CODE                  PIC S9(04)  COMP             CHGBD230
00194                                  VALUE +205.                      CHGBD230
00195      05  ABEND-MOD                   PIC  X(08)                   CHGBD230
00196                                  VALUE 'DTSBU999'.                CHGBD230
00197      05  ABEND-MSG                   PIC  X(60).                  CHGBD230
00198                                                                   CHGBD230
00199      05  BD200-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD230
00200          88  BD200-FILE-OK-88    VALUE ZERO.                      CHGBD230
00201          88  BD200-FILE-EOF-88   VALUE '10'.                      CHGBD230
00202                                                                   CHGBD230
00203      05  BD230-CHG-STATUS            PIC  X(02) VALUE SPACES.     CHGBD230
00204          88  BD230-FILE-OK-88    VALUE ZERO.                      CHGBD230
00205          88  BD230-FILE-DUP-88   VALUE '22'.                      CHGBD230
00206                                                                   CHGBD230
00207      05  WRK-ERROR-IND               PIC  X(01).                  CHGBD230
00208          88  WRK-ERROR-YES-88    VALUE 'Y'.                       CHGBD230
00209          88  WRK-ERROR-NO-88     VALUE 'N'.                       CHGBD230
00210                                                                   CHGBD230
00211      05  WRK-BD200-CHG-READ        PIC  9(09) COMP-3 VALUE 0.     CHGBD230
00212      05  WRK-BD230-WRITE           PIC  9(09) COMP-3 VALUE 0.     CHGBD230
00213      05  WRK-BD230-DUP             PIC  9(09) COMP-3 VALUE 0.     CHGBD230
00214      05  WRK-CNT-DISP              PIC  Z(08)9.                   CHGBD230
00215                                                                   CHGBD230
00216 ** ADD ERROR MSG TABLE SET UP                                     CHGBD230
00217  01  MSG-TABLE.                                                   CHGBD230
00218      05  MSG1-NO-MPRF.                                            CHGBD230
00219          10  MSG1-ID.                                             CHGBD230
00220              15  MSG1-ID1      PIC X(08)  VALUE 'CHGBD205'.       CHGBD230
00221              15  MSG1-ID2      PIC X(03)  VALUE '205'.            CHGBD230
00222          10  MSG1-SHORT-TEXT   PIC X(20)                          CHGBD230
00223                    VALUE 'EMP NOT ON FILE  :  '.                  CHGBD230
00224          10  MSG1-LONG-TEXT.                                      CHGBD230
00225              15  FILLER        PIC X(29)                          CHGBD230
00226                    VALUE 'EMPLOYER NOT ON MASTER FILE  '.         CHGBD230
00227              15  FILLER        PIC X(32)  VALUE SPACES.           CHGBD230
00228                                                                   CHGBD230
00229      05  MSG2-NOT-LIABLE.                                         CHGBD230
00230          10  MSG2-ID.                                             CHGBD230
00231              15  MSG2-ID1      PIC X(08)  VALUE 'CHGBD205'.       CHGBD230
00232              15  MSG2-ID2      PIC X(03)  VALUE '205'.            CHGBD230
00233          10  MSG2-SHORT-TEXT   PIC X(20)                          CHGBD230
00234                    VALUE 'EMP NOT LIABLE   :  '.                  CHGBD230
00235          10  MSG2-LONG-TEXT.                                      CHGBD230
00236              15  FILLER        PIC X(29)                          CHGBD230
00237                    VALUE 'EMPLOYER IS NOT LIABLE       '.         CHGBD230
00238              15  FILLER        PIC X(32)  VALUE SPACES.           CHGBD230
00239                                                                   CHGBD230
00240      05  MSG4-PRINTING-TURNED-OFF.                                CHGBD230
00241          10  MSG4-ID.                                             CHGBD230
00242              15  MSG4-ID1      PIC X(08)  VALUE 'CHGBD205'.       CHGBD230
00243              15  MSG4-ID2      PIC X(03)  VALUE '205'.            CHGBD230
00244          10  MSG4-SHORT-TEXT   PIC X(20)                          CHGBD230
00245                    VALUE 'CHG STMT PRINT OFF: '.                  CHGBD230
00246          10  MSG4-LONG-TEXT.                                      CHGBD230
00247              15  FILLER        PIC X(36)                          CHGBD230
00248                    VALUE 'CHARGE STATEMENT PRINTING TURNED OFF'.  CHGBD230
00249              15  FILLER        PIC X(25)  VALUE SPACES.           CHGBD230
00250                                                                   CHGBD230
00251      05  MSG5-NO-ADDRESS.                                         CHGBD230
00252          10  MSG5-ID.                                             CHGBD230
00253              15  MSG5-ID1      PIC X(08)  VALUE 'CHGBD205'.       CHGBD230
00254              15  MSG5-ID2      PIC X(03)  VALUE '205'.            CHGBD230
00255          10  MSG5-SHORT-TEXT   PIC X(20)                          CHGBD230
00256                    VALUE 'NO ADDRESS FOUND:   '.                  CHGBD230
00257          10  MSG5-LONG-TEXT.                                      CHGBD230
00258              15  FILLER        PIC X(29)                          CHGBD230
00259                    VALUE 'ADDRESS NOT FOUND            '.         CHGBD230
00260              15  FILLER        PIC X(25)                          CHGBD230
00261                    VALUE '  MPRF EMPLOYER NUMBER = '.             CHGBD230
00262              15  MSG5-EMP-NO   PIC 9(07).                         CHGBD230
00263                                                                   CHGBD230
00264 *&      ADDED 02-21-2002                                          CHGBD230
00265      05  MSG8-TOT-CREDIT-AMT.                                     CHGBD230
00266          10  MSG8-ID.                                             CHGBD230
00267              15  MSG8-ID1      PIC X(08)  VALUE 'CHGBD205'.       CHGBD230
00268              15  MSG8-ID2      PIC X(03)  VALUE '205'.            CHGBD230
00269          10  MSG8-SHORT-TEXT   PIC X(20)                          CHGBD230
00270                    VALUE '                    '.                  CHGBD230
00271          10  MSG8-LONG-TEXT.                                      CHGBD230
00272              15  FILLER        PIC X(15)                          CHGBD230
00273                    VALUE 'BYE < 1/1/2001 '.                       CHGBD230
00274              15  FILLER        PIC X(08)  VALUE '  SSN = '.       CHGBD230
00275              15  MSG8-SSN      PIC 9(09)B9.                       CHGBD230
00276              15  FILLER        PIC X(08)  VALUE '  BYE = '.       CHGBD230
00277              15  MSG8-BYE      PIC 9999B99B99.                    CHGBD230
00278              15  FILLER        PIC X(06)  VALUE '  PGM '.         CHGBD230
00279              15  MSG8-PGM      PIC X(01).                         CHGBD230
00280              15  FILLER        PIC X(12)  VALUE '  CHG AMT = '.   CHGBD230
00281              15  MSG8-AMT      PIC Z(04)9.99-.                    CHGBD230
00282              15  FILLER        PIC X(13)  VALUE '  CHG DATE = '.  CHGBD230
00283              15  MSG8-DATE     PIC 9999B99B99.                    CHGBD230
00284                                                                   CHGBD230
00285 ** ERROR MSG OUTPUT RECORD                                        CHGBD230
00286  01  R907-REC.                                                    CHGBD230
00287  ++INCLUDE DTSIR907                                               CHGBD230
00288                                                                   CHGBD230
00289  01  L001-LINK-AREA.                                              CHGBD230
00290  ++INCLUDE DTSIL001                                               CHGBD230
00291                                                                   CHGBD230
00292  01  L004-LINK-AREA.                                              CHGBD230
00293  ++INCLUDE DTSIL004                                               CHGBD230
00294                                                                   CHGBD230
00295      EJECT                                                        CHGBD230
00296  PROCEDURE DIVISION.                                              CHGBD230
00297      SKIP2                                                        CHGBD230
00298  CHGBD230-MAIN.                                                   CHGBD230
00299      PERFORM I0000-INITIATE THRU I0000-EXIT.                      CHGBD230
00300      IF WRK-ERROR-YES-88                                          CHGBD230
00301         GO TO CHGBD230-EXIT.                                      CHGBD230
00302                                                                   CHGBD230
00303      PERFORM P0000-PROCESS THRU P0000-EXIT.                       CHGBD230
00304                                                                   CHGBD230
00305      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     CHGBD230
00306                                                                   CHGBD230
00307  CHGBD230-EXIT.                                                   CHGBD230
00308      STOP RUN.                                                    CHGBD230
00309      EJECT                                                        CHGBD230
00310  I0000-INITIATE.                                                  CHGBD230
00311                                                                   CHGBD230
00312      MOVE ZERO TO  WRK-BD200-CHG-READ                             CHGBD230
00313                    WRK-BD230-WRITE.                               CHGBD230
00314                                                                   CHGBD230
00315      SET WRK-ERROR-NO-88 TO TRUE.                                 CHGBD230
00316                                                                   CHGBD230
00317      PERFORM I1000-OPEN-FILES THRU I1000-EXIT.                    CHGBD230
00318                                                                   CHGBD230
00319  I0000-EXIT.                                                      CHGBD230
00320      EXIT.                                                        CHGBD230
00321                                                                   CHGBD230
00322  I1000-OPEN-FILES.                                                CHGBD230
00323                                                                   CHGBD230
00324      OPEN INPUT BD200-CHG-FILE-IN.                                CHGBD230
00325      IF NOT BD200-FILE-OK-88                                      CHGBD230
00326         DISPLAY 'BD200 FILE OPEN ERROR: ' BD200-CHG-STATUS        CHGBD230
00327         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD230
00328                                                                   CHGBD230
00329      OPEN OUTPUT BD230-CHG-FILE-OUT.                              CHGBD230
00330      IF NOT BD230-FILE-OK-88                                      CHGBD230
00331         DISPLAY 'BD230 FILE OPEN ERROR: ' BD230-CHG-STATUS        CHGBD230
00332         PERFORM S999-ABEND THRU S999-EXIT.                        CHGBD230
00333                                                                   CHGBD230
00334  I1000-EXIT.                                                      CHGBD230
00335      EXIT.                                                        CHGBD230
00336                                                                   CHGBD230
00337                                                                   CHGBD230
00338  P0000-PROCESS.                                                   CHGBD230
00339                                                                   CHGBD230
00340      READ BD200-CHG-FILE-IN NEXT.                                 CHGBD230
00341                                                                   CHGBD230
00342      IF BD200-FILE-EOF-88                                         CHGBD230
00343         GO TO P0000-EXIT                                          CHGBD230
00344      ELSE                                                         CHGBD230
00345         IF NOT BD200-FILE-OK-88                                   CHGBD230
00346            DISPLAY 'CANNOT READ FIRST REC: ' BD200-CHG-STATUS     CHGBD230
00347            SET WRK-ERROR-YES-88 TO TRUE                           CHGBD230
00348            GO TO P0000-EXIT                                       CHGBD230
00349         ELSE                                                      CHGBD230
00350            ADD 1 TO WRK-BD200-CHG-READ.                           CHGBD230
00351                                                                   CHGBD230
00352      MOVE CHG2-CHARGE-DATE      TO WRK-CURR-DATE.                 CHGBD230
00353      MOVE CHG2-SSN              TO WRK-CURR-SSN.                  CHGBD230
00354      MOVE CHG2-BYE              TO WRK-CURR-BYE.                  CHGBD230
00355      MOVE CHG2-PROGRAM          TO WRK-CURR-PROGRAM.              CHGBD230
00356      MOVE CHG2-EMP-NO           TO WRK-CURR-EMP-NO                CHGBD230
00357      MOVE ZERO                  TO WRK-TOT-CHG.                   CHGBD230
00358                                                                   CHGBD230
00359      PERFORM P1000-READ-CHARGES THRU P1000-EXIT                   CHGBD230
00360         UNTIL BD200-FILE-EOF-88                                   CHGBD230
00361         OR    WRK-ERROR-YES-88.                                   CHGBD230
00362                                                                   CHGBD230
00363  P0000-EXIT.                                                      CHGBD230
00364      EXIT.                                                        CHGBD230
00365                                                                   CHGBD230
00366  P1000-READ-CHARGES.                                              CHGBD230
00367      MOVE CHG2-SSN      TO WRK-SSN.                               CHGBD230
00368                                                                   CHGBD230
00369 *&                                                                CHGBD230
00370 ***  IF WRK-SSN9 = 979280473                                      CHGBD230
00371 **   IF CHG2-SSN = 2166634031                                     CHGBD230
00372 **   AND CHG2-CHARGE-DATE >= 20020701                             CHGBD230
00373 *       MOVE CHG2-SSN TO WRK-SSN-DISP                             CHGBD230
00374 *       MOVE CHG2-CHARGE-DATE TO WRK-DATE                         CHGBD230
00375 *       MOVE CHG2-BYE TO WRK-BYE-DISP                             CHGBD230
00376 *       COMPUTE WRK-TOT-CHG-DISP =                                CHGBD230
00377 *        (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)                  CHGBD230
00378 *       MOVE WRK-TOT-CHG-DISP TO WRK-CHG-AMT-DISP                 CHGBD230
00379 *       MOVE CHG2-PROGRAM    TO WRK-PROG                          CHGBD230
00380 *       ADD WRK-TOT-CHG-DISP TO WRK-CHG-DISP                      CHGBD230
00381 *       DISPLAY 'P1000 ' WRK-DISP-AREA.                           CHGBD230
00382 *&                                                                CHGBD230
00383                                                                   CHGBD230
00384 *       DISPLAY 'CHG2-CHARGE-DATE '  CHG2-CHARGE-DATE             CHGBD230
00385 *       DISPLAY 'WRK-CURR-DATE    '  WRK-CURR-DATE                CHGBD230
00386 *       DISPLAY 'WRK-SSN9         '  WRK-SSN9                     CHGBD230
00387 *       DISPLAY 'WRK-CURR-SSN9    '  WRK-CURR-SSN9                CHGBD230
00388 *       DISPLAY 'CHG2-BYE         '  CHG2-BYE                     CHGBD230
00389 *       DISPLAY 'WRK-CURR-BYE     '  WRK-CURR-BYE                 CHGBD230
00390 *       DISPLAY 'CHG2-PROGRAM     '  CHG2-PROGRAM                 CHGBD230
00391 *       DISPLAY 'WRK-CURR-PROGRAM '  WRK-CURR-PROGRAM             CHGBD230
00392      IF CHG2-CHARGE-DATE = WRK-CURR-DATE                          CHGBD230
00393         AND WRK-SSN9     = WRK-CURR-SSN9                          CHGBD230
00394         AND CHG2-BYE     = WRK-CURR-BYE                           CHGBD230
00395         AND CHG2-PROGRAM = WRK-CURR-PROGRAM                       CHGBD230
00396         AND CHG2-EMP-NO  = WRK-CURR-EMP-NO                        CHGBD230
00397             NEXT SENTENCE                                         CHGBD230
00398      ELSE                                                         CHGBD230
00399         PERFORM S1100-WRITE-BD230  THRU S1100-EXIT                CHGBD230
00400         PERFORM P1100-INIT-REC     THRU P1100-EXIT.               CHGBD230
00401                                                                   CHGBD230
00402      COMPUTE WRK-TOT-CHG = WRK-TOT-CHG +                          CHGBD230
00403        (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT).                   CHGBD230
00404         DISPLAY 'WRK-SSN9    '  WRK-SSN9                          CHGBD230
00405         DISPLAY 'WRK-TOT-CHG '  WRK-TOT-CHG                       CHGBD230
00406         DISPLAY 'CHG2-CURR-BEN-AMT '  CHG2-CURR-BEN-AMT           CHGBD230
00407         DISPLAY 'CHG2-CURR-ADJ-AMT ' CHG2-CURR-ADJ-AMT            CHGBD230
00408                                                                   CHGBD230
00409      READ BD200-CHG-FILE-IN NEXT.                                 CHGBD230
00410                                                                   CHGBD230
00411      IF BD200-FILE-EOF-88                                         CHGBD230
00412         GO TO P1000-EXIT                                          CHGBD230
00413      ELSE                                                         CHGBD230
00414         IF NOT BD200-FILE-OK-88                                   CHGBD230
00415            DISPLAY 'BD200 FILE READ ERROR: ' BD200-CHG-STATUS     CHGBD230
00416            SET WRK-ERROR-YES-88 TO TRUE                           CHGBD230
00417            GO TO P1000-EXIT                                       CHGBD230
00418         ELSE                                                      CHGBD230
00419            ADD 1 TO WRK-BD200-CHG-READ.                           CHGBD230
00420                                                                   CHGBD230
00421  P1000-EXIT.                                                      CHGBD230
00422      EXIT.                                                        CHGBD230
00423                                                                   CHGBD230
00424  P1100-INIT-REC.                                                  CHGBD230
00425      MOVE CHG2-CHARGE-DATE      TO WRK-CURR-DATE.                 CHGBD230
00426      MOVE CHG2-SSN              TO WRK-CURR-SSN.                  CHGBD230
00427      MOVE CHG2-BYE              TO WRK-CURR-BYE.                  CHGBD230
00428      MOVE CHG2-PROGRAM          TO WRK-CURR-PROGRAM.              CHGBD230
00429      MOVE ZERO                  TO WRK-TOT-CHG.                   CHGBD230
00430                                                                   CHGBD230
00431  P1100-EXIT.                                                      CHGBD230
00432      EXIT.                                                        CHGBD230
00433                                                                   CHGBD230
00434  S1100-WRITE-BD230.                                               CHGBD230
00435 *&                                                                CHGBD230
00436 *    IF WRK-CURR-SSN9 = 979280473                                 CHGBD230
00437 *       MOVE WRK-CURR-SSN TO WRK-SSN-DISP                         CHGBD230
00438 *       MOVE WRK-CURR-DATE TO WRK-DATE                            CHGBD230
00439 *       MOVE WRK-CURR-BYE TO WRK-BYE-DISP                         CHGBD230
00440 *       MOVE WRK-TOT-CHG        TO WRK-CHG-AMT-DISP               CHGBD230
00441 *       MOVE WRK-CURR-PROGRAM   TO WRK-PROG                       CHGBD230
00442 *       DISPLAY 'S1100 ' WRK-DISP-AREA.                           CHGBD230
00443 *&                                                                CHGBD230
00444          DISPLAY 'WRK-CURR-SSN9'  WRK-CURR-SSN9                   CHGBD230
00445          DISPLAY 'WRK-TOT-CHG '   WRK-TOT-CHG                     CHGBD230
00446      IF WRK-TOT-CHG = ZERO                                        CHGBD230
00447         GO TO S1100-EXIT.                                         CHGBD230
00448                                                                   CHGBD230
00449      MOVE WRK-CURR-SSN9    TO CHG30-SSN.                          CHGBD230
00450      MOVE WRK-CURR-BYE     TO CHG30-BYE.                          CHGBD230
00451      MOVE WRK-CURR-PROGRAM TO CHG30-PROGRAM.                      CHGBD230
00452      MOVE WRK-CURR-DATE    TO CHG30-CHARGE-DATE.                  CHGBD230
00453      MOVE WRK-TOT-CHG      TO CHG30-TOT-CHG-AMT.                  CHGBD230
00454                                                                   CHGBD230
00455      WRITE BD230-CHG-REC.                                         CHGBD230
00456      IF BD230-FILE-OK-88                                          CHGBD230
00457         ADD 1 TO WRK-BD230-WRITE                                  CHGBD230
00458         COMPUTE WRK-TOT-BEN = WRK-TOT-BEN + WRK-TOT-CHG           CHGBD230
00459      ELSE                                                         CHGBD230
00460      IF BD230-FILE-DUP-88                                         CHGBD230
00461         ADD 1 TO WRK-BD230-DUP.                                   CHGBD230
00462                                                                   CHGBD230
00463  S1100-EXIT.                                                      CHGBD230
00464      EXIT.                                                        CHGBD230
00465                                                                   CHGBD230
00466 *S001-FROM-CAL-6.                                                 CHGBD230
00467 **   SET L001-FROM-CAL-6 TO TRUE.                                 CHGBD230
00468 **   GO TO S001-DATE.                                             CHGBD230
00469                                                                   CHGBD230
00470 *S001-FROM-FED-8.                                                 CHGBD230
00471 **   SET L001-FROM-FED-8 TO TRUE.                                 CHGBD230
00472 **   GO TO S001-DATE.                                             CHGBD230
00473                                                                   CHGBD230
00474 *S001-FROM-ABS.                                                   CHGBD230
00475 **   SET L001-FROM-ABS-DAY  TO TRUE.                              CHGBD230
00476 **   GO TO S001-DATE.                                             CHGBD230
00477                                                                   CHGBD230
00478 *S001-DATE.                                                       CHGBD230
00479 *    CALL 'DTSBU001' USING L001-LINK-AREA.                        CHGBD230
00480 *S001-EXIT. EXIT.                                                 CHGBD230
00481                                                                   CHGBD230
00482 *S004-FROM-DATE.                                                  CHGBD230
00483 **   SET L004-FROM-DATE TO TRUE.                                  CHGBD230
00484 **   GO TO S004-YRQ.                                              CHGBD230
00485                                                                   CHGBD230
00486 *S004-YRQ.                                                        CHGBD230
00487 **   CALL 'DTSBU004' USING L004-LINK-AREA.                        CHGBD230
00488 *S004-EXIT. EXIT.                                                 CHGBD230
00489                                                                   CHGBD230
00490 ** ADD ERROR MSG PROCESS PARA.                                    CHGBD230
00491 *S946-R907-WRITE.                                                 CHGBD230
00492 **   CALL 'DTSBU946' USING R907-REC.                              CHGBD230
00493 *S946-EXIT. EXIT.                                                 CHGBD230
00494                                                                   CHGBD230
00495  T0000-TERMINATE.                                                 CHGBD230
00496                                                                   CHGBD230
00497      PERFORM S1100-WRITE-BD230  THRU S1100-EXIT.                  CHGBD230
00498                                                                   CHGBD230
00499      CLOSE BD200-CHG-FILE-IN                                      CHGBD230
00500            BD230-CHG-FILE-OUT.                                    CHGBD230
00501                                                                   CHGBD230
00502      DISPLAY '**************  CHGBD230 COUNTS  **************'.   CHGBD230
00503      DISPLAY '***                                         ***'.   CHGBD230
00504                                                                   CHGBD230
00505      MOVE WRK-BD200-CHG-READ TO WRK-CNT-DISP.                     CHGBD230
00506      DISPLAY 'CHARGE RECORDS READ:     '                          CHGBD230
00507         WRK-CNT-DISP.                                             CHGBD230
00508                                                                   CHGBD230
00509      MOVE WRK-BD230-WRITE TO WRK-CNT-DISP.                        CHGBD230
00510      DISPLAY 'CHARGE RECORDS WRITTEN:  '                          CHGBD230
00511         WRK-CNT-DISP.                                             CHGBD230
00512                                                                   CHGBD230
00513      MOVE WRK-BD230-DUP   TO WRK-CNT-DISP.                        CHGBD230
00514      DISPLAY 'DUPLICATE RECS EXCLUDED: '                          CHGBD230
00515         WRK-CNT-DISP.                                             CHGBD230
00516                                                                   CHGBD230
00517      DISPLAY SPACE.                                               CHGBD230
00518      MOVE WRK-TOT-BEN     TO WRK-TOT-BEN-DISP.                    CHGBD230
00519      DISPLAY 'TOTAL BENEFIT CHARGE AMOUNTS: '                     CHGBD230
00520         WRK-TOT-BEN-DISP.                                         CHGBD230
00521                                                                   CHGBD230
00522      DISPLAY SPACE.                                               CHGBD230
00523                                                                   CHGBD230
00524      DISPLAY '***********************************************'.   CHGBD230
00525                                                                   CHGBD230
00526  T0000-EXIT.                                                      CHGBD230
00527      EXIT.                                                        CHGBD230
00528      EJECT                                                        CHGBD230
00529                                                                   CHGBD230
00530  S999-ABEND.                                                      CHGBD230
00531      DISPLAY '****  CHGBD230 ABENDING '                           CHGBD230
00532         ABEND-MSG.                                                CHGBD230
00533      CALL ABEND-MOD USING ABEND-CODE.                             CHGBD230
00534                                                                   CHGBD230
00535  S999-EXIT.                                                       CHGBD230
00536      EXIT.                                                        CHGBD230
00537                                                                   CHGBD230
