00001 IDENTIFICATION DIVISION. 05/25/10 00002 PROGRAM-ID. CHGBD201. CHGBD201 00003 *AUTHOR. TRW. LV009 00004 *DATE-WRITTEN. APRIL 2001. CHGBD201 00005 DATE-COMPILED. CHGBD201 00006 SKIP3 CHGBD201 00007 ***** CHGBD201 00008 * CHGBD201 00009 * FUNCTION: CHGBD201 00010 * CHGBD201 00011 * BENEFIT CHARGE CONVERSION PROCESS STEP 2 CHGBD201 00012 * (1) READ CHGIM002 RECORDS CREATED BY CHGBD101 CHGBD201 00013 * (2) ACCUMULATE CHARGES BY DATE/EMPLOYER/SSN/BYE CHGBD201 00014 * (3) WRITE CHGIM002 RECORDS TO VSAM FILE CHGBD201 00015 * CHGBD201 00016 * INPUT: CHGBD201 00017 * CHGBD201 00018 * BD100CHG - CHARGE RECORDS GENERATED BY CHGBD201 00019 * CHGBD100. CHGBD201 00020 * CHGPARM - PARAMETER DATA INPUT FROM CHGBD100 CHGBD201 00021 * CHGBD201 00022 * OUTPUT: CHGBD201 00023 * CHGBD201 00024 * BE200CHG - CHARGE REPORT RECORDS CHGBD201 00025 * CHGBD201 00026 ***** CHGBD201 00027 CHGBD201 00028 ******************************************************************CHGBD201 00029 * MODIFICATION HISTORY: *CHGBD201 00030 * *CHGBD201 00031 * 02-02-1999 INITIAL DEVELOPMENT *CHGBD201 00032 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD201 00033 * *CHGBD201 00034 * 04-09-2001 ELIMINATED THE CHG-PARM-FILE AND CHANGED CHGIM002 *CHGBD201 00035 * TO PRODUCE A NEW VERSION OF OUTPUT PERMANENT VSAM *CHGBD201 00036 * FILE WITHOUT THE EMPLOYEE NAME. *CHGBD201 00037 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBD201 00038 * *CHGBD201 00039 * 06-29-2004 ADDED EMP-TYPE 17 - DOMESTIC VIOLENCE. *CHGBD201 00040 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD201 00041 * *CHGBD201 00042 * *CHGBD201 00043 * 12-03-2009 REMOVED WRK-EMP-TYPE FROM WORKING STORAGE CHANGED *CHGBD201 00044 * CODE TO USE CHG2 COPYBOOK VALUES. CHGBD201 00045 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD201 00046 * *CHGBD201 00047 * *CHGBD201 00048 * 05-04-2010 RECOMPILED FOR NEW VERSION OF COPYBOOK CHGIM002 *CHGBD201 00049 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD201 00050 * *CHGBD201 00051 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD201 00052 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD201 00053 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD201 00054 ******************************************************************CHGBD201 00055 CHGBD201 00056 SKIP3 CHGBD201 00057 ENVIRONMENT DIVISION. CHGBD201 00058 SKIP3 CHGBD201 00059 INPUT-OUTPUT SECTION. CHGBD201 00060 SKIP3 CHGBD201 00061 FILE-CONTROL. CHGBD201 00062 CHGBD201 00063 SELECT BD100-CHG-FILE ASSIGN TO BD100CHG CHGBD201 00064 FILE STATUS IS BD100-CHG-STATUS. CHGBD201 00065 CHGBD201 00066 SELECT BD200-CHG-FILE ASSIGN TO BD200CHG CHGBD201 00067 FILE STATUS IS BD200-CHG-STATUS. CHGBD201 00068 EJECT CHGBD201 00069 DATA DIVISION. CHGBD201 00070 SKIP3 CHGBD201 00071 FILE SECTION. CHGBD201 00072 SKIP3 CHGBD201 00073 ************************************************************ CHGBD201 00074 * PARAMETER RECORD PASSED FROM CHGBD100. CHGBD201 00075 ************************************************************ CHGBD201 00076 CHGBD201 00077 FD BD100-CHG-FILE CHGBD201 00078 LABEL RECORDS ARE STANDARD CHGBD201 00079 BLOCK CONTAINS 0 CHARACTERS. CHGBD201 00080 SKIP1 CHGBD201 00081 01 BD100-CHG-REC. CHGBD201 00082 ++INCLUDE CHGIM001 CHGBD201 00083 CHGBD201 00084 FD BD200-CHG-FILE CHGBD201 00085 LABEL RECORDS ARE STANDARD CHGBD201 00086 BLOCK CONTAINS 0 CHARACTERS. CHGBD201 00087 SKIP1 CHGBD201 00088 01 BD200-CHG-REC PIC X(064). CHGBD201 00089 CHGBD201 00090 WORKING-STORAGE SECTION. CHGBD201 000905 77 PAN-VALET PICTURE X(24) VALUE '009CHGBD201 05/25/10'. CHGBD201 00091 CHGBD201 00092 01 WRK-AREA. CHGBD201 00093 05 ABEND-CODE PIC S9(04) COMP CHGBD201 00094 VALUE +202. CHGBD201 00095 05 ABEND-MSG PIC X(60). CHGBD201 00096 05 FILLER REDEFINES ABEND-MSG. CHGBD201 00097 10 ABEND-MSG-TEXT PIC X(59). CHGBD201 00098 10 ABEND-MSG-PROG-CODE PIC X(01). CHGBD201 00099 CHGBD201 00100 05 ABEND-MOD PIC X(08) CHGBD201 00101 VALUE 'DTSBU999'. CHGBD201 00102 CHGBD201 00103 05 BD100-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD201 00104 88 BD100-FILE-OK-88 VALUE ZERO. CHGBD201 00105 88 BD100-FILE-EOF-88 VALUE '10'. CHGBD201 00106 05 BD200-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD201 00107 88 BD200-FILE-OK-88 VALUE ZERO. CHGBD201 00108 ** 88 BD200-FILE-DUP-88 VALUE '22'. CHGBD201 00109 CHGBD201 00110 05 WRK-ERROR-IND PIC X(01). CHGBD201 00111 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD201 00112 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD201 00113 CHGBD201 00114 05 WRK-CHG-REC-IND PIC X(01). CHGBD201 00115 88 WRK-CHG-REC-OK-88 VALUE 'Y'. CHGBD201 00116 88 WRK-CHG-REC-INVALID-88 VALUE 'N'. CHGBD201 00117 CHGBD201 00118 05 WRK-REPORT-TYPE PIC X(01). CHGBD201 00119 88 WRK-RPT-TYPE-RATED-88 VALUE '1'. CHGBD201 00120 88 WRK-RPT-TYPE-SELF-INS-88 VALUE '2'. CHGBD201 00121 88 WRK-RPT-TYPE-CWC-88 VALUE '3'. CHGBD201 00122 88 WRK-RPT-TYPE-FED-88 VALUE '4'. CHGBD201 00123 88 WRK-RPT-TYPE-UNKNOWN-88 VALUE '5'. CHGBD201 00124 88 WRK-RPT-TYPE-NOT-LIAB-88 VALUE '6'. CHGBD201 00125 88 WRK-NO-RPT-88 VALUE '0'. CHGBD201 00126 CHGBD201 00127 CHGBD201 00128 05 WRK-BD100-READ PIC 9(09) COMP-3. CHGBD201 00129 05 WRK-BD200-CHG-WRITTEN PIC 9(09) COMP-3. CHGBD201 00130 05 TOT-BEN-ADJ-AMT PIC S9(09)V99 COMP-3 VALUE +0. CHGBD201 00131 05 TOT-BEN-ADJ-AMT-DISP PIC ZZZ,ZZZ,ZZ9.99. CHGBD201 00132 *RW CHGBD201 00133 * 05 TOT-BEN-AMT PIC S9(09)V99 COMP-3 VALUE +0. CHGBD201 00134 * 05 TOT-BEN-AMT-DISP PIC ZZZ,ZZZ,ZZ9.99. CHGBD201 00135 * 05 TOT-ADJ-AMT PIC S9(09)V99 COMP-3 VALUE +0. CHGBD201 00136 * 05 TOT-ADJ-AMT-DISP PIC ZZZ,ZZZ,ZZ9.99. CHGBD201 00137 * 05 TOT-RECOUP-AMT PIC S9(09)V99 COMP-3 VALUE +0. CHGBD201 00138 * 05 TOT-RECOUP-AMT-DISP PIC ZZZ,ZZZ,ZZ9.99. CHGBD201 00139 05 WRK-DATE-DISP PIC 9(08). CHGBD201 00140 05 WRK-SSN-AREA PIC 9(10). CHGBD201 00141 05 FILLER REDEFINES WRK-SSN-AREA. CHGBD201 00142 10 WRK-SSN-9 PIC 9(09). CHGBD201 00143 10 FILLER PIC X(01). CHGBD201 00144 CHGBD201 00145 *************************************************************** CHGBD201 00146 * WORKING STORAGE AND ACCUMULATOR FIELDS FOR CURRENT SSN/BYE. CHGBD201 00147 * CHARGES FOR INDIVIDUAL EMPLOYERS ARE IN THE TABLE BELOW. CHGBD201 00148 *************************************************************** CHGBD201 00149 05 WRK-CHARGE-DATE PIC S9(09) COMP-3 VALUE +0. CHGBD201 00150 05 WRK-CURR-SSN PIC S9(10) COMP-3. CHGBD201 00151 05 WRK-CLMNT-NAME PIC X(32). CHGBD201 00152 05 WRK-CURR-BYE PIC S9(09) COMP-3. CHGBD201 00153 05 WRK-CURR-EMP PIC S9(07) COMP-3. CHGBD201 00154 05 WRK-PROGRAM-TOTALS OCCURS 4 TIMES. CHGBD201 00155 10 WRK-TOT-BEN PIC S9(07)V99 COMP-3. CHGBD201 00156 10 WRK-TOT-ADJ PIC S9(07)V99 COMP-3. CHGBD201 00157 CHGBD201 00158 *************************************************************** CHGBD201 00159 * THE TABLE BELOW RECORDS CHARGE DATA FOR EACH EMPLOYER WITHIN CHGBD201 00160 * A GIVEN SSN/BYE. WITHIN EACH TABLE ENTRY, A SEPARATE TABLE CHGBD201 00161 * DISTINGUISHES CHARGE AMOUNTS BY BENEFIT PROGRAM. CHGBD201 00162 * PROG-SUB-MAX INDICATES THE MAXIMUM NUMBER OF PROGRAMS THE CHGBD201 00163 * CHARGE AMOUNT TABLE MAY CONTAIN. CHGBD201 00164 * EMP-ENTRY-MAX INDICATES THE MAXIMUM NUMBER OF EMPLOYERS THE CHGBD201 00165 * EMPLOYER TABLE MAY CONTAIN. CHGBD201 00166 *************************************************************** CHGBD201 00167 05 EMP-SUB PIC S9(04) COMP. CHGBD201 00168 05 PROG-SUB PIC S9(04) COMP. CHGBD201 00169 88 PROG-SUB-UI VALUE +1. CHGBD201 00170 88 PROG-SUB-EB VALUE +2. CHGBD201 00171 88 PROG-SUB-TEUC VALUE +3. CHGBD201 00172 88 PROG-SUB-TEUCA VALUE +4. CHGBD201 00173 88 PROG-SUB-VALID VALUE +1, +2, +3, +4. CHGBD201 00174 05 PROG-SUB-MAX PIC S9(04) COMP CHGBD201 00175 VALUE +4. CHGBD201 00176 05 EMP-ENTRY-MAX PIC S9(04) COMP CHGBD201 00177 VALUE +100. CHGBD201 00178 05 EMP-CNT PIC S9(04) COMP. CHGBD201 00179 CHGBD201 00180 05 EMP-TABLE. CHGBD201 00181 10 EMP-TABLE-ENTRY OCCURS 100 TIMES. CHGBD201 00182 15 TAB-EMP-ACCT PIC 9(06). CHGBD201 00183 88 TAB-POOL-ACCT-YES-88 CHGBD201 00184 VALUE 028411, CHGBD201 00185 999000 THRU 999992. CHGBD201 00186 15 TAB-EMP-TYPE PIC 9(02). CHGBD201 00187 *************************************************************** CHGBD201 00188 * THE TABLE BELOW RECORDS AMOUNTS CHARGED FOR EACH BENEFIT CHGBD201 00189 * PROGRAM. THE FIRST OCCURRENCE IS FOR REGULAR UI AND THE CHGBD201 00190 * SECOND FOR EB. ADD ADDITIONAL OCCURRENCES AS REQUIRED. CHGBD201 00191 *************************************************************** CHGBD201 00192 15 TAB-EMP-CHARGE-AMTS CHGBD201 00193 OCCURS 4 TIMES. CHGBD201 00194 20 TAB-BEN-CHG PIC S9(07)V99 COMP-3. CHGBD201 00195 20 TAB-ADJ-CHG PIC S9(07)V99 COMP-3. CHGBD201 00196 20 TAB-OP-RECOVER PIC S9(07)V99 COMP-3. CHGBD201 00197 CHGBD201 00198 **** CHGBD201 00199 01 WRK-AMT-DISP PIC Z(06)9.99-. CHGBD201 00200 01 WRK-TEST-AMT-OUT PIC S9(07)V99 COMP-3 VALUE ZERO. CHGBD201 00201 01 WRK-TEST-TOT-OUT PIC S9(07)V99 COMP-3 VALUE ZERO. CHGBD201 00202 01 WRK-AMT-DISP-OUT PIC Z(06)9.99-. CHGBD201 00203 **** CHGBD201 00204 01 WK-DISP-AREA1. CHGBD201 00205 05 FILLER PIC X(10) VALUE 'CHG1-SSN: '. CHGBD201 00206 05 WK-DISP-SSN PIC 9(10). CHGBD201 00207 05 FILLER PIC X(12) VALUE ' CHG1-BYE: '. CHGBD201 00208 05 WK-DISP-BYE PIC 9(09). CHGBD201 00209 05 FILLER PIC X(12) VALUE ' CHG1-EMP: '. CHGBD201 00210 05 WK-DISP-EMP PIC 9(07). CHGBD201 00211 05 FILLER PIC X(11) VALUE ' EMP-CNT: '. CHGBD201 00212 05 WK-DISP-CNT PIC 9(04). CHGBD201 00213 **** CHGBD201 00214 01 WRK-BD200-CHG-REC. CHGBD201 00215 ++INCLUDE CHGIM002 CHGBD201 00216 CHGBD201 00217 01 L001-LINK-AREA. CHGBD201 00218 ++INCLUDE DTSIL001 CHGBD201 00219 CHGBD201 00220 01 L004-LINK-AREA. CHGBD201 00221 ++INCLUDE DTSIL004 CHGBD201 00222 EJECT CHGBD201 00223 01 L100-LINK-AREA. CHGBD201 00224 ++INCLUDE CHGIL100 CHGBD201 00225 EJECT CHGBD201 00226 CHGBD201 00227 01 L910-LINK-AREA. CHGBD201 00228 ++INCLUDE DTSIL910 CHGBD201 00229 CHGBD201 00230 01 MSKL-REC. CHGBD201 00231 ++INCLUDE DTSIMSKL CHGBD201 00232 CHGBD201 00233 01 L921-LINK-AREA. CHGBD201 00234 ++INCLUDE DTSIL921 CHGBD201 00235 CHGBD201 00236 01 ISKL-REC. CHGBD201 00237 ++INCLUDE DTSIISKL CHGBD201 00238 CHGBD201 00239 PROCEDURE DIVISION. CHGBD201 00240 SKIP2 CHGBD201 00241 CHGBD202-MAIN. CHGBD201 00242 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD201 00243 IF WRK-ERROR-YES-88 CHGBD201 00244 GO TO CHGBD202-EXIT. CHGBD201 00245 CHGBD201 00246 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD201 00247 CHGBD201 00248 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD201 00249 CHGBD201 00250 CHGBD202-EXIT. CHGBD201 00251 * STOP RUN. CHGBD201 00252 GOBACK. CHGBD201 00253 EJECT CHGBD201 00254 I0000-INITIATE. CHGBD201 00255 CHGBD201 00256 PERFORM I1000-INIT-WRK-DATA THRU I1000-EXIT. CHGBD201 00257 CHGBD201 00258 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CHGBD201 00259 CHGBD201 00260 I0000-EXIT. CHGBD201 00261 EXIT. CHGBD201 00262 CHGBD201 00263 I1000-INIT-WRK-DATA. CHGBD201 00264 MOVE ZERO TO WRK-BD100-READ, CHGBD201 00265 WRK-BD200-CHG-WRITTEN, CHGBD201 00266 EMP-CNT. CHGBD201 00267 CHGBD201 00268 SET WRK-ERROR-NO-88 TO TRUE. CHGBD201 00269 CHGBD201 00270 I1000-EXIT. CHGBD201 00271 EXIT. CHGBD201 00272 CHGBD201 00273 I2000-OPEN-FILES. CHGBD201 00274 OPEN INPUT BD100-CHG-FILE. CHGBD201 00275 IF NOT BD100-FILE-OK-88 CHGBD201 00276 DISPLAY 'SORT FILE OPEN ERROR: ' BD100-CHG-STATUS CHGBD201 00277 SET WRK-ERROR-YES-88 TO TRUE CHGBD201 00278 GO TO I2000-EXIT. CHGBD201 00279 CHGBD201 00280 OPEN OUTPUT BD200-CHG-FILE. CHGBD201 00281 IF NOT BD200-FILE-OK-88 CHGBD201 00282 DISPLAY 'BD200 FILE OPEN ERROR: ' BD200-CHG-STATUS CHGBD201 00283 SET WRK-ERROR-YES-88 TO TRUE CHGBD201 00284 GO TO I2000-EXIT. CHGBD201 00285 CHGBD201 00286 PERFORM S910-OPEN-READ THRU S910-EXIT. CHGBD201 00287 CHGBD201 00288 PERFORM S921-OPEN-READ THRU S921-EXIT. CHGBD201 00289 CHGBD201 00290 I2000-EXIT. CHGBD201 00291 EXIT. CHGBD201 00292 CHGBD201 00293 P0000-PROCESS. CHGBD201 00294 READ BD100-CHG-FILE. CHGBD201 00295 IF NOT BD100-FILE-OK-88 CHGBD201 00296 DISPLAY 'SORT FILE EMPTY: ' BD100-CHG-STATUS CHGBD201 00297 SET WRK-ERROR-YES-88 TO TRUE CHGBD201 00298 GO TO P0000-EXIT CHGBD201 00299 ELSE CHGBD201 00300 ADD 1 TO WRK-BD100-READ. CHGBD201 00301 CHGBD201 00302 PERFORM P2000-INIT-EMP-DATA THRU P2000-EXIT. CHGBD201 00303 CHGBD201 00304 PERFORM P1000-READ-CHARGES THRU P1000-EXIT CHGBD201 00305 UNTIL BD100-FILE-EOF-88 CHGBD201 00306 OR WRK-ERROR-YES-88. CHGBD201 00307 CHGBD201 00308 P0000-EXIT. CHGBD201 00309 EXIT. CHGBD201 00310 CHGBD201 00311 P1000-READ-CHARGES. CHGBD201 00312 *& CHGBD201 00313 * MOVE CHG1-SSN TO WRK-SSN-AREA. CHGBD201 00314 * IF WRK-SSN-9 = 578946150 CHGBD201 00315 * OR WRK-SSN-9 = 135345144 CHGBD201 00316 * MOVE CHG1-CHARGE-CURR-AMT TO WRK-AMT-DISP CHGBD201 00317 * DISPLAY '>> EMP ' CHG1-EMP-NO CHGBD201 00318 * ' SSN ' CHG1-SSN CHGBD201 00319 * ' DATE ' CHG1-CHARGE-DATE CHGBD201 00320 * ' AMT ' WRK-AMT-DISP CHGBD201 00321 * ' BYE ' CHG1-BYE. CHGBD201 00322 *& CHGBD201 00323 CHGBD201 00324 IF CHG1-CHARGE-DATE = WRK-CHARGE-DATE CHGBD201 00325 AND CHG1-SSN = WRK-CURR-SSN CHGBD201 00326 AND CHG1-BYE = WRK-CURR-BYE CHGBD201 00327 PERFORM P1200-ACCUM-CHARGES THRU P1200-EXIT CHGBD201 00328 ELSE CHGBD201 00329 PERFORM P1400-WRITE-CHG-RECS THRU P1400-EXIT CHGBD201 00330 VARYING EMP-SUB FROM +1 BY +1 CHGBD201 00331 UNTIL EMP-SUB > EMP-CNT CHGBD201 00332 PERFORM P2000-INIT-EMP-DATA THRU P2000-EXIT CHGBD201 00333 PERFORM P1200-ACCUM-CHARGES THRU P1200-EXIT. CHGBD201 00334 CHGBD201 00335 PERFORM P1010-READ-NEXT-REC THRU P1010-EXIT. CHGBD201 00336 CHGBD201 00337 P1000-EXIT. CHGBD201 00338 EXIT. CHGBD201 00339 CHGBD201 00340 P1010-READ-NEXT-REC. CHGBD201 00341 READ BD100-CHG-FILE. CHGBD201 00342 CHGBD201 00343 IF BD100-FILE-EOF-88 CHGBD201 00344 PERFORM P1400-WRITE-CHG-RECS THRU P1400-EXIT CHGBD201 00345 VARYING EMP-SUB FROM +1 BY +1 CHGBD201 00346 UNTIL EMP-SUB > EMP-CNT CHGBD201 00347 ELSE CHGBD201 00348 IF BD100-FILE-OK-88 CHGBD201 00349 ADD 1 TO WRK-BD100-READ CHGBD201 00350 ELSE CHGBD201 00351 DISPLAY 'SORT FILE READ ERROR: ' BD100-CHG-STATUS CHGBD201 00352 SET WRK-ERROR-YES-88 TO TRUE CHGBD201 00353 END-IF CHGBD201 00354 END-IF. CHGBD201 00355 CHGBD201 00356 P1010-EXIT. CHGBD201 00357 EXIT. CHGBD201 00358 CHGBD201 00359 P1200-ACCUM-CHARGES. CHGBD201 00360 IF CHG1-EMP-NO NOT = WRK-CURR-EMP CHGBD201 00361 PERFORM P1210-NEW-EMP THRU P1210-EXIT. CHGBD201 00362 CHGBD201 00363 PERFORM P1220-UPDATE-EMP-TABLE THRU P1220-EXIT. CHGBD201 00364 CHGBD201 00365 P1200-EXIT. CHGBD201 00366 EXIT. CHGBD201 00367 CHGBD201 00368 **************************************************************** CHGBD201 00369 * CHARGE RECORDS ARRIVE IN EMPLOYER NUMBER ORDER (WITHIN CHGBD201 00370 * SSN/BYE). ALL CHARGE RECORDS FOR A GIVEN EMPLOYER WILL BE CHGBD201 00371 * GROUPED TOGETHER BY THE SORT. CHGBD201 00372 **************************************************************** CHGBD201 00373 P1210-NEW-EMP. CHGBD201 00374 ADD +1 TO EMP-SUB CHGBD201 00375 EMP-CNT. CHGBD201 00376 IF EMP-SUB > EMP-ENTRY-MAX CHGBD201 00377 MOVE 'EMPLOYER TABLE LENGTH EXCEEDED' CHGBD201 00378 TO ABEND-MSG CHGBD201 00379 PERFORM S999-ABEND THRU S999-EXIT CHGBD201 00380 GO TO P1210-EXIT CHGBD201 00381 ELSE CHGBD201 00382 MOVE CHG1-EMP-NO TO WRK-CURR-EMP CHGBD201 00383 TAB-EMP-ACCT (EMP-SUB) CHGBD201 00384 MOVE CHG1-CHARGE-EMP-TYPE CHGBD201 00385 TO TAB-EMP-TYPE (EMP-SUB). CHGBD201 00386 P1210-EXIT. CHGBD201 00387 EXIT. CHGBD201 00388 CHGBD201 00389 **************************************************************** CHGBD201 00390 * TOTAL REGULAR CHARGES AND ADJUSTMENTS SEPARATELY. CHGBD201 00391 * CHG1-CHARGE-PAY-OP-RECOUP IS SET FOR OVERPAYMENT RECOVERIES CHGBD201 00392 * DIRECTED TO A CWC ACCOUNT AND ARE TOTALLED SEPARATELY. CHGBD201 00393 **************************************************************** CHGBD201 00394 P1220-UPDATE-EMP-TABLE. CHGBD201 00395 PERFORM P1229-EDIT-PROG-CODE THRU P1229-EXIT. CHGBD201 00396 CHGBD201 00397 IF CHG1-CHARGE-BEN CHGBD201 00398 PERFORM P1221-BEN-CHARGE THRU P1221-EXIT CHGBD201 00399 ELSE CHGBD201 00400 IF CHG1-CHARGE-ALL-ADJ CHGBD201 00401 PERFORM P1222-ADJ-CHARGE THRU P1222-EXIT. CHGBD201 00402 CHGBD201 00403 P1220-EXIT. CHGBD201 00404 EXIT. CHGBD201 00405 CHGBD201 00406 P1221-BEN-CHARGE. CHGBD201 00407 ADD CHG1-CHARGE-CURR-AMT TO CHGBD201 00408 TAB-BEN-CHG (EMP-SUB, PROG-SUB), CHGBD201 00409 WRK-TOT-BEN (PROG-SUB). CHGBD201 00410 P1221-EXIT. CHGBD201 00411 EXIT. CHGBD201 00412 CHGBD201 00413 P1222-ADJ-CHARGE. CHGBD201 00414 ADD CHG1-CHARGE-CURR-AMT TO CHGBD201 00415 TAB-ADJ-CHG (EMP-SUB, PROG-SUB) CHGBD201 00416 WRK-TOT-ADJ (PROG-SUB). CHGBD201 00417 CHGBD201 00418 IF CHG1-CHARGE-PAY-OP-RECOUP CHGBD201 00419 ADD CHG1-CHARGE-CURR-AMT TO CHGBD201 00420 TAB-OP-RECOVER (EMP-SUB, PROG-SUB). CHGBD201 00421 CHGBD201 00422 P1222-EXIT. CHGBD201 00423 EXIT. CHGBD201 00424 CHGBD201 00425 P1229-EDIT-PROG-CODE. CHGBD201 00426 MOVE CHG1-CHARGE-PROGRAM TO PROG-SUB. CHGBD201 00427 IF NOT PROG-SUB-VALID CHGBD201 00428 MOVE 'INVALID PROGRAM CODE' CHGBD201 00429 TO ABEND-MSG-TEXT CHGBD201 00430 MOVE CHG1-CHARGE-PROGRAM CHGBD201 00431 TO ABEND-MSG-PROG-CODE CHGBD201 00432 PERFORM S999-ABEND THRU S999-EXIT. CHGBD201 00433 CHGBD201 00434 P1229-EXIT. CHGBD201 00435 EXIT. CHGBD201 00436 CHGBD201 00437 P1400-WRITE-CHG-RECS. CHGBD201 00438 MOVE WRK-CHARGE-DATE TO CHG2-CHARGE-DATE. CHGBD201 00439 MOVE TAB-EMP-ACCT (EMP-SUB) TO CHG2-EMP-NO. CHGBD201 00440 MOVE WRK-CURR-SSN TO CHG2-SSN. CHGBD201 00441 MOVE WRK-CURR-BYE TO CHG2-BYE. CHGBD201 00442 CHGBD201 00443 PERFORM P1410-EMP-TYPE THRU P1410-EXIT. CHGBD201 00444 * MOVE WRK-EMP-TYPE TO CHG2-EMP-TYPE. CHGBD201 00445 CHGBD201 00446 PERFORM P1420-CHARGE-AMOUNTS THRU P1420-EXIT CHGBD201 00447 VARYING PROG-SUB FROM +1 BY +1 CHGBD201 00448 UNTIL PROG-SUB > PROG-SUB-MAX. CHGBD201 00449 CHGBD201 00450 P1400-EXIT. CHGBD201 00451 EXIT. CHGBD201 00452 CHGBD201 00453 *************************************************************** CHGBD201 00454 * READ THE EMPLOYER PROFILE RECORD TO FIND THE CHGBD201 00455 * CORRECT EMPLOYER TYPE. THE EMPLOYER TYPE IS NEEDED TO CHGBD201 00456 * DETERMINE IN WHICH REPORT TO INCLUDE THE EMPLOYER'S CHARGES. CHGBD201 00457 *************************************************************** CHGBD201 00458 P1410-EMP-TYPE. CHGBD201 00459 MOVE CHG2-EMP-NO TO L100-EMP-NO. CHGBD201 00460 PERFORM S100-CALL-CHGBU100 THRU S100-EXIT. CHGBD201 00461 IF L100-OK-88 CHGBD201 00462 *& DISPLAY 'EMP-TYPE ' CHG2-EMP-NO CHGBD201 00463 * ' OLD ' WRK-EMP-TYPE CHGBD201 00464 *& ' NEW ' L100-EMP-TYPE CHGBD201 00465 MOVE L100-EMP-TYPE TO CHG2-EMP-TYPE CHGBD201 00466 ELSE CHGBD201 00467 MOVE TAB-EMP-TYPE (EMP-SUB) TO CHG2-EMP-TYPE. CHGBD201 00468 CHGBD201 00469 P1410-EXIT. CHGBD201 00470 EXIT. CHGBD201 00471 CHGBD201 00472 P1420-CHARGE-AMOUNTS. CHGBD201 00473 CHGBD201 00474 MOVE PROG-SUB TO CHG2-PROGRAM. CHGBD201 00475 CHGBD201 00476 IF (TAB-BEN-CHG (EMP-SUB, PROG-SUB) + CHGBD201 00477 TAB-ADJ-CHG (EMP-SUB, PROG-SUB)) NOT = ZERO CHGBD201 00478 MOVE TAB-BEN-CHG (EMP-SUB, PROG-SUB) CHGBD201 00479 TO CHG2-CURR-BEN-AMT CHGBD201 00480 MOVE TAB-ADJ-CHG (EMP-SUB, PROG-SUB) CHGBD201 00481 TO CHG2-CURR-ADJ-AMT CHGBD201 00482 MOVE WRK-TOT-BEN (PROG-SUB) TO CHG2-TOT-BEN-AMT CHGBD201 00483 MOVE WRK-TOT-ADJ (PROG-SUB) TO CHG2-TOT-ADJ-AMT CHGBD201 00484 MOVE TAB-OP-RECOVER (EMP-SUB, PROG-SUB) CHGBD201 00485 TO CHG2-OP-RECOVER-AMT CHGBD201 00486 PERFORM S200-WRITE-CHG2 THRU S200-EXIT CHGBD201 00487 *& CHGBD201 00488 * MOVE CHG2-SSN TO WRK-SSN-AREA CHGBD201 00489 * IF WRK-SSN-9 = 578946150 CHGBD201 00490 * OR WRK-SSN-9 = 135345144 CHGBD201 00491 * COMPUTE WRK-AMT-DISP = CHGBD201 00492 * (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT) CHGBD201 00493 * COMPUTE WRK-AMT-DISP-OUT = CHGBD201 00494 * (CHG2-TOT-BEN-AMT + CHG2-TOT-ADJ-AMT) CHGBD201 00495 * DISPLAY 'DATE ' CHG2-CHARGE-DATE CHGBD201 00496 * ' EMP ' CHG2-EMP-NO CHGBD201 00497 * ' SSN ' CHG2-SSN CHGBD201 00498 * ' AMT ' WRK-AMT-DISP CHGBD201 00499 * ' TOT ' WRK-AMT-DISP-OUT CHGBD201 00500 * END-IF CHGBD201 00501 *& CHGBD201 00502 COMPUTE TOT-BEN-ADJ-AMT = TOT-BEN-ADJ-AMT + CHGBD201 00503 (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT). CHGBD201 00504 CHGBD201 00505 P1420-EXIT. CHGBD201 00506 EXIT. CHGBD201 00507 EJECT CHGBD201 00508 P2000-INIT-EMP-DATA. CHGBD201 00509 MOVE CHG1-CHARGE-DATE TO WRK-CHARGE-DATE. CHGBD201 00510 MOVE CHG1-SSN TO WRK-CURR-SSN. CHGBD201 00511 MOVE CHG1-BYE TO WRK-CURR-BYE. CHGBD201 00512 MOVE CHG1-CHARGE-NAME CHGBD201 00513 TO WRK-CLMNT-NAME. CHGBD201 00514 CHGBD201 00515 MOVE ZERO TO WRK-CURR-EMP. CHGBD201 00516 CHGBD201 00517 PERFORM CHGBD201 00518 VARYING PROG-SUB FROM +1 BY +1 CHGBD201 00519 UNTIL PROG-SUB > PROG-SUB-MAX CHGBD201 00520 MOVE ZERO TO WRK-TOT-BEN (PROG-SUB), CHGBD201 00521 WRK-TOT-ADJ (PROG-SUB) CHGBD201 00522 END-PERFORM. CHGBD201 00523 CHGBD201 00524 PERFORM P2100-INIT-EMP-TABLE THRU P2100-EXIT CHGBD201 00525 VARYING EMP-SUB FROM +1 BY +1 CHGBD201 00526 UNTIL EMP-SUB > EMP-ENTRY-MAX. CHGBD201 00527 CHGBD201 00528 MOVE +0 TO EMP-SUB, CHGBD201 00529 EMP-CNT. CHGBD201 00530 CHGBD201 00531 P2000-EXIT. CHGBD201 00532 EXIT. CHGBD201 00533 CHGBD201 00534 P2100-INIT-EMP-TABLE. CHGBD201 00535 MOVE ZERO TO TAB-EMP-ACCT (EMP-SUB), CHGBD201 00536 TAB-EMP-TYPE (EMP-SUB). CHGBD201 00537 CHGBD201 00538 PERFORM P2110-INIT-AMT-TABLE THRU P2110-EXIT CHGBD201 00539 VARYING PROG-SUB FROM +1 BY +1 CHGBD201 00540 UNTIL PROG-SUB > PROG-SUB-MAX. CHGBD201 00541 P2100-EXIT. CHGBD201 00542 EXIT. CHGBD201 00543 CHGBD201 00544 P2110-INIT-AMT-TABLE. CHGBD201 00545 MOVE ZERO TO TAB-BEN-CHG (EMP-SUB, PROG-SUB), CHGBD201 00546 TAB-ADJ-CHG (EMP-SUB, PROG-SUB), CHGBD201 00547 TAB-OP-RECOVER (EMP-SUB, PROG-SUB). CHGBD201 00548 P2110-EXIT. CHGBD201 00549 EXIT. CHGBD201 00550 CHGBD201 00551 T0000-TERMINATE. CHGBD201 00552 CLOSE BD100-CHG-FILE CHGBD201 00553 BD200-CHG-FILE. CHGBD201 00554 CHGBD201 00555 PERFORM S910-CLOSE THRU S910-EXIT. CHGBD201 00556 CHGBD201 00557 PERFORM S921-CLOSE THRU S921-EXIT. CHGBD201 00558 CHGBD201 00559 DISPLAY ' CHGBD201 CHARGE RECORDS READ : ' CHGBD201 00560 WRK-BD100-READ. CHGBD201 00561 DISPLAY ' CHARGE RECORDS WRITTEN: ' CHGBD201 00562 WRK-BD200-CHG-WRITTEN. CHGBD201 00563 MOVE TOT-BEN-ADJ-AMT TO TOT-BEN-ADJ-AMT-DISP. CHGBD201 00564 DISPLAY ' '. CHGBD201 00565 DISPLAY ' TOTAL BENEFIT AND ADJ AMT = ' CHGBD201 00566 TOT-BEN-ADJ-AMT-DISP. CHGBD201 00567 T0000-EXIT. CHGBD201 00568 EXIT. CHGBD201 00569 EJECT CHGBD201 00570 CHGBD201 00571 S100-CALL-CHGBU100. CHGBD201 00572 CALL 'CHGBU100' USING L100-LINK-AREA. CHGBD201 00573 CHGBD201 00574 S100-EXIT. CHGBD201 00575 EXIT. CHGBD201 00576 CHGBD201 00577 S200-WRITE-CHG2. CHGBD201 00578 WRITE BD200-CHG-REC CHGBD201 00579 FROM WRK-BD200-CHG-REC. CHGBD201 00580 ADD +1 TO WRK-BD200-CHG-WRITTEN. CHGBD201 00581 CHGBD201 00582 S200-EXIT. CHGBD201 00583 EXIT. CHGBD201 00584 CHGBD201 00585 S910-OPEN-READ. CHGBD201 00586 SET L910-OPEN-READ-88 TO TRUE. CHGBD201 00587 GO TO S910-MSTR-IO. CHGBD201 00588 CHGBD201 00589 S910-CLOSE. CHGBD201 00590 SET L910-CLOSE-88 TO TRUE. CHGBD201 00591 GO TO S910-MSTR-IO. CHGBD201 00592 CHGBD201 00593 S910-MSTR-IO. CHGBD201 00594 CALL 'DTSBU910' USING L910-LINK-AREA CHGBD201 00595 MSKL-REC. CHGBD201 00596 CHGBD201 00597 S910-EXIT. CHGBD201 00598 EXIT. CHGBD201 00599 CHGBD201 00600 S921-OPEN-READ. CHGBD201 00601 SET L921-OPEN-READ-88 TO TRUE. CHGBD201 00602 GO TO S921-AIX-IO. CHGBD201 00603 CHGBD201 00604 S921-CLOSE. CHGBD201 00605 SET L921-CLOSE-88 TO TRUE. CHGBD201 00606 GO TO S921-AIX-IO. CHGBD201 00607 CHGBD201 00608 S921-AIX-IO. CHGBD201 00609 CALL 'DTSBU921' USING L921-LINK-AREA CHGBD201 00610 ISKL-REC. CHGBD201 00611 CHGBD201 00612 S921-EXIT. CHGBD201 00613 EXIT. CHGBD201 00614 CHGBD201 00615 S999-ABEND. CHGBD201 00616 DISPLAY '**** CHGBD201 ABENDING ' CHGBD201 00617 ABEND-MSG. CHGBD201 00618 CALL ABEND-MOD USING ABEND-CODE. CHGBD201 00619 S999-EXIT. CHGBD201 00620 EXIT. CHGBD201