Files
DUTAS/Batch/CHGBD301.cob
2025-07-21 11:20:11 -04:00

387 lines
30 KiB
COBOL

00001 IDENTIFICATION DIVISION. 10/06/14
00002 PROGRAM-ID. CHGBD301. CHGBD301
00003 *AUTHOR. TCL. LV002
00004 *DATE-WRITTEN. FEBRUARY 1999. CHGBD301
00005 DATE-COMPILED. CHGBD301
00006 SKIP3 CHGBD301
00007 ***** CHGBD301
00008 * CHGBD301
00009 * CHGBD301
00010 * FUNCTION: CHGBD301
00011 * CHGBD301
00012 * CHARGE PRINT DRIVER CHGBD301
00013 * CHGBD301
00014 ***** CHGBD301
00015 * CHGBD301
00016 * DESCRIPTION: CHGBD301
00017 * CHGBD301
00018 * DRIVER FOR BENEFIT CHARGE REPORTING PRINT PROCESS. CHGBD301
00019 * CHGBD301 READS RECORDS SELECTED BY CHGBD210 AND CHGBD301
00020 * BD220, AND CALLS THE APPROPRIATE REPORT PROGRAM. CHGBD301
00021 * CHGBD301
00022 ***** CHGBD301
00023 * CHGBD301
00024 * INPUT: CHGBD301
00025 * CHGBD301
00026 * BD220CHG - CHARGE RECORDS GENERATED BY CHGBD220. CHGBD301
00027 * CHGBD301
00028 * CHGPARM - PARAMETER DATA INPUT FROM CHGBD210 CHGBD301
00029 * CHGBD301
00030 ****** CHGBD301
00031 * CHGBD301
00032 * OUTPUT: CHGBD301
00033 * CHGBD301
00034 * RPC100R1 - PRINT RATED NOTICES. CHGBD301
00035 * RPC100R3 - PRINT RATED BENEFIT CHARGE SPECIAL REPORT CHGBD301
00036 * RPC110R1 - PRINT SELF-INSURED BILLS CHGBD301
00037 * RPC110R2 - SELF-INSURED QUARTERLY/ANNUAL CHARGE SUMMARY REPORTCHGBD301
00038 * AND BENEFIT CHARGE SPECIAL REPORT CHGBD301
00039 * RPC120R1 - CWC QUARTERLY/ANNUAL CHARGE SUMMARY REPORT CHGBD301
00040 * AND BENEFIT CHARGE SPECIAL REPORT CHGBD301
00041 * RPC130R1 - FEDERAL QUARTERLY/ANNUAL CHARGE SUMMARY REPORT CHGBD301
00042 * AND BENEFIT CHARGE SPECIAL REPORT CHGBD301
00043 * RPC150R1 - TEUC QUARTERLY/ANNUAL CHARGE SUMMARY REPORT CHGBD301
00044 * AND BENEFIT CHARGE SPECIAL REPORT CHGBD301
00045 * RPC160R1 - DC GOVERNMENT CHARGE SUMMARY REPORT CHGBD301
00046 * CHGBD301
00047 ***** CHGBD301
00048 ***************************************************************** CHGBD301
00049 * * CHGBD301
00050 * MODIFICATION HISTORY: * CHGBD301
00051 * * CHGBD301
00052 * 05-05-1999 NEW DEVELOPMENT * CHGBD301
00053 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD301
00054 * * CHGBD301
00055 * 06-25-2001 MODIFIED FOR NEW REPORTING PROCESS. * CHGBD301
00056 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD301
00057 * * CHGBD301
00058 * 06-25-2001 MODIFIED TO OUTPUT TEUC RPC150R1 REPORT. * CHGBD301
00059 * REFERENCE RFP # AUTHOR OF CHANGE - RW1* CHGBD301
00060 * * CHGBD301
00061 * 09-04-2003 MODIFIED TO OUTPUT DC RPC160R1 REPORT. * CHGBD301
00062 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD301
00063 * * CHGBD301
00064 * 04-15-2004 MODIFIED TO PRINT SELF-INSURED BILLS AFTER * CHGBD301
00065 * THE DAILY UPDATE IN ORDER TO CORRECTLY ACCOUNT * CHGBD301
00066 * FOR CREDITS. CHGBD301
00067 * STEP 1 OF THE CHARGE REPORTING PROCESS RUNS * CHGBD301
00068 * PRIOR TO THE DAILY UPDATE, GENERATING ACCOUNTING * CHGBD301
00069 * TRANSACTION WITH THE SELF-INS CHARGES. THIS STEP * CHGBD301
00070 * PRINTS ALL REPORTS EXCEPT FOR THE SELF INS EMPS. * CHGBD301
00071 * STEP 2 RUNS FOLLOWING THE DAILY UPDATE, AND * CHGBD301
00072 * EXECUTES THE PRINT PROCESS (CHGBD301) TO PRODUCE * CHGBD301
00073 * THE SELF-INSURED REPORTS. THIS PROCESS CHECKS THE * CHGBD301
00074 * ACTUAL BALANCE DUE ON THE TAX FILE AND PRINTS THIS * CHGBD301
00075 * AMOUNT ON THE BILL. * CHGBD301
00076 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD301
00077 * * CHGBD301
00078 * 07-15-2004 CORRECTED PROBLEM IN I2000 EDITS - FQTR NOT * CHGBD301
00079 * YET UPDATED WHEN STEP 2 BEGINS. P1000 NOW * CHGBD301
00080 * VERIFIES THAT STEP 1 HAS BEEN RUN. * CHGBD301
00081 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD301
00082 * * CHGBD301
00083 * 04-03-2009 RECOMPILED FOR NEW VERSION OF CHGIM004. * CHGBD301
00084 * REFERENCE RFP # AUTHOR OF CHANGE - GD * CHGBD301
00085 * * CHGBD301
00086 * * CHGBD301
00087 * 07-07-2009 CHANGED PROGRAM TO WRITE TPS SAMPLE RECORDS. * CHGBD301
00088 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1* CHGBD301
00089 * * CHGBD301
00090 * * CHGBD301
00091 * 05-14-2010 RECOMPILED FOR NEW VERSION OF CHGIM004. * CHGBD301
00092 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1* CHGBD301
00093 * * CHGBD301
00094 * * CL**2
00095 * 05-14-2010 RECOMPILED FOR NEW VERSION OF CHGIM004. * CL**2
00096 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1* CL**2
00097 * * CL**2
00098 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * CHGBD301
00099 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * CHGBD301
00100 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** * CHGBD301
00101 ***************************************************************** CHGBD301
00102 CHGBD301
00103 SKIP3 CHGBD301
00104 ENVIRONMENT DIVISION. CHGBD301
00105 SKIP3 CHGBD301
00106 INPUT-OUTPUT SECTION. CHGBD301
00107 SKIP3 CHGBD301
00108 FILE-CONTROL. CHGBD301
00109 CHGBD301
00110 SELECT CHG-PARM-FILE ASSIGN TO CHGPARM CHGBD301
00111 FILE STATUS IS CHG-PARM-STATUS. CHGBD301
00112 CHGBD301
00113 SELECT BD220-CHG-FILE ASSIGN TO BD220CHG CHGBD301
00114 FILE STATUS IS BD220-CHG-STATUS. CHGBD301
00115 EJECT CHGBD301
00116 DATA DIVISION. CHGBD301
00117 SKIP3 CHGBD301
00118 FILE SECTION. CHGBD301
00119 SKIP3 CHGBD301
00120 CHGBD301
00121 FD CHG-PARM-FILE CHGBD301
00122 RECORDING MODE IS F CHGBD301
00123 BLOCK CONTAINS 0 CHARACTERS. CHGBD301
00124 SKIP1 CHGBD301
00125 01 CHG-PARM-REC. CHGBD301
00126 ++INCLUDE CHGIM003 CHGBD301
00127 CHGBD301
00128 FD BD220-CHG-FILE CHGBD301
00129 LABEL RECORDS ARE STANDARD CHGBD301
00130 BLOCK CONTAINS 0 CHARACTERS. CHGBD301
00131 SKIP1 CHGBD301
00132 01 BD220-CHG-REC. CHGBD301
00133 ++INCLUDE CHGIM004 CHGBD301
00134 EJECT CHGBD301
00135 WORKING-STORAGE SECTION. CHGBD301
001355 77 PAN-VALET PICTURE X(24) VALUE '002CHGBD301 10/06/14'. CHGBD301
00136 77 PAN-VALET PICTURE X(24) VALUE '009CHGBD301 05/25/10'. CHGBD301
00137 CHGBD301
00138 01 WRK-AREA. CHGBD301
00139 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. CHGBD301
00140 05 WRK-EMP-TOT PIC S9(08)V99 COMP-3 CHGBD301
00141 VALUE +0. CHGBD301
00142 CHGBD301
00143 05 WRK-RPT-TYPE-RATED PIC S9(09)V99 COMP-3 VALUE +0.CHGBD301
00144 05 WRK-RPT-TYPE-RATED-DISP PIC Z9(08)9.99-. CHGBD301
00145 CHGBD301
00146 05 ABEND-CODE PIC S9(04) COMP CHGBD301
00147 VALUE +300. CHGBD301
00148 05 ABEND-MSG PIC X(60). CHGBD301
00149 CHGBD301
00150 05 CHG-PARM-STATUS PIC X(02) VALUE SPACES. CHGBD301
00151 88 CHG-PARM-FILE-OK-88 VALUE ZERO. CHGBD301
00152 88 CHG-PARM-FILE-EOF-88 VALUE '10'. CHGBD301
00153 05 BD220-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD301
00154 88 BD220-FILE-OK-88 VALUE ZERO. CHGBD301
00155 88 BD220-FILE-EOF-88 VALUE '10'. CHGBD301
00156 CHGBD301
00157 05 WRK-ERROR-IND PIC X(01). CHGBD301
00158 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD301
00159 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD301
00160 CHGBD301
00161 05 WRK-EMP-FOUND-IND PIC X(01). CHGBD301
00162 88 WRK-EMP-FOUND-YES-88 VALUE 'Y'. CHGBD301
00163 88 WRK-EMP-FOUND-NO-88 VALUE 'N'. CHGBD301
00164 CHGBD301
00165 05 WRK-BD220-CHG-READ PIC 9(07) COMP-3 VALUE 0. CHGBD301
00166 05 WRK-REPORT-MOD PIC X(08). CHGBD301
00167 88 TPS-UNIV-MOD VALUE 'CHGBR111'. CHGBD301
00168 CHGBD301
00169 01 REPORT-LINK-AREA. CHGBD301
00170 ++INCLUDE CHGIL001 CHGBD301
00171 CHGBD301
00172 01 L001-LINK-AREA. CHGBD301
00173 ++INCLUDE DTSIL001 CHGBD301
00174 EJECT CHGBD301
00175 01 L003-LINK-AREA. CHGBD301
00176 ++INCLUDE DTSIL003 CHGBD301
00177 EJECT CHGBD301
00178 01 L004-LINK-AREA. CHGBD301
00179 ++INCLUDE DTSIL004 CHGBD301
00180 EJECT CHGBD301
00181 01 L005-LINK-AREA. CHGBD301
00182 ++INCLUDE DTSIL005 CHGBD301
00183 EJECT CHGBD301
00184 01 L931-LINK-AREA. CHGBD301
00185 ++INCLUDE DTSIL931 CHGBD301
00186 SKIP3 CHGBD301
00187 01 FSKL-REC. CHGBD301
00188 ++INCLUDE DTSIFSKL CHGBD301
00189 SKIP3 CHGBD301
00190 01 FQTR-REC. CHGBD301
00191 ++INCLUDE DTSIFQTR CHGBD301
00192 EJECT CHGBD301
00193 PROCEDURE DIVISION. CHGBD301
00194 CHGBD301-MAIN. CHGBD301
00195 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD301
00196 IF WRK-ERROR-YES-88 CHGBD301
00197 DISPLAY '*** JOB CANCELLED DUE TO ERRORS ***' CHGBD301
00198 GO TO CHGBD301-EXIT. CHGBD301
00199 CHGBD301
00200 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD301
00201 CHGBD301
00202 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD301
00203 CHGBD301
00204 CHGBD301-EXIT. CHGBD301
00205 STOP RUN. CHGBD301
00206 EJECT CHGBD301
00207 I0000-INITIATE. CHGBD301
00208 SET WRK-ERROR-NO-88 TO TRUE. CHGBD301
00209 CHGBD301
00210 PERFORM I1000-READ-BD100-PARMS THRU I1000-EXIT. CHGBD301
00211 CHGBD301
00212 PERFORM I4000-OPEN-CHARGE-FILE THRU I4000-EXIT. CHGBD301
00213 CHGBD301
00214 PERFORM I6000-INIT-REPORTS THRU I6000-EXIT. CHGBD301
00215 CHGBD301
00216 I0000-EXIT. CHGBD301
00217 EXIT. CHGBD301
00218 CHGBD301
00219 I1000-READ-BD100-PARMS. CHGBD301
00220 OPEN INPUT CHG-PARM-FILE. CHGBD301
00221 IF NOT CHG-PARM-FILE-OK-88 CHGBD301
00222 DISPLAY 'CHG PARM FILE OPEN ERROR: ' CHG-PARM-STATUS CHGBD301
00223 SET WRK-ERROR-YES-88 TO TRUE CHGBD301
00224 GO TO I1000-EXIT. CHGBD301
00225 CHGBD301
00226 READ CHG-PARM-FILE. CHGBD301
00227 IF NOT CHG-PARM-FILE-OK-88 CHGBD301
00228 DISPLAY 'CHG-PARM READ ERROR: ' CHG-PARM-STATUS CHGBD301
00229 SET WRK-ERROR-YES-88 TO TRUE CHGBD301
00230 GO TO I1000-EXIT. CHGBD301
00231 CHGBD301
00232 I1000-EXIT. CHGBD301
00233 EXIT. CHGBD301
00234 CHGBD301
00235 I4000-OPEN-CHARGE-FILE. CHGBD301
00236 OPEN INPUT BD220-CHG-FILE. CHGBD301
00237 IF NOT BD220-FILE-OK-88 CHGBD301
00238 DISPLAY 'BD220 FILE OPEN ERROR: ' BD220-CHG-STATUS CHGBD301
00239 SET WRK-ERROR-YES-88 TO TRUE. CHGBD301
00240 CHGBD301
00241 I4000-EXIT. CHGBD301
00242 EXIT. CHGBD301
00243 CHGBD301
00244 I6000-INIT-REPORTS. CHGBD301
00245 MOVE CHG3-BEGIN-DATE TO CHG-LINK1-PERIOD-BEGIN. CHGBD301
00246 MOVE CHG3-END-DATE TO CHG-LINK1-PERIOD-END. CHGBD301
00247 MOVE CHG3-RUN-TYPE TO CHG-LINK1-RUN-TYPE. CHGBD301
00248 CHGBD301
00249 SET CHG-LINK1-CMD-INIT-88 TO TRUE. CHGBD301
00250 CHGBD301
00251 CALL 'CHGBR100' USING REPORT-LINK-AREA CHGBD301
00252 BD220-CHG-REC. CHGBD301
00253 PERFORM S2000-CALL-TPS THRU S2000-EXIT. CHGBD301
00254 CHGBD301
00255 I6000-EXIT. CHGBD301
00256 EXIT. CHGBD301
00257 CHGBD301
00258 CHGBD301
00259 P0000-PROCESS. CHGBD301
00260 PERFORM S1000-READ-CHG-FILE THRU S1000-EXIT. CHGBD301
00261 IF NOT BD220-FILE-OK-88 CHGBD301
00262 GO TO P0000-EXIT CHGBD301
00263 END-IF. CHGBD301
00264 CHGBD301
00265 SET CHG-LINK1-CMD-PROCESS-88 TO TRUE. CHGBD301
00266 PERFORM CHGBD301
00267 UNTIL BD220-FILE-EOF-88 CHGBD301
00268 OR WRK-ERROR-YES-88 CHGBD301
00269 CALL 'CHGBR100' USING REPORT-LINK-AREA CHGBD301
00270 BD220-CHG-REC CHGBD301
00271 PERFORM S2000-CALL-TPS THRU S2000-EXIT CHGBD301
00272 PERFORM S1000-READ-CHG-FILE THRU S1000-EXIT CHGBD301
00273 END-PERFORM. CHGBD301
00274 CHGBD301
00275 P0000-EXIT. CHGBD301
00276 EXIT. CHGBD301
00277 CHGBD301
00278 T0000-TERMINATE. CHGBD301
00279 SET CHG-LINK1-CMD-CLOSE-88 TO TRUE. CHGBD301
00280 CALL 'CHGBR100' USING REPORT-LINK-AREA CHGBD301
00281 BD220-CHG-REC. CHGBD301
00282 CHGBD301
00283 PERFORM S2000-CALL-TPS THRU S2000-EXIT. CHGBD301
00284 CHGBD301
00285 CLOSE BD220-CHG-FILE CHGBD301
00286 CHG-PARM-FILE. CHGBD301
00287 CHGBD301
00288 DISPLAY '*********************************************'. CHGBD301
00289 DISPLAY '** BD301 COUNTS **'. CHGBD301
00290 DISPLAY SPACE. CHGBD301
00291 DISPLAY ' CHGBD220 CHARGE RECORDS READ: ' CHGBD301
00292 WRK-BD220-CHG-READ. CHGBD301
00293 CHGBD301
00294 CHGBD301
00295 T0000-EXIT. CHGBD301
00296 EXIT. CHGBD301
00297 CHGBD301
00298 S001-FROM-FED-8. CHGBD301
00299 SET L001-FROM-FED-8 TO TRUE. CHGBD301
00300 GO TO S001-DATE. CHGBD301
00301 CHGBD301
00302 S001-FROM-ABS. CHGBD301
00303 SET L001-FROM-ABS-DAY TO TRUE. CHGBD301
00304 GO TO S001-DATE. CHGBD301
00305 CHGBD301
00306 S001-DATE. CHGBD301
00307 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD301
00308 S001-EXIT. CHGBD301
00309 EXIT. CHGBD301
00310 CHGBD301
00311 S003-AGENCY-DAY. CHGBD301
00312 SET L003-AGENCY-DAY TO TRUE. CHGBD301
00313 GO TO S003-WORK-DAY. CHGBD301
00314 CHGBD301
00315 S003-WORK-DAY. CHGBD301
00316 CALL 'DTSBU003' USING L003-LINK-AREA. CHGBD301
00317 S003-EXIT. CHGBD301
00318 EXIT. CHGBD301
00319 CHGBD301
00320 S004-FROM-DATE. CHGBD301
00321 SET L004-FROM-DATE TO TRUE. CHGBD301
00322 GO TO S004-YRQ. CHGBD301
00323 CHGBD301
00324 S004-YRQ. CHGBD301
00325 CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD301
00326 S004-EXIT. CHGBD301
00327 EXIT. CHGBD301
00328 CHGBD301
00329 S005-FROM-SYS. CHGBD301
00330 SET L005-FROM-SYS TO TRUE. CHGBD301
00331 GO TO S005-ABSTIME. CHGBD301
00332 CHGBD301
00333 S005-ABSTIME. CHGBD301
00334 CALL 'DTSBU005' USING L005-LINK-AREA. CHGBD301
00335 S005-EXIT. CHGBD301
00336 EXIT. CHGBD301
00337 CHGBD301
00338 S931-OPEN-READ. CHGBD301
00339 SET L931-OPEN-READ-88 TO TRUE. CHGBD301
00340 GO TO S931-REF-I. CHGBD301
00341 CHGBD301
00342 S931-READ. CHGBD301
00343 SET L931-READ-88 TO TRUE. CHGBD301
00344 GO TO S931-REF-I. CHGBD301
00345 CHGBD301
00346 S931-CLOSE. CHGBD301
00347 SET L931-CLOSE-88 TO TRUE. CHGBD301
00348 GO TO S931-REF-I. CHGBD301
00349 CHGBD301
00350 S931-REF-I. CHGBD301
00351 CALL 'DTSBU931' USING L931-LINK-AREA CHGBD301
00352 FSKL-REC. CHGBD301
00353 S931-EXIT. CHGBD301
00354 EXIT. CHGBD301
00355 CHGBD301
00356 S1000-READ-CHG-FILE. CHGBD301
00357 READ BD220-CHG-FILE. CHGBD301
00358 IF BD220-FILE-OK-88 CHGBD301
00359 ADD 1 TO WRK-BD220-CHG-READ CHGBD301
00360 ELSE CHGBD301
00361 IF BD220-FILE-EOF-88 CHGBD301
00362 NEXT SENTENCE CHGBD301
00363 ELSE CHGBD301
00364 DISPLAY 'BD220 FILE READ ERROR: ' BD220-CHG-STATUS CHGBD301
00365 SET WRK-ERROR-YES-88 TO TRUE CHGBD301
00366 END-IF CHGBD301
00367 END-IF. CHGBD301
00368 CHGBD301
00369 S1000-EXIT. CHGBD301
00370 EXIT. CHGBD301
00371 CHGBD301
00372 S2000-CALL-TPS. CHGBD301
00373 IF CHG3-RUN-TYPE-QTRLY-88 CHGBD301
00374 CALL 'CHGBR111' USING REPORT-LINK-AREA CHGBD301
00375 BD220-CHG-REC. CHGBD301
00376 S2000-EXIT. CHGBD301
00377 EXIT. CHGBD301
00378 CHGBD301
00379 CHGBD301
00380 S999-ABEND. CHGBD301
00381 DISPLAY '**** CHGBD301 ABENDING ' CHGBD301
00382 ABEND-MSG. CHGBD301
00383 CALL 'DTSBU999' USING ABEND-CODE. CHGBD301
00384 S999-EXIT. CHGBD301
00385 EXIT. CHGBD301