00001 IDENTIFICATION DIVISION. 05/15/19 00002 PROGRAM-ID. CHGBR130. CHGBR130 00003 *AUTHOR. TRW. LV072 00004 *DATE-WRITTEN. APRIL 2000. CHGBR130 00005 DATE-COMPILED. CHGBR130 00006 CHGBR130 00007 ***** CHGBR130 00008 * CALLING SEQUENCE: CHGBD300 CALLS CHGBR130 00009 * CHGBR130 READS CHGIM004 RECORDS CHGBR130 00010 * CHGBR130 WRITES FEDERAL/SPECIAL RPT. CHGBR130 00011 * CHGBR130 00012 * FUNCTION: PRINT FEDERAL SUMMARY/SPECIAL REPORT CHGBR130 00013 * CHGBR130 00014 * DESCRIPTION: CHGBR130 00015 * CHGBR130 00016 * THIS MODULE GENERATES THE QUARTERLY/SPECIAL FEDERAL CHGBR130 00017 * SUMMARY/SPECIAL REPORT. CHGBR130 00018 * CHGBR130 00019 * RECORDS READ: CHGBR130 00020 * CHGBR130 00021 * NONE. CHGBR130 00022 * CHGBR130 00023 * INPUT: CHGBR130 00024 * CHGBR130 00025 * CHGIM004 RECORD PASSED FROM CHGBD300 CHGBR130 00026 * CHGBR130 00027 * PRINTED OUTPUTS: CHGBR130 00028 * CHGBR130 00029 * RPC130R1 - PRINT FEDERAL SUMMARY REPORT CHGBR130 00030 * CHGBR130 00031 * MODULES CALLED: CHGBR130 00032 * CHGBR130 00033 * DTSBU001 DATE EDIT/CONVERSION MODULE CHGBR130 00034 * CHGBR130 00035 ***** CHGBR130 00036 CHGBR130 00037 ******************************************************************CHGBR130 00038 * MODIFICATION HISTORY: *CHGBR130 00039 * *CHGBR130 00040 * 02-08-2001 ADDED A HDR TO 'GRAND TOTALS' PAGE, AND WILL NOW *CHGBR130 00041 * PRINT IT ONLY IF MORE THAN ONE EMPLOYER HAS BEEN *CHGBR130 00042 * REPORTED. FIXED OVERRUN ON 1ST PAGE. - JHP *CHGBR130 00043 * *CHGBR130 00044 * 04-25-2000 MODIFIED THE REPORT WRITER CHGBR130 TO COBOL II *CHGBR130 00045 * PROGRAM. *CHGBR130 00046 * REFERENCE RFP # AUTHOR OF CHANGE - RLW *CHGBR130 00047 * *CHGBR130 00048 * 02-02-1999 MODIFIED FROM MT CHG100D *CHGBR130 00049 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBR130 00050 * *CHGBR130 00051 * 72-28-2008 REMOVED ORLANDO NAME FROM REPORT *CHGBR130 00052 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBR130 00053 * *CHGBR130 00054 * 04-03-2009 MODIFIED FOR NEW PROGRAM CODE VALUES *CHGBR130 00055 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBR130 00056 * *CHGBR130 00057 * 01-07-2010 MODIFIED TO EXCLUDE EB CHARGES FOR THE FEDS *CHGBR130 00058 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBR130 00059 * *CHGBR130 00060 * 05-14-2010 RECOMPILE FOR NEW VERSION OF CHGIM004 *CHGBR130 00061 * PRINT LAST 4 DIGITS OF SSN *CHGBR130 00062 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBR130 00063 * *CHGBR130 00064 * 10-04-2014 RECOMPILE FOR NEW VERSION OF CHGIM004 *CHGBR130 00065 * REFERENCE RFP # UCPIA AUTHOR OF CHANGE - ZL1 *CHGBR130 00066 ******************************************************************CHGBR130 00067 CHGBR130 00068 ENVIRONMENT DIVISION. CHGBR130 00069 CONFIGURATION SECTION. CHGBR130 00070 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CHGBR130 00071 CHGBR130 00072 INPUT-OUTPUT SECTION. CHGBR130 00073 FILE-CONTROL. CHGBR130 00074 *** BEN.CHG. RPT (O) CHGBR130 00075 SELECT FEDERAL-CSV ASSIGN TO CSV130R1. CHGBR130 00076 SELECT FEDERAL-RPT ASSIGN TO RPC130R1. CHGBR130 00077 SELECT MILITARY-RPT ASSIGN TO RPC130R2. CHGBR130 00078 EJECT CHGBR130 00079 DATA DIVISION. CHGBR130 00080 FILE SECTION. CHGBR130 00081 CHGBR130 00082 FD FEDERAL-RPT CHGBR130 00083 RECORDING MODE IS F CHGBR130 00084 RECORD CONTAINS 133 CHARACTERS CHGBR130 00085 BLOCK CONTAINS 0 RECORDS. CHGBR130 00086 CHGBR130 00087 01 FEDERAL-REPORT PIC X(133). CHGBR130 00088 CHGBR130 00089 FD FEDERAL-CSV. CHGBR130 00090 01 FEDERAL-CSV-REC PIC X(678). CHGBR130 00091 *NH CHGBR130 00092 FD MILITARY-RPT CHGBR130 00093 RECORDING MODE IS F CHGBR130 00094 RECORD CONTAINS 133 CHARACTERS CHGBR130 00095 BLOCK CONTAINS 0 RECORDS. CHGBR130 00096 CHGBR130 00097 01 MILITARY-REPORT PIC X(133). CHGBR130 00098 *NH CHGBR130 00099 WORKING-STORAGE SECTION. CHGBR130 000995 77 PAN-VALET PICTURE X(24) VALUE '072CHGBR130 05/15/19'. CHGBR130 00100 77 PAN-VALET PICTURE X(24) VALUE '046CHGBR130 10/24/18'. CHGBR130 00101 77 PAN-VALET PICTURE X(24) VALUE '070CHGBR130 09/17/10'. CHGBR130 00102 CHGBR130 00103 01 WRK-AREA. CHGBR130 00104 05 WRK-ABEND-CODE PIC S9(04) COMP VALUE +130. CHGBR130 00105 CHGBR130 00106 05 ABEND-MSG PIC X(60) VALUE SPACE. CHGBR130 00107 CHGBR130 00108 05 ABEND-MOD PIC X(08) VALUE 'DTSBU999'. CHGBR130 00109 CHGBR130 00110 05 WRK-REG-BEN-PAYMENT PIC X(25) CHGBR130 00111 VALUE ' REGULAR BENEFIT PAYMENT '. CHGBR130 00112 05 WRK-EXT-BEN-PAYMENT PIC X(25) CHGBR130 00113 VALUE ' EXTENDED BENEFIT PAYMENT'. CHGBR130 00114 05 WRK-TEUC-BEN-PAYMENT PIC X(25) CHGBR130 00115 VALUE ' TEUC BENEFIT PAYMENT '. CHGBR130 00116 05 WRK-TEUCA-BEN-PAYMENT PIC X(25) CHGBR130 00117 VALUE ' TEUCA BENEFIT PAYMENT '. CHGBR130 00118 05 WRK-FAC-BEN-PAYMENT PIC X(25) CHGBR130 00119 VALUE ' FED ADDL COMP PAYMENT '. CHGBR130 00120 05 WRK-ADJUSTMENTS PIC X(25) CHGBR130 00121 VALUE ' ADJUSTMENTS '. CHGBR130 00122 05 WRK-RPT-SUMMARY PIC X(26) CHGBR130 00123 VALUE 'QUARTERLY CHARGE SUMMARY'. CHGBR130 00124 05 WRK-RPT-SPECIAL PIC X(26) CHGBR130 00125 VALUE ' BENEFIT CHARGE SPECIAL '. CHGBR130 00126 CHGBR130 00127 05 WRK-SSN PIC 9(09) VALUE 0. CHGBR130 00128 05 FILLER REDEFINES WRK-SSN. CHGBR130 00129 10 WRK-SSN1 PIC 9(03). CHGBR130 00130 10 WRK-SSN2 PIC 9(02). CHGBR130 00131 10 WRK-SSN3 PIC 9(04). CHGBR130 00132 CHGBR130 00133 05 WRK-RUN-DATE. CHGBR130 00134 10 WRK-RUN-YY PIC 9(04) VALUE ZEROS. CHGBR130 00135 10 WRK-RUN-MM PIC 9(02) VALUE ZEROS. CHGBR130 00136 10 WRK-RUN-DD PIC 9(02) VALUE ZEROS. CHGBR130 00137 CHGBR130 00138 05 WRK-LINE-CNT PIC S9(04) COMP VALUE +0. CHGBR130 00139 05 WRK-PAGE-CNT PIC S9(04) COMP VALUE +0. CHGBR130 00140 05 WRK-EMPLYR-CNT PIC 9(07) COMP VALUE 0. CHGBR130 00141 05 WS-SYSTEM-DATE PIC 9(08) VALUE 0. CHGBR130 00142 05 WS-REC PIC X(133) VALUE SPACES. CHGBR130 00143 CHGBR130 00144 05 WRK-CURR-EMP PIC 9(06) VALUE 0. CHGBR130 00145 05 ZWRK-CURR-EMP REDEFINES WRK-CURR-EMP. CHGBR130 00146 10 WRK-CURR-EMPA PIC 999. CHGBR130 00147 10 WRK-CURR-EMPB PIC 999. CHGBR130 00148 05 WRK-CURR-AMT PIC S9(07)V99 COMP-3 VALUE +0. CHGBR130 00149 05 WRK-TOT-AMT PIC S9(07)V99 COMP-3 VALUE +0. CHGBR130 00150 05 WRK-TOTAL-BENEFITS PIC S9(09)V99 COMP-3 VALUE +0. CHGBR130 00151 05 WRK-ACCT-TOTAL PIC S9(09)V99 COMP-3 VALUE +0. CHGBR130 00152 05 WRK-GRAND-TOTAL-BENEFITS PIC S9(10)V99 COMP-3 VALUE +0. CHGBR130 00153 05 WRK-GRAND-TOTAL-CHARGED PIC S9(10)V99 COMP-3 VALUE +0. CHGBR130 00154 05 WRK-GRAND-TOT-BEN PIC Z(13)9.99-. CHGBR130 00155 05 WRK-GRAND-TOT-CHG PIC Z(13)9.99-. CHGBR130 00156 05 NAME-REFORMAT-AREA. CHGBR130 00157 10 NAME-MAX PIC S9(04) COMP VALUE +32. CHGBR130 00158 10 S1 PIC S9(04) COMP VALUE +0. CHGBR130 00159 10 S2 PIC S9(04) COMP VALUE +0. CHGBR130 00160 10 S3 PIC S9(04) COMP VALUE +0. CHGBR130 00161 10 WRK-LAST-FOUND PIC X(01). CHGBR130 00162 88 WRK-LAST-FOUND-YES-88 VALUE 'Y'. CHGBR130 00163 88 WRK-LAST-FOUND-NO-88 VALUE 'N'. CHGBR130 00164 10 WRK-FIRST-FOUND PIC X(01). CHGBR130 00165 88 WRK-FIRST-FOUND-YES-88 VALUE 'Y'. CHGBR130 00166 88 WRK-FIRST-FOUND-NO-88 VALUE 'N'. CHGBR130 00167 10 WRK-INIT-FOUND PIC X(01). CHGBR130 00168 88 WRK-INIT-FOUND-YES-88 VALUE 'Y'. CHGBR130 00169 88 WRK-INIT-FOUND-NO-88 VALUE 'N'. CHGBR130 00170 10 WRK-LAST-NAME PIC X(32). CHGBR130 00171 10 WRK-FIRST-NAME PIC X(32). CHGBR130 00172 10 WRK-MID-INIT PIC X(01). CHGBR130 00173 CHGBR130 00174 CHGBR130 00175 CHGBR130 00176 01 FSDES-LINE. CHGBR130 00177 10 FILLER PIC X(02) VALUE 'QB'. CHGBR130 00178 10 FILLER PIC X(01) VALUE ','. CHGBR130 00179 10 FSDES-DATE PIC 9(08). CHGBR130 00180 10 FILLER PIC X(01) VALUE ','. CHGBR130 00181 10 FSDES-STATE PIC X(02) VALUE 'DC'. CHGBR130 00182 10 FILLER PIC X(01) VALUE ','. CHGBR130 00183 10 FSDES-FIC PIC 9(03). CHGBR130 00184 10 FILLER PIC X(01) VALUE ','. CHGBR130 00185 10 FSDES-SSN PIC X(09). CHGBR130 00186 10 FILLER PIC X(01) VALUE ','. CHGBR130 00187 10 FSDES-FNAME PIC X(25). CHGBR130 00188 10 FILLER PIC X(01) VALUE ','. CHGBR130 00189 10 FSDES-INAME PIC X(01). CHGBR130 00190 10 FILLER PIC X(01) VALUE ','. CHGBR130 00191 10 FSDES-LNAME PIC X(30). CHGBR130 00192 10 FILLER PIC X(01) VALUE ','. CHGBR130 00193 10 FSDES-QTR PIC X(01). CHGBR130 00194 10 FILLER PIC X(01) VALUE ','. CHGBR130 00195 10 FSDES-YEAR PIC 9(04). CHGBR130 00196 10 FILLER PIC X(01) VALUE ','. CHGBR130 00197 10 FSDES-BYE PIC 9(08). CHGBR130 00198 10 FILLER PIC X(01) VALUE ','. CHGBR130 00199 10 FSDES-PAID PIC 9999999.99. CHGBR130 00200 10 FILLER PIC X(01) VALUE ','. CHGBR130 00201 10 FSDES-CHARGED PIC 9999999.99. CHGBR130 00202 10 FILLER PIC X(01) VALUE ','. CHGBR130 00203 10 FSDES-CODE PIC X(03). CHGBR130 00204 10 FILLER PIC X(01) VALUE ','. CHGBR130 00205 10 FSDES-PERCENT PIC 999.99999. CHGBR130 00206 10 FILLER PIC X(01) VALUE ','. CHGBR130 00207 10 FSDES-CREDIT PIC 9999999.99. CHGBR130 00208 10 FILLER PIC X(01) VALUE ','. CHGBR130 00209 10 FSDES-CRE-BEG-DATE PIC X(08). CHGBR130 00210 10 FILLER PIC X(01) VALUE ','. CHGBR130 00211 10 FSDES-CRE-END-DATE PIC X(08). CHGBR130 00212 10 FILLER PIC X(01) VALUE ','. CHGBR130 00213 10 FSDES-CRE-REASON PIC X(500). CHGBR130 00214 10 FILLER PIC X(01) VALUE ','. CHGBR130 00215 10 FSDES-BYB PIC X(08). CHGBR130 00216 CHGBR130 00217 CHGBR130 00218 01 REPORT-LINE-AREA. CHGBR130 00219 05 HEAD01. CHGBR130 00220 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00221 10 FILLER PIC X(08) VALUE 'CHGBR130'. CHGBR130 00222 10 FILLER PIC X(47) VALUE SPACE. CHGBR130 00223 10 FILLER PIC X(20) VALUE 'DISTRICT OF COLUMBIA'. CHGBR130 00224 10 FILLER PIC X(42) VALUE SPACE. CHGBR130 00225 10 FILLER PIC X(09) VALUE 'PAGE NO.:'. CHGBR130 00226 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00227 10 WRK-PRT-PAGE-CNT PIC ZZZ99. CHGBR130 00228 CHGBR130 00229 05 HEAD02. CHGBR130 00230 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00231 10 FILLER PIC X(10) VALUE ' '. CHGBR130 00232 10 FILLER PIC X(42) VALUE SPACE. CHGBR130 00233 10 H2-RPT-TYP PIC X(26) VALUE SPACE. CHGBR130 00234 * 10 FILLER PIC X(13) VALUE 'QUARTERLY CH'. CHGBR130 00235 * 10 FILLER PIC X(13) VALUE 'ARGE SUMMARY'. CHGBR130 00236 10 FILLER PIC X(49) VALUE SPACE. CHGBR130 00237 10 FILLER PIC X(02) VALUE 'TT'. CHGBR130 00238 10 WRK-PRT-EMP-TYPE PIC X(02) VALUE SPACE. CHGBR130 00239 CHGBR130 00240 05 HEAD03. CHGBR130 00241 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00242 10 FILLER PIC X(10) VALUE 'ROOM 325'. CHGBR130 00243 10 FILLER PIC X(35) VALUE SPACE. CHGBR130 00244 10 FILLER PIC X(13) VALUE 'DEPARTMENT '. CHGBR130 00245 10 FILLER PIC X(13) VALUE 'OF EMPLOYME'. CHGBR130 00246 10 FILLER PIC X(13) VALUE 'NT SERVICES'. CHGBR130 00247 CHGBR130 00248 05 HEAD04. CHGBR130 00249 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00250 10 FILLER PIC X(49) VALUE SPACE. CHGBR130 00251 10 FILLER PIC X(12) VALUE 'EMPLOYER ACC'. CHGBR130 00252 10 FILLER PIC X(12) VALUE 'OUNT NUMBER '. CHGBR130 00253 10 WRK-PRT-HDR-EMP PIC 9(06). CHGBR130 00254 CHGBR130 00255 05 HEAD05. CHGBR130 00256 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00257 10 FILLER PIC X(39) VALUE SPACE. CHGBR130 00258 10 FILLER PIC X(14) VALUE 'REPORT INCLUDE'. CHGBR130 00259 10 FILLER PIC X(14) VALUE 'S PERIOD FROM '. CHGBR130 00260 10 WS-REPORT-START-DATE PIC X(10) VALUE SPACE. CHGBR130 00261 10 FILLER PIC X(04) VALUE ' TO '. CHGBR130 00262 10 WS-REPORT-END-DATE PIC X(10) VALUE SPACE. CHGBR130 00263 CHGBR130 00264 05 HEAD06. CHGBR130 00265 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00266 10 FILLER PIC X(05) VALUE SPACE. CHGBR130 00267 10 FILLER PIC X(03) VALUE 'SSN'. CHGBR130 00268 10 FILLER PIC X(10) VALUE SPACE. CHGBR130 00269 10 FILLER PIC X(03) VALUE 'BYE'. CHGBR130 00270 10 FILLER PIC X(09) VALUE SPACE. CHGBR130 00271 10 FILLER PIC X(09) VALUE 'NAME OF '. CHGBR130 00272 10 FILLER PIC X(09) VALUE ' CLAIMANT'. CHGBR130 00273 10 FILLER PIC X(19) VALUE SPACE. CHGBR130 00274 10 FILLER PIC X(14) VALUE 'TOTAL BENEFITS'. CHGBR130 00275 10 FILLER PIC X(05) VALUE SPACE. CHGBR130 00276 10 FILLER PIC X(15) VALUE 'ACCOUNT CHARGES'. CHGBR130 00277 10 FILLER PIC X(09) VALUE SPACE. CHGBR130 00278 10 FILLER PIC X(11) VALUE 'SOURCE TYPE'. CHGBR130 00279 CHGBR130 00280 05 WRK-PRINT-LINE. CHGBR130 00281 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00282 10 FILLER PIC X(04) VALUE SPACE. CHGBR130 00283 10 WRK-PRT-SSN1 PIC X(03) VALUE SPACE. CHGBR130 00284 10 FILLER PIC X(01) VALUE '-'. CHGBR130 00285 10 WRK-PRT-SSN2 PIC X(02) VALUE SPACE. CHGBR130 00286 10 FILLER PIC X(01) VALUE '-'. CHGBR130 00287 10 WRK-PRT-SSN3 PIC X(04) VALUE SPACE. CHGBR130 00288 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00289 10 WRK-PRT-BYE-DATE PIC X(10) VALUE SPACE. CHGBR130 00290 10 FILLER PIC X(03) VALUE SPACE. CHGBR130 00291 10 WRK-PRT-CLMNT-NAME PIC X(32) VALUE SPACE. CHGBR130 00292 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00293 10 WRK-PRT-TOT-AMT PIC $$,$$$,$$$,$$9.99-. CHGBR130 00294 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00295 10 WRK-PRT-CURR-AMT PIC $$,$$$,$$$,$$9.99-. CHGBR130 00296 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00297 10 WRK-PRT-SOURCE-TYPE PIC X(25) VALUE SPACE. CHGBR130 00298 CHGBR130 00299 05 WRK-PRINT-LINE-MIL. CHGBR130 00300 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00301 10 WRK-PRT-EMPNUM-MIL PIC X(07) VALUE SPACE. CHGBR130 00302 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00303 10 WRK-PRT-SSN1-MIL PIC X(03) VALUE SPACE. CHGBR130 00304 10 FILLER PIC X(01) VALUE '-'. CHGBR130 00305 10 WRK-PRT-SSN2-MIL PIC X(02) VALUE SPACE. CHGBR130 00306 10 FILLER PIC X(01) VALUE '-'. CHGBR130 00307 10 WRK-PRT-SSN3-MIL PIC X(04) VALUE SPACE. CHGBR130 00308 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00309 10 WRK-PRT-BYE-DATE-MIL PIC X(10) VALUE SPACE. CHGBR130 00310 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00311 10 WRK-PRT-CLMNT-NAME-MIL PIC X(32) VALUE SPACE. CHGBR130 00312 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00313 10 WRK-PRT-TOT-AMT-MIL PIC $$,$$$,$$$,$$9.99-. CHGBR130 00314 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00315 10 WRK-PRT-CURR-AMT-MIL PIC $$,$$$,$$$,$$9.99-. CHGBR130 00316 10 FILLER PIC X(02) VALUE SPACE. CHGBR130 00317 10 WRK-PRT-SOURCE-TYPE-MIL PIC X(25) VALUE SPACE. CHGBR130 00318 CHGBR130 00319 05 WRK-PRINT-TOTAL. CHGBR130 00320 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00321 10 FILLER PIC X(34) VALUE SPACES. CHGBR130 00322 10 FILLER PIC X(20) VALUE 'GRAND TOTAL CHARGED:'. CHGBR130 00323 10 FILLER PIC X(10) VALUE SPACES. CHGBR130 00324 10 WRK-PRT-TOT-BEN PIC $$,$$$,$$$,$$9.99-. CHGBR130 00325 10 FILLER PIC X(22) VALUE SPACES. CHGBR130 00326 10 FILLER PIC X(25) VALUE CHGBR130 00327 ' ************ '. CHGBR130 00328 05 WRK-PRINT-TOTAL-ACCT. CHGBR130 00329 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00330 10 FILLER PIC X(39) VALUE SPACES. CHGBR130 00331 10 FILLER PIC X(14) VALUE 'GRAND TOTAL AC'. CHGBR130 00332 10 FILLER PIC X(14) VALUE 'COUNT CHARGED:'. CHGBR130 00333 10 FILLER PIC X(17) VALUE SPACES. CHGBR130 00334 10 WRK-PRT-ACCT-TOT PIC $$,$$$,$$$,$$9.99-. CHGBR130 00335 10 FILLER PIC X(04) VALUE SPACES. CHGBR130 00336 10 FILLER PIC X(25) VALUE CHGBR130 00337 ' ************ '. CHGBR130 00338 CHGBR130 00339 05 WRK-PRINT-GRAND. CHGBR130 00340 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00341 10 FILLER PIC X(64) VALUE SPACES. CHGBR130 00342 10 FILLER PIC X(20) VALUE '--------------------'. CHGBR130 00343 10 FILLER PIC X(21) VALUE '---------------------'. CHGBR130 00344 CHGBR130 00345 05 WRK-PRINT-GRAND-PERIOD. CHGBR130 00346 10 FILLER PIC X(01) VALUE SPACE. CHGBR130 00347 10 FILLER PIC X(13) VALUE SPACES. CHGBR130 00348 10 FILLER PIC X(19) VALUE 'TOTAL AMOUNT CHARGE'. CHGBR130 00349 10 FILLER PIC X(18) VALUE 'D FOR THE PERIOD: '. CHGBR130 00350 10 FILLER PIC X(14) VALUE SPACES. CHGBR130 00351 10 WRK-PRT-GRAND-TOT-BEN PIC $$,$$$,$$$,$$9.99-. CHGBR130 00352 10 FILLER PIC X(02) VALUE SPACES. CHGBR130 00353 10 WRK-PRT-GRAND-TOT-CHG PIC $$,$$$,$$$,$$9.99-. CHGBR130 00354 10 FILLER PIC X(03) VALUE SPACES. CHGBR130 00355 10 FILLER PIC X(25) VALUE CHGBR130 00356 ' ************ '. CHGBR130 00357 CHGBR130 00358 01 L001-LINK-AREA. CHGBR130 00359 ++INCLUDE DTSIL001 CHGBR130 00360 CHGBR130 00361 CHGBR130 00362 01 L004-LINK-AREA. CHGBR130 00363 ++INCLUDE DTSIL004 CHGBR130 00364 CHGBR130 00365 CHGBR130 00366 01 L005-LINK-AREA. CHGBR130 00367 ++INCLUDE DTSIL005 CHGBR130 00368 CHGBR130 00369 EJECT CHGBR130 00370 LINKAGE SECTION. CHGBR130 00371 CHGBR130 00372 01 REPORT-LINK-AREA. CHGBR130 00373 ++INCLUDE CHGIL001 CHGBR130 00374 CHGBR130 00375 01 BD210-CHG-REC. CHGBR130 00376 ++INCLUDE CHGIM004 CHGBR130 00377 EJECT CHGBR130 00378 PROCEDURE DIVISION USING REPORT-LINK-AREA CHGBR130 00379 BD210-CHG-REC. CHGBR130 00380 CHGBR130 00381 CHGBR130-MAIN. CHGBR130 00382 IF CHG-LINK1-CMD-INIT-88 CHGBR130 00383 PERFORM I0000-INITIATE THRU I0000-EXIT CHGBR130 00384 ELSE CHGBR130 00385 IF CHG-LINK1-CMD-PROCESS-88 CHGBR130 00386 PERFORM P0000-PROCESS THRU P0000-EXIT CHGBR130 00387 ELSE CHGBR130 00388 IF CHG-LINK1-CMD-CLOSE-88 CHGBR130 00389 PERFORM T0000-TERMINATE THRU T0000-EXIT CHGBR130 00390 ELSE CHGBR130 00391 MOVE 'INVALID CHG-LINK1-COMMAND VALUE' CHGBR130 00392 TO ABEND-MSG CHGBR130 00393 PERFORM S999-ABEND THRU S999-EXIT CHGBR130 00394 END-IF CHGBR130 00395 END-IF CHGBR130 00396 END-IF. CHGBR130 00397 CHGBR130 00398 CHGBR130-EXIT. CHGBR130 00399 GOBACK. CHGBR130 00400 CHGBR130 00401 I0000-INITIATE. CHGBR130 00402 IF CHG-LINK1-RUN-TYPE-SPC-88 CHGBR130 00403 MOVE WRK-RPT-SPECIAL TO H2-RPT-TYP CHGBR130 00404 ELSE CHGBR130 00405 MOVE WRK-RPT-SUMMARY TO H2-RPT-TYP CHGBR130 00406 END-IF. CHGBR130 00407 CHGBR130 00408 MOVE CHG-LINK1-PERIOD-BEGIN TO L001-FED-8-DATE-9. CHGBR130 00409 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR130 00410 MOVE L001-SLASH-8-DATE TO WS-REPORT-START-DATE. CHGBR130 00411 CHGBR130 00412 MOVE CHG-LINK1-PERIOD-END TO L001-FED-8-DATE-9. CHGBR130 00413 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR130 00414 MOVE L001-SLASH-8-DATE TO WS-REPORT-END-DATE. CHGBR130 00415 CHGBR130 00416 ACCEPT WS-SYSTEM-DATE FROM DATE. CHGBR130 00417 DISPLAY 'DATE: ' WS-SYSTEM-DATE. CHGBR130 00418 CHGBR130 00419 OPEN OUTPUT FEDERAL-RPT FEDERAL-CSV CHGBR130 00420 MILITARY-RPT. CHGBR130 00421 I0000-EXIT. CHGBR130 00422 EXIT. CHGBR130 00423 EJECT CHGBR130 00424 P0000-PROCESS. CHGBR130 00425 PERFORM P1000-CHK-FOR-NEW-PAGE THRU P1000-EXIT CHGBR130 00426 CHGBR130 00427 EVALUATE TRUE CHGBR130 00428 WHEN CHG4-PROG-UI CHGBR130 00429 MOVE WRK-REG-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR130 00430 WRK-PRT-SOURCE-TYPE-MIL CHGBR130 00431 CHGBR130 00432 * WHEN CHG4-PROG-EB CHGBR130 00433 * MOVE WRK-EXT-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR130 00434 CHGBR130 00435 WHEN CHG4-PROG-TEUC CHGBR130 00436 MOVE WRK-TEUC-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR130 00437 WRK-PRT-SOURCE-TYPE-MIL CHGBR130 00438 CHGBR130 00439 WHEN CHG4-PROG-TEUCA CHGBR130 00440 MOVE WRK-TEUCA-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR130 00441 WRK-PRT-SOURCE-TYPE-MIL CHGBR130 00442 CHGBR130 00443 WHEN CHG4-PROG-FAC CHGBR130 00444 MOVE WRK-FAC-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR130 00445 WRK-PRT-SOURCE-TYPE-MIL CHGBR130 00446 CHGBR130 00447 WHEN OTHER CHGBR130 00448 MOVE ' UNKNOWN ' TO WRK-PRT-SOURCE-TYPE CHGBR130 00449 WRK-PRT-SOURCE-TYPE-MIL CHGBR130 00450 END-EVALUATE. CHGBR130 00451 CHGBR130 00452 IF CHG4-PROG-EB CHGBR130 00453 GO TO P0000-EXIT. CHGBR130 00454 CHGBR130 00455 MOVE CHG4-SSN TO WRK-SSN CHGBR130 00456 MOVE WRK-SSN1 TO WRK-PRT-SSN1 CHGBR130 00457 WRK-PRT-SSN1-MIL. CHGBR130 00458 MOVE WRK-SSN2 TO WRK-PRT-SSN2 CHGBR130 00459 WRK-PRT-SSN2-MIL. CHGBR130 00460 MOVE WRK-SSN3 TO WRK-PRT-SSN3 CHGBR130 00461 WRK-PRT-SSN3-MIL. CHGBR130 00462 CHGBR130 00463 MOVE CHG4-BYE TO L001-FED-8-DATE-9. CHGBR130 00464 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR130 00465 MOVE L001-SLASH-8-DATE TO WRK-PRT-BYE-DATE CHGBR130 00466 WRK-PRT-BYE-DATE-MIL. CHGBR130 00467 MOVE CHG4-CLMNT-NAME TO WRK-PRT-CLMNT-NAME CHGBR130 00468 WRK-PRT-CLMNT-NAME-MIL. CHGBR130 00469 CHGBR130 00470 COMPUTE WRK-TOT-AMT = CHGBR130 00471 CHG4-TOT-BEN-AMT + CHG4-TOT-ADJ-AMT CHGBR130 00472 MOVE WRK-TOT-AMT TO WRK-PRT-TOT-AMT CHGBR130 00473 WRK-PRT-TOT-AMT-MIL. CHGBR130 00474 CHGBR130 00475 COMPUTE WRK-CURR-AMT = CHGBR130 00476 CHG4-CURR-BEN-AMT + CHG4-CURR-ADJ-AMT CHGBR130 00477 MOVE WRK-CURR-AMT TO WRK-PRT-CURR-AMT CHGBR130 00478 WRK-PRT-CURR-AMT-MIL. CHGBR130 00479 CHGBR130 00480 IF WRK-CURR-AMT NOT = ZERO CHGBR130 00481 IF WRK-CURR-EMP = (000801 OR 000802 OR 000803 OR CHGBR130 00482 000804 OR 000805) CHGBR130 00483 MOVE WRK-CURR-EMP TO WRK-PRT-EMPNUM-MIL CHGBR130 00484 WRITE MILITARY-REPORT FROM WRK-PRINT-LINE-MIL CHGBR130 00485 WRITE FEDERAL-REPORT FROM WRK-PRINT-LINE CHGBR130 00486 AFTER ADVANCING 1 LINE CHGBR130 00487 ADD +1 TO WRK-LINE-CNT CHGBR130 00488 PERFORM P1050-FSDES THRU P1050-EXIT CHGBR130 00489 PERFORM P4000-TOTALS THRU P4000-EXIT CHGBR130 00490 ELSE CHGBR130 00491 WRITE FEDERAL-REPORT FROM WRK-PRINT-LINE CHGBR130 00492 AFTER ADVANCING 1 LINE CHGBR130 00493 ADD +1 TO WRK-LINE-CNT CHGBR130 00494 PERFORM P1050-FSDES THRU P1050-EXIT CHGBR130 00495 PERFORM P4000-TOTALS THRU P4000-EXIT CHGBR130 00496 END-IF CHGBR130 00497 END-IF. CHGBR130 00498 CHGBR130 00499 P0000-EXIT. CHGBR130 00500 EXIT. CHGBR130 00501 CHGBR130 00502 P1000-CHK-FOR-NEW-PAGE. CHGBR130 00503 IF CHG4-EMP-NO NOT = WRK-CURR-EMP CHGBR130 00504 IF WRK-CURR-EMP = ZERO CHGBR130 00505 *** 1ST TIME CHGBR130 00506 MOVE CHG4-EMP-NO TO WRK-CURR-EMP CHGBR130 00507 WRK-PRT-HDR-EMP CHGBR130 00508 MOVE CHG4-EMP-TYPE TO WRK-PRT-EMP-TYPE CHGBR130 00509 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT CHGBR130 00510 ADD 1 TO WRK-EMPLYR-CNT CHGBR130 00511 ELSE CHGBR130 00512 *** NEW ONE CHGBR130 00513 PERFORM P1200-PRINT-FOOTER THRU P1200-EXIT CHGBR130 00514 MOVE CHG4-EMP-NO TO WRK-CURR-EMP CHGBR130 00515 WRK-PRT-HDR-EMP CHGBR130 00516 MOVE CHG4-EMP-TYPE TO WRK-PRT-EMP-TYPE CHGBR130 00517 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT CHGBR130 00518 ADD 1 TO WRK-EMPLYR-CNT CHGBR130 00519 ELSE CHGBR130 00520 *** SAME ONE CHGBR130 00521 IF WRK-LINE-CNT > +54 CHGBR130 00522 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT CHGBR130 00523 END-IF CHGBR130 00524 END-IF. CHGBR130 00525 CHGBR130 00526 P1000-EXIT. CHGBR130 00527 EXIT. CHGBR130 00528 CHGBR130 00529 P1050-FSDES. CHGBR130 00530 IF WRK-CURR-EMP = (000801 OR 000802 OR 000803 OR CHGBR130 00531 000804 OR 000805) CHGBR130 00532 GO TO P1050-EXIT. CHGBR130 00533 CHGBR130 00534 MOVE SPACES TO FSDES-CRE-REASON. CHGBR130 00535 MOVE ZEROS TO FSDES-CREDIT CHGBR130 00536 FSDES-PERCENT. CHGBR130 00537 MOVE SPACES TO FSDES-CRE-BEG-DATE CHGBR130 00538 FSDES-CRE-END-DATE CHGBR130 00539 FSDES-BYB. CHGBR130 00540 CHGBR130 00541 CHGBR130 00542 MOVE CHG4-BYE TO L001-FED-8-DATE-9. CHGBR130 00543 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR130 00544 MOVE L001-FED-8-DATE-9 TO FSDES-BYE. CHGBR130 00545 MOVE CHG4-SSN TO WRK-SSN CHGBR130 00546 MOVE WRK-SSN TO FSDES-SSN CHGBR130 00547 MOVE CHG4-EMP-NO TO WRK-CURR-EMP CHGBR130 00548 DISPLAY ' EMP ' WRK-CURR-EMP CHGBR130 00549 MOVE WRK-CURR-EMPB TO FSDES-FIC. CHGBR130 00550 CHGBR130 00551 PERFORM P1075-REFORMAT-NAME THRU P1075-EXIT. CHGBR130 00552 CHGBR130 00553 IF WRK-LAST-FOUND-YES-88 CHGBR130 00554 MOVE WRK-LAST-NAME TO FSDES-LNAME CHGBR130 00555 ELSE CHGBR130 00556 MOVE SPACES TO FSDES-LNAME. CHGBR130 00557 CHGBR130 00558 IF WRK-FIRST-FOUND-YES-88 CHGBR130 00559 MOVE WRK-FIRST-NAME TO FSDES-FNAME CHGBR130 00560 ELSE CHGBR130 00561 MOVE SPACES TO FSDES-FNAME. CHGBR130 00562 CHGBR130 00563 IF WRK-INIT-FOUND-YES-88 CHGBR130 00564 MOVE WRK-MID-INIT TO FSDES-INAME CHGBR130 00565 ELSE CHGBR130 00566 MOVE SPACES TO FSDES-INAME. CHGBR130 00567 CHGBR130 00568 EVALUATE TRUE CHGBR130 00569 WHEN CHG4-PROG-UI CHGBR130 00570 MOVE 'REG' TO FSDES-CODE CHGBR130 00571 WHEN CHG4-PROG-TEUC CHGBR130 00572 MOVE 'UC ' TO FSDES-CODE CHGBR130 00573 WHEN CHG4-PROG-TEUCA CHGBR130 00574 MOVE 'UCA' TO FSDES-CODE CHGBR130 00575 WHEN CHG4-PROG-FAC CHGBR130 00576 MOVE 'FED' TO FSDES-CODE CHGBR130 00577 WHEN OTHER CHGBR130 00578 MOVE 'UNK' TO FSDES-CODE CHGBR130 00579 END-EVALUATE. CHGBR130 00580 CHGBR130 00581 MOVE CHG-LINK1-PERIOD-BEGIN TO L004-DATE CHGBR130 00582 PERFORM S004-FROM-DATE THRU S004-EXIT. CHGBR130 00583 MOVE L004-SLASH-5-YR TO FSDES-YEAR CHGBR130 00584 MOVE L004-SLASH-5-Q TO FSDES-QTR CHGBR130 00585 CHGBR130 00586 IF WRK-CURR-AMT < 0 CHGBR130 00587 MOVE ZEROS TO FSDES-CHARGED CHGBR130 00588 MOVE WRK-CURR-AMT TO FSDES-CREDIT CHGBR130 00589 ELSE CHGBR130 00590 MOVE ZEROS TO FSDES-CREDIT CHGBR130 00591 MOVE WRK-CURR-AMT TO FSDES-CHARGED. CHGBR130 00592 CHGBR130 00593 IF WRK-TOT-AMT < 0 CHGBR130 00594 MOVE ZEROS TO FSDES-PAID CHGBR130 00595 * MOVE WRK-TOT-AMT TO FSDES-CREDIT CHGBR130 00596 ELSE CHGBR130 00597 MOVE WRK-TOT-AMT TO FSDES-PAID. CHGBR130 00598 CHGBR130 00599 SET L005-FROM-SYS TO TRUE. CHGBR130 00600 CALL 'DTSBU005' USING L005-LINK-AREA. CHGBR130 00601 CHGBR130 00602 MOVE L005-DATE-8-YR TO WRK-RUN-YY. CHGBR130 00603 MOVE L005-DATE-8-MO TO WRK-RUN-MM. CHGBR130 00604 MOVE L005-DATE-8-DA TO WRK-RUN-DD. CHGBR130 00605 CHGBR130 00606 MOVE WRK-RUN-DATE TO FSDES-DATE. CHGBR130 00607 WRITE FEDERAL-CSV-REC FROM FSDES-LINE. CHGBR130 00608 CHGBR130 00609 P1050-EXIT. CHGBR130 00610 EXIT. CHGBR130 00611 P1075-REFORMAT-NAME. CHGBR130 00612 INSPECT CHG4-CLMNT-NAME REPLACING ALL ',' BY SPACE. CHGBR130 00613 INSPECT CHG4-CLMNT-NAME REPLACING ALL LOW-VALUES BY SPACE. CHGBR130 00614 CHGBR130 00615 MOVE SPACES TO WRK-LAST-NAME CHGBR130 00616 WRK-FIRST-NAME CHGBR130 00617 WRK-MID-INIT. CHGBR130 00618 CHGBR130 00619 MOVE ZERO TO S1 CHGBR130 00620 S2. CHGBR130 00621 CHGBR130 00622 CHGBR130 00623 SET WRK-LAST-FOUND-NO-88 TO TRUE. CHGBR130 00624 SET WRK-FIRST-FOUND-NO-88 TO TRUE. CHGBR130 00625 SET WRK-INIT-FOUND-NO-88 TO TRUE. CHGBR130 00626 ** FIND LAST NAME CHGBR130 00627 PERFORM CHGBR130 00628 VARYING S1 FROM +1 BY +1 CHGBR130 00629 UNTIL WRK-LAST-FOUND-YES-88 CHGBR130 00630 OR S1 > NAME-MAX CHGBR130 00631 IF CHG4-CLMNT-NAME (S1:1) NOT = '/' CHGBR130 00632 ADD +1 TO S2 CHGBR130 00633 MOVE CHG4-CLMNT-NAME (S1:1) TO WRK-LAST-NAME(S2:1) CHGBR130 00634 ELSE CHGBR130 00635 MOVE S1 TO S3 CHGBR130 00636 SET WRK-LAST-FOUND-YES-88 TO TRUE CHGBR130 00637 END-IF CHGBR130 00638 END-PERFORM. CHGBR130 00639 CHGBR130 00640 ** FIND FIRST NAME CHGBR130 00641 MOVE ZERO TO S2. CHGBR130 00642 IF S3 = +32 CHGBR130 00643 GO TO P1075-EXIT CHGBR130 00644 END-IF. CHGBR130 00645 CHGBR130 00646 ADD +1 TO S3. CHGBR130 00647 CHGBR130 00648 PERFORM CHGBR130 00649 VARYING S1 FROM S3 BY +1 CHGBR130 00650 UNTIL WRK-FIRST-FOUND-YES-88 CHGBR130 00651 OR S1 > NAME-MAX CHGBR130 00652 IF CHG4-CLMNT-NAME (S1:1) NOT = ' ' CHGBR130 00653 ADD +1 TO S2 CHGBR130 00654 MOVE CHG4-CLMNT-NAME (S1:1) TO WRK-FIRST-NAME(S2:1) CHGBR130 00655 ELSE CHGBR130 00656 MOVE S1 TO S3 CHGBR130 00657 SET WRK-FIRST-FOUND-YES-88 TO TRUE CHGBR130 00658 END-IF CHGBR130 00659 END-PERFORM. CHGBR130 00660 ** FIND MIDDLE INITIAL CHGBR130 00661 CHGBR130 00662 IF S3 = +32 CHGBR130 00663 GO TO P1075-EXIT CHGBR130 00664 END-IF. CHGBR130 00665 CHGBR130 00666 PERFORM CHGBR130 00667 VARYING S1 FROM NAME-MAX BY -1 CHGBR130 00668 UNTIL WRK-INIT-FOUND-YES-88 CHGBR130 00669 OR S1 < S3 CHGBR130 00670 IF CHG4-CLMNT-NAME (S1:1) NOT = ' ' CHGBR130 00671 IF CHG4-CLMNT-NAME ((S1 - 1):1) = ' ' CHGBR130 00672 MOVE CHG4-CLMNT-NAME (S1:1) TO WRK-MID-INIT CHGBR130 00673 SET WRK-INIT-FOUND-YES-88 TO TRUE CHGBR130 00674 END-IF CHGBR130 00675 END-IF CHGBR130 00676 END-PERFORM. CHGBR130 00677 CHGBR130 00678 P1075-EXIT. CHGBR130 00679 EXIT. CHGBR130 00680 CHGBR130 00681 P1100-PRINT-HEADER. CHGBR130 00682 MOVE ZERO TO WRK-LINE-CNT CHGBR130 00683 ADD 1 TO WRK-PAGE-CNT. CHGBR130 00684 MOVE WRK-PAGE-CNT TO WRK-PRT-PAGE-CNT. CHGBR130 00685 MOVE HEAD01 TO WS-REC CHGBR130 00686 WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING TOP-OF-PAGE CHGBR130 00687 MOVE HEAD02 TO WS-REC CHGBR130 00688 WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR130 00689 MOVE HEAD03 TO WS-REC CHGBR130 00690 WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR130 00691 MOVE SPACES TO WS-REC CHGBR130 00692 WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR130 00693 MOVE HEAD04 TO WS-REC CHGBR130 00694 WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR130 00695 MOVE SPACES TO WS-REC CHGBR130 00696 WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR130 00697 MOVE HEAD05 TO WS-REC CHGBR130 00698 WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR130 00699 MOVE HEAD06 TO WS-REC CHGBR130 00700 WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 2 LINE CHGBR130 00701 MOVE SPACES TO WS-REC CHGBR130 00702 WRITE FEDERAL-REPORT FROM WS-REC AFTER ADVANCING 1 LINE. CHGBR130 00703 MOVE +10 TO WRK-LINE-CNT. CHGBR130 00704 CHGBR130 00705 P1100-EXIT. CHGBR130 00706 EXIT. CHGBR130 00707 CHGBR130 00708 P1200-PRINT-FOOTER. CHGBR130 00709 IF WRK-LINE-CNT > +48 CHGBR130 00710 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT CHGBR130 00711 END-IF CHGBR130 00712 CHGBR130 00713 MOVE WRK-TOTAL-BENEFITS TO WRK-PRT-TOT-BEN. CHGBR130 00714 MOVE WRK-ACCT-TOTAL TO WRK-PRT-ACCT-TOT. CHGBR130 00715 CHGBR130 00716 WRITE FEDERAL-REPORT FROM WRK-PRINT-TOTAL CHGBR130 00717 AFTER ADVANCING 4 LINE. CHGBR130 00718 WRITE FEDERAL-REPORT FROM WRK-PRINT-TOTAL-ACCT CHGBR130 00719 AFTER ADVANCING 2 LINE. CHGBR130 00720 CHGBR130 00721 ADD WRK-TOTAL-BENEFITS TO WRK-GRAND-TOTAL-BENEFITS. CHGBR130 00722 ADD WRK-ACCT-TOTAL TO WRK-GRAND-TOTAL-CHARGED. CHGBR130 00723 CHGBR130 00724 MOVE ZERO TO WRK-TOTAL-BENEFITS CHGBR130 00725 WRK-ACCT-TOTAL. CHGBR130 00726 P1200-EXIT. CHGBR130 00727 EXIT. CHGBR130 00728 CHGBR130 00729 P4000-TOTALS. CHGBR130 00730 COMPUTE WRK-TOTAL-BENEFITS = WRK-TOTAL-BENEFITS CHGBR130 00731 + CHG4-TOT-BEN-AMT CHGBR130 00732 + CHG4-TOT-ADJ-AMT. CHGBR130 00733 CHGBR130 00734 COMPUTE WRK-ACCT-TOTAL = WRK-ACCT-TOTAL CHGBR130 00735 + CHG4-CURR-BEN-AMT CHGBR130 00736 + CHG4-CURR-ADJ-AMT. CHGBR130 00737 CHGBR130 00738 P4000-EXIT. CHGBR130 00739 EXIT. CHGBR130 00740 EJECT CHGBR130 00741 T0000-TERMINATE. CHGBR130 00742 IF WRK-EMPLYR-CNT > 0 CHGBR130 00743 PERFORM P1200-PRINT-FOOTER THRU P1200-EXIT CHGBR130 00744 END-IF CHGBR130 00745 CHGBR130 00746 IF WRK-EMPLYR-CNT > 1 CHGBR130 00747 PERFORM T1000-PRINT-GRAND-TOTALS THRU T1000-EXIT CHGBR130 00748 END-IF CHGBR130 00749 CHGBR130 00750 PERFORM T1100-CLOSE-FILES THRU T1100-EXIT. CHGBR130 00751 T0000-EXIT. CHGBR130 00752 EXIT. CHGBR130 00753 EJECT CHGBR130 00754 T1000-PRINT-GRAND-TOTALS. CHGBR130 00755 MOVE SPACE TO HEAD04. CHGBR130 00756 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT. CHGBR130 00757 CHGBR130 00758 MOVE WRK-GRAND-TOTAL-BENEFITS TO WRK-PRT-GRAND-TOT-BEN. CHGBR130 00759 MOVE WRK-GRAND-TOTAL-CHARGED TO WRK-PRT-GRAND-TOT-CHG. CHGBR130 00760 CHGBR130 00761 WRITE FEDERAL-REPORT FROM WRK-PRINT-GRAND-PERIOD CHGBR130 00762 AFTER ADVANCING 3. CHGBR130 00763 WRITE FEDERAL-REPORT FROM WRK-PRINT-GRAND CHGBR130 00764 AFTER ADVANCING 2. CHGBR130 00765 T1000-EXIT. CHGBR130 00766 EXIT. CHGBR130 00767 CHGBR130 00768 T1100-CLOSE-FILES. CHGBR130 00769 CLOSE FEDERAL-RPT FEDERAL-CSV CHGBR130 00770 MILITARY-RPT. CHGBR130 00771 T1100-EXIT. CHGBR130 00772 EXIT. CHGBR130 00773 CHGBR130 00774 S001-FROM-FED-8. CHGBR130 00775 SET L001-FROM-FED-8 TO TRUE. CHGBR130 00776 GO TO S001-DATE. CHGBR130 00777 CHGBR130 00778 S001-DATE. CHGBR130 00779 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR130 00780 CHGBR130 00781 S001-EXIT. CHGBR130 00782 EXIT. CHGBR130 00783 CHGBR130 00784 CHGBR130 00785 S004-FROM-DATE. CHGBR130 00786 SET L004-FROM-DATE TO TRUE. CHGBR130 00787 GO TO S004-DATE. CHGBR130 00788 CHGBR130 00789 S004-DATE. CHGBR130 00790 CALL 'DTSBU004' USING L004-LINK-AREA. CHGBR130 00791 CHGBR130 00792 S004-EXIT. CHGBR130 00793 EXIT. CHGBR130 00794 CHGBR130 00795 S999-ABEND. CHGBR130 00796 DISPLAY '**** CHGBR130 ABENDING ' CHGBR130 00797 ABEND-MSG. CHGBR130 00798 CALL ABEND-MOD USING WRK-ABEND-CODE. CHGBR130 00799 CHGBR130 00800 S999-EXIT. CHGBR130 00801 EXIT. CHGBR130