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