882 lines
70 KiB
COBOL
882 lines
70 KiB
COBOL
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
|