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