622 lines
49 KiB
COBOL
622 lines
49 KiB
COBOL
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
|