00001 IDENTIFICATION DIVISION. 02/26/24 00002 PROGRAM-ID. CHGBD200. CHGBD200 00003 *AUTHOR. TCL. LV048 00004 *DATE-WRITTEN. FEBRUARY 1999. CHGBD200 00005 DATE-COMPILED. CHGBD200 00006 SKIP3 CHGBD200 00007 ***** CHGBD200 00008 * CHGBD200 00009 * FUNCTION: CHGBD200 00010 * CHGBD200 00011 * DAILY BENEFIT CHARGE REPORTING PROCESS STEP 2 CHGBD200 00012 * (1) READ CHGIM001 RECORDS CREATED BY CHGBD100 CHGBD200 00013 * (2) ACCUMULATE CHARGES BY EMPLOYER/SSN/BYE CHGBD200 00014 * (3) WRITE CHGIM002 RECORDS TO VSAM CHARGE FILE CHGBD200 00015 * (4) WRITE CHGIM002 RECORDS TO FLAT FILE FOR INPUT CHGBD200 00016 * TO CHGBD207 (BUILD TOTAL CHARGE RECORDS) CHGBD200 00017 * CHGBD200 00018 * INPUT: CHGBD200 00019 * CHGBD200 00020 * BD100CHG - CHARGE RECORDS GENERATED BY CHGBD200 00021 * CHGBD100. CHGBD200 00022 * CHGPARM - PARAMETER DATA INPUT FROM CHGBD100 CHGBD200 00023 * CHGBD200 00024 * OUTPUT: CHGBD200 00025 * CHGBD200 00026 * BD200CHG - CHARGE REPORT RECORDS CHGBD200 00027 * BD200TOT - CHARGE REPORT RECORDS PASSED TO CHGBD207 CHGBD200 00028 * CHGBD200 00029 ***** CHGBD200 00030 CHGBD200 00031 ******************************************************************CHGBD200 00032 * MODIFICATION HISTORY: *CHGBD200 00033 * *CHGBD200 00034 * 02-02-1999 INITIAL DEVELOPMENT *CHGBD200 00035 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD200 00036 * *CHGBD200 00037 * 04-09-2001 ELIMINATED THE CHG-PARM-FILE AND CHANGED CHGIM002 *CHGBD200 00038 * TO PRODUCE A NEW VERSION OF OUTPUT PERMANENT VSAM *CHGBD200 00039 * FILE WITHOUT THE EMPLOYEE NAME. *CHGBD200 00040 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBD200 00041 * *CHGBD200 00042 * 03-22-2002 ADDED A NEW VALUE TEUC (THE NEW FEDERAL EXTENDED *CHGBD200 00043 * BENEFITS PROGRAM) TO THE PROGRAM CODE DATA ELEMENT *CHGBD200 00044 * IN THE CHARGE SYSTEM DISTINGUISHED BENEFIT PROGRAM. *CHGBD200 00045 * NOW IT CONTAINS VALUES ONLY FOR UI AND EB. *CHGBD200 00046 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBD200 00047 * *CHGBD200 00048 * 07-03-2002 COMMENTED OUT SPECIAL DEBUG DISPLAY OF CHGBD200 00049 * WK-DISP-AREA1 CHGBD200 00050 * REFERENCE RFP # AUTHOR OF CHANGE - JHP *CHGBD200 00051 * *CHGBD200 00052 * 08-06-2002 MODIFIED TO ADD THE DAILY CHARGE RECORDS TO A DISK *CHGBD200 00053 * FILE. THIS FILE IS INPUT TO CHGBD207 AND USED TO *CHGBD200 00054 * BUILD THE CHGM030 TOTAL CHARGE FILE. *CHGBD200 00055 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBD200 00056 * *CHGBD200 00057 * 06-29-2004 ADDED EMP TYPE 17 - DOMESTIC VIOLENCE. *CHGBD200 00058 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD200 00059 * *CHGBD200 00060 * 03-06-2009 MODIFIED FOR NEW FORMAT OF PROGRAM CODE - CHANGED *CHGBD200 00061 * FROM NUMERIC TO CHARACTER. *CHGBD200 00062 * UPDATED EMPLOYER TYPES. *CHGBD200 00063 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD200 00064 * *CHGBD200 00065 * 08-05-2009 ADDED NEW PROGRAM CODES FOR AB,TRAINING AND *CHGBD200 00066 * DEPENDENTS. *CHGBD200 00067 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD200 00068 * *CHGBD200 00069 * 03-31-2010 ADDED NEW PROGRAM CODES FOR SPECIAL PAYMENTS. *CHGBD200 00070 * REFERENCE RFP # AUTHOR OF CHANGE - ZGD *CHGBD200 00071 * *CHGBD200 00072 * 03-19-2013 MODIFIED P1222-ADJ-CHARGE: REMOVED TEST OF *CHGBD200 00073 * CHG1-CHARGE-PAY-OP-RECOUP. THIS INDICATOR, BASED *CHGBD200 00074 * ON CHARGE-PAY-TYPE IN THE BENEFITS FILE, DOES NOT *CHGBD200 00075 * CONTAIN INFORMATION ABOUT OVERPAYMENTS. THE FIELD *CHGBD200 00076 * IS BLANK IN RECORDS THAT HAVE OP RECOVERY AMOUNTS. *CHGBD200 00077 * THE PROGRAM NOW SAVES OP RECOVERIES BASED ONLY ON *CHGBD200 00078 * THE CHARGE-CODE - A VALUE OF CHARGE-OP-RECOUP *CHGBD200 00079 * INDICATES THAT THE RECORD CONTAINS CHARGE *CHGBD200 00080 * ADJUSTMENTS FROM OP RECOVERIES. *CHGBD200 00081 * REFERENCE AUTHOR OF CHANGE - GD *CHGBD200 00082 * *CHGBD200 00083 * 09-26-2014 ADDED NEW PROGRAM CODES FOR UCPIA *CHGBD200 00084 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD200 00085 * *CHGBD200 00086 * * CL**2 00087 * 04-14-2020 ADDED NEW PROGRAM CODES FOR PUA, FPUC AND FRUR * CL**2 00088 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**2 00089 * * CL**2 00090 * * CL*11 00091 * 04-24-2020 ADDED NEW PROGRAM CODES FOR PEUC * CL*11 00092 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL*11 00093 * * CL*11 00094 * * CL*18 00095 * 06-24-2020 ADDED NEW PROGRAM CODES FOR REUR * CL*18 00096 * CHARGES FOR RATED EMPLOYER IS MOVING TO 5032 DUE * CL*18 00097 * TO COVID * CL*18 00098 * * CL*18 00099 * * CL*20 00100 * 09-18-2020 ADDED NEW PROGRAM CODES FOR LWA -005033 * CL*20 00101 * LWA CHARGES WILL COME TO DUTAS FAC * CL*20 00102 * * CL*20 00103 * 12-08-2020 ADDED NEW PROGRAM CODES FOR PUA STIMULUS 5034 * CL*23 00104 * PUA CHARGES WILL COME TO DUTAS AS U2 * CL*23 00105 * * CL*23 00106 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL*18 00107 * * CL*18 00108 * *CHGBD200 00109 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD200 00110 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD200 00111 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD200 00112 ******************************************************************CHGBD200 00113 CHGBD200 00114 SKIP3 CHGBD200 00115 ENVIRONMENT DIVISION. CHGBD200 00116 SKIP3 CHGBD200 00117 INPUT-OUTPUT SECTION. CHGBD200 00118 SKIP3 CHGBD200 00119 FILE-CONTROL. CHGBD200 00120 CHGBD200 00121 SELECT BD100-CHG-FILE ASSIGN TO BD100CHG CHGBD200 00122 FILE STATUS IS BD100-CHG-STATUS. CHGBD200 00123 CHGBD200 00124 SELECT BD200-CHG-FILE ASSIGN TO BD200CHG CHGBD200 00125 ORGANIZATION IS INDEXED CHGBD200 00126 ACCESS IS DYNAMIC CHGBD200 00127 RECORD KEY IS BD200-CHG-REC-KEY CHGBD200 00128 FILE STATUS IS BD200-CHG-STATUS. CHGBD200 00129 CHGBD200 00130 SELECT BD200-TOTAL-CHG ASSIGN TO BD200TOT CHGBD200 00131 FILE STATUS IS BD200-TOTAL-STATUS. CHGBD200 00132 CHGBD200 00133 SELECT BD200-SRVR-CHG ASSIGN TO BD200SVR CHGBD200 00134 FILE STATUS IS BD200-TOTAL-STATUS. CHGBD200 00135 CHGBD200 00136 EJECT CHGBD200 00137 DATA DIVISION. CHGBD200 00138 SKIP3 CHGBD200 00139 FILE SECTION. CHGBD200 00140 SKIP3 CHGBD200 00141 ************************************************************ CHGBD200 00142 * PARAMETER RECORD PASSED FROM CHGBD100. CHGBD200 00143 ************************************************************ CHGBD200 00144 CHGBD200 00145 FD BD100-CHG-FILE CHGBD200 00146 LABEL RECORDS ARE STANDARD CHGBD200 00147 RECORDING MODE IS F CHGBD200 00148 BLOCK CONTAINS 0 CHARACTERS. CHGBD200 00149 SKIP1 CHGBD200 00150 01 BD100-CHG-REC. CHGBD200 00151 ++INCLUDE CHGIM001 CHGBD200 00152 CHGBD200 00153 FD BD200-CHG-FILE CHGBD200 00154 RECORD CONTAINS 64 CHARACTERS CHGBD200 00155 DATA RECORD IS BD200-CHG-REC. CHGBD200 00156 SKIP1 CHGBD200 00157 01 BD200-CHG-REC. CHGBD200 00158 05 BD200-CHG-REC-KEY PIC X(21). CHGBD200 00159 05 BD200-CHG-REC-DATA PIC X(43). CHGBD200 00160 CHGBD200 00161 FD BD200-TOTAL-CHG CHGBD200 00162 LABEL RECORDS ARE STANDARD CHGBD200 00163 RECORDING MODE IS F CHGBD200 00164 BLOCK CONTAINS 0 CHARACTERS. CHGBD200 00165 SKIP1 CHGBD200 00166 01 BD200-TOTAL-REC PIC X(64). CHGBD200 00167 CHGBD200 00168 FD BD200-SRVR-CHG CHGBD200 00169 LABEL RECORDS ARE STANDARD CHGBD200 00170 RECORDING MODE IS F CHGBD200 00171 BLOCK CONTAINS 0 CHARACTERS. CHGBD200 00172 SKIP1 CHGBD200 00173 01 BD200-SRVR-REC PIC X(73). CL*38 00174 CHGBD200 00175 WORKING-STORAGE SECTION. CHGBD200 001755 77 PAN-VALET PICTURE X(24) VALUE '048CHGBD200 02/26/24'. CHGBD200 00176 77 PAN-VALET PICTURE X(24) VALUE '146CHGBD200 10/08/14'. CHGBD200 00177 77 PAN-VALET PICTURE X(24) VALUE '002CHGBD200 10/02/14'. CHGBD200 00178 77 PAN-VALET PICTURE X(24) VALUE '144CHGBD200 10/01/14'. CHGBD200 00179 77 PAN-VALET PICTURE X(24) VALUE '002CHGBD200 09/26/14'. CHGBD200 00180 77 PAN-VALET PICTURE X(24) VALUE '142CHGBD200 03/31/14'. CHGBD200 00181 77 PAN-VALET PICTURE X(24) VALUE '037CHGBD200 03/27/14'. CHGBD200 00182 77 PAN-VALET PICTURE X(24) VALUE '140CHGBD200 01/02/14'. CHGBD200 00183 77 PAN-VALET PICTURE X(24) VALUE '002CHGBD200 12/30/13'. CHGBD200 00184 77 PAN-VALET PICTURE X(24) VALUE '138CHGBD200 10/17/13'. CHGBD200 00185 77 PAN-VALET PICTURE X(24) VALUE '006CHGBD200 10/09/13'. CHGBD200 00186 77 PAN-VALET PICTURE X(24) VALUE '136CHGBD200 04/01/10'. CHGBD200 00187 CHGBD200 00188 01 WRK-AREA. CHGBD200 00189 05 ABEND-CODE PIC S9(04) COMP CHGBD200 00190 VALUE +200. CHGBD200 00191 05 ABEND-MSG PIC X(60). CHGBD200 00192 05 FILLER REDEFINES ABEND-MSG. CHGBD200 00193 10 ABEND-MSG-TEXT PIC X(59). CHGBD200 00194 10 ABEND-MSG-PROG-CODE PIC X(01). CHGBD200 00195 CHGBD200 00196 05 ABEND-MOD PIC X(08) CHGBD200 00197 VALUE 'DTSBU999'. CHGBD200 00198 CHGBD200 00199 05 BD100-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD200 00200 88 BD100-FILE-OK-88 VALUE ZERO. CHGBD200 00201 88 BD100-FILE-EOF-88 VALUE '10'. CHGBD200 00202 05 BD200-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD200 00203 88 BD200-FILE-OK-88 VALUE ZERO. CHGBD200 00204 88 BD200-FILE-DUP-88 VALUE '22'. CHGBD200 00205 05 BD200-TOTAL-STATUS PIC X(02) VALUE SPACES. CHGBD200 00206 88 BD200-TOTAL-FILE-OK-88 VALUE ZERO. CHGBD200 00207 * 88 BD200-TOTAL-FILE-EOF-88 VALUE '10'. CHGBD200 00208 CHGBD200 00209 05 WRK-ERROR-IND PIC X(01). CHGBD200 00210 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD200 00211 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD200 00212 CHGBD200 00213 05 WRK-CHG-REC-IND PIC X(01). CHGBD200 00214 88 WRK-CHG-REC-OK-88 VALUE 'Y'. CHGBD200 00215 88 WRK-CHG-REC-INVALID-88 VALUE 'N'. CHGBD200 00216 CHGBD200 00217 05 WRK-CHG-NEXT-REC PIC X(01). CHGBD200 00218 88 WRK-CHG-NEXT-OK-88 VALUE 'Y'. CHGBD200 00219 CHGBD200 00220 ********************************************************* CHGBD200 00221 * THE FOLLOWING INDICATOR IS USED DURING RERUNS. CHGBD200 00222 * WHEN IT IS SET TO YES, THE PROGRAM WILL WRITE CHGBD200 00223 * CHARGE RECORDS TO PASS TO CHGBD207, BUT WILL NOT CHGBD200 00224 * WRITE EMPLOYER CHARGE RECORDS. CHGBD200 00225 ********************************************************* CHGBD200 00226 05 WRK-ACCEPT-DUPS-IND PIC X(01). CHGBD200 00227 88 WRK-ACCEPT-DUPS-YES-88 VALUE 'Y'. CHGBD200 00228 88 WRK-ACCEPT-DUPS-NO-88 VALUE 'N'. CHGBD200 00229 CHGBD200 00230 05 WRK-REPORT-TYPE PIC X(01). CHGBD200 00231 88 WRK-RPT-TYPE-RATED-88 VALUE '1'. CHGBD200 00232 88 WRK-RPT-TYPE-SELF-INS-88 VALUE '2'. CHGBD200 00233 88 WRK-RPT-TYPE-CWC-88 VALUE '3'. CHGBD200 00234 88 WRK-RPT-TYPE-FED-88 VALUE '4'. CHGBD200 00235 88 WRK-RPT-TYPE-UNKNOWN-88 VALUE '5'. CHGBD200 00236 88 WRK-RPT-TYPE-NOT-LIAB-88 VALUE '6'. CHGBD200 00237 88 WRK-NO-RPT-88 VALUE '0'. CHGBD200 00238 CHGBD200 00239 05 WRK-EMP-TYPE PIC 9(02). CHGBD200 00240 88 WRK-EMP-TYPE-CONTRIB-88 VALUE 00. CHGBD200 00241 88 WRK-EMP-TYPE-UCX-88 VALUE 01. CHGBD200 00242 88 WRK-EMP-TYPE-UCFE-88 VALUE 02. CHGBD200 00243 88 WRK-EMP-TYPE-FED-88 VALUE 01, 02. CHGBD200 00244 88 WRK-EMP-TYPE-CWC-88 VALUE 04. CHGBD200 00245 88 WRK-EMP-TYPE-SELF-INS-88 VALUE 08. CHGBD200 00246 88 WRK-EMP-TYPE-DC-GOV-88 VALUE 10. CHGBD200 00247 88 WRK-EMP-TYPE-NOT-LIAB-88 VALUE 13. CHGBD200 00248 88 WRK-EMP-TYPE-TEUC-88 VALUE 16. CHGBD200 00249 88 WRK-EMP-TYPE-DOM-VIOLENC-88 VALUE 17. CHGBD200 00250 88 WRK-EMP-TYPE-POOL-88 CHGBD200 00251 VALUE 03, 05, 06, 07, 09, 11 CHGBD200 00252 12, 15, 16, 17, 18, 19, 20. CL*19 00253 CHGBD200 00254 88 WRK-EMP-TYPE-VALID-88 CHGBD200 00255 VALUE 00, 01, 02, 03, 04, 05, 06, 07, CHGBD200 00256 07, 08, 09, 10, 11, 12, CHGBD200 00257 13, 15, 16, 17, 18, 19, 20, CHGBD200 00258 21, 22, 23, 24, 25, 26, 27, 28 CL**2 00259 29, 31, 32, 33, 34, 35, 36, 37. CL*23 00260 CHGBD200 00261 05 WRK-BD100-READ PIC 9(07) COMP-3. CHGBD200 00262 05 WRK-SRVR-WRITE-CNT PIC 9(07) COMP-3. CHGBD200 00263 05 WRK-BD200-CHG-WRITTEN PIC 9(07) COMP-3. CHGBD200 00264 05 WRK-BD200-TOTAL-WRITTEN PIC 9(07) COMP-3. CHGBD200 00265 05 WRK-BD200-CHG-DUP PIC 9(07) COMP-3. CHGBD200 00266 05 WRK-BD200-CHG-DEL PIC 9(07) VALUE 0. CL*30 00267 05 TOT-BEN-ADJ-AMT PIC S9(09)V99 VALUE +0. CHGBD200 00268 05 TOT-BEN-ADJ-AMT-DISP PIC ZZZ,ZZZ,ZZ9.99. CHGBD200 00269 05 WRK-TOT-CHG PIC S9(11)V99 COMP-3 CHGBD200 00270 VALUE +0. CHGBD200 00271 05 WRK-CHRG-READ-CNT PIC 9(07) COMP-3 VALUE 0. CHGBD200 00272 05 WRK-CHRG-WRITE-CNT PIC 9(07) COMP-3 VALUE 0. CHGBD200 00273 05 WRK-SSN PIC 9(10). CHGBD200 00274 05 WRK-SSN-X REDEFINES WRK-SSN. CHGBD200 00275 10 WRK-OUT-SSN PIC 9(09). CHGBD200 00276 10 WRK-OUT-SSN-ZERO PIC 9(01). CHGBD200 00277 05 WRK-CURR-AMT PIC S9(11)V99 COMP-3. CHGBD200 00278 CHGBD200 00279 CHGBD200 00280 *************************************************************** CHGBD200 00281 * WORKING STORAGE AND ACCUMULATOR FIELDS FOR CURRENT SSN/BYE. CHGBD200 00282 * CHARGES FOR INDIVIDUAL EMPLOYERS ARE IN THE TABLE BELOW. CHGBD200 00283 *************************************************************** CHGBD200 00284 05 WRK-CURR-SSN PIC S9(10) COMP-3. CHGBD200 00285 05 WRK-CLMNT-NAME PIC X(32). CHGBD200 00286 05 WRK-CURR-BYE PIC S9(09) COMP-3. CHGBD200 00287 05 WRK-CURR-CHG-DATE PIC S9(09) COMP-3. CL*28 00288 05 WRK-CURR-EMP PIC S9(07) COMP-3. CHGBD200 00289 CHGBD200 00290 05 WRK-PROGRAM-TOTALS OCCURS 27 TIMES. CL*24 00291 10 WRK-TOT-BEN PIC S9(07)V99 COMP-3. CHGBD200 00292 10 WRK-TOT-ADJ PIC S9(07)V99 COMP-3. CHGBD200 00293 CHGBD200 00294 *************************************************************** CHGBD200 00295 * THE TABLE BELOW RECORDS CHARGE DATA FOR EACH EMPLOYER WITHIN CHGBD200 00296 * A GIVEN SSN/BYE. WITHIN EACH TABLE ENTRY, A SEPARATE TABLE CHGBD200 00297 * DISTINGUISHES CHARGE AMOUNTS BY BENEFIT PROGRAM. CHGBD200 00298 * PROG-SUB-MAX INDICATES THE MAXIMUM NUMBER OF PROGRAMS THE CHGBD200 00299 * CHARGE AMOUNT TABLE MAY CONTAIN. CHGBD200 00300 * EMP-ENTRY-MAX INDICATES THE MAXIMUM NUMBER OF EMPLOYERS THE CHGBD200 00301 * EMPLOYER TABLE MAY CONTAIN. CHGBD200 00302 *************************************************************** CHGBD200 00303 05 EMP-SUB PIC S9(04) COMP. CHGBD200 00304 05 PROG-SUB PIC S9(04) COMP. CHGBD200 00305 88 PROG-SUB-UI VALUE +1. CHGBD200 00306 88 PROG-SUB-EB VALUE +2. CHGBD200 00307 88 PROG-SUB-TEUC VALUE +3. CHGBD200 00308 88 PROG-SUB-TEUCA VALUE +4. CHGBD200 00309 88 PROG-SUB-FAC VALUE +5. CHGBD200 00310 88 PROG-SUB-FSB VALUE +6. CHGBD200 00311 88 PROG-SUB-FSC VALUE +7. CHGBD200 00312 88 PROG-SUB-DUA VALUE +8. CHGBD200 00313 88 PROG-SUB-TR2 VALUE +9. CHGBD200 00314 88 PROG-SUB-TRA VALUE +10. CHGBD200 00315 88 PROG-SUB-STEPLDR VALUE +11. CHGBD200 00316 88 PROG-SUB-AB VALUE +12. CHGBD200 00317 88 PROG-SUB-TRAINING VALUE +13. CHGBD200 00318 88 PROG-SUB-DEPENDENTS VALUE +14. CHGBD200 00319 88 PROG-SUB-EUC08-2PLUS VALUE +15. CHGBD200 00320 88 PROG-SUB-EUC08TR3 VALUE +16. CHGBD200 00321 88 PROG-SUB-EUC08TR4 VALUE +17. CHGBD200 00322 88 PROG-SUB-SPEC-PAY VALUE +18. CHGBD200 00323 88 PROG-SUB-UCPIA VALUE +19. CHGBD200 00324 88 PROG-SUB-GPA VALUE +20. CL**2 00325 88 PROG-SUB-PUA VALUE +21. CL**2 00326 88 PROG-SUB-FPUC VALUE +22. CL**2 00327 88 PROG-SUB-FRUR VALUE +23. CL**2 00328 88 PROG-SUB-PEUC VALUE +24. CL*11 00329 88 PROG-SUB-REUR VALUE +25. CL*18 00330 88 PROG-SUB-LWA VALUE +26. CL*21 00331 88 PROG-SUB-PUA-STIM VALUE +27. CL*24 00332 88 PROG-SUB-VALID VALUE +1 THRU +27. CL*24 00333 05 PROG-SUB-MAX PIC S9(04) COMP CHGBD200 00334 VALUE +27. CL*24 00335 05 EMP-ENTRY-MAX PIC S9(04) COMP CHGBD200 00336 VALUE +100. CHGBD200 00337 05 EMP-CNT PIC S9(04) COMP. CHGBD200 00338 CHGBD200 00339 05 EMP-TABLE. CHGBD200 00340 10 EMP-TABLE-ENTRY OCCURS 100 TIMES. CHGBD200 00341 15 TAB-EMP-ACCT PIC 9(06). CHGBD200 00342 88 TAB-POOL-ACCT-YES-88 CHGBD200 00343 VALUE 028411, CHGBD200 00344 999000 THRU 999992. CHGBD200 00345 15 TAB-EMP-TYPE PIC 9(02). CHGBD200 00346 *************************************************************** CHGBD200 00347 * THE TABLE BELOW RECORDS AMOUNTS CHARGED FOR EACH BENEFIT CHGBD200 00348 * PROGRAM. THE FIRST OCCURRENCE IS FOR REGULAR UI AND THE CHGBD200 00349 * SECOND FOR EB. ADD ADDITIONAL OCCURRENCES AS REQUIRED. CHGBD200 00350 *************************************************************** CHGBD200 00351 15 TAB-EMP-CHARGE-AMTS CHGBD200 00352 OCCURS 27 TIMES. CL*26 00353 20 TAB-BEN-CHG PIC S9(07)V99 COMP-3. CHGBD200 00354 20 TAB-ADJ-CHG PIC S9(07)V99 COMP-3. CHGBD200 00355 20 TAB-OP-RECOVER PIC S9(07)V99 COMP-3. CHGBD200 00356 CHGBD200 00357 **** CHGBD200 00358 01 BD200-CHG-READ PIC X(64). CL*35 00359 01 WRK-TEST-TOT PIC S9(07)V99 COMP-3 VALUE ZERO. CHGBD200 00360 01 WRK-AMT-DISP PIC S9(07)V99 COMP-3 VALUE ZERO. CHGBD200 00361 01 WRK-TEST-AMT-OUT PIC S9(07)V99 COMP-3 VALUE ZERO. CHGBD200 00362 01 WRK-TEST-TOT-OUT PIC S9(07)V99 COMP-3 VALUE ZERO. CHGBD200 00363 01 WRK-AMT-DISP-OUT PIC S9(07)V99. CHGBD200 00364 **** CHGBD200 00365 01 WK-DISP-AREA1. CHGBD200 00366 05 FILLER PIC X(12) VALUE ' CHG-DATE: '. CHGBD200 00367 05 WK-DISP-CGD PIC 9(09). CHGBD200 00368 05 FILLER PIC X(12) VALUE ' CHG2-EMP: '. CHGBD200 00369 05 WK-DISP-EMP PIC 9(07). CHGBD200 00370 05 FILLER PIC X(12) VALUE ' CHG2-SSN: '. CHGBD200 00371 05 WK-DISP-SSN PIC 9(10). CHGBD200 00372 05 FILLER PIC X(12) VALUE ' CHG2-BYE: '. CHGBD200 00373 05 WK-DISP-BYE PIC 9(09). CHGBD200 00374 05 FILLER PIC X(11) VALUE ' EMP-PGM: '. CHGBD200 00375 05 WK-DISP-PGM PIC X(01). CHGBD200 00376 **** CHGBD200 00377 01 WRK-OUT-REC. CHGBD200 00378 05 OUT-CHARGE-DATE PIC X(10). CHGBD200 00379 05 FILLER PIC X(01) VALUE ';'. CHGBD200 00380 05 OUT-EMP-NO PIC 9(06). CHGBD200 00381 05 FILLER PIC X(01) VALUE ';'. CHGBD200 00382 05 OUT-SSN PIC 9(10). CL*38 00383 05 FILLER PIC X(01) VALUE ';'. CHGBD200 00384 05 OUT-BYE PIC X(10). CHGBD200 00385 05 FILLER PIC X(01) VALUE ';'. CHGBD200 00386 05 OUT-PROGRAM PIC X(01). CHGBD200 00387 05 FILLER PIC X(01) VALUE ';'. CHGBD200 00388 05 OUT-EMP-TYPE PIC 9(02). CHGBD200 00389 05 FILLER PIC X(01) VALUE ';'. CHGBD200 00390 05 OUT-CURR-AMT PIC ---------9.99. CL*45 00391 05 FILLER PIC X(01) VALUE ';'. CHGBD200 00392 05 OUT-RECOVERIES PIC ---------9.99. CL*45 00393 05 OUT-DEL PIC X(01) VALUE SPACES. CL*44 00394 EJECT CHGBD200 00395 01 WRK-BD200-CHG-REC. CHGBD200 00396 ++INCLUDE CHGIM002 CHGBD200 00397 CHGBD200 00398 01 L001-LINK-AREA. CHGBD200 00399 ++INCLUDE DTSIL001 CHGBD200 00400 CHGBD200 00401 01 L004-LINK-AREA. CHGBD200 00402 ++INCLUDE DTSIL004 CHGBD200 00403 CHGBD200 00404 01 L100-LINK-AREA. CHGBD200 00405 ++INCLUDE CHGIL100 CHGBD200 00406 CHGBD200 00407 01 L910-LINK-AREA. CHGBD200 00408 ++INCLUDE DTSIL910 CHGBD200 00409 CHGBD200 00410 01 MSKL-REC. CHGBD200 00411 ++INCLUDE DTSIMSKL CHGBD200 00412 CHGBD200 00413 01 MPRF-REC. CHGBD200 00414 ++INCLUDE DTSIMPRF CHGBD200 00415 CHGBD200 00416 01 L921-LINK-AREA. CHGBD200 00417 ++INCLUDE DTSIL921 CHGBD200 00418 CHGBD200 00419 01 ISKL-REC. CHGBD200 00420 ++INCLUDE DTSIISKL CHGBD200 00421 CHGBD200 00422 LINKAGE SECTION. CHGBD200 00423 CHGBD200 00424 01 PARM-AREA. CHGBD200 00425 05 PARM-LENGTH PIC S9(04) COMP. CHGBD200 00426 05 PARM-DATA. CHGBD200 00427 10 PARM-ACCEPT-DUPS-IND PIC X(01). CHGBD200 00428 88 PARM-ACCEPT-DUPS-YES-88 VALUE 'Y'. CHGBD200 00429 88 PARM-ACCEPT-DUPS-NO-88 VALUE 'N'. CHGBD200 00430 CHGBD200 00431 PROCEDURE DIVISION USING PARM-AREA. CHGBD200 00432 SKIP2 CHGBD200 00433 CHGBD200-MAIN. CHGBD200 00434 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD200 00435 IF WRK-ERROR-YES-88 CHGBD200 00436 GO TO CHGBD200-EXIT. CHGBD200 00437 CHGBD200 00438 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD200 00439 CHGBD200 00440 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD200 00441 CHGBD200 00442 CHGBD200-EXIT. CHGBD200 00443 STOP RUN. CHGBD200 00444 EJECT CHGBD200 00445 I0000-INITIATE. CHGBD200 00446 CHGBD200 00447 PERFORM I1000-INIT-WRK-DATA THRU I1000-EXIT. CHGBD200 00448 CHGBD200 00449 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CHGBD200 00450 CHGBD200 00451 PERFORM I3000-PARM THRU I3000-EXIT. CHGBD200 00452 CHGBD200 00453 I0000-EXIT. CHGBD200 00454 EXIT. CHGBD200 00455 CHGBD200 00456 I1000-INIT-WRK-DATA. CHGBD200 00457 MOVE ZERO TO WRK-BD100-READ, CHGBD200 00458 WRK-BD200-CHG-WRITTEN, CHGBD200 00459 WRK-BD200-TOTAL-WRITTEN, CHGBD200 00460 WRK-BD200-CHG-DUP, CHGBD200 00461 WRK-AMT-DISP, CHGBD200 00462 EMP-CNT. CHGBD200 00463 CHGBD200 00464 SET WRK-ERROR-NO-88 TO TRUE. CHGBD200 00465 CHGBD200 00466 I1000-EXIT. CHGBD200 00467 EXIT. CHGBD200 00468 CHGBD200 00469 I2000-OPEN-FILES. CHGBD200 00470 DISPLAY 'SORT FILE OPEN : ' BD100-CHG-STATUS CL**9 00471 OPEN INPUT BD100-CHG-FILE. CHGBD200 00472 IF NOT BD100-FILE-OK-88 CHGBD200 00473 DISPLAY 'SORT FILE OPEN ERROR: ' BD100-CHG-STATUS CHGBD200 00474 SET WRK-ERROR-YES-88 TO TRUE CHGBD200 00475 GO TO I2000-EXIT. CHGBD200 00476 CHGBD200 00477 DISPLAY 'BD200 VSAM OPEN : ' BD200-CHG-STATUS CL**9 00478 OPEN I-O BD200-CHG-FILE. CHGBD200 00479 IF NOT BD200-FILE-OK-88 CHGBD200 00480 DISPLAY 'BD200 VSAM OPEN ERROR: ' BD200-CHG-STATUS CL**7 00481 SET WRK-ERROR-YES-88 TO TRUE CHGBD200 00482 GO TO I2000-EXIT. CHGBD200 00483 CHGBD200 00484 DISPLAY 'TOTAL CHG FILE OPEN : ' CL**9 00485 OPEN OUTPUT BD200-TOTAL-CHG. CHGBD200 00486 IF NOT BD200-TOTAL-FILE-OK-88 CHGBD200 00487 DISPLAY 'TOTAL CHG FILE OPEN ERROR: ' CHGBD200 00488 BD200-TOTAL-STATUS CHGBD200 00489 SET WRK-ERROR-YES-88 TO TRUE CHGBD200 00490 GO TO I2000-EXIT. CHGBD200 00491 CHGBD200 00492 CHGBD200 00493 DISPLAY 'SRVR CHG FILE OPEN : ' CL**9 00494 OPEN OUTPUT BD200-SRVR-CHG. CHGBD200 00495 IF NOT BD200-TOTAL-FILE-OK-88 CHGBD200 00496 DISPLAY 'SRVR CHG FILE OPEN ERROR: ' CHGBD200 00497 BD200-TOTAL-STATUS CHGBD200 00498 SET WRK-ERROR-YES-88 TO TRUE CHGBD200 00499 GO TO I2000-EXIT. CHGBD200 00500 CHGBD200 00501 PERFORM S910-OPEN-READ THRU S910-EXIT. CHGBD200 00502 PERFORM S921-OPEN-READ THRU S921-EXIT. CHGBD200 00503 CHGBD200 00504 I2000-EXIT. CHGBD200 00505 EXIT. CHGBD200 00506 CHGBD200 00507 I3000-PARM. CHGBD200 00508 SET WRK-ACCEPT-DUPS-NO-88 TO TRUE. CHGBD200 00509 CHGBD200 00510 IF PARM-LENGTH = +1 CHGBD200 00511 NEXT SENTENCE CHGBD200 00512 ELSE CHGBD200 00513 DISPLAY 'PARM IGNORED: PARM-LENGTH NOT EQUAL TO 1' CHGBD200 00514 GO TO I3000-EXIT. CHGBD200 00515 CHGBD200 00516 IF PARM-ACCEPT-DUPS-YES-88 CHGBD200 00517 SET WRK-ACCEPT-DUPS-YES-88 TO TRUE. CHGBD200 00518 CHGBD200 00519 I3000-EXIT. CHGBD200 00520 EXIT. CHGBD200 00521 CHGBD200 00522 P0000-PROCESS. CHGBD200 00523 READ BD100-CHG-FILE. CHGBD200 00524 IF NOT BD100-FILE-OK-88 CHGBD200 00525 DISPLAY 'SORT FILE EMPTY: ' BD100-CHG-STATUS CHGBD200 00526 SET WRK-ERROR-YES-88 TO TRUE CHGBD200 00527 GO TO P0000-EXIT CHGBD200 00528 ELSE CHGBD200 00529 ADD 1 TO WRK-BD100-READ. CHGBD200 00530 CHGBD200 00531 * DISPLAY 'P2000 INIT EMP: ' CL*16 00532 PERFORM P2000-INIT-EMP-DATA THRU P2000-EXIT. CHGBD200 00533 CHGBD200 00534 * DISPLAY 'P1000 READ EMP: ' CL*16 00535 PERFORM P1000-READ-CHARGES THRU P1000-EXIT CHGBD200 00536 UNTIL BD100-FILE-EOF-88 CHGBD200 00537 OR WRK-ERROR-YES-88. CHGBD200 00538 CHGBD200 00539 P0000-EXIT. CHGBD200 00540 EXIT. CHGBD200 00541 CHGBD200 00542 P1000-READ-CHARGES. CHGBD200 00543 DISPLAY 'CHG ' CHG1-EMP-NO ' ' CHG1-SSN ' ' CHG1-BYE. CL*47 00544 DISPLAY 'WRK ' WRK-CURR-EMP ' ' WRK-CURR-SSN ' ' WRK-CURR-BYE CL*48 00545 IF CHG1-SSN = WRK-CURR-SSN CL*46 00546 AND CHG1-BYE = WRK-CURR-BYE CL*46 00547 PERFORM P1200-ACCUM-CHARGES THRU P1200-EXIT CL*46 00548 ELSE CL*46 00549 PERFORM P1400-WRITE-CHG-RECS THRU P1400-EXIT CHGBD200 00550 VARYING EMP-SUB FROM +1 BY +1 CL*46 00551 UNTIL EMP-SUB > EMP-CNT CL*46 00552 PERFORM P2000-INIT-EMP-DATA THRU P2000-EXIT CL*46 00553 PERFORM P1200-ACCUM-CHARGES THRU P1200-EXIT. CL*46 00554 CHGBD200 00555 PERFORM P1010-READ-NEXT-REC THRU P1010-EXIT. CHGBD200 00556 CHGBD200 00557 P1000-EXIT. CHGBD200 00558 EXIT. CHGBD200 00559 CHGBD200 00560 P1010-READ-NEXT-REC. CHGBD200 00561 * DISPLAY 'P1010-READ-NEXT-REC..'. CL**8 00562 READ BD100-CHG-FILE. CHGBD200 00563 CHGBD200 00564 IF BD100-FILE-EOF-88 CHGBD200 00565 PERFORM P1400-WRITE-CHG-RECS THRU P1400-EXIT CHGBD200 00566 PERFORM S200-WRITE-CHG2 THRU S200-EXIT CL*41 00567 VARYING EMP-SUB FROM +1 BY +1 CL*46 00568 UNTIL EMP-SUB > EMP-CNT CL*46 00569 ELSE CHGBD200 00570 IF BD100-FILE-OK-88 CHGBD200 00571 ADD 1 TO WRK-BD100-READ CHGBD200 00572 ELSE CHGBD200 00573 DISPLAY 'SORT FILE READ ERROR: ' BD100-CHG-STATUS CHGBD200 00574 SET WRK-ERROR-YES-88 TO TRUE CHGBD200 00575 END-IF CHGBD200 00576 END-IF. CHGBD200 00577 CHGBD200 00578 P1010-EXIT. CHGBD200 00579 EXIT. CHGBD200 00580 CHGBD200 00581 P1200-ACCUM-CHARGES. CHGBD200 00582 * DISPLAY 'P1200-ACCUM-CHARGES...'. CL**8 00583 IF CHG1-EMP-NO NOT = WRK-CURR-EMP CHGBD200 00584 PERFORM P1210-NEW-EMP THRU P1210-EXIT. CHGBD200 00585 CHGBD200 00586 PERFORM P1220-UPDATE-EMP-TABLE THRU P1220-EXIT. CHGBD200 00587 CHGBD200 00588 P1200-EXIT. CHGBD200 00589 EXIT. CHGBD200 00590 CHGBD200 00591 **************************************************************** CHGBD200 00592 * CHARGE RECORDS ARRIVE IN EMPLOYER NUMBER ORDER (WITHIN CHGBD200 00593 * SSN/BYE). ALL CHARGE RECORDS FOR A GIVEN EMPLOYER WILL BE CHGBD200 00594 * GROUPED TOGETHER BY THE SORT. CHGBD200 00595 **************************************************************** CHGBD200 00596 P1210-NEW-EMP. CHGBD200 00597 * DISPLAY 'P1210-NEW-EMP...'. CL**8 00598 ADD +1 TO EMP-SUB CHGBD200 00599 EMP-CNT. CHGBD200 00600 IF EMP-SUB > EMP-ENTRY-MAX CHGBD200 00601 MOVE 'EMPLOYER TABLE LENGTH EXCEEDED' CHGBD200 00602 TO ABEND-MSG CHGBD200 00603 PERFORM S999-ABEND THRU S999-EXIT CHGBD200 00604 GO TO P1210-EXIT CHGBD200 00605 ELSE CHGBD200 00606 MOVE CHG1-EMP-NO TO WRK-CURR-EMP CHGBD200 00607 TAB-EMP-ACCT (EMP-SUB) CHGBD200 00608 MOVE CHG1-CHARGE-EMP-TYPE CHGBD200 00609 TO TAB-EMP-TYPE (EMP-SUB). CHGBD200 00610 P1210-EXIT. CHGBD200 00611 EXIT. CHGBD200 00612 CHGBD200 00613 **************************************************************** CHGBD200 00614 * TOTAL REGULAR CHARGES AND ADJUSTMENTS SEPARATELY. CHGBD200 00615 * CHG1-CHARGE-PAY-OP-RECOUP IS SET FOR OVERPAYMENT RECOVERIES CHGBD200 00616 * DIRECTED TO A CWC ACCOUNT AND ARE TOTALLED SEPARATELY. CHGBD200 00617 **************************************************************** CHGBD200 00618 P1220-UPDATE-EMP-TABLE. CHGBD200 00619 * DISPLAY 'P1220-UPDATE-EMP-TABLE...'. CL**8 00620 PERFORM P1229-EDIT-PROG-CODE THRU P1229-EXIT. CHGBD200 00621 CHGBD200 00622 IF CHG1-CHARGE-BEN CHGBD200 00623 PERFORM P1221-BEN-CHARGE THRU P1221-EXIT CHGBD200 00624 ELSE CHGBD200 00625 IF CHG1-CHARGE-ALL-ADJ CHGBD200 00626 PERFORM P1222-ADJ-CHARGE THRU P1222-EXIT. CHGBD200 00627 CHGBD200 00628 P1220-EXIT. CHGBD200 00629 EXIT. CHGBD200 00630 CHGBD200 00631 P1221-BEN-CHARGE. CHGBD200 00632 ADD CHG1-CHARGE-CURR-AMT TO CHGBD200 00633 TAB-BEN-CHG (EMP-SUB, PROG-SUB), CHGBD200 00634 WRK-TOT-BEN (PROG-SUB). CHGBD200 00635 CHGBD200 00636 P1221-EXIT. CHGBD200 00637 EXIT. CHGBD200 00638 CHGBD200 00639 P1222-ADJ-CHARGE. CHGBD200 00640 ADD CHG1-CHARGE-CURR-AMT TO CHGBD200 00641 TAB-ADJ-CHG (EMP-SUB, PROG-SUB), CHGBD200 00642 WRK-TOT-ADJ (PROG-SUB). CHGBD200 00643 CHGBD200 00644 *** IF CHG1-CHARGE-PAY-OP-RECOUP CHGBD200 00645 IF CHG1-CHARGE-OP-RECOUP CHGBD200 00646 ADD CHG1-CHARGE-CURR-AMT TO CHGBD200 00647 TAB-OP-RECOVER (EMP-SUB, PROG-SUB). CHGBD200 00648 CHGBD200 00649 P1222-EXIT. CHGBD200 00650 EXIT. CHGBD200 00651 CHGBD200 00652 P1229-EDIT-PROG-CODE. CHGBD200 00653 * DISPLAY 'P1229-EDIT-PROG-CODE...'. CL**8 00654 * DISPLAY'PROG CODE: ' CHG1-CHARGE-PROGRAM ' ' CHG1-EMP-NO CL*16 00655 EVALUATE CHG1-CHARGE-PROGRAM CHGBD200 00656 WHEN '1' CHGBD200 00657 SET PROG-SUB-UI TO TRUE CHGBD200 00658 WHEN '2' CHGBD200 00659 SET PROG-SUB-EB TO TRUE CHGBD200 00660 WHEN '3' CHGBD200 00661 SET PROG-SUB-TEUC TO TRUE CHGBD200 00662 WHEN '4' CHGBD200 00663 SET PROG-SUB-TEUCA TO TRUE CHGBD200 00664 WHEN '5' CHGBD200 00665 SET PROG-SUB-FAC TO TRUE CHGBD200 00666 WHEN '6' CHGBD200 00667 SET PROG-SUB-FSB TO TRUE CHGBD200 00668 WHEN '7' CHGBD200 00669 SET PROG-SUB-FSC TO TRUE CHGBD200 00670 WHEN '8' CHGBD200 00671 SET PROG-SUB-DUA TO TRUE CHGBD200 00672 WHEN '9' CHGBD200 00673 SET PROG-SUB-TR2 TO TRUE CHGBD200 00674 WHEN '0' CHGBD200 00675 SET PROG-SUB-TRA TO TRUE CHGBD200 00676 WHEN 'A' CHGBD200 00677 SET PROG-SUB-STEPLDR TO TRUE CHGBD200 00678 WHEN 'B' CHGBD200 00679 SET PROG-SUB-AB TO TRUE CHGBD200 00680 WHEN 'C' CL*19 00681 SET PROG-SUB-TRAINING TO TRUE CHGBD200 00682 WHEN 'D' CHGBD200 00683 SET PROG-SUB-DEPENDENTS TO TRUE CHGBD200 00684 WHEN 'E' CHGBD200 00685 SET PROG-SUB-EUC08-2PLUS TO TRUE CHGBD200 00686 WHEN 'F' CHGBD200 00687 SET PROG-SUB-EUC08TR3 TO TRUE CHGBD200 00688 WHEN 'G' CHGBD200 00689 SET PROG-SUB-EUC08TR4 TO TRUE CHGBD200 00690 WHEN 'H' CHGBD200 00691 SET PROG-SUB-SPEC-PAY TO TRUE CHGBD200 00692 WHEN 'I' CHGBD200 00693 SET PROG-SUB-UCPIA TO TRUE CHGBD200 00694 WHEN 'J' CL**2 00695 SET PROG-SUB-GPA TO TRUE CL**2 00696 WHEN 'U' CL*13 00697 SET PROG-SUB-PUA TO TRUE CL**2 00698 WHEN 'L' CL**2 00699 SET PROG-SUB-FPUC TO TRUE CL**2 00700 WHEN 'M' CL**2 00701 SET PROG-SUB-FRUR TO TRUE CL**2 00702 WHEN 'N' CL*19 00703 SET PROG-SUB-PEUC TO TRUE CL*11 00704 WHEN 'Y' CL*18 00705 SET PROG-SUB-REUR TO TRUE CL*18 00706 WHEN 'X' CL*21 00707 SET PROG-SUB-LWA TO TRUE CL*21 00708 WHEN 'R' CL*25 00709 SET PROG-SUB-PUA-STIM TO TRUE CL*25 00710 WHEN OTHER CHGBD200 00711 DISPLAY 'INVALID PROGRAM CODE ' CHGBD200 00712 CHG1-CHARGE-PROGRAM ' ' CHG1-EMP-NO CHGBD200 00713 ' ' CHG1-SSN CHGBD200 00714 * SET PROG-SUB-PUA TO TRUE CL*46 00715 SET PROG-SUB-EUC08TR4 TO TRUE CL*46 00716 * CL*29 00717 *** ZL1 CHANGED TO PUA CL*29 00718 * SET PROG-SUB-EUC08TR4 TO TRUE CL*29 00719 * MOVE 'INVALID PROGRAM CODE' CHGBD200 00720 * TO ABEND-MSG-TEXT CHGBD200 00721 * MOVE CHG1-CHARGE-PROGRAM CHGBD200 00722 * TO ABEND-MSG-PROG-CODE CHGBD200 00723 * PERFORM S999-ABEND THRU S999-EXIT CHGBD200 00724 CHGBD200 00725 END-EVALUATE. CHGBD200 00726 CHGBD200 00727 *** MOVE CHG1-CHARGE-PROGRAM TO PROG-SUB. CHGBD200 00728 * IF NOT PROG-SUB-VALID CHGBD200 00729 * MOVE 'INVALID PROGRAM CODE' CHGBD200 00730 * TO ABEND-MSG-TEXT CHGBD200 00731 * MOVE CHG1-CHARGE-PROGRAM CHGBD200 00732 * TO ABEND-MSG-PROG-CODE CHGBD200 00733 *** PERFORM S999-ABEND THRU S999-EXIT. CHGBD200 00734 CHGBD200 00735 P1229-EXIT. CHGBD200 00736 EXIT. CHGBD200 00737 CHGBD200 00738 P1400-WRITE-CHG-RECS. CHGBD200 00739 * DISPLAY 'P1400-WRITE-CHG-RECS...'. CL**8 00740 MOVE CHG1-CHARGE-DATE TO CHG2-CHARGE-DATE. CL*41 00741 MOVE CHG1-EMP-NO TO CHG2-EMP-NO. CL*41 00742 MOVE CHG1-SSN TO CHG2-SSN. CL*41 00743 MOVE CHG1-BYE TO CHG2-BYE. CL*41 00744 MOVE CHG1-CHARGE-PROGRAM TO CHG2-PROGRAM. CL*41 00745 MOVE CHG1-CHARGE-EMP-TYPE TO CHG2-EMP-TYPE. CL*41 00746 MOVE ZEROS TO CHG2-CURR-BEN-AMT CL*41 00747 CHG2-CURR-ADJ-AMT CL*41 00748 CHG2-TOT-BEN-AMT CL*41 00749 CHG2-TOT-ADJ-AMT CL*41 00750 CHG2-OP-RECOVER-AMT. CL*41 00751 CL*41 00752 DISPLAY 'P1400 WRITE ' CHG2-CHARGE-DATE CL*43 00753 ' ' CHG2-EMP-NO CL*43 00754 ' ' CHG2-SSN CL*43 00755 ' ' CHG2-BYE CL*43 00756 ' ' CHG2-PROGRAM. CL*43 00757 CL*27 00758 PERFORM P1410-EMP-TYPE THRU P1410-EXIT. CL*46 00759 CHGBD200 00760 MOVE WRK-EMP-TYPE TO CHG2-EMP-TYPE. CL*46 00761 CHGBD200 00762 PERFORM P1420-CHARGE-AMOUNTS THRU P1420-EXIT CL*46 00763 VARYING PROG-SUB FROM +1 BY +1 CL*46 00764 UNTIL PROG-SUB > PROG-SUB-MAX. CL*46 00765 CHGBD200 00766 P1400-EXIT. CHGBD200 00767 EXIT. CHGBD200 00768 CHGBD200 00769 *************************************************************** CHGBD200 00770 * IF THE EMPLOYER TYPE FROM THE ORIGINAL CHARGE RECORD IS CHGBD200 00771 * INVALID, READ THE EMPLOYER PROFILE RECORD TO FIND THE CHGBD200 00772 * CORRECT EMPLOYER TYPE. THE EMPLOYER TYPE IS NEEDED TO CHGBD200 00773 * DETERMINE IN WHICH REPORT TO INCLUDE THE EMPLOYER'S CHARGES. CHGBD200 00774 *************************************************************** CHGBD200 00775 P1410-EMP-TYPE. CHGBD200 00776 * DISPLAY 'P1410-EMP-TYPE.. '. CL**8 00777 MOVE CHG2-EMP-NO TO L100-EMP-NO. CHGBD200 00778 PERFORM S100-CALL-CHGBU100 THRU S100-EXIT. CHGBD200 00779 IF L100-OK-88 CHGBD200 00780 MOVE L100-EMP-TYPE TO WRK-EMP-TYPE CHGBD200 00781 ELSE CHGBD200 00782 MOVE TAB-EMP-TYPE (EMP-SUB) TO WRK-EMP-TYPE. CHGBD200 00783 CHGBD200 00784 P1410-EXIT. CHGBD200 00785 EXIT. CHGBD200 00786 CHGBD200 00787 P1420-CHARGE-AMOUNTS. CHGBD200 00788 * DISPLAY 'P1420-CHARGE-AMOUNTS...'. CL**8 00789 * DISPLAY 'PROG SUB: ' PROG-SUB CL*16 00790 EVALUATE TRUE CHGBD200 00791 WHEN PROG-SUB-UI CHGBD200 00792 SET CHG2-PROG-UI TO TRUE CHGBD200 00793 WHEN PROG-SUB-EB CHGBD200 00794 SET CHG2-PROG-EB TO TRUE CHGBD200 00795 WHEN PROG-SUB-TEUC CHGBD200 00796 SET CHG2-PROG-TEUC TO TRUE CHGBD200 00797 WHEN PROG-SUB-TEUCA CHGBD200 00798 SET CHG2-PROG-TEUCA TO TRUE CHGBD200 00799 WHEN PROG-SUB-FAC CHGBD200 00800 SET CHG2-PROG-FAC TO TRUE CHGBD200 00801 WHEN PROG-SUB-FSB CHGBD200 00802 SET CHG2-PROG-FSB TO TRUE CHGBD200 00803 WHEN PROG-SUB-FSC CHGBD200 00804 SET CHG2-PROG-FSC TO TRUE CHGBD200 00805 WHEN PROG-SUB-DUA CHGBD200 00806 SET CHG2-PROG-DUA TO TRUE CHGBD200 00807 WHEN PROG-SUB-TR2 CHGBD200 00808 SET CHG2-PROG-TR2 TO TRUE CHGBD200 00809 WHEN PROG-SUB-TRA CHGBD200 00810 SET CHG2-PROG-TRA TO TRUE CHGBD200 00811 WHEN PROG-SUB-STEPLDR CHGBD200 00812 SET CHG2-PROG-STEPLDR TO TRUE CHGBD200 00813 WHEN PROG-SUB-AB CHGBD200 00814 SET CHG2-PROG-AB TO TRUE CHGBD200 00815 WHEN PROG-SUB-TRAINING CHGBD200 00816 SET CHG2-PROG-TRAINING TO TRUE CHGBD200 00817 WHEN PROG-SUB-DEPENDENTS CHGBD200 00818 SET CHG2-PROG-DEPENDENTS TO TRUE CHGBD200 00819 WHEN PROG-SUB-EUC08-2PLUS CHGBD200 00820 SET CHG2-PROG-EUC08-2PLUS TO TRUE CHGBD200 00821 WHEN PROG-SUB-EUC08TR3 CHGBD200 00822 SET CHG2-PROG-EUC08TR3 TO TRUE CHGBD200 00823 WHEN PROG-SUB-EUC08TR4 CHGBD200 00824 SET CHG2-PROG-EUC08TR4 TO TRUE CHGBD200 00825 WHEN PROG-SUB-SPEC-PAY CHGBD200 00826 SET CHG2-PROG-SPECIAL-PAY TO TRUE CHGBD200 00827 WHEN PROG-SUB-UCPIA CHGBD200 00828 SET CHG2-PROG-UCPIA TO TRUE CHGBD200 00829 WHEN PROG-SUB-GPA CL**2 00830 SET CHG2-PROG-GPA TO TRUE CL**2 00831 WHEN PROG-SUB-PUA CL**2 00832 SET CHG2-PROG-PUA TO TRUE CL**2 00833 WHEN PROG-SUB-FPUC CL**2 00834 SET CHG2-PROG-FRUR TO TRUE CL**2 00835 WHEN PROG-SUB-PEUC CL*11 00836 SET CHG2-PROG-PEUC TO TRUE CL*11 00837 WHEN PROG-SUB-REUR CL*18 00838 SET CHG2-PROG-REUR TO TRUE CL*18 00839 WHEN PROG-SUB-LWA CL*21 00840 SET CHG2-PROG-LWA TO TRUE CL*21 00841 WHEN PROG-SUB-PUA-STIM CL*25 00842 SET CHG2-PROG-PUA-STIM TO TRUE CL*25 00843 CHGBD200 00844 END-EVALUATE. CHGBD200 00845 CHGBD200 00846 CHGBD200 00847 *** MOVE PROG-SUB TO CHG2-PROGRAM. CHGBD200 00848 CHGBD200 00849 IF (TAB-BEN-CHG (EMP-SUB, PROG-SUB) + CHGBD200 00850 TAB-ADJ-CHG (EMP-SUB, PROG-SUB)) NOT = ZERO CHGBD200 00851 MOVE TAB-BEN-CHG (EMP-SUB, PROG-SUB) CHGBD200 00852 TO CHG2-CURR-BEN-AMT CHGBD200 00853 MOVE TAB-ADJ-CHG (EMP-SUB, PROG-SUB) CHGBD200 00854 TO CHG2-CURR-ADJ-AMT CHGBD200 00855 MOVE WRK-TOT-BEN (PROG-SUB) TO CHG2-TOT-BEN-AMT CHGBD200 00856 MOVE WRK-TOT-ADJ (PROG-SUB) TO CHG2-TOT-ADJ-AMT CHGBD200 00857 MOVE TAB-OP-RECOVER (EMP-SUB, PROG-SUB) CHGBD200 00858 TO CHG2-OP-RECOVER-AMT CHGBD200 00859 *& CHGBD200 00860 IF CHG2-OP-RECOVER-AMT NOT = ZERO CHGBD200 00861 MOVE CHG2-OP-RECOVER-AMT TO WRK-AMT-DISP CHGBD200 00862 DISPLAY 'OP RECOVER ' CHG2-EMP-NO ' ' CHGBD200 00863 CHG2-SSN ' ' WRK-AMT-DISP CHGBD200 00864 END-IF CHGBD200 00865 *& CHGBD200 00866 PERFORM S200-WRITE-CHG2 THRU S200-EXIT CHGBD200 00867 PERFORM P1450-WRITE-SRVR THRU P1450-EXIT CL*46 00868 COMPUTE TOT-BEN-ADJ-AMT = TOT-BEN-ADJ-AMT + CHGBD200 00869 (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT). CHGBD200 00870 CHGBD200 00871 P1420-EXIT. CHGBD200 00872 EXIT. CHGBD200 00873 EJECT CHGBD200 00874 P1450-WRITE-SRVR. CHGBD200 00875 * DISPLAY 'P1450-WRITE-SRVR...'. CL**8 00876 MOVE CHG2-EMP-NO TO OUT-EMP-NO. CHGBD200 00877 MOVE CHG2-CHARGE-DATE TO L001-FED-8-DATE-9. CHGBD200 00878 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD200 00879 MOVE L001-SLASH-8-DATE TO OUT-CHARGE-DATE. CHGBD200 00880 MOVE CHG2-SSN TO WRK-SSN. CHGBD200 00881 * MOVE WRK-OUT-SSN TO OUT-SSN. CL*38 00882 MOVE WRK-SSN TO OUT-SSN. CL*38 00883 MOVE CHG2-BYE TO L001-FED-8-DATE-9. CHGBD200 00884 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBD200 00885 IF L001-INVALID-DATE CHGBD200 00886 MOVE '01/01/1930' TO OUT-BYE CHGBD200 00887 ELSE CHGBD200 00888 MOVE L001-SLASH-8-DATE TO OUT-BYE. CHGBD200 00889 MOVE CHG2-PROGRAM TO OUT-PROGRAM. CHGBD200 00890 MOVE CHG2-EMP-TYPE TO OUT-EMP-TYPE. CHGBD200 00891 COMPUTE WRK-CURR-AMT = CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMTCHGBD200 00892 MOVE WRK-CURR-AMT TO OUT-CURR-AMT. CHGBD200 00893 ADD WRK-CURR-AMT TO WRK-TOT-CHG. CHGBD200 00894 CL*27 00895 * DISPLAY 'P1450 WRITE ' CHG2-CHARGE-DATE CL*36 00896 * ' ' CHG2-EMP-NO CL*36 00897 * ' ' CHG2-SSN CL*36 00898 * ' ' CHG2-BYE CL*36 00899 * ' ' OUT-CURR-AMT. CL*36 00900 **NH MOD FOR RECOVERIES CHGBD200 00901 MOVE WRK-AMT-DISP TO OUT-RECOVERIES. CHGBD200 00902 **NH MOD FOR RECOVERIES CHGBD200 00903 WRITE BD200-SRVR-REC FROM WRK-OUT-REC. CHGBD200 00904 ADD 1 TO WRK-SRVR-WRITE-CNT. CHGBD200 00905 MOVE ZERO TO OUT-RECOVERIES. CHGBD200 00906 MOVE ZERO TO WRK-AMT-DISP. CHGBD200 00907 CHGBD200 00908 P1450-EXIT. CHGBD200 00909 EXIT. CHGBD200 00910 EJECT CHGBD200 00911 P2000-INIT-EMP-DATA. CHGBD200 00912 * DISPLAY 'P2000-INIT-EMP-DATA...'. CL*11 00913 MOVE CHG1-SSN TO WRK-CURR-SSN. CHGBD200 00914 MOVE CHG1-BYE TO WRK-CURR-BYE. CHGBD200 00915 MOVE CHG1-CHARGE-DATE TO WRK-CURR-CHG-DATE CL*28 00916 MOVE CHG1-CHARGE-NAME CL*28 00917 TO WRK-CLMNT-NAME. CHGBD200 00918 CHGBD200 00919 MOVE ZERO TO WRK-CURR-EMP. CHGBD200 00920 CHGBD200 00921 PERFORM CHGBD200 00922 VARYING PROG-SUB FROM +1 BY +1 CHGBD200 00923 UNTIL PROG-SUB > PROG-SUB-MAX CHGBD200 00924 MOVE ZERO TO WRK-TOT-BEN (PROG-SUB), CHGBD200 00925 WRK-TOT-ADJ (PROG-SUB) CHGBD200 00926 * DISPLAY 'P2000-INIT-EMP-.VARY..' PROG-SUB ' ' PROG-SUB-MAX CL*11 00927 END-PERFORM. CHGBD200 00928 CHGBD200 00929 PERFORM P2100-INIT-EMP-TABLE THRU P2100-EXIT CHGBD200 00930 VARYING EMP-SUB FROM +1 BY +1 CHGBD200 00931 UNTIL EMP-SUB > EMP-ENTRY-MAX. CHGBD200 00932 CHGBD200 00933 MOVE +0 TO EMP-SUB, CHGBD200 00934 EMP-CNT. CHGBD200 00935 CHGBD200 00936 P2000-EXIT. CHGBD200 00937 EXIT. CHGBD200 00938 CHGBD200 00939 P2100-INIT-EMP-TABLE. CHGBD200 00940 * DISPLAY 'P2100-INIT-EMP-TABLE...'. CL*11 00941 MOVE ZERO TO TAB-EMP-ACCT (EMP-SUB), CHGBD200 00942 TAB-EMP-TYPE (EMP-SUB). CHGBD200 00943 CHGBD200 00944 PERFORM P2110-INIT-AMT-TABLE THRU P2110-EXIT CHGBD200 00945 VARYING PROG-SUB FROM +1 BY +1 CHGBD200 00946 UNTIL PROG-SUB > PROG-SUB-MAX. CHGBD200 00947 P2100-EXIT. CHGBD200 00948 EXIT. CHGBD200 00949 CHGBD200 00950 P2110-INIT-AMT-TABLE. CHGBD200 00951 * DISPLAY 'P2110-INIT-AMT-TABLE....'. CL*11 00952 MOVE ZERO TO TAB-BEN-CHG (EMP-SUB, PROG-SUB), CHGBD200 00953 TAB-ADJ-CHG (EMP-SUB, PROG-SUB), CHGBD200 00954 TAB-OP-RECOVER (EMP-SUB, PROG-SUB). CHGBD200 00955 P2110-EXIT. CHGBD200 00956 EXIT. CHGBD200 00957 CHGBD200 00958 T0000-TERMINATE. CHGBD200 00959 CLOSE BD100-CHG-FILE CHGBD200 00960 BD200-CHG-FILE CHGBD200 00961 BD200-TOTAL-CHG. CHGBD200 00962 CHGBD200 00963 PERFORM S910-CLOSE THRU S910-EXIT. CHGBD200 00964 PERFORM S921-CLOSE THRU S921-EXIT. CHGBD200 00965 CHGBD200 00966 DISPLAY ' CHGBD200 CHARGE RECORDS READ: ' CHGBD200 00967 WRK-BD100-READ. CHGBD200 00968 DISPLAY ' EMPLOYER CHARGE RECORDS WRITTEN: ' CHGBD200 00969 WRK-BD200-CHG-WRITTEN. CHGBD200 00970 DISPLAY ' SSN CHARGE RECORDS WRITTEN: ' CHGBD200 00971 WRK-BD200-TOTAL-WRITTEN. CHGBD200 00972 DISPLAY ' CHARGE RECORDS DUPLICATED: ' CHGBD200 00973 WRK-BD200-CHG-DUP. CHGBD200 00974 DISPLAY ' CHARGE RECORDS DELETED...: ' CL*30 00975 WRK-BD200-CHG-DEL. CL*30 00976 MOVE TOT-BEN-ADJ-AMT TO TOT-BEN-ADJ-AMT-DISP. CHGBD200 00977 DISPLAY ' '. CHGBD200 00978 DISPLAY ' TOTAL BENEFIT AND ADJ AMT = ' CHGBD200 00979 TOT-BEN-ADJ-AMT-DISP. CHGBD200 00980 CHGBD200 00981 T0000-EXIT. CHGBD200 00982 EXIT. CHGBD200 00983 EJECT CHGBD200 00984 CHGBD200 00985 S001-FROM-FED-8. CHGBD200 00986 SET L001-FROM-FED-8 TO TRUE. CHGBD200 00987 GO TO S001-DATE. CHGBD200 00988 CHGBD200 00989 S001-FROM-ABS-DAY. CHGBD200 00990 SET L001-FROM-ABS-DAY TO TRUE. CHGBD200 00991 GO TO S001-DATE. CHGBD200 00992 CHGBD200 00993 S001-DATE. CHGBD200 00994 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD200 00995 CHGBD200 00996 S001-EXIT. CHGBD200 00997 EXIT. CHGBD200 00998 SKIP3 CHGBD200 00999 CHGBD200 01000 S100-CALL-CHGBU100. CHGBD200 01001 CALL 'CHGBU100' USING L100-LINK-AREA. CHGBD200 01002 CHGBD200 01003 S100-EXIT. CHGBD200 01004 EXIT. CHGBD200 01005 CHGBD200 01006 S200-WRITE-CHG2. CHGBD200 01007 CHGBD200 01008 * PERFORM S300-DELETE-CHG2 THRU S300-EXIT CL*46 01009 * PERFORM P1450-WRITE-SRVR THRU P1450-EXIT CL*44 01010 * GO TO S200-EXIT CL*46 01011 CL*40 01012 WRITE BD200-CHG-REC FROM WRK-BD200-CHG-REC. CHGBD200 01013 CHGBD200 01014 IF BD200-FILE-DUP-88 CHGBD200 01015 ADD +1 TO WRK-BD200-CHG-DUP CHGBD200 01016 IF WRK-ACCEPT-DUPS-YES-88 CHGBD200 01017 WRITE BD200-TOTAL-REC FROM WRK-BD200-CHG-REC CHGBD200 01018 ADD +1 TO WRK-BD200-TOTAL-WRITTEN CHGBD200 01019 END-IF CHGBD200 01020 ELSE CHGBD200 01021 WRITE BD200-TOTAL-REC FROM WRK-BD200-CHG-REC CHGBD200 01022 ADD +1 TO WRK-BD200-CHG-WRITTEN CHGBD200 01023 ADD +1 TO WRK-BD200-TOTAL-WRITTEN. CHGBD200 01024 CHGBD200 01025 S200-EXIT. CHGBD200 01026 EXIT. CHGBD200 01027 CHGBD200 01028 S300-DELETE-CHG2. CL*30 01029 CL*30 01030 MOVE WRK-BD200-CHG-REC TO BD200-CHG-REC-KEY. CL*30 01031 READ BD200-CHG-FILE INTO BD200-CHG-READ. CL*34 01032 CL*30 01033 IF NOT BD200-FILE-OK-88 CL*30 01034 DISPLAY 'BD200 VSAM READ ERROR: ' BD200-CHG-STATUS CL*30 01035 * DISPLAY 'REC NOT FND ' WRK-BD200-CHG-REC CL*40 01036 MOVE 'N' TO OUT-DEL CL*44 01037 PERFORM P1450-WRITE-SRVR THRU P1450-EXIT CL*44 01038 DISPLAY 'REC NOT FND ' CHG2-CHARGE-DATE CL*40 01039 ',' CHG2-EMP-NO CL*40 01040 ',' CHG2-SSN CL*40 01041 ',' CHG2-BYE CL*40 01042 ',' CHG2-PROGRAM CL*43 01043 GO TO S300-EXIT. CL*30 01044 CL*30 01045 DELETE BD200-CHG-FILE RECORD. CL*30 01046 CL*30 01047 IF NOT BD200-FILE-OK-88 CL*30 01048 DISPLAY 'BD200 VSAM DELETE ERROR: ' BD200-CHG-STATUS CL*30 01049 DISPLAY 'NOT DELETED ' BD200-CHG-READ CL*34 01050 GO TO S300-EXIT. CL*30 01051 CL*30 01052 MOVE 'Y' TO OUT-DEL CL*44 01053 PERFORM P1450-WRITE-SRVR THRU P1450-EXIT CL*44 01054 DISPLAY 'REC DELETED ' BD200-CHG-REC-KEY CL*32 01055 ADD 1 TO WRK-BD200-CHG-DEL. CL*31 01056 S300-EXIT. CL*30 01057 EXIT. CL*30 01058 S910-OPEN-READ. CHGBD200 01059 SET L910-OPEN-READ-88 TO TRUE. CHGBD200 01060 GO TO S910-MSTR-IO. CHGBD200 01061 CHGBD200 01062 *S910-READ. CHGBD200 01063 ** SET L910-READ-88 TO TRUE. CHGBD200 01064 ** GO TO S910-MSTR-IO. CHGBD200 01065 CHGBD200 01066 S910-CLOSE. CHGBD200 01067 SET L910-CLOSE-88 TO TRUE. CHGBD200 01068 GO TO S910-MSTR-IO. CHGBD200 01069 CHGBD200 01070 S910-MSTR-IO. CHGBD200 01071 CALL 'DTSBU910' USING L910-LINK-AREA CHGBD200 01072 MSKL-REC. CHGBD200 01073 CHGBD200 01074 S910-EXIT. CHGBD200 01075 EXIT. CHGBD200 01076 CHGBD200 01077 S921-OPEN-READ. CHGBD200 01078 SET L921-OPEN-READ-88 TO TRUE. CHGBD200 01079 GO TO S921-AIX-IO. CHGBD200 01080 CHGBD200 01081 S921-CLOSE. CHGBD200 01082 SET L921-CLOSE-88 TO TRUE. CHGBD200 01083 GO TO S921-AIX-IO. CHGBD200 01084 CHGBD200 01085 S921-AIX-IO. CHGBD200 01086 CALL 'DTSBU921' USING L921-LINK-AREA CHGBD200 01087 ISKL-REC. CHGBD200 01088 CHGBD200 01089 S921-EXIT. CHGBD200 01090 EXIT. CHGBD200 01091 CHGBD200 01092 S999-ABEND. CHGBD200 01093 DISPLAY '**** CHGBD200 ABENDING ' CHGBD200 01094 ABEND-MSG. CHGBD200 01095 CALL ABEND-MOD USING ABEND-CODE. CHGBD200 01096 S999-EXIT. CHGBD200 01097 EXIT. CHGBD200