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

691 lines
55 KiB
COBOL

00001 IDENTIFICATION DIVISION. 05/07/20
00002 PROGRAM-ID. CHGBR170. CHGBR170
00003 *AUTHOR. TCL. LV013
00004 *DATE-WRITTEN. SEPTEMBER 2003. CHGBR170
00005 DATE-COMPILED. CHGBR170
00006 CHGBR170
00007 ***** CHGBR170
00008 * CALLING SEQUENCE: CHGBD300 CALLS CHGBR170
00009 * CHGBR170 READS CHGIM004 RECORDS CL**2
00010 * CHGBR170 WRITES FPUC BENEFIT, CL**2
00011 * SUMMARY, OR SPECIAL RPT CHGBR170
00012 ***** CHGBR170
00013 * CHGBR170
00014 * FUNCTION: CHGBR170
00015 * CHGBR170
00016 * (1) FOR QUARTERLY RUN: CHGBR170
00017 * THIS MODULE WILL GENERATE A QUARTERLY BENEFIT REPORT CHGBR170
00018 * FOR THE D.C. AGENCIES. CHGBR170
00019 * (2) FOR SPECIAL RUN: CHGBR170
00020 * THIS MODULE WILL GENERATE A BENEFIT CHARGE REPORT ONLY CHGBR170
00021 * (2) FOR ANNUAL RUN: CHGBR170
00022 * THIS MODULE WILL GENERATE NEITHER A BENEFIT CHARGE RPT.CHGBR170
00023 * CHGBR170
00024 * RECORDS READ: CHGBR170
00025 * CHGBR170
00026 * NONE. CHGBR170
00027 * CHGBR170
00028 * INPUT: CHGBR170
00029 * CHGBR170
00030 * CHGIM004 RECORD PASSED FROM CHGBD300 CHGBR170
00031 * FPUC ACCOUNT NUMBERS & NAMES FILE CL**3
00032 * CHGBR170
00033 * OUTPUT: CHGBR170
00034 * CHGBR170
00035 * RPC170R1 - FEDERAL PANDEMIC ACCOUNTS CL**3
00036 * DEFAULT CHARGE ACCOUNT REPORT. CHGBR170
00037 * CHGBR170
00038 * RECORDS WRITTEN ON DISK: CHGBR170
00039 * CHGBR170
00040 * NONE CHGBR170
00041 * CHGBR170
00042 * MODULES CALLED: CHGBR170
00043 * CHGBR170
00044 * DTSBU001 DATE EDIT/CONVERSION MODULE CHGBR170
00045 * DTSBU071 NAME CONVERSION MODULE CHGBR170
00046 * CHGBR170
00047 ***** CHGBR170
00048 CHGBR170
00049 ******************************************************************CHGBR170
00050 * MODIFICATION HISTORY: *CHGBR170
00051 * *CHGBR170
00052 * 09-12-2003 INITIAL DEVELOPMENT *CHGBR170
00053 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBR170
00054 * *CHGBR170
00055 * 01-28-2004 REPLACED DC GOVERNMENT DEFAULT ACCOUNT NUMBER *CHGBR170
00056 * 998888 BY EACH DC GOVERNMENT AGENCY ACCOUNT *CHGBR170
00057 * NUMBER AND NAME IN CHGBR160 REPORT. *CHGBR170
00058 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBR170
00059 * *CHGBR170
00060 * 07-28-2008 REMOVED ORLANDO NAME FROM REPORT *CHGBR170
00061 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBR170
00062 * *CHGBR170
00063 * 04-03-2009 MODIFIED FOR NEW PROGRAM CODE VALUES *CHGBR170
00064 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBR170
00065 * *CHGBR170
00066 * 04-03-2009 RECOMPILE FOR NEW VERSION OF CHGIM004 AND PRINT *CHGBR170
00067 * LAST 4 DIGITS OF SSN *CHGBR170
00068 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBR170
00069 * *CHGBR170
00070 * 04-23-2020 RECOMPILE FOR NEW VERSION OF CHGIM004 AND PRINT * CL*13
00071 * PANDEMIC REPORTS FOR PUA FPUC FRUR PEUC * CL*13
00072 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL*13
00073 * * CL*13
00074 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR170
00075 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR170
00076 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBR170
00077 ******************************************************************CHGBR170
00078 CHGBR170
00079 ENVIRONMENT DIVISION. CHGBR170
00080 CONFIGURATION SECTION. CHGBR170
00081 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CHGBR170
00082 CHGBR170
00083 INPUT-OUTPUT SECTION. CHGBR170
00084 FILE-CONTROL. CHGBR170
00085 CHGBR170
00086 * SELECT DC-AGENCY ASSIGN TO DCAGNCY CL**3
00087 * FILE STATUS IS DC-AGENCY-STATUS. CL**3
00088 CHGBR170
00089 SELECT BEN-CHRG-FPUC-RPT ASSIGN TO RPC170R1 CL**4
00090 FILE STATUS IS FPUC-CHRG-STATUS. CL**4
00091 CHGBR170
00092 DATA DIVISION. CHGBR170
00093 CHGBR170
00094 FILE SECTION. CHGBR170
00095 CHGBR170
00096 *FD DC-AGENCY CL**3
00097 * RECORDING MODE IS F CL**3
00098 * LABEL RECORDS ARE STANDARD CL**3
00099 * BLOCK CONTAINS 0 CHARACTERS. CL**3
00100 * SKIP1 CL**3
00101 *01 DC-AGENCY-REC. CL**3
00102 * 05 DC-AGENCY-CODE PIC X(02). CL**3
00103 * 05 DC-AGENCY-NAME PIC X(38). CL**3
00104 * 05 DC-AGENCY-EMP-NO PIC 9(06). CL**3
00105 * 05 FILLER PIC X(02). CL**3
00106 CHGBR170
00107 FD BEN-CHRG-FPUC-RPT CL**3
00108 RECORDING MODE IS F CHGBR170
00109 RECORD CONTAINS 133 CHARACTERS CHGBR170
00110 BLOCK CONTAINS 0 RECORDS CHGBR170
00111 LABEL RECORDS ARE OMITTED. CHGBR170
00112 CHGBR170
00113 01 CHRG-RPT-REC PIC X(133). CHGBR170
00114 CHGBR170
00115 WORKING-STORAGE SECTION. CHGBR170
001155 77 PAN-VALET PICTURE X(24) VALUE '013CHGBR170 05/07/20'. CHGBR170
00116 77 PAN-VALET PICTURE X(24) VALUE '015CHGBR160 06/12/15'. CHGBR170
00117 CHGBR170
00118 01 WRK-AREA. CHGBR170
00119 05 WRK-ABEND-CODE PIC S9(04) COMP CHGBR170
00120 VALUE +170. CL**3
00121 05 ABEND-MSG PIC X(60) VALUE SPACE. CHGBR170
00122 CHGBR170
00123 05 NEW-PAGE-SW PIC X VALUE 'N'. CHGBR170
00124 CHGBR170
00125 05 WRK-REG-BENEFITS PIC X(25) CHGBR170
00126 VALUE ' REGULAR BENEFIT PAYMENT '. CHGBR170
00127 05 WRK-EXT-BENEFITS PIC X(25) CHGBR170
00128 VALUE ' EXTENDED BENEFIT PAYMENT'. CHGBR170
00129 05 WRK-TEUC-BENEFITS PIC X(25) CHGBR170
00130 VALUE ' TEUC BENEFIT PAYMENT '. CHGBR170
00131 05 WRK-TEUCA-BENEFITS PIC X(25) CHGBR170
00132 VALUE ' TEUCA BENEFIT PAYMENT '. CHGBR170
00133 05 WRK-FAC-BENEFITS PIC X(25) CHGBR170
00134 VALUE ' FPUC BENEFIT PAYMENT '. CL*12
00135 05 WRK-PUA-BENEFITS PIC X(25) CL*13
00136 VALUE ' PUA BENEFIT PAYMENT '. CL*13
00137 05 WRK-RUR-BENEFITS PIC X(25) CL*13
00138 VALUE ' FRUR BENEFIT PAYMENT '. CL*13
00139 05 WRK-EUC-BENEFITS PIC X(25) CL*13
00140 VALUE ' PEUC BENEFIT PAYMENT '. CL*13
00141 05 WRK-FPUC-BENEFITS PIC X(25) CL**3
00142 VALUE 'FED PANDEMIC COMP PAYMENT'. CL**3
00143 05 WRK-ADJUSTMENTS PIC X(25) CHGBR170
00144 VALUE ' ADJUSTMENTS '. CHGBR170
00145 05 WRK-RPT-TYPE1 PIC X(26) CHGBR170
00146 VALUE 'QUARTERLY CHARGE SUMMARY'. CHGBR170
00147 05 WRK-RPT-TYPE2 PIC X(26) CHGBR170
00148 VALUE ' BENEFIT CHARGE SPECIAL '. CHGBR170
00149 CHGBR170
00150 05 WRK-LINE-CNT PIC S9(02) COMP-3 VALUE +0. CHGBR170
00151 05 WRK-PAGE-CNT PIC S9(05) COMP-3 VALUE +0. CHGBR170
00152 05 WRK-EMPLYR-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR170
00153 CHGBR170
00154 05 DC-AGENCY-STATUS PIC X(02) VALUE SPACES. CHGBR170
00155 88 DC-AGENCY-OK-88 VALUE ZERO. CHGBR170
00156 88 DC-AGENCY-EOF-88 VALUE '10'. CHGBR170
00157 CHGBR170
00158 05 FPUC-CHRG-STATUS PIC X(02) VALUE SPACES. CL**4
00159 88 FPUC-CHRG-OK-88 VALUE ZERO. CL**4
00160 88 FPUC-CHRG-EOF-88 VALUE '10'. CL**4
00161 CL**4
00162 05 WRK-ERROR-IND PIC X(01). CHGBR170
00163 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBR170
00164 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBR170
00165 CHGBR170
00166 05 WRK-SSN PIC 9(09) VALUE 0. CHGBR170
00167 05 FILLER REDEFINES WRK-SSN. CHGBR170
00168 10 WRK-SSN1 PIC 9(03). CHGBR170
00169 10 WRK-SSN2 PIC 9(02). CHGBR170
00170 10 WRK-SSN3 PIC 9(04). CHGBR170
00171 CHGBR170
00172 05 WRK-CURR-EMP PIC S9(07) COMP-3 VALUE +0. CHGBR170
00173 CHGBR170
00174 05 WRK-TOT-AMT PIC S9(09)V99 VALUE +0. CHGBR170
00175 05 WRK-CURR-AMT PIC S9(09)V99 VALUE +0. CHGBR170
00176 05 WRK-EMP-TOT-CHG PIC S9(09)V99 VALUE +0. CHGBR170
00177 05 WRK-EMP-ACCT-CHG PIC S9(09)V99 VALUE +0. CHGBR170
00178 05 WRK-RPT-TOT-CHG PIC S9(10)V99 VALUE +0. CHGBR170
00179 05 WRK-RPT-ACCT-CHG PIC S9(10)V99 VALUE +0. CHGBR170
00180 05 WS-OVPY-RECOVER PIC S9(09)V99 VALUE +0. CHGBR170
00181 CHGBR170
00182 05 WRK-DEFAULT-DC-EMP-NO PIC S9(07) COMP-3 CHGBR170
00183 VALUE +998888. CHGBR170
00184 CHGBR170
00185 05 WRK-EMP-NO PIC X(06). CHGBR170
00186 05 WRK-EMP-NO-9 REDEFINES WRK-EMP-NO CHGBR170
00187 PIC 9(06). CHGBR170
00188 05 WRK-SSN-COUNT PIC 9(07) VALUE 0. CHGBR170
00189 05 WRK-IN-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR170
00190 05 WRK-OUT-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR170
00191 05 WRK-AGENCY-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR170
00192 05 WRK-ERROR-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR170
00193 CHGBR170
00194 01 DC-AGENCY-TBL-AREA. CHGBR170
00195 05 DC-TBL-SUB PIC S9(04) COMP. CHGBR170
00196 05 DC-TBL-LAST PIC S9(04) COMP VALUE +0. CHGBR170
00197 05 DC-TBL-MAX PIC S9(04) COMP VALUE +200. CHGBR170
00198 05 DC-AGENCY-TBL OCCURS 200 TIMES INDEXED BY DC-NDX. CHGBR170
00199 10 DC-TBL-CODE PIC X(02). CHGBR170
00200 10 DC-TBL-NAME PIC X(38). CHGBR170
00201 10 DC-TBL-EMP-NO PIC 9(06). CHGBR170
00202 10 FILLER PIC X(02). CHGBR170
00203 CHGBR170
00204 01 CHG-DETAIL-HEADER-AREA. CHGBR170
00205 05 CHG-DETAIL-HDR1. CHGBR170
00206 10 FILLER PIC X VALUE SPACE. CHGBR170
00207 10 FILLER PIC X(08) CHGBR170
00208 VALUE 'CHGBR170'. CL**3
00209 10 FILLER PIC X(47) VALUE SPACES. CHGBR170
00210 10 FILLER PIC X(20) CHGBR170
00211 VALUE 'DISTRICT OF COLUMBIA'. CHGBR170
00212 10 FILLER PIC X(43) VALUE SPACES. CHGBR170
00213 10 FILLER PIC X(09) CHGBR170
00214 VALUE 'PAGE NO.:'. CHGBR170
00215 10 CHG-DTL-PAGE-NO PIC ZZZ99. CHGBR170
00216 CHGBR170
00217 05 CHG-DETAIL-HDR2. CHGBR170
00218 10 FILLER PIC X VALUE SPACE. CHGBR170
00219 10 FILLER PIC X(10) CHGBR170
00220 VALUE ' '. CHGBR170
00221 10 FILLER PIC X(42) VALUE SPACES. CHGBR170
00222 10 H2-RPT-TYPE PIC X(26) VALUE SPACES. CHGBR170
00223 * VALUE ' FPUC SUMMARY'. CL**3
00224 10 FILLER PIC X(49) VALUE SPACES. CHGBR170
00225 10 FILLER PIC X(02) VALUE 'TT'. CHGBR170
00226 10 CHG-DTL-EMP-TYPE PIC 9(02) VALUE 0. CHGBR170
00227 CHGBR170
00228 05 CHG-DETAIL-HDR3. CHGBR170
00229 10 FILLER PIC X VALUE SPACE. CHGBR170
00230 10 FILLER PIC X(08) CHGBR170
00231 VALUE 'ROOM 425'. CL**3
00232 10 FILLER PIC X(37) VALUE SPACES. CHGBR170
00233 10 FILLER PIC X(39) CHGBR170
00234 VALUE 'DEPARTMENT OF EMPLOYMENT SERVICES'. CHGBR170
00235 CHGBR170
00236 05 CHG-DETAIL-HDR4. CHGBR170
00237 10 FILLER PIC X VALUE SPACE. CHGBR170
00238 10 FILLER PIC X(39) VALUE SPACES. CHGBR170
00239 10 FILLER PIC X(24) CHGBR170
00240 VALUE 'EMPLOYER ACCOUNT NUMBER '. CHGBR170
00241 10 CHG-DTL-EMP-NO PIC 9(06) VALUE 0. CHGBR170
00242 10 FILLER PIC X(02) VALUE SPACES. CHGBR170
00243 10 H4-AGENCY-NAME PIC X(38) VALUE SPACES. CHGBR170
00244 10 FILLER PIC X(10) VALUE SPACES. CHGBR170
00245 CHGBR170
00246 05 CHG-DETAIL-HDR5. CHGBR170
00247 10 FILLER PIC X VALUE SPACE. CHGBR170
00248 10 FILLER PIC X(39) VALUE SPACES. CHGBR170
00249 10 FILLER PIC X(28) CHGBR170
00250 VALUE 'REPORT INCLUDES PERIOD FROM '. CHGBR170
00251 10 CHG-DTL-START-DT PIC X(10) VALUE SPACE. CHGBR170
00252 10 FILLER PIC X(04) VALUE ' TO '. CHGBR170
00253 10 CHG-DTL-END-DT PIC X(10) VALUE SPACE. CHGBR170
00254 CHGBR170
00255 05 CHG-DETAIL-HDR6. CHGBR170
00256 10 FILLER PIC X VALUE SPACE. CHGBR170
00257 10 FILLER PIC X(05) VALUE SPACES. CHGBR170
00258 10 FILLER PIC X(03) VALUE 'SSN'. CHGBR170
00259 10 FILLER PIC X(09) VALUE SPACES. CHGBR170
00260 10 FILLER PIC X(03) VALUE 'BYE'. CHGBR170
00261 10 FILLER PIC X(09) VALUE SPACES. CHGBR170
00262 10 FILLER PIC X(18) CHGBR170
00263 VALUE 'NAME OF CLAIMANT'. CHGBR170
00264 10 FILLER PIC X(19) VALUE SPACES. CHGBR170
00265 10 FILLER PIC X(14) VALUE 'TOTAL BENEFITS'. CHGBR170
00266 10 FILLER PIC X(07) VALUE SPACES. CHGBR170
00267 10 FILLER PIC X(15) VALUE 'ACCOUNT CHARGES'. CHGBR170
00268 10 FILLER PIC X(08) VALUE SPACES. CHGBR170
00269 10 FILLER PIC X(11) VALUE 'SOURCE TYPE'. CHGBR170
00270 CHGBR170
00271 01 CHG-DETAIL-LINE. CHGBR170
00272 05 FILLER PIC X(04) VALUE SPACES. CHGBR170
00273 05 CHG-DTL-SSN1 PIC X(03) VALUE 'XXX'. CL**3
00274 05 FILLER PIC X(01) VALUE '-'. CHGBR170
00275 05 CHG-DTL-SSN2 PIC X(02) VALUE 'XX'. CL**3
00276 05 FILLER PIC X(01) VALUE '-'. CHGBR170
00277 05 CHG-DTL-SSN3 PIC X(04) VALUE SPACE. CHGBR170
00278 05 FILLER PIC X(02) VALUE SPACES. CHGBR170
00279 05 CHG-DTL-BYE PIC X(10) VALUE SPACE. CHGBR170
00280 05 FILLER PIC X(03) VALUE SPACES. CHGBR170
00281 05 CHG-DTL-NAME PIC X(32) VALUE SPACE. CHGBR170
00282 05 FILLER PIC X(02) VALUE SPACES. CHGBR170
00283 05 CHG-DTL-TOT-AMT PIC $$,$$$,$$$,$$9.99-. CHGBR170
00284 05 FILLER PIC X(04) VALUE SPACES. CHGBR170
00285 05 CHG-DTL-CURR-AMT PIC $$,$$$,$$$,$$9.99-. CHGBR170
00286 05 FILLER PIC X(03) VALUE SPACES. CHGBR170
00287 05 CHG-DTL-SOURCE PIC X(25) VALUE SPACE. CHGBR170
00288 CHGBR170
00289 01 CHG-DETAIL-EMP-FOOTER-AREA. CHGBR170
00290 05 CHG-DETAIL-EMP-FOOTER1. CHGBR170
00291 10 FILLER PIC X(34) VALUE SPACES. CHGBR170
00292 10 FILLER PIC X(20) CHGBR170
00293 VALUE 'GRAND TOTAL CHARGED:'. CHGBR170
00294 10 FILLER PIC X(10) VALUE SPACES. CHGBR170
00295 10 CHG-DTL-EMP-TOT-CHG PIC $$,$$$,$$$,$$9.99-. CHGBR170
00296 10 FILLER PIC X(25) VALUE SPACES. CHGBR170
00297 10 FILLER PIC X(25) CHGBR170
00298 VALUE ' ************ '. CHGBR170
00299 CHGBR170
00300 05 CHG-DETAIL-EMP-FOOTER2. CHGBR170
00301 10 FILLER PIC X(41) VALUE SPACES. CHGBR170
00302 10 FILLER PIC X(28) CHGBR170
00303 VALUE 'GRAND TOTAL ACCOUNT CHARGED:'. CHGBR170
00304 10 FILLER PIC X(17) VALUE SPACES. CHGBR170
00305 10 CHG-DTL-EMP-ACCT-CHG PIC $$,$$$,$$$,$$9.99-. CHGBR170
00306 10 FILLER PIC X(03) VALUE SPACES. CHGBR170
00307 10 FILLER PIC X(25) CHGBR170
00308 VALUE ' ************ '. CHGBR170
00309 CHGBR170
00310 01 CHG-DETAIL-RPT-FOOTER-AREA. CHGBR170
00311 05 CHG-DETAIL-RPT-FOOTER1. CHGBR170
00312 10 FILLER PIC X(65) VALUE SPACES. CHGBR170
00313 10 FILLER PIC X(41) CHGBR170
00314 VALUE '-----------------------------------------'. CHGBR170
00315 CHGBR170
00316 05 CHG-DETAIL-RPT-FOOTER2. CHGBR170
00317 10 FILLER PIC X(15) VALUE SPACES. CHGBR170
00318 10 FILLER PIC X(37) CHGBR170
00319 VALUE 'TOTAL AMOUNT CHARGED FOR THE PERIOD: '. CHGBR170
00320 10 FILLER PIC X(12) VALUE SPACES. CHGBR170
00321 10 CHG-DTL-RPT-TOT-CHG PIC $$,$$$,$$$,$$9.99-. CHGBR170
00322 10 FILLER PIC X(04) VALUE SPACES. CHGBR170
00323 10 CHG-DTL-RPT-ACCT-CHG PIC $$,$$$,$$$,$$9.99-. CHGBR170
00324 10 FILLER PIC X(03) VALUE SPACES. CHGBR170
00325 10 FILLER PIC X(25) CHGBR170
00326 VALUE ' ************ '. CHGBR170
00327 CHGBR170
00328 05 CHG-DETAIL-RPT-FOOTER3. CHGBR170
00329 10 FILLER PIC X(15) VALUE SPACES. CHGBR170
00330 10 FILLER PIC X(27) CHGBR170
00331 VALUE 'TOTAL SSNS FOR THE PERIOD: '. CHGBR170
00332 10 FILLER PIC X(12) VALUE SPACES. CHGBR170
00333 10 CHG-DTL-RPT-SSNS PIC ZZZ,ZZZ,999. CHGBR170
00334 CHGBR170
00335 EJECT CHGBR170
00336 01 L001-LINK-AREA. CHGBR170
00337 ++INCLUDE DTSIL001 CHGBR170
00338 EJECT CHGBR170
00339 01 L004-LINK-AREA. CHGBR170
00340 ++INCLUDE DTSIL004 CHGBR170
00341 EJECT CHGBR170
00342 01 L005-LINK-AREA. CHGBR170
00343 ++INCLUDE DTSIL005 CHGBR170
00344 EJECT CHGBR170
00345 LINKAGE SECTION. CHGBR170
00346 01 CHG-LINK-REC. CHGBR170
00347 ++INCLUDE CHGIL001 CHGBR170
00348 EJECT CHGBR170
00349 01 BD210-CHG-REC. CHGBR170
00350 ++INCLUDE CHGIM004 CHGBR170
00351 EJECT CHGBR170
00352 PROCEDURE DIVISION USING CHG-LINK-REC CHGBR170
00353 BD210-CHG-REC. CHGBR170
00354 CHGBR170
00355 CHGBR160-MAIN. CHGBR170
00356 IF CHG-LINK1-CMD-INIT-88 CHGBR170
00357 PERFORM I0000-INITIATE THRU I0000-EXIT CHGBR170
00358 ELSE CHGBR170
00359 IF CHG-LINK1-CMD-PROCESS-88 CHGBR170
00360 PERFORM P0000-PROCESS THRU P0000-EXIT CHGBR170
00361 ELSE CHGBR170
00362 IF CHG-LINK1-CMD-CLOSE-88 CHGBR170
00363 PERFORM T0000-TERMINATE THRU T0000-EXIT CHGBR170
00364 ELSE CHGBR170
00365 MOVE 'INVALID CHG-LINK1-COMMAND VALUE' CHGBR170
00366 TO ABEND-MSG CHGBR170
00367 PERFORM S999-ABEND THRU S999-EXIT CHGBR170
00368 END-IF CHGBR170
00369 END-IF CHGBR170
00370 END-IF. CHGBR170
00371 CHGBR170
00372 GOBACK. CHGBR170
00373 EJECT CHGBR170
00374 I0000-INITIATE. CHGBR170
00375 CHGBR170
00376 MOVE ZERO TO WRK-PAGE-CNT CHGBR170
00377 WRK-EMP-TOT-CHG CHGBR170
00378 WRK-EMP-ACCT-CHG CHGBR170
00379 WRK-RPT-TOT-CHG CHGBR170
00380 WRK-RPT-ACCT-CHG. CHGBR170
00381 CHGBR170
00382 IF CHG-LINK1-RUN-TYPE-SPC-88 CHGBR170
00383 OR CHG-LINK1-RUN-TYPE-RPTS-88 CHGBR170
00384 OR CHG-LINK1-RUN-TYPE-AGTS-88 CHGBR170
00385 MOVE WRK-RPT-TYPE2 TO H2-RPT-TYPE CHGBR170
00386 ELSE CHGBR170
00387 MOVE WRK-RPT-TYPE1 TO H2-RPT-TYPE CHGBR170
00388 END-IF. CHGBR170
00389 CHGBR170
00390 MOVE CHG-LINK1-PERIOD-BEGIN TO L001-FED-8-DATE-9. CHGBR170
00391 SET L001-FROM-FED-8 TO TRUE. CHGBR170
00392 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR170
00393 MOVE L001-SLASH-8-DATE TO CHG-DTL-START-DT. CHGBR170
00394 CHGBR170
00395 MOVE CHG-LINK1-PERIOD-END TO L001-FED-8-DATE-9. CHGBR170
00396 SET L001-FROM-FED-8 TO TRUE. CHGBR170
00397 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR170
00398 MOVE L001-SLASH-8-DATE TO CHG-DTL-END-DT. CHGBR170
00399 CHGBR170
00400 * OPEN INPUT DC-AGENCY. CL**3
00401 * IF NOT DC-AGENCY-OK-88 CL**3
00402 * DISPLAY 'DC AGENCY FILE OPEN STATUS: ' DC-AGENCY-STATUS CL**3
00403 * MOVE 'DC AGENCY FILE OPEN ERROR: ' TO ABEND-MSG CL**3
00404 * PERFORM S999-ABEND THRU S999-EXIT. CL**3
00405 CHGBR170
00406 DISPLAY 'FPUC CHRG FILE GOINT TO OPEN : '. CL**9
00407 OPEN OUTPUT BEN-CHRG-FPUC-RPT. CL**3
00408 IF NOT FPUC-CHRG-OK-88 CL**4
00409 MOVE 'FPUC CHRG FILE OPEN ERROR: ' TO ABEND-MSG CL*11
00410 PERFORM S999-ABEND THRU S999-EXIT. CL**4
00411 CL**4
00412 DISPLAY 'FPUC CHRG FILE OPEN : ' ABEND-MSG. CL**6
00413 CHGBR170
00414 * PERFORM I3000-AGENCY-DATA THRU I3000-EXIT. CL**3
00415 CHGBR170
00416 I0000-EXIT. CHGBR170
00417 EXIT. CHGBR170
00418 P0000-PROCESS. CHGBR170
00419 IF CHG4-EMP-NO NOT = WRK-CURR-EMP CHGBR170
00420 IF WRK-CURR-EMP = ZERO CHGBR170
00421 *** 1ST TIME CHGBR170
00422 MOVE CHG4-EMP-NO TO WRK-CURR-EMP CHGBR170
00423 CHG-DTL-EMP-NO CHGBR170
00424 WRK-EMP-NO CHGBR170
00425 * PERFORM P0100-FIND-NAME THRU P0100-EXIT CL**3
00426 MOVE CHG4-EMP-TYPE TO CHG-DTL-EMP-TYPE CHGBR170
00427 ADD 1 TO WRK-EMPLYR-CNT CHGBR170
00428 PERFORM P1000-PRINT-HEADER THRU P1000-EXIT CHGBR170
00429 ELSE CHGBR170
00430 *** NEW ONE CHGBR170
00431 PERFORM P2000-EMP-COMPLETE THRU P2000-EXIT CHGBR170
00432 MOVE CHG4-EMP-NO TO WRK-CURR-EMP CHGBR170
00433 CHG-DTL-EMP-NO CHGBR170
00434 WRK-EMP-NO CHGBR170
00435 * PERFORM P0100-FIND-NAME THRU P0100-EXIT CL**3
00436 MOVE CHG4-EMP-TYPE TO CHG-DTL-EMP-TYPE CHGBR170
00437 ADD 1 TO WRK-EMPLYR-CNT CHGBR170
00438 PERFORM P1000-PRINT-HEADER THRU P1000-EXIT CHGBR170
00439 END-IF CHGBR170
00440 ELSE CHGBR170
00441 *** SAME ONE CHGBR170
00442 IF WRK-LINE-CNT > +54 CHGBR170
00443 PERFORM P1000-PRINT-HEADER THRU P1000-EXIT CHGBR170
00444 END-IF CHGBR170
00445 END-IF. CHGBR170
00446 CHGBR170
00447 IF CHG4-EMP-NO NOT = ZEROS CHGBR170
00448 * DISPLAY ' CHG4-EMP NO : ' WRK-CURR-EMP CL*12
00449 PERFORM P3000-BUILD-CHG-DETAIL THRU P3000-EXIT. CHGBR170
00450 CHGBR170
00451 * DISPLAY ' WRK-CURR EMP : ' WRK-CURR-EMP. CL*12
00452 *& IF CHG4-OP-RECOVER-AMT > +0 CHGBR170
00453 *& MOVE SPACES TO EI-SPACES CHGBR170
00454 *& MOVE CHG4-OP-RECOVER-AMT TO EI-CURR-AMT CHGBR170
00455 *& MOVE ' OVERPAYMENTS COLLECTED' TO EI-BENNIE CHGBR170
00456 *& PERFORM P2000-WRITE-RPT CHGBR170
00457 *& THRU P2000-EXIT. CHGBR170
00458 CHGBR170
00459 P0000-EXIT. CHGBR170
00460 EXIT. CHGBR170
00461 CHGBR170
00462 P0100-FIND-NAME. CHGBR170
00463 * IF WRK-EMP-NO-9 = 998888 CL**3
00464 * GO TO P0100-EXIT CL**3
00465 * ELSE CL**3
00466 * PERFORM P0200-FIND-EMP-NO THRU P0200-EXIT. CL**3
00467 * END-IF. CL**3
00468 CHGBR170
00469 P0100-EXIT. CHGBR170
00470 EXIT. CHGBR170
00471 CHGBR170
00472 P0200-FIND-EMP-NO. CHGBR170
00473 SET DC-NDX TO +1. CHGBR170
00474 SEARCH DC-AGENCY-TBL VARYING DC-NDX CHGBR170
00475 AT END CHGBR170
00476 GO TO P0200-EXIT CHGBR170
00477 WHEN DC-TBL-EMP-NO (DC-NDX) = CHG4-EMP-NO CHGBR170
00478 MOVE DC-TBL-NAME (DC-NDX) TO H4-AGENCY-NAME CHGBR170
00479 END-SEARCH. CHGBR170
00480 CHGBR170
00481 P0200-EXIT. CHGBR170
00482 EXIT. CHGBR170
00483 CHGBR170
00484 P1000-PRINT-HEADER. CHGBR170
00485 IF CHG-DTL-EMP-NO = 005027 CL*13
00486 MOVE 'PANDEMIC UNEMPLOYMENT ASSISTANCE (PUA)' CL*13
00487 TO H4-AGENCY-NAME CL*13
00488 ELSE CL*13
00489 IF CHG-DTL-EMP-NO = 005029 CL*13
00490 MOVE 'FED PANDEMIC UNEMPLOYMENT COMP (FPUC)' CL*13
00491 TO H4-AGENCY-NAME CL*13
00492 ELSE CL*13
00493 IF CHG-DTL-EMP-NO = 005030 CL*13
00494 MOVE 'FED REIMBURSING UNEMPLOYMENT RELIEF ' CL*13
00495 TO H4-AGENCY-NAME CL*13
00496 ELSE CL*13
00497 IF CHG-DTL-EMP-NO = 005031 CL*13
00498 MOVE 'PANDEMIC EXTENDED UNEMPLOYMENT COMP ' CL*13
00499 TO H4-AGENCY-NAME. CL*13
00500 CHGBR170
00501 ADD +1 TO WRK-PAGE-CNT. CHGBR170
00502 MOVE WRK-PAGE-CNT TO CHG-DTL-PAGE-NO. CHGBR170
00503 CHGBR170
00504 WRITE CHRG-RPT-REC FROM CHG-DETAIL-HDR1 CHGBR170
00505 AFTER ADVANCING TOP-OF-PAGE. CHGBR170
00506 WRITE CHRG-RPT-REC FROM CHG-DETAIL-HDR2 CHGBR170
00507 AFTER ADVANCING 1 LINE. CHGBR170
00508 WRITE CHRG-RPT-REC FROM CHG-DETAIL-HDR3 CHGBR170
00509 AFTER ADVANCING 1 LINE. CHGBR170
00510 WRITE CHRG-RPT-REC FROM CHG-DETAIL-HDR4 CHGBR170
00511 AFTER ADVANCING 2 LINES. CHGBR170
00512 WRITE CHRG-RPT-REC FROM CHG-DETAIL-HDR5 CHGBR170
00513 AFTER ADVANCING 2 LINES. CHGBR170
00514 WRITE CHRG-RPT-REC FROM CHG-DETAIL-HDR6 CHGBR170
00515 AFTER ADVANCING 2 LINES. CHGBR170
00516 MOVE SPACE TO CHRG-RPT-REC. CHGBR170
00517 WRITE CHRG-RPT-REC AFTER ADVANCING 1 LINES. CHGBR170
00518 CHGBR170
00519 MOVE +10 TO WRK-LINE-CNT. CHGBR170
00520 P1000-EXIT. CHGBR170
00521 EXIT. CHGBR170
00522 CHGBR170
00523 P2000-EMP-COMPLETE. CHGBR170
00524 PERFORM P2100-CHG-DTL-FOOTER THRU P2100-EXIT. CHGBR170
00525 MOVE ZERO TO WRK-EMP-TOT-CHG CHGBR170
00526 WRK-EMP-ACCT-CHG. CHGBR170
00527 CHGBR170
00528 P2000-EXIT. CHGBR170
00529 EXIT. CHGBR170
00530 CHGBR170
00531 P2100-CHG-DTL-FOOTER. CHGBR170
00532 IF WRK-PAGE-CNT > +48 CHGBR170
00533 PERFORM P1000-PRINT-HEADER THRU P1000-EXIT CHGBR170
00534 END-IF. CHGBR170
00535 CHGBR170
00536 MOVE WRK-EMP-TOT-CHG TO CHG-DTL-EMP-TOT-CHG. CHGBR170
00537 MOVE WRK-EMP-ACCT-CHG TO CHG-DTL-EMP-ACCT-CHG. CHGBR170
00538 MOVE +0 TO WRK-PAGE-CNT. CHGBR170
00539 CHGBR170
00540 WRITE CHRG-RPT-REC FROM CHG-DETAIL-EMP-FOOTER1 CHGBR170
00541 AFTER ADVANCING 4 LINES. CHGBR170
00542 CHGBR170
00543 WRITE CHRG-RPT-REC FROM CHG-DETAIL-EMP-FOOTER2 CHGBR170
00544 AFTER ADVANCING 2 LINES. CHGBR170
00545 CHGBR170
00546 P2100-EXIT. CHGBR170
00547 EXIT. CHGBR170
00548 CHGBR170
00549 P3000-BUILD-CHG-DETAIL. CHGBR170
00550 CHGBR170
00551 ADD 1 TO WRK-SSN-COUNT. CHGBR170
00552 CHGBR170
00553 MOVE CHG4-SSN TO WRK-SSN. CHGBR170
00554 MOVE 'XXX' TO CHG-DTL-SSN1. CHGBR170
00555 MOVE 'XX' TO CHG-DTL-SSN2. CHGBR170
00556 * MOVE WRK-SSN1 TO CHG-DTL-SSN1. CHGBR170
00557 * MOVE WRK-SSN2 TO CHG-DTL-SSN2. CHGBR170
00558 MOVE WRK-SSN3 TO CHG-DTL-SSN3. CHGBR170
00559 MOVE CHG4-CLMNT-NAME TO CHG-DTL-NAME. CHGBR170
00560 CHGBR170
00561 * DISPLAY ' CHG4 SSN: ' WRK-SSN. CL*12
00562 MOVE CHG4-BYE TO L001-FED-8-DATE-9. CHGBR170
00563 SET L001-FROM-FED-8 TO TRUE. CHGBR170
00564 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR170
00565 MOVE L001-SLASH-8-DATE TO CHG-DTL-BYE. CHGBR170
00566 CHGBR170
00567 EVALUATE TRUE CHGBR170
00568 WHEN CHG4-PROG-UI CHGBR170
00569 MOVE WRK-REG-BENEFITS TO CHG-DTL-SOURCE CHGBR170
00570 CHGBR170
00571 WHEN CHG4-PROG-EB CHGBR170
00572 MOVE WRK-EXT-BENEFITS TO CHG-DTL-SOURCE CHGBR170
00573 CHGBR170
00574 WHEN CHG4-PROG-TEUC CHGBR170
00575 MOVE WRK-TEUC-BENEFITS TO CHG-DTL-SOURCE CHGBR170
00576 CHGBR170
00577 WHEN CHG4-PROG-TEUCA CHGBR170
00578 MOVE WRK-TEUCA-BENEFITS TO CHG-DTL-SOURCE CHGBR170
00579 CHGBR170
00580 WHEN CHG4-PROG-FAC CHGBR170
00581 MOVE WRK-FAC-BENEFITS TO CHG-DTL-SOURCE CHGBR170
00582 WHEN CHG4-PROG-PUA CL*13
00583 MOVE WRK-PUA-BENEFITS TO CHG-DTL-SOURCE CL*13
00584 WHEN CHG4-PROG-FRUR CL*13
00585 MOVE WRK-RUR-BENEFITS TO CHG-DTL-SOURCE CL*13
00586 WHEN CHG4-PROG-PEUC CL*13
00587 MOVE WRK-EUC-BENEFITS TO CHG-DTL-SOURCE CL*13
00588 CL**3
00589 WHEN CHG4-PROG-FPUC CL**3
00590 MOVE WRK-FPUC-BENEFITS TO CHG-DTL-SOURCE CL**3
00591 CHGBR170
00592 WHEN OTHER CHGBR170
00593 MOVE ' UNKNOWN ' TO CHG-DTL-SOURCE CHGBR170
00594 END-EVALUATE. CHGBR170
00595 CHGBR170
00596 COMPUTE WRK-TOT-AMT = CHGBR170
00597 CHG4-TOT-BEN-AMT + CHGBR170
00598 CHG4-TOT-ADJ-AMT. CHGBR170
00599 MOVE WRK-TOT-AMT TO CHG-DTL-TOT-AMT CHGBR170
00600 CHGBR170
00601 COMPUTE WRK-CURR-AMT = CHGBR170
00602 CHG4-CURR-BEN-AMT + CHGBR170
00603 CHG4-CURR-ADJ-AMT. CHGBR170
00604 MOVE WRK-CURR-AMT TO CHG-DTL-CURR-AMT. CHGBR170
00605 CHGBR170
00606 IF WRK-CURR-AMT NOT = ZEROS CHGBR170
00607 * DISPLAY 'CHG DETAIL ' CHG-DETAIL-LINE CL*12
00608 WRITE CHRG-RPT-REC FROM CHG-DETAIL-LINE CL**8
00609 AFTER ADVANCING 1 LINE CHGBR170
00610 IF NOT FPUC-CHRG-OK-88 CL**9
00611 DISPLAY 'WRITE ERROR ' FPUC-CHRG-STATUS CL*11
00612 MOVE 'FPUC CHRG FILE WRITE ERROR: ' TO ABEND-MSG CL**9
00613 PERFORM S999-ABEND THRU S999-EXIT CL**9
00614 END-IF CL**9
00615 CL**9
00616 ADD +1 TO WRK-LINE-CNT CHGBR170
00617 PERFORM P3900-TOTALS THRU P3900-EXIT CHGBR170
00618 * DISPLAY 'FPUC CHRG FILE WRITE OK: ' CL*12
00619 END-IF. CHGBR170
00620 CHGBR170
00621 P3000-EXIT. CHGBR170
00622 EXIT. CHGBR170
00623 CHGBR170
00624 P3900-TOTALS. CHGBR170
00625 COMPUTE WRK-EMP-ACCT-CHG = CHGBR170
00626 WRK-EMP-ACCT-CHG + CHGBR170
00627 CHG4-CURR-BEN-AMT + CHGBR170
00628 CHG4-CURR-ADJ-AMT. CHGBR170
00629 CHGBR170
00630 COMPUTE WRK-RPT-ACCT-CHG = CHGBR170
00631 WRK-RPT-ACCT-CHG + CHGBR170
00632 CHG4-CURR-BEN-AMT + CHGBR170
00633 CHG4-CURR-ADJ-AMT. CHGBR170
00634 CHGBR170
00635 COMPUTE WRK-EMP-TOT-CHG = CHGBR170
00636 WRK-EMP-TOT-CHG + CHGBR170
00637 CHG4-TOT-BEN-AMT + CHGBR170
00638 CHG4-TOT-ADJ-AMT. CHGBR170
00639 CHGBR170
00640 COMPUTE WRK-RPT-TOT-CHG = CHGBR170
00641 WRK-RPT-TOT-CHG + CHGBR170
00642 CHG4-TOT-BEN-AMT + CHGBR170
00643 CHG4-TOT-ADJ-AMT. CHGBR170
00644 CHGBR170
00645 P3900-EXIT. CHGBR170
00646 EXIT. CHGBR170
00647 CHGBR170
00648 T0000-TERMINATE. CHGBR170
00649 IF WRK-EMPLYR-CNT > 0 CHGBR170
00650 PERFORM P2000-EMP-COMPLETE THRU P2000-EXIT CHGBR170
00651 END-IF. CL**8
00652 CHGBR170
00653 IF WRK-EMPLYR-CNT > 1 CHGBR170
00654 PERFORM T1000-FINAL-TOTALS THRU T1000-EXIT CHGBR170
00655 END-IF. CL**7
00656 CHGBR170
00657 CLOSE BEN-CHRG-FPUC-RPT. CL**3
00658 CHGBR170
00659 T0000-EXIT. CHGBR170
00660 EXIT. CHGBR170
00661 CHGBR170
00662 T1000-FINAL-TOTALS. CHGBR170
00663 MOVE SPACE TO CHG-DETAIL-HDR4. CHGBR170
00664 PERFORM P1000-PRINT-HEADER THRU P1000-EXIT. CHGBR170
00665 CHGBR170
00666 MOVE WRK-RPT-TOT-CHG TO CHG-DTL-RPT-TOT-CHG. CHGBR170
00667 MOVE WRK-RPT-ACCT-CHG TO CHG-DTL-RPT-ACCT-CHG. CHGBR170
00668 CHGBR170
00669 WRITE CHRG-RPT-REC FROM CHG-DETAIL-RPT-FOOTER2 CHGBR170
00670 AFTER ADVANCING 3 LINES. CHGBR170
00671 CHGBR170
00672 MOVE WRK-SSN-COUNT TO CHG-DTL-RPT-SSNS. CHGBR170
00673 WRITE CHRG-RPT-REC FROM CHG-DETAIL-RPT-FOOTER3 CHGBR170
00674 AFTER ADVANCING 3 LINES. CHGBR170
00675 CHGBR170
00676 WRITE CHRG-RPT-REC FROM CHG-DETAIL-RPT-FOOTER1 CHGBR170
00677 AFTER ADVANCING 2 LINES. CHGBR170
00678 CHGBR170
00679 T1000-EXIT. CHGBR170
00680 EXIT. CHGBR170
00681 CHGBR170
00682 S999-ABEND. CHGBR170
00683 DISPLAY '**** CHGBR170 ABENDING ' CL**3
00684 ABEND-MSG. CHGBR170
00685 CHGBR170
00686 CALL 'DTSBU999' USING WRK-ABEND-CODE. CHGBR170
00687 CHGBR170
00688 S999-EXIT. CHGBR170
00689 EXIT. CHGBR170