00001 IDENTIFICATION DIVISION. 09/16/22 00002 PROGRAM-ID. CHGBD300. CHGBD300 00003 *AUTHOR. TCL. LV016 00004 *DATE-WRITTEN. FEBRUARY 1999. CHGBD300 00005 DATE-COMPILED. CHGBD300 00006 SKIP3 CHGBD300 00007 ***** CHGBD300 00008 * CHGBD300 00009 * FUNCTION: CHGBD300 00010 * CHGBD300 00011 * CHARGE PRINT DRIVER CHGBD300 00012 * CHGBD300 00013 ***** CHGBD300 00014 * CHGBD300 00015 * DESCRIPTION: CHGBD300 00016 * CHGBD300 00017 * DRIVER FOR BENEFIT CHARGE REPORTING PRINT PROCESS. CHGBD300 00018 * CHGBD300 READS RECORDS SELECTED BY CHGBD210 AND CHGBD300 00019 * BD220, AND CALLS THE APPROPRIATE REPORT PROGRAM. CHGBD300 00020 * CHGBD300 00021 ***** CHGBD300 00022 * CHGBD300 00023 * INPUT: CHGBD300 00024 * CHGBD300 00025 * BD220CHG - CHARGE RECORDS GENERATED BY CHGBD220. CHGBD300 00026 * CHGBD300 00027 * CHGPARM - PARAMETER DATA INPUT FROM CHGBD210 CHGBD300 00028 * CHGBD300 00029 ****** CHGBD300 00030 * CHGBD300 00031 * OUTPUT: CHGBD300 00032 * CHGBD300 00033 * RPC100R1 - PRINT RATED NOTICES. CHGBD300 00034 * RPC100R3 - PRINT RATED BENEFIT CHARGE SPECIAL REPORT CHGBD300 00035 * RPC110R1 - PRINT SELF-INSURED BILLS CHGBD300 00036 * RPC110R2 - SELF-INSURED QUARTERLY/ANNUAL CHARGE SUMMARY REPORTCHGBD300 00037 * AND BENEFIT CHARGE SPECIAL REPORT CHGBD300 00038 * RPC120R1 - CWC QUARTERLY/ANNUAL CHARGE SUMMARY REPORT CHGBD300 00039 * AND BENEFIT CHARGE SPECIAL REPORT CHGBD300 00040 * RPC130R1 - FEDERAL QUARTERLY/ANNUAL CHARGE SUMMARY REPORT CHGBD300 00041 * AND BENEFIT CHARGE SPECIAL REPORT CHGBD300 00042 * RPC150R1 - TEUC QUARTERLY/ANNUAL CHARGE SUMMARY REPORT CHGBD300 00043 * AND BENEFIT CHARGE SPECIAL REPORT CHGBD300 00044 * RPC160R1 - DC GOVERNMENT CHARGE SUMMARY REPORT CHGBD300 00045 * RPC170R1 - PANDEMIC REPORTS FOR PUA, FPUC, FRUR, PEUC CL*14 00046 * CHGBD300 00047 ***** CHGBD300 00048 ***************************************************************** CHGBD300 00049 * * CHGBD300 00050 * MODIFICATION HISTORY: * CHGBD300 00051 * * CHGBD300 00052 * 05-05-1999 NEW DEVELOPMENT * CHGBD300 00053 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD300 00054 * * CHGBD300 00055 * 06-25-2001 MODIFIED FOR NEW REPORTING PROCESS. * CHGBD300 00056 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD300 00057 * * CHGBD300 00058 * 06-25-2001 MODIFIED TO OUTPUT TEUC RPC150R1 REPORT. * CHGBD300 00059 * REFERENCE RFP # AUTHOR OF CHANGE - RW1* CHGBD300 00060 * * CHGBD300 00061 * 09-04-2003 MODIFIED TO OUTPUT DC RPC160R1 REPORT. * CHGBD300 00062 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD300 00063 * * CHGBD300 00064 * 04-15-2004 MODIFIED TO PRINT SELF-INSURED BILLS AFTER * CHGBD300 00065 * THE DAILY UPDATE IN ORDER TO CORRECTLY ACCOUNT * CHGBD300 00066 * FOR CREDITS. CHGBD300 00067 * STEP 1 OF THE CHARGE REPORTING PROCESS RUNS * CHGBD300 00068 * PRIOR TO THE DAILY UPDATE, GENERATING ACCOUNTING * CHGBD300 00069 * TRANSACTION WITH THE SELF-INS CHARGES. THIS STEP * CHGBD300 00070 * PRINTS ALL REPORTS EXCEPT FOR THE SELF INS EMPS. * CHGBD300 00071 * STEP 2 RUNS FOLLOWING THE DAILY UPDATE, AND * CHGBD300 00072 * EXECUTES THE PRINT PROCESS (CHGBD300) TO PRODUCE * CHGBD300 00073 * THE SELF-INSURED REPORTS. THIS PROCESS CHECKS THE * CHGBD300 00074 * ACTUAL BALANCE DUE ON THE TAX FILE AND PRINTS THIS * CHGBD300 00075 * AMOUNT ON THE BILL. * CHGBD300 00076 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD300 00077 * * CHGBD300 00078 * 07-15-2004 CORRECTED PROBLEM IN I2000 EDITS - FQTR NOT * CHGBD300 00079 * YET UPDATED WHEN STEP 2 BEGINS. P1000 NOW * CHGBD300 00080 * VERIFIES THAT STEP 1 HAS BEEN RUN. * CHGBD300 00081 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD300 00082 * * CHGBD300 00083 * 12-06-2007 MODIFIED FOR NEW PROCESS INVOLVING PARTIAL * CHGBD300 00084 * TRANSFERS OF EXPERIENCE, AND FOR NEW VERSION * CHGBD300 00085 * OF CHGIM004. * CHGBD300 00086 * THIS PROGRAM NO LONGER PROCESSES CHARGES FOR * CHGBD300 00087 * RATED EMPLOYERS. THE PRINT DRIVER FOR RATED * CHGBD300 00088 * CHARGES IS CHGBD301. CHGBD300 00089 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD300 00090 * * CHGBD300 00091 * 04-03-2009 RECOMPILED FOR NEW VERSION OF CHGIM004. * CHGBD300 00092 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD300 00093 * * CHGBD300 00094 * * CHGBD300 00095 * 04-04-2010 RECOMPILED FOR NEW VERSION OF CHGIM004. * CHGBD300 00096 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1* CHGBD300 00097 * * CHGBD300 00098 * * CL**2 00099 * 10-04-2014 RECOMPILED FOR NEW VERSION OF CHGIM004. * CL**2 00100 * REFERENCE RFP # UCPIA AUTHOR OF CHANGE - ZL1* CL**2 00101 * * CL**2 00102 * * CL**4 00103 * 04-14-2020 RECOMPILED FOR NEW VERSION OF CHGIM004. * CL**4 00104 * REFERENCE PUA FPUC FRUR AUTHOR OF CHANGE - ZL1* CL**4 00105 * * CL**4 00106 * * CL*14 00107 * 05-04-2020 RECOMPILED FOR NEW VERSION OF CHGIM004. * CL*14 00108 * REFERENCE PUA FPUC FRUR PEUC AUTHOR OF CHANGE - ZL1* CL*14 00109 * * CL*14 00110 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * CHGBD300 00111 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * CHGBD300 00112 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** * CHGBD300 00113 ***************************************************************** CHGBD300 00114 CHGBD300 00115 SKIP3 CHGBD300 00116 ENVIRONMENT DIVISION. CHGBD300 00117 SKIP3 CHGBD300 00118 INPUT-OUTPUT SECTION. CHGBD300 00119 SKIP3 CHGBD300 00120 FILE-CONTROL. CHGBD300 00121 CHGBD300 00122 SELECT CHG-PARM-FILE ASSIGN TO CHGPARM CHGBD300 00123 FILE STATUS IS CHG-PARM-STATUS. CHGBD300 00124 CHGBD300 00125 SELECT BD220-CHG-FILE ASSIGN TO BD220CHG CHGBD300 00126 FILE STATUS IS BD220-CHG-STATUS. CHGBD300 00127 EJECT CHGBD300 00128 DATA DIVISION. CHGBD300 00129 SKIP3 CHGBD300 00130 FILE SECTION. CHGBD300 00131 SKIP3 CHGBD300 00132 CHGBD300 00133 FD CHG-PARM-FILE CHGBD300 00134 RECORDING MODE IS F CHGBD300 00135 BLOCK CONTAINS 0 CHARACTERS. CHGBD300 00136 SKIP1 CHGBD300 00137 01 CHG-PARM-REC. CHGBD300 00138 ++INCLUDE CHGIM003 CHGBD300 00139 CHGBD300 00140 FD BD220-CHG-FILE CHGBD300 00141 LABEL RECORDS ARE STANDARD CHGBD300 00142 BLOCK CONTAINS 0 CHARACTERS. CHGBD300 00143 SKIP1 CHGBD300 00144 01 BD220-CHG-REC. CHGBD300 00145 ++INCLUDE CHGIM004 CHGBD300 00146 EJECT CHGBD300 00147 WORKING-STORAGE SECTION. CHGBD300 001475 77 PAN-VALET PICTURE X(24) VALUE '016CHGBD300 09/16/22'. CHGBD300 00148 77 PAN-VALET PICTURE X(24) VALUE '160CHGBD300 05/25/10'. CHGBD300 00149 CHGBD300 00150 01 WRK-AREA. CHGBD300 00151 *& CHGBD300 00152 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. CHGBD300 00153 05 WRK-EMP-TOT PIC S9(08)V99 COMP-3 CHGBD300 00154 VALUE +0. CHGBD300 00155 05 WRK-RATED-TOT PIC S9(09)V99 COMP-3 CHGBD300 00156 VALUE +0. CHGBD300 00157 05 WRK-EMP-TOT-DISP PIC Z9(07)9.99-. CHGBD300 00158 05 WRK-RATED-TOT-DISP PIC Z9(08)9.99-. CHGBD300 00159 CHGBD300 00160 ** 05 WRK-RPT-TYPE-RATED PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300 00161 ** 05 WRK-RPT-TYPE-RATED-DISP PIC Z9(08)9.99-. CHGBD300 00162 05 WRK-RPT-TYPE-SELF-INS PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300 00163 05 WRK-RPT-TYPE-SELF-INS-DISP PIC Z9(08)9.99-. CHGBD300 00164 05 WRK-RPT-TYPE-CWC PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300 00165 05 WRK-RPT-TYPE-CWC-DISP PIC Z9(08)9.99-. CHGBD300 00166 05 WRK-RPT-TYPE-FED PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300 00167 05 WRK-RPT-TYPE-FED-DISP PIC Z9(08)9.99-. CHGBD300 00168 05 WRK-RPT-TYPE-TEUC PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300 00169 05 WRK-RPT-TYPE-TEUC-DISP PIC Z9(08)9.99-. CHGBD300 00170 05 WRK-RPT-TYPE-DC-GOV PIC S9(09)V99 COMP-3 VALUE +0.CHGBD300 00171 05 WRK-RPT-TYPE-DC-GOV-DISP PIC Z9(08)9.99-. CHGBD300 00172 05 WRK-RPT-TYPE-FPUC PIC S9(09)V99 COMP-3 VALUE +0. CL**6 00173 05 WRK-RPT-TYPE-FPUC-DISP PIC Z9(08)9.99-. CL**6 00174 CL**6 00175 05 ABEND-CODE PIC S9(04) COMP CHGBD300 00176 VALUE +300. CHGBD300 00177 05 ABEND-MSG PIC X(60). CHGBD300 00178 CHGBD300 00179 05 CHG-PARM-STATUS PIC X(02) VALUE SPACES. CHGBD300 00180 88 CHG-PARM-FILE-OK-88 VALUE ZERO. CHGBD300 00181 88 CHG-PARM-FILE-EOF-88 VALUE '10'. CHGBD300 00182 05 BD220-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD300 00183 88 BD220-FILE-OK-88 VALUE ZERO. CHGBD300 00184 88 BD220-FILE-EOF-88 VALUE '10'. CHGBD300 00185 CHGBD300 00186 05 WRK-SELF-INS-STEP PIC X(01). CHGBD300 00187 88 WRK-SELF-INS-STEP1-88 VALUE '1'. CHGBD300 00188 88 WRK-SELF-INS-STEP2-88 VALUE '2'. CHGBD300 00189 CHGBD300 00190 05 WRK-ERROR-IND PIC X(01). CHGBD300 00191 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD300 00192 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD300 00193 CHGBD300 00194 05 WRK-EMP-FOUND-IND PIC X(01). CHGBD300 00195 88 WRK-EMP-FOUND-YES-88 VALUE 'Y'. CHGBD300 00196 88 WRK-EMP-FOUND-NO-88 VALUE 'N'. CHGBD300 00197 CHGBD300 00198 05 WRK-REPORT-MOD PIC X(08). CHGBD300 00199 ** 88 RATED-MOD VALUE 'CHGBR100'. CHGBD300 00200 88 SELF-INS-MOD VALUE 'CHGBR110'. CHGBD300 00201 88 TPS-UNIV-MOD VALUE 'CHGBR111'. CHGBD300 00202 88 T026-TAX-MOD VALUE 'CHGBR112'. CHGBD300 00203 88 CWC-MOD VALUE 'CHGBR120'. CHGBD300 00204 88 FEDERAL-MOD VALUE 'CHGBR130'. CHGBD300 00205 88 PGM-NULL-MOD VALUE 'CHGBR140'. CHGBD300 00206 88 TEUC-MOD VALUE 'CHGBR150'. CHGBD300 00207 88 DC-GOV-MOD VALUE 'CHGBR160'. CHGBD300 00208 88 FPUC-MOD VALUE 'CHGBR170'. CL**5 00209 CHGBD300 00210 CHGBD300 00211 05 WRK-BD220-CHG-READ PIC 9(07) COMP-3 VALUE 0. CHGBD300 00212 05 WRK-BD220-CHG-SELECTED PIC 9(07) COMP-3 VALUE 0. CHGBD300 00213 ** 05 WRK-RATED-READ PIC 9(07) COMP-3 VALUE 0. CHGBD300 00214 05 WRK-SELF-INS-READ PIC 9(07) COMP-3 VALUE 0. CHGBD300 00215 05 WRK-FED-READ PIC 9(07) COMP-3 VALUE 0. CHGBD300 00216 05 WRK-TEUC-READ PIC 9(07) COMP-3 VALUE 0. CHGBD300 00217 05 WRK-FPUC-READ PIC 9(07) COMP-3 VALUE 0. CL**6 00218 05 WRK-CWC-READ PIC 9(07) COMP-3 VALUE 0. CHGBD300 00219 05 WRK-DC-GOV-READ PIC 9(07) COMP-3 VALUE 0. CHGBD300 00220 CHGBD300 00221 01 REPORT-LINK-AREA. CHGBD300 00222 ++INCLUDE CHGIL001 CHGBD300 00223 CHGBD300 00224 01 L001-LINK-AREA. CHGBD300 00225 ++INCLUDE DTSIL001 CHGBD300 00226 EJECT CHGBD300 00227 01 L003-LINK-AREA. CHGBD300 00228 ++INCLUDE DTSIL003 CHGBD300 00229 EJECT CHGBD300 00230 01 L004-LINK-AREA. CHGBD300 00231 ++INCLUDE DTSIL004 CHGBD300 00232 EJECT CHGBD300 00233 01 L005-LINK-AREA. CHGBD300 00234 ++INCLUDE DTSIL005 CHGBD300 00235 EJECT CHGBD300 00236 01 L931-LINK-AREA. CHGBD300 00237 ++INCLUDE DTSIL931 CHGBD300 00238 SKIP3 CHGBD300 00239 01 FSKL-REC. CHGBD300 00240 ++INCLUDE DTSIFSKL CHGBD300 00241 SKIP3 CHGBD300 00242 01 FQTR-REC. CHGBD300 00243 ++INCLUDE DTSIFQTR CHGBD300 00244 EJECT CHGBD300 00245 LINKAGE SECTION. CHGBD300 00246 SKIP3 CHGBD300 00247 01 PARM-AREA. CHGBD300 00248 05 PARM-LENGTH PIC S9(04) COMP. CHGBD300 00249 05 PARM-DATA. CHGBD300 00250 10 PARM-SELF-INS-STEP PIC X(01). CHGBD300 00251 88 PARM-SELF-INS-STEP1-88 VALUE '1'. CHGBD300 00252 88 PARM-SELF-INS-STEP2-88 VALUE '2'. CHGBD300 00253 88 PARM-SELF-INS-VALID-88 VALUE '1' '2'. CHGBD300 00254 SKIP2 CHGBD300 00255 PROCEDURE DIVISION USING PARM-AREA. CHGBD300 00256 CHGBD300-MAIN. CHGBD300 00257 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD300 00258 IF WRK-ERROR-YES-88 CHGBD300 00259 DISPLAY '*** JOB CANCELLED DUE TO ERRORS ***' CHGBD300 00260 GO TO CHGBD300-EXIT. CHGBD300 00261 CHGBD300 00262 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD300 00263 CHGBD300 00264 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD300 00265 CHGBD300 00266 CHGBD300-EXIT. CHGBD300 00267 STOP RUN. CHGBD300 00268 EJECT CHGBD300 00269 I0000-INITIATE. CHGBD300 00270 MOVE ZERO TO WRK-BD220-CHG-READ CHGBD300 00271 WRK-BD220-CHG-SELECTED CHGBD300 00272 ** WRK-RATED-READ CHGBD300 00273 WRK-SELF-INS-READ CHGBD300 00274 WRK-FED-READ CHGBD300 00275 WRK-TEUC-READ CHGBD300 00276 WRK-FPUC-READ CL**7 00277 WRK-CWC-READ CHGBD300 00278 WRK-DC-GOV-READ. CHGBD300 00279 CHGBD300 00280 SET WRK-ERROR-NO-88 TO TRUE. CHGBD300 00281 CHGBD300 00282 PERFORM I0100-INPUT-PARM THRU I0100-EXIT. CHGBD300 00283 CHGBD300 00284 PERFORM I1000-READ-BD100-PARMS THRU I1000-EXIT. CHGBD300 00285 CHGBD300 00286 IF CHG3-RUN-TYPE-QTRLY-88 CHGBD300 00287 PERFORM I2000-CHK-QTR-STATUS THRU I2000-EXIT. CHGBD300 00288 CHGBD300 00289 PERFORM I4000-OPEN-CHARGE-FILE THRU I4000-EXIT. CHGBD300 00290 CHGBD300 00291 PERFORM I6000-INIT-REPORTS THRU I6000-EXIT. CHGBD300 00292 CHGBD300 00293 I0000-EXIT. CHGBD300 00294 EXIT. CHGBD300 00295 CHGBD300 00296 I0100-INPUT-PARM. CHGBD300 00297 IF PARM-LENGTH = +1 CHGBD300 00298 NEXT SENTENCE CHGBD300 00299 ELSE CHGBD300 00300 MOVE 'PARM-LENGTH NOT EQUAL TO 1' CHGBD300 00301 TO ABEND-MSG CHGBD300 00302 PERFORM S999-ABEND THRU S999-EXIT CHGBD300 00303 END-IF. CHGBD300 00304 CHGBD300 00305 IF PARM-SELF-INS-VALID-88 CHGBD300 00306 MOVE PARM-SELF-INS-STEP TO WRK-SELF-INS-STEP CHGBD300 00307 DISPLAY 'SELF INSURED JOB STEP ' WRK-SELF-INS-STEP CHGBD300 00308 ELSE CHGBD300 00309 STRING 'INVALID PARM ' PARM-SELF-INS-STEP CHGBD300 00310 DELIMITED BY SIZE CHGBD300 00311 INTO ABEND-MSG CHGBD300 00312 PERFORM S999-ABEND THRU S999-EXIT CHGBD300 00313 END-IF. CHGBD300 00314 I0100-EXIT. CHGBD300 00315 EXIT. CHGBD300 00316 CHGBD300 00317 I1000-READ-BD100-PARMS. CHGBD300 00318 OPEN INPUT CHG-PARM-FILE. CHGBD300 00319 IF NOT CHG-PARM-FILE-OK-88 CHGBD300 00320 DISPLAY 'CHG PARM FILE OPEN ERROR: ' CHG-PARM-STATUS CHGBD300 00321 SET WRK-ERROR-YES-88 TO TRUE CHGBD300 00322 GO TO I1000-EXIT. CHGBD300 00323 CHGBD300 00324 READ CHG-PARM-FILE. CHGBD300 00325 IF NOT CHG-PARM-FILE-OK-88 CHGBD300 00326 DISPLAY 'CHG-PARM READ ERROR: ' CHG-PARM-STATUS CHGBD300 00327 SET WRK-ERROR-YES-88 TO TRUE CHGBD300 00328 GO TO I1000-EXIT. CHGBD300 00329 CHGBD300 00330 IF WRK-SELF-INS-STEP2-88 CHGBD300 00331 IF CHG3-RUN-TYPE-QTRLY-88 CHGBD300 00332 NEXT SENTENCE CHGBD300 00333 ELSE CHGBD300 00334 DISPLAY 'STEP 1 NOT YET RUN FOR THIS QTR ' CHGBD300 00335 PERFORM S999-ABEND THRU S999-EXIT CHGBD300 00336 END-IF CHGBD300 00337 END-IF. CHGBD300 00338 CHGBD300 00339 I1000-EXIT. CHGBD300 00340 EXIT. CHGBD300 00341 CHGBD300 00342 I2000-CHK-QTR-STATUS. CHGBD300 00343 MOVE SPACE TO L931-TRACE-IND. CHGBD300 00344 MOVE 'CHGBD300' TO L931-MOD-NAME. CHGBD300 00345 CHGBD300 00346 PERFORM S931-OPEN-READ THRU S931-EXIT. CHGBD300 00347 IF L931-OK-88 CHGBD300 00348 NEXT SENTENCE CHGBD300 00349 ELSE CHGBD300 00350 DISPLAY 'CANNOT OPEN REF FILE ' CHGBD300 00351 PERFORM S999-ABEND THRU S999-EXIT. CHGBD300 00352 CHGBD300 00353 MOVE LOW-VALUES TO FQTR-KEY-AREA. CHGBD300 00354 CHGBD300 00355 SET FQTR-QTR-88 TO TRUE. CHGBD300 00356 CHGBD300 00357 MOVE CHG3-BEGIN-DATE TO L004-DATE. CHGBD300 00358 PERFORM S004-FROM-DATE THRU S004-EXIT. CHGBD300 00359 MOVE L004-QTR-5-9 TO FQTR-YRQ. CHGBD300 00360 CHGBD300 00361 MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA. CHGBD300 00362 CHGBD300 00363 PERFORM S931-READ THRU S931-EXIT. CHGBD300 00364 CHGBD300 00365 IF L931-NO-REC-88 CHGBD300 00366 PERFORM S931-CLOSE THRU S931-EXIT CHGBD300 00367 GO TO I2000-EXIT CHGBD300 00368 END-IF. CHGBD300 00369 CHGBD300 00370 MOVE FSKL-REC TO FQTR-REC. CHGBD300 00371 CHGBD300 00372 PERFORM S931-CLOSE THRU S931-EXIT. CHGBD300 00373 CHGBD300 00374 MOVE ZERO TO FQTR-SELF-INS-CHG-RUN-DATE. CL**3 00375 IF FQTR-SELF-INS-CHG-RUN-DATE NOT NUMERIC CHGBD300 00376 MOVE ZERO TO FQTR-SELF-INS-CHG-RUN-DATE. CHGBD300 00377 CHGBD300 00378 IF WRK-SELF-INS-STEP1-88 CHGBD300 00379 IF FQTR-SELF-INS-CHG-RUN-DATE = ZERO CHGBD300 00380 NEXT SENTENCE CHGBD300 00381 ELSE CHGBD300 00382 DISPLAY 'CHARGES ALREADY RUN FOR THIS QTR ' FQTR-YRQ CHGBD300 00383 PERFORM S999-ABEND THRU S999-EXIT CHGBD300 00384 END-IF CHGBD300 00385 END-IF. CHGBD300 00386 CHGBD300 00387 I2000-EXIT. CHGBD300 00388 EXIT. CHGBD300 00389 CHGBD300 00390 I4000-OPEN-CHARGE-FILE. CHGBD300 00391 OPEN INPUT BD220-CHG-FILE. CHGBD300 00392 IF NOT BD220-FILE-OK-88 CHGBD300 00393 DISPLAY 'BD220 FILE OPEN ERROR: ' BD220-CHG-STATUS CHGBD300 00394 SET WRK-ERROR-YES-88 TO TRUE. CHGBD300 00395 CHGBD300 00396 I4000-EXIT. CHGBD300 00397 EXIT. CHGBD300 00398 CHGBD300 00399 I6000-INIT-REPORTS. CHGBD300 00400 MOVE CHG3-BEGIN-DATE TO CHG-LINK1-PERIOD-BEGIN. CHGBD300 00401 MOVE CHG3-END-DATE TO CHG-LINK1-PERIOD-END. CHGBD300 00402 MOVE CHG3-RUN-TYPE TO CHG-LINK1-RUN-TYPE. CHGBD300 00403 CHGBD300 00404 SET CHG-LINK1-CMD-INIT-88 TO TRUE. CHGBD300 00405 CHGBD300 00406 IF WRK-SELF-INS-STEP1-88 CHGBD300 00407 SET CHG-LINK1-SELF-INS-STEP1-88 TO TRUE CHGBD300 00408 ELSE CHGBD300 00409 SET CHG-LINK1-SELF-INS-STEP2-88 TO TRUE CHGBD300 00410 END-IF. CHGBD300 00411 CHGBD300 00412 *& CHGBD300 00413 DISPLAY 'BD300 RUN/REPORT TYPE: ' CHG-LINK1-RUN-TYPE CL*15 00414 ' ' CHG3-RPT-TYPES. CL*15 00415 CL*15 00416 DISPLAY 'BD300 I6 LINK1 SI STEP ' CL*15 00417 CHG-LINK1-SELF-INS-STEP. CHGBD300 00418 DISPLAY ' WRK STEP ' WRK-SELF-INS-STEP. CHGBD300 00419 *& CHGBD300 00420 *** IF CHG3-RPT-TYPE-RATED-88 CHGBD300 00421 * SET RATED-MOD TO TRUE CHGBD300 00422 *** PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00423 CHGBD300 00424 IF CHG3-RPT-TYPE-SELF-INS-88 CL**7 00425 SET SELF-INS-MOD TO TRUE CHGBD300 00426 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00427 CHGBD300 00428 IF CHG3-RUN-TYPE-QTRLY-88 CL**7 00429 SET TPS-UNIV-MOD TO TRUE CHGBD300 00430 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00431 SET T026-TAX-MOD TO TRUE CHGBD300 00432 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00433 END-IF. CHGBD300 00434 CHGBD300 00435 IF CHG3-RPT-TYPE-CWC-88 CL**7 00436 DISPLAY ' CHG3 REPORT CWC ' CHG3-RPT-TYPES CL**8 00437 SET CWC-MOD TO TRUE CHGBD300 00438 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00439 CHGBD300 00440 IF CHG3-RPT-TYPE-FED-88 CHGBD300 00441 DISPLAY ' CHG3 REPORT FED ' CHG3-RPT-TYPES CL**8 00442 SET FEDERAL-MOD TO TRUE CHGBD300 00443 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00444 CHGBD300 00445 IF CHG3-RPT-TYPE-TEUC-88 CHGBD300 00446 DISPLAY ' CHG3 REPORT TECU ' CHG3-RPT-TYPES CL**8 00447 SET TEUC-MOD TO TRUE CHGBD300 00448 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00449 CL**6 00450 * IF CHG3-RPT-TYPE-FPUC-88 CL*16 00451 * DISPLAY ' CHG3 REPORT FPUC ' CHG3-RPT-TYPES CL*16 00452 * SET FPUC-MOD TO TRUE CL*16 00453 * PERFORM S2000-CALL THRU S2000-EXIT. CL*16 00454 CHGBD300 00455 IF CHG3-RPT-TYPE-DC-88 CHGBD300 00456 DISPLAY ' CHG3 REPORT DC ' CHG3-RPT-TYPES CL**8 00457 SET DC-GOV-MOD TO TRUE CHGBD300 00458 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00459 CHGBD300 00460 I6000-EXIT. CHGBD300 00461 EXIT. CHGBD300 00462 CHGBD300 00463 CHGBD300 00464 P0000-PROCESS. CHGBD300 00465 PERFORM P1000-READ-CHARGES THRU P1000-EXIT CHGBD300 00466 UNTIL BD220-FILE-EOF-88 CHGBD300 00467 OR WRK-ERROR-YES-88. CHGBD300 00468 CHGBD300 00469 P0000-EXIT. CHGBD300 00470 EXIT. CHGBD300 00471 CHGBD300 00472 P1000-READ-CHARGES. CHGBD300 00473 PERFORM S1000-READ-CHG-FILE THRU S1000-EXIT. CHGBD300 00474 IF BD220-FILE-EOF-88 CHGBD300 00475 OR WRK-ERROR-YES-88 CHGBD300 00476 GO TO P1000-EXIT. CHGBD300 00477 CHGBD300 00478 PERFORM P2000-CALL-REPORT THRU P2000-EXIT. CHGBD300 00479 CHGBD300 00480 P1000-EXIT. CHGBD300 00481 EXIT. CHGBD300 00482 CHGBD300 00483 P2000-CALL-REPORT. CHGBD300 00484 SET CHG-LINK1-CMD-PROCESS-88 TO TRUE. CHGBD300 00485 CHGBD300 00486 IF WRK-SELF-INS-STEP1-88 CHGBD300 00487 PERFORM P2100-STEP1 THRU P2100-EXIT CHGBD300 00488 ELSE CHGBD300 00489 PERFORM P2200-STEP2 THRU P2200-EXIT CHGBD300 00490 END-IF. CHGBD300 00491 CHGBD300 00492 P2000-EXIT. CHGBD300 00493 EXIT. CHGBD300 00494 CHGBD300 00495 P2100-STEP1. CHGBD300 00496 EVALUATE TRUE CHGBD300 00497 WHEN CHG4-RPT-TYPE-SELF-INS-88 CHGBD300 00498 IF (CHG3-RUN-TYPE-QTRLY-88 CHGBD300 00499 AND CHG4-EMP-TYPE = 08) CHGBD300 00500 SET TPS-UNIV-MOD TO TRUE CHGBD300 00501 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00502 SET T026-TAX-MOD TO TRUE CHGBD300 00503 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00504 ELSE CHGBD300 00505 SET SELF-INS-MOD TO TRUE CHGBD300 00506 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00507 END-IF CHGBD300 00508 CHGBD300 00509 WHEN CHG4-RPT-TYPE-CWC-88 CHGBD300 00510 ADD +1 TO WRK-CWC-READ CHGBD300 00511 SET CWC-MOD TO TRUE CHGBD300 00512 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00513 CHGBD300 00514 *** WHEN CHG4-RPT-TYPE-RATED-88 CHGBD300 00515 * ADD +1 TO WRK-RATED-READ CHGBD300 00516 * SET RATED-MOD TO TRUE CHGBD300 00517 *** PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00518 CHGBD300 00519 WHEN CHG4-RPT-TYPE-FED-88 CHGBD300 00520 IF CHG4-PROG-UI CHGBD300 00521 ADD +1 TO WRK-FED-READ CHGBD300 00522 SET FEDERAL-MOD TO TRUE CHGBD300 00523 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00524 END-IF CHGBD300 00525 CHGBD300 00526 WHEN CHG4-RPT-TYPE-TEUC-88 CHGBD300 00527 ADD +1 TO WRK-TEUC-READ CHGBD300 00528 SET TEUC-MOD TO TRUE CHGBD300 00529 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00530 CHGBD300 00531 WHEN CHG4-RPT-TYPE-DC-88 CHGBD300 00532 ADD +1 TO WRK-DC-GOV-READ CHGBD300 00533 SET DC-GOV-MOD TO TRUE CHGBD300 00534 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00535 CL**6 00536 * WHEN CHG4-RPT-TYPE-FPUC-88 CL*16 00537 * ADD +1 TO WRK-FPUC-READ CL*16 00538 * SET FPUC-MOD TO TRUE CL*16 00539 * DISPLAY 'FPUC REPORT TYPE CALLED: ' CHG4-REPORT-TYPE CL*16 00540 * PERFORM S2000-CALL THRU S2000-EXIT CL*16 00541 CHGBD300 00542 WHEN CHG4-RPT-TYPE-NULL-88 CHGBD300 00543 SET PGM-NULL-MOD TO TRUE CHGBD300 00544 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00545 CHGBD300 00546 WHEN OTHER CHGBD300 00547 DISPLAY 'INVALID REPORT TYPE ' CHG4-REPORT-TYPE CHGBD300 00548 GO TO P2000-EXIT CHGBD300 00549 CHGBD300 00550 END-EVALUATE. CHGBD300 00551 CHGBD300 00552 ADD 1 TO WRK-BD220-CHG-SELECTED. CHGBD300 00553 CHGBD300 00554 P2100-EXIT. CHGBD300 00555 EXIT. CHGBD300 00556 CHGBD300 00557 P2200-STEP2. CHGBD300 00558 IF CHG4-RPT-TYPE-SELF-INS-88 CHGBD300 00559 IF (CHG3-RUN-TYPE-QTRLY-88 CHGBD300 00560 AND CHG4-EMP-TYPE = 08) CHGBD300 00561 ADD +1 TO WRK-SELF-INS-READ CHGBD300 00562 SET SELF-INS-MOD TO TRUE CHGBD300 00563 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00564 END-IF CHGBD300 00565 END-IF. CHGBD300 00566 CHGBD300 00567 P2200-EXIT. CHGBD300 00568 EXIT. CHGBD300 00569 CHGBD300 00570 P2110-SELF-INS. CHGBD300 00571 ADD +1 TO WRK-SELF-INS-READ. CHGBD300 00572 IF (CHG3-RUN-TYPE-QTRLY-88 CHGBD300 00573 AND CHG4-EMP-TYPE = 08) CHGBD300 00574 IF WRK-SELF-INS-STEP1-88 CHGBD300 00575 SET TPS-UNIV-MOD TO TRUE CHGBD300 00576 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00577 SET T026-TAX-MOD TO TRUE CHGBD300 00578 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00579 ELSE CHGBD300 00580 SET SELF-INS-MOD TO TRUE CHGBD300 00581 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00582 END-IF CHGBD300 00583 ELSE CHGBD300 00584 SET SELF-INS-MOD TO TRUE CHGBD300 00585 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00586 END-IF. CHGBD300 00587 CHGBD300 00588 P2110-EXIT. CHGBD300 00589 EXIT. CHGBD300 00590 CHGBD300 00591 T0000-TERMINATE. CHGBD300 00592 PERFORM T1000-CLOSE-REPORTS THRU T1000-EXIT. CHGBD300 00593 CHGBD300 00594 PERFORM T3000-CLOSE-FILES THRU T3000-EXIT. CHGBD300 00595 CHGBD300 00596 DISPLAY '*********************************************'. CHGBD300 00597 DISPLAY '** BD300 COUNTS **'. CHGBD300 00598 DISPLAY SPACE. CHGBD300 00599 DISPLAY ' CHGBD220 CHARGE RECORDS READ: ' CHGBD300 00600 WRK-BD220-CHG-READ. CHGBD300 00601 DISPLAY ' CHGBD220 CHARGE RECORDS SELECTED: ' CHGBD300 00602 WRK-BD220-CHG-SELECTED. CHGBD300 00603 ** DISPLAY ' RATED RECORDS PASSED : ' CHGBD300 00604 ** WRK-RATED-READ. CHGBD300 00605 DISPLAY ' SELF INSURED RECORDS PASSED : ' CHGBD300 00606 WRK-SELF-INS-READ. CHGBD300 00607 DISPLAY ' CWC RECORDS PASSED : ' CHGBD300 00608 WRK-CWC-READ. CHGBD300 00609 DISPLAY ' FEDERAL RECORDS PASSED : ' CHGBD300 00610 WRK-FED-READ. CHGBD300 00611 DISPLAY ' TEUC RECORDS PASSED : ' CHGBD300 00612 WRK-TEUC-READ. CHGBD300 00613 DISPLAY ' DC GOV RECORDS PASSED : ' CHGBD300 00614 WRK-DC-GOV-READ. CHGBD300 00615 DISPLAY ' FPUC RECORDS PASSED : ' CL**9 00616 WRK-FPUC-READ. CL*10 00617 CHGBD300 00618 ** DISPLAY SPACE. CHGBD300 00619 * MOVE WRK-RPT-TYPE-RATED TO WRK-RPT-TYPE-RATED-DISP. CHGBD300 00620 * DISPLAY 'TOTAL REPORT TYPE RATED : ' CHGBD300 00621 ** WRK-RPT-TYPE-RATED-DISP. CHGBD300 00622 CHGBD300 00623 DISPLAY SPACE. CHGBD300 00624 MOVE WRK-RPT-TYPE-SELF-INS TO WRK-RPT-TYPE-SELF-INS-DISP. CHGBD300 00625 DISPLAY 'TOTAL REPORT TYPE SELF-INS : ' CHGBD300 00626 WRK-RPT-TYPE-SELF-INS-DISP. CHGBD300 00627 CHGBD300 00628 DISPLAY SPACE. CHGBD300 00629 MOVE WRK-RPT-TYPE-CWC TO WRK-RPT-TYPE-CWC-DISP. CHGBD300 00630 DISPLAY 'TOTAL REPORT TYPE CWC : ' CHGBD300 00631 WRK-RPT-TYPE-CWC-DISP. CHGBD300 00632 CHGBD300 00633 DISPLAY SPACE. CHGBD300 00634 MOVE WRK-RPT-TYPE-FED TO WRK-RPT-TYPE-FED-DISP. CHGBD300 00635 DISPLAY 'TOTAL REPORT TYPE FED : ' CHGBD300 00636 WRK-RPT-TYPE-FED-DISP. CHGBD300 00637 CHGBD300 00638 DISPLAY SPACE. CHGBD300 00639 MOVE WRK-RPT-TYPE-TEUC TO WRK-RPT-TYPE-TEUC-DISP. CHGBD300 00640 DISPLAY 'TOTAL REPORT TYPE TEUC : ' CHGBD300 00641 WRK-RPT-TYPE-TEUC-DISP. CHGBD300 00642 CHGBD300 00643 DISPLAY SPACE. CHGBD300 00644 MOVE WRK-RPT-TYPE-DC-GOV CHGBD300 00645 TO WRK-RPT-TYPE-DC-GOV-DISP. CHGBD300 00646 DISPLAY 'TOTAL DC GOVERNMENT : ' CHGBD300 00647 WRK-RPT-TYPE-DC-GOV-DISP. CHGBD300 00648 CHGBD300 00649 DISPLAY SPACE. CL**6 00650 MOVE WRK-RPT-TYPE-FPUC TO WRK-RPT-TYPE-FPUC-DISP. CL**6 00651 DISPLAY 'TOTAL REPORT TYPE FPUC : ' CL**6 00652 WRK-RPT-TYPE-FPUC-DISP. CL**6 00653 CL**6 00654 ** DISPLAY SPACE. CHGBD300 00655 ** MOVE WRK-RATED-TOT CHGBD300 00656 ** TO WRK-RATED-TOT-DISP. CHGBD300 00657 ** DISPLAY 'TOTAL CHARGE : ' CHGBD300 00658 ** WRK-RATED-TOT-DISP. CHGBD300 00659 CHGBD300 00660 T0000-EXIT. CHGBD300 00661 EXIT. CHGBD300 00662 CHGBD300 00663 T1000-CLOSE-REPORTS. CHGBD300 00664 SET CHG-LINK1-CMD-CLOSE-88 TO TRUE. CHGBD300 00665 CHGBD300 00666 *** IF CHG3-RPT-TYPE-RATED-88 CHGBD300 00667 * SET RATED-MOD TO TRUE CHGBD300 00668 *** PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00669 CHGBD300 00670 IF CHG3-RPT-TYPE-SELF-INS-88 CHGBD300 00671 SET SELF-INS-MOD TO TRUE CHGBD300 00672 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00673 IF CHG3-RUN-TYPE-QTRLY-88 CHGBD300 00674 SET TPS-UNIV-MOD TO TRUE CHGBD300 00675 PERFORM S2000-CALL THRU S2000-EXIT CHGBD300 00676 SET T026-TAX-MOD TO TRUE CHGBD300 00677 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00678 CHGBD300 00679 IF CHG3-RPT-TYPE-CWC-88 CHGBD300 00680 SET CWC-MOD TO TRUE CHGBD300 00681 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00682 CHGBD300 00683 IF CHG3-RPT-TYPE-FED-88 CHGBD300 00684 SET FEDERAL-MOD TO TRUE CHGBD300 00685 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00686 CHGBD300 00687 IF CHG3-RPT-TYPE-TEUC-88 CHGBD300 00688 SET TEUC-MOD TO TRUE CHGBD300 00689 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00690 CHGBD300 00691 IF CHG3-RPT-TYPE-DC-88 CHGBD300 00692 SET DC-GOV-MOD TO TRUE CHGBD300 00693 PERFORM S2000-CALL THRU S2000-EXIT. CHGBD300 00694 CHGBD300 00695 IF CHG3-RPT-TYPE-FPUC-88 CL**6 00696 SET FPUC-MOD TO TRUE CL**6 00697 DISPLAY 'REPORT TYPE TEUC CLOSED: ' CL**9 00698 PERFORM S2000-CALL THRU S2000-EXIT. CL**6 00699 CL**6 00700 T1000-EXIT. CHGBD300 00701 EXIT. CHGBD300 00702 EJECT CHGBD300 00703 EJECT CHGBD300 00704 T3000-CLOSE-FILES. CHGBD300 00705 CLOSE BD220-CHG-FILE. CHGBD300 00706 CHGBD300 00707 CLOSE CHG-PARM-FILE. CHGBD300 00708 CHGBD300 00709 T3000-EXIT. CHGBD300 00710 EXIT. CHGBD300 00711 CHGBD300 00712 S001-FROM-FED-8. CHGBD300 00713 SET L001-FROM-FED-8 TO TRUE. CHGBD300 00714 GO TO S001-DATE. CHGBD300 00715 CHGBD300 00716 S001-FROM-ABS. CHGBD300 00717 SET L001-FROM-ABS-DAY TO TRUE. CHGBD300 00718 GO TO S001-DATE. CHGBD300 00719 CHGBD300 00720 S001-DATE. CHGBD300 00721 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD300 00722 S001-EXIT. CHGBD300 00723 EXIT. CHGBD300 00724 CHGBD300 00725 S003-AGENCY-DAY. CHGBD300 00726 SET L003-AGENCY-DAY TO TRUE. CHGBD300 00727 GO TO S003-WORK-DAY. CHGBD300 00728 CHGBD300 00729 S003-WORK-DAY. CHGBD300 00730 CALL 'DTSBU003' USING L003-LINK-AREA. CHGBD300 00731 S003-EXIT. CHGBD300 00732 EXIT. CHGBD300 00733 CHGBD300 00734 S004-FROM-DATE. CHGBD300 00735 SET L004-FROM-DATE TO TRUE. CHGBD300 00736 GO TO S004-YRQ. CHGBD300 00737 CHGBD300 00738 S004-YRQ. CHGBD300 00739 CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD300 00740 S004-EXIT. CHGBD300 00741 EXIT. CHGBD300 00742 CHGBD300 00743 S005-FROM-SYS. CHGBD300 00744 SET L005-FROM-SYS TO TRUE. CHGBD300 00745 GO TO S005-ABSTIME. CHGBD300 00746 CHGBD300 00747 S005-ABSTIME. CHGBD300 00748 CALL 'DTSBU005' USING L005-LINK-AREA. CHGBD300 00749 S005-EXIT. CHGBD300 00750 EXIT. CHGBD300 00751 CHGBD300 00752 S931-OPEN-READ. CHGBD300 00753 SET L931-OPEN-READ-88 TO TRUE. CHGBD300 00754 GO TO S931-REF-I. CHGBD300 00755 CHGBD300 00756 S931-READ. CHGBD300 00757 SET L931-READ-88 TO TRUE. CHGBD300 00758 GO TO S931-REF-I. CHGBD300 00759 CHGBD300 00760 S931-CLOSE. CHGBD300 00761 SET L931-CLOSE-88 TO TRUE. CHGBD300 00762 GO TO S931-REF-I. CHGBD300 00763 CHGBD300 00764 S931-REF-I. CHGBD300 00765 CALL 'DTSBU931' USING L931-LINK-AREA CHGBD300 00766 FSKL-REC. CHGBD300 00767 S931-EXIT. CHGBD300 00768 EXIT. CHGBD300 00769 CHGBD300 00770 S1000-READ-CHG-FILE. CHGBD300 00771 READ BD220-CHG-FILE. CHGBD300 00772 IF BD220-FILE-OK-88 CHGBD300 00773 ADD 1 TO WRK-BD220-CHG-READ CHGBD300 00774 PERFORM S1200-TEST-TOTALS THRU S1200-EXIT CHGBD300 00775 ELSE CHGBD300 00776 IF BD220-FILE-EOF-88 CHGBD300 00777 NEXT SENTENCE CHGBD300 00778 ELSE CHGBD300 00779 DISPLAY 'BD220 FILE READ ERROR: ' BD220-CHG-STATUS CHGBD300 00780 SET WRK-ERROR-YES-88 TO TRUE CHGBD300 00781 END-IF CHGBD300 00782 END-IF. CHGBD300 00783 CHGBD300 00784 S1000-EXIT. CHGBD300 00785 EXIT. CHGBD300 00786 CHGBD300 00787 S1200-TEST-TOTALS. CHGBD300 00788 CHGBD300 00789 EVALUATE TRUE CHGBD300 00790 ** WHEN CHG4-RPT-TYPE-RATED-88 CHGBD300 00791 * COMPUTE WRK-RPT-TYPE-RATED = WRK-RPT-TYPE-RATED CHGBD300 00792 * + CHG4-CURR-BEN-AMT CHGBD300 00793 ** + CHG4-CURR-ADJ-AMT CHGBD300 00794 CHGBD300 00795 WHEN CHG4-RPT-TYPE-SELF-INS-88 CHGBD300 00796 COMPUTE WRK-RPT-TYPE-SELF-INS = WRK-RPT-TYPE-SELF-INS CHGBD300 00797 + CHG4-CURR-BEN-AMT CHGBD300 00798 + CHG4-CURR-ADJ-AMT CHGBD300 00799 CHGBD300 00800 WHEN CHG4-RPT-TYPE-CWC-88 CHGBD300 00801 COMPUTE WRK-RPT-TYPE-CWC = WRK-RPT-TYPE-CWC CHGBD300 00802 + CHG4-CURR-BEN-AMT CHGBD300 00803 + CHG4-CURR-ADJ-AMT CHGBD300 00804 CHGBD300 00805 WHEN CHG4-RPT-TYPE-FED-88 CHGBD300 00806 COMPUTE WRK-RPT-TYPE-FED = WRK-RPT-TYPE-FED CHGBD300 00807 + CHG4-CURR-BEN-AMT CHGBD300 00808 + CHG4-CURR-ADJ-AMT CHGBD300 00809 CHGBD300 00810 WHEN CHG4-RPT-TYPE-TEUC-88 CHGBD300 00811 COMPUTE WRK-RPT-TYPE-TEUC = WRK-RPT-TYPE-TEUC CHGBD300 00812 + CHG4-CURR-BEN-AMT CHGBD300 00813 + CHG4-CURR-ADJ-AMT CHGBD300 00814 CL**6 00815 WHEN CHG4-RPT-TYPE-FPUC-88 CL**6 00816 COMPUTE WRK-RPT-TYPE-FPUC = WRK-RPT-TYPE-FPUC CL**6 00817 + CHG4-CURR-BEN-AMT CL**6 00818 + CHG4-CURR-ADJ-AMT CL**6 00819 CHGBD300 00820 WHEN CHG4-RPT-TYPE-DC-88 CHGBD300 00821 COMPUTE WRK-RPT-TYPE-DC-GOV = WRK-RPT-TYPE-DC-GOV CHGBD300 00822 + CHG4-CURR-BEN-AMT CHGBD300 00823 + CHG4-CURR-ADJ-AMT CHGBD300 00824 CHGBD300 00825 END-EVALUATE. CHGBD300 00826 CHGBD300 00827 ** COMPUTE WRK-RATED-TOT = WRK-RATED-TOT CHGBD300 00828 * + CHG4-CURR-BEN-AMT CHGBD300 00829 ** + CHG4-CURR-ADJ-AMT. CHGBD300 00830 CHGBD300 00831 IF WRK-EMP-NO = ZERO CHGBD300 00832 MOVE CHG4-EMP-NO TO WRK-EMP-NO CHGBD300 00833 COMPUTE WRK-EMP-TOT = CHGBD300 00834 CHG4-CURR-BEN-AMT CHGBD300 00835 + CHG4-CURR-ADJ-AMT CHGBD300 00836 ELSE CHGBD300 00837 IF CHG4-EMP-NO NOT = WRK-EMP-NO CHGBD300 00838 MOVE WRK-EMP-TOT TO WRK-EMP-TOT-DISP CHGBD300 00839 *& DISPLAY 'CHGBD300 TOT ' WRK-EMP-NO CHGBD300 00840 *& ' ' WRK-EMP-TOT-DISP CHGBD300 00841 MOVE CHG4-EMP-NO TO WRK-EMP-NO CHGBD300 00842 COMPUTE WRK-EMP-TOT = CHGBD300 00843 CHG4-CURR-BEN-AMT CHGBD300 00844 + CHG4-CURR-ADJ-AMT CHGBD300 00845 ELSE CHGBD300 00846 COMPUTE WRK-EMP-TOT = WRK-EMP-TOT CHGBD300 00847 + CHG4-CURR-BEN-AMT CHGBD300 00848 + CHG4-CURR-ADJ-AMT CHGBD300 00849 END-IF CHGBD300 00850 END-IF. CHGBD300 00851 S1200-EXIT. CHGBD300 00852 EXIT. CHGBD300 00853 CHGBD300 00854 S2000-CALL. CHGBD300 00855 *& CHGBD300 00856 * IF CHG-LINK1-CMD-PROCESS-88 CHGBD300 00857 * COMPUTE WRK-EMP-TOT = CHGBD300 00858 * CHG4-CURR-BEN-AMT CHGBD300 00859 * + CHG4-CURR-ADJ-AMT. CHGBD300 00860 * MOVE WRK-EMP-TOT TO WRK-EMP-TOT-DISP CHGBD300 00861 * IF CHG4-SSN = 002545648 CHGBD300 00862 * DISPLAY 'BD300 ' WRK-REPORT-MOD CL*12 00863 * ' ' CHG4-REPORT-TYPE CL*12 00864 * ' ' CHG4-EMP-NO CL*12 00865 * ' ' CHG4-SSN CL*12 00866 * ' ' WRK-EMP-TOT-DISP. CL*12 00867 *& CHGBD300 00868 DISPLAY ' REPORT BEING CALLED:' WRK-REPORT-MOD CL*13 00869 *& CL*10 00870 CALL WRK-REPORT-MOD USING REPORT-LINK-AREA CHGBD300 00871 BD220-CHG-REC. CHGBD300 00872 S2000-EXIT. CHGBD300 00873 EXIT. CHGBD300 00874 CHGBD300 00875 S999-ABEND. CHGBD300 00876 DISPLAY '**** CHGBD300 ABENDING ' CHGBD300 00877 ABEND-MSG. CHGBD300 00878 CALL 'DTSBU999' USING ABEND-CODE. CHGBD300 00879 S999-EXIT. CHGBD300 00880 EXIT. CHGBD300