DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
881
Batch/CHGBD300.cob
Normal file
881
Batch/CHGBD300.cob
Normal file
@ -0,0 +1,881 @@
|
||||
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
|
||||
Reference in New Issue
Block a user