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