00001 IDENTIFICATION DIVISION. 04/05/24 00002 PROGRAM-ID. CHGBR100. CHGBR100 00003 *AUTHOR. NORTHROP GRUMMAN. LV020 00004 *DATE-WRITTEN. JULY 2007. CHGBR100 00005 DATE-COMPILED. CHGBR100 00006 CHGBR100 00007 ***** CHGBR100 00008 *** CHGBR100 00009 * FUNCTION: PRINT RATED NOTICES OR SPECIAL REPORT CHGBR100 00010 * CHGBR100 00011 * DESCRIPTION: CHGBR100 00012 * CHGBR100 00013 * (1) QUARTERLY OR ANNUAL RUN: CHGBR100 00014 * IT WILL GIVE YOU THE RATED NOTICES, MANAGER RPT, AND CHGBR100 00015 * A FISCAL AGENT DISK FILE. THE FISCAL AGENT FILE THAN CHGBR100 00016 * COPY TO A MAGNETIC MEDIA TAPE USING THE IBM IEBGENER CHGBR100 00017 * UTILITIES. THE OUTPUT OF THE MAGNETIC TAPE WILL SEND CHGBR100 00018 * TO THE FISCAL AGENT. CHGBR100 00019 * (2) SPECIAL RUN: CHGBR100 00020 * THIS MODULE WILL GENERATE A BENEFIT CHARGE REPORT ANDCHGBR100 00021 * A RATED NOTICE ON ONE EMPLOYER ACCOUNT ONLY. CHGBR100 00022 * CHGBR100 00023 * RECORDS READ: CHGBR100 00024 * CHGBR100 00025 * NONE. CHGBR100 00026 * CHGBR100 00027 * INPUT: CHGBR100 00028 * CHGBR100 00029 * CHGIM004 RECORD PASSED FROM CHGBD301 CHGBR100 00030 * CHGBR100 00031 * PRINTED OUTPUTS: CHGBR100 00032 * CHGBR100 00033 * RPC100R1 - RATED NOTICES CHGBR100 00034 * CHGBR100 00035 * RPC100R3 - MANAGEMENT RPT. CHGBR100 00036 * CHGBR100 00037 * RECORDS WRITTEN ON DISK: CHGBR100 00038 * CHGBR100 00039 * RPC100R2 - FISCAL AGENT FILE CHGBR100 00040 * CHGBR100 00041 * MODULES CALLED: CHGBR100 00042 * CHGBR100 00043 * DTSBU001 DATE EDIT/CONVERSION MODULE CHGBR100 00044 * DTSBU071 NAME CONVERSION MODULE CHGBR100 00045 * CHGBR100 00046 ***** CHGBR100 00047 CHGBR100 00048 ******************************************************************CHGBR100 00049 * MODIFICATION HISTORY: *CHGBR100 00050 * *CHGBR100 00051 * 02-08-2001 FIXED PAGE OVERRUN ON IST PAGE OF RPT, ADDED A HDR *CHGBR100 00052 * TO 'GRAND TOTALS' PAGE, AND WILL NOW PRINT IT ONLY *CHGBR100 00053 * IF MORE THAN ONE EMPLOYER HAS BEEN REPORTED - JHP *CHGBR100 00054 * *CHGBR100 00055 * 08-07-2000 CHANGED "TOTALS" LINE ON S-M TO "TOTAL CHARGE OR *CHGBR100 00056 * CREDIT" AND ADDED A SIGN (+/-) TO THE TOTAL-AMT *CHGBR100 00057 * EDIT FIELD (REQST FM FRANK O.) CHNGD BY - JHP *CHGBR100 00058 * *CHGBR100 00059 * 04-27-2000 REWRITTEN *CHGBR100 00060 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBR100 00061 * *CHGBR100 00062 * 02-02-1999 MODIFIED FROM MT CHG100D *CHGBR100 00063 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBR100 00064 * *CHGBR100 00065 * 07-11-2007 THE BENEFIT CHARGED REPORT OF THE RATED EMPLOYERS *CHGBR100 00066 * HAS BEEN CHANGED TO ACCOMMODATE THE REQUIREMENTS *CHGBR100 00067 * OF PARTIAL TRANSFERED OF ASSETS FROM ONE BUSINESS *CHGBR100 00068 * TO ANOTHER. THEREFORE, THE PROGRAM CHANGES APPLID *CHGBR100 00069 * AND USED FOR THE RATED EMPLOYER REPORTS ONLY. *CHGBR100 00070 * (THIS PGM ORIGINAL NAME CHGBR101, BUT IT RENAMED *CHGBR100 00071 * TO CHGBR100 BY GD.) *CHGBR100 00072 * *CHGBR100 00073 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBR100 00074 * *CHGBR100 00075 * 07-28-2008 REMOVED F ORLANDO NAME FROM REPORT ZL1 *CHGBR100 00076 * *CHGBR100 00077 * 03-09-2009 RECOMPLIED FOR NEW VERSION OF CHGIM004. GD *CHGBR100 00078 * *CHGBR100 00079 * 05-14-2010 RECOMPLIED FOR NEW VERSION OF CHGIM004. ZL1 *CHGBR100 00080 * MOVE XXX TO SSN PRINT LAST 4 DIGITS *CHGBR100 00081 * * CL**2 00082 * 06-05-2020 RECOMPLIED FOR NEW VERSION OF CHGIM004. ZL1 * CL**2 00083 * * CL**2 00084 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR100 00085 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR100 00086 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBR100 00087 ******************************************************************CHGBR100 00088 CHGBR100 00089 ENVIRONMENT DIVISION. CHGBR100 00090 CONFIGURATION SECTION. CHGBR100 00091 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CHGBR100 00092 CHGBR100 00093 INPUT-OUTPUT SECTION. CHGBR100 00094 FILE-CONTROL. CHGBR100 00095 *** SELF-MAILER (R) CHGBR100 00096 SELECT RATED-FILE1 ASSIGN TO RPC100R1. CHGBR100 00097 *** FISC.AGNT FILE CHGBR100 00098 SELECT FISCAL-AGENT-FILE ASSIGN TO RPC100R2. CHGBR100 00099 *** BEN.CHG. RPT (O) CHGBR100 00100 SELECT RATED-RPT ASSIGN TO RPC100R3. CHGBR100 00101 SELECT RATED-DATA ASSIGN TO RPC100R4. CL**5 00102 CHGBR100 00103 EJECT CHGBR100 00104 DATA DIVISION. CHGBR100 00105 CHGBR100 00106 FILE SECTION. CHGBR100 00107 CHGBR100 00108 FD RATED-FILE1 CHGBR100 00109 RECORDING MODE IS F CHGBR100 00110 BLOCK CONTAINS 0 RECORDS CHGBR100 00111 LABEL RECORDS ARE OMITTED. CHGBR100 00112 CHGBR100 00113 01 RATED-PRINT-REC PIC X(133). CHGBR100 00114 CHGBR100 00115 FD RATED-DATA CL**5 00116 RECORDING MODE IS F CL**3 00117 BLOCK CONTAINS 0 RECORDS CL**3 00118 LABEL RECORDS ARE OMITTED. CL**3 00119 CL**3 00120 01 RATED-DAT PIC X(133). CL**5 00121 CL**3 00122 FD FISCAL-AGENT-FILE CHGBR100 00123 RECORDING MODE IS F CHGBR100 00124 BLOCK CONTAINS 0 RECORDS CHGBR100 00125 LABEL RECORDS ARE OMITTED. CHGBR100 00126 CHGBR100 00127 01 CHG8-REC. CHGBR100 00128 ++INCLUDE CHGIM008 CHGBR100 00129 CHGBR100 00130 FD RATED-RPT CHGBR100 00131 RECORDING MODE IS F CHGBR100 00132 RECORD CONTAINS 133 CHARACTERS CHGBR100 00133 BLOCK CONTAINS 0 RECORDS. CHGBR100 00134 CHGBR100 00135 01 RATED-REPORT PIC X(133). CHGBR100 00136 EJECT CHGBR100 00137 WORKING-STORAGE SECTION. CHGBR100 001375 77 PAN-VALET PICTURE X(24) VALUE '020CHGBR100 04/05/24'. CHGBR100 00138 77 PAN-VALET PICTURE X(24) VALUE '010CHGBR100 10/06/11'. CHGBR100 00139 *** WRK-AREA CHGBR100 00140 01 FILLER. CHGBR100 00141 05 WRK-ABEND-CODE PIC S9(04) COMP VALUE +100. CHGBR100 00142 05 ABEND-MSG PIC X(60) VALUE SPACES. CHGBR100 00143 CHGBR100 00144 05 X1-CA-JDEA PIC X(11) VALUE 'JDE=UC399A,'. CHGBR100 00145 05 X1-CA-JDEQ PIC X(11) VALUE 'JDE=UC399Q,'. CHGBR100 00146 CHGBR100 00147 05 WRK-CURR-PAGE PIC S9(03) COMP-3 VALUE +0. CHGBR100 00148 05 WRK-TOTAL-PAGES PIC S9(03) COMP-3 VALUE +0. CHGBR100 00149 05 WRK-MAX-LINES-PER-PAGE PIC S9(03) COMP-3 VALUE +34. CHGBR100 00150 05 WRK-CURR-LINE PIC S9(03) COMP-3 VALUE +0. CHGBR100 00151 05 ADVANCE-LINE-CNT PIC 9(02) VALUE ZEROS. CHGBR100 00152 CHGBR100 00153 05 WRK-PRINT-COMPLETE-IND PIC X(01). CHGBR100 00154 88 WRK-PRINT-COMPLETE-YES-88 VALUE 'Y'. CHGBR100 00155 88 WRK-PRINT-COMPLETE-NO-88 VALUE 'N'. CHGBR100 00156 CHGBR100 00157 05 WS-SSN PIC 9(09) VALUE ZEROS. CHGBR100 00158 05 FILLER REDEFINES WS-SSN. CHGBR100 00159 10 WS-SSN1 PIC 9(03). CHGBR100 00160 10 WS-SSN2 PIC 9(02). CHGBR100 00161 10 WS-SSN3 PIC 9(04). CHGBR100 00162 CHGBR100 00163 05 WRK-CURRENT-EMP PIC S9(07) COMP-3 VALUE +0. CHGBR100 00164 05 WRK-CURR-FISC-AGNT-EMP PIC S9(07) COMP-3 VALUE +0. CHGBR100 00165 CHGBR100 00166 05 REMAINDER-CNT PIC 9(02) VALUE ZEROS. CHGBR100 00167 CHGBR100 00168 05 WRK-EMP-CURR-AMT PIC S9(10)V99 COMP-3 VALUE +0. CHGBR100 00169 05 WRK-EMP-TOT-AMT PIC S9(10)V99 COMP-3 VALUE +0. CHGBR100 00170 05 WRK-CHG8-TOT-CHG-AMT PIC S9(08)V99 COMP-3 VALUE +0. CHGBR100 00171 05 WRK-FISCAL-TOT-AMT PIC S9(11)V99 COMP-3 VALUE +0. CHGBR100 00172 05 WRK-RATED-TOT-AMT PIC S9(11)V99 COMP-3 VALUE +0. CHGBR100 00173 05 WRK-RATED-TOT-DISP PIC $$,$$$,$$$,$$9.99-. CHGBR100 00174 CHGBR100 00175 05 WRK-FISCAL-AGNT-EMP-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR100 00176 05 WRK-PRINTED-FORM-EMP-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR100 00177 05 WRK-SELF-MAILER-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR100 00178 05 WRK-EMPLYR-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR100 00179 05 CHG8-REC-CNT PIC 9(07) COMP-3 VALUE 0. CHGBR100 00180 CHGBR100 00181 *** WRK-AREA2 CHGBR100 00182 01 FILLER. CHGBR100 00183 05 ABEND-MOD PIC X(08) CHGBR100 00184 VALUE 'DTSBU999'. CHGBR100 00185 CHGBR100 00186 05 WRK-REG-BEN-PAYMENT PIC X(25) CHGBR100 00187 VALUE ' REGULAR BENEFIT PAYMENT '. CHGBR100 00188 05 WRK-EXT-BEN-PAYMENT PIC X(25) CHGBR100 00189 VALUE ' EXTENDED BENEFIT PAYMENT'. CHGBR100 00190 05 WRK-TEUC-BEN-PAYMENT PIC X(25) CHGBR100 00191 VALUE ' TEUC BENEFIT PAYMENT '. CHGBR100 00192 05 WRK-TEUCA-BEN-PAYMENT PIC X(25) CHGBR100 00193 VALUE ' TEUCA BENEFIT PAYMENT '. CHGBR100 00194 05 WRK-FAC-BEN-PAYMENT PIC X(25) CHGBR100 00195 VALUE ' FED ADDL COMP PAYMENT '. CHGBR100 00196 05 WRK-ADJUSTMENTS PIC X(25) CHGBR100 00197 VALUE ' ADJUSTMENTS '. CHGBR100 00198 05 WRK-RPT-ANNUAL-SUMM PIC X(26) CHGBR100 00199 VALUE 'ANNUALLY CHARGE SUMMARY '. CHGBR100 00200 05 WRK-RPT-SUMMARY PIC X(26) CHGBR100 00201 VALUE 'QUARTERLY CHARGE SUMMARY'. CHGBR100 00202 05 WRK-RPT-SPECIAL PIC X(26) CHGBR100 00203 VALUE ' BENEFIT CHARGE SPECIAL '. CHGBR100 00204 *RW1 CHGBR100 00205 05 WRK-PERCENT PIC 9(03)V99 VALUE ZEROS. CHGBR100 00206 *RW2 CHGBR100 00207 05 WRK-SSN PIC 9(09) VALUE ZERO. CHGBR100 00208 05 FILLER REDEFINES WRK-SSN. CHGBR100 00209 10 WRK-SSN1 PIC 9(03). CHGBR100 00210 10 WRK-SSN2 PIC 9(02). CHGBR100 00211 10 WRK-SSN3 PIC 9(04). CHGBR100 00212 CHGBR100 00213 05 WRK-LINE-CNT PIC S9(04) COMP VALUE +0. CHGBR100 00214 05 WRK-PAGE-CNT PIC S9(04) COMP VALUE +0. CHGBR100 00215 05 WS-REC PIC X(133) VALUE SPACES. CHGBR100 00216 CHGBR100 00217 05 WRK-CURR-EMP PIC S9(07) COMP-3 VALUE +0. CHGBR100 00218 05 WRK-CURR-AMT PIC S9(07)V99 COMP-3 VALUE +0. CHGBR100 00219 05 WRK-TOT-AMT PIC S9(07)V99 COMP-3 VALUE +0. CHGBR100 00220 05 WRK-TOTAL-BENEFITS PIC S9(09)V99 COMP-3 VALUE +0. CHGBR100 00221 05 WRK-ACCT-TOTAL PIC S9(09)V99 COMP-3 VALUE +0. CHGBR100 00222 05 WRK-GRAND-TOTAL-BENEFITS PIC S9(10)V99 COMP-3 VALUE +0. CHGBR100 00223 05 WRK-GRAND-TOTAL-CHARGED PIC S9(10)V99 COMP-3 VALUE +0. CHGBR100 00224 CHGBR100 00225 *** REPORT-LINE-AREA CHGBR100 00226 01 FILLER. CHGBR100 00227 05 HEAD01. CHGBR100 00228 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00229 10 FILLER PIC X(08) VALUE 'CHGBR100'. CHGBR100 00230 10 FILLER PIC X(47) VALUE SPACE. CHGBR100 00231 10 FILLER PIC X(20) VALUE 'DISTRICT OF COLUMBIA'. CHGBR100 00232 10 FILLER PIC X(42) VALUE SPACE. CHGBR100 00233 10 FILLER PIC X(09) VALUE 'PAGE NO.:'. CHGBR100 00234 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00235 10 WRK-PRT-PAGE-CNT PIC ZZZ99. CHGBR100 00236 CHGBR100 00237 05 HEAD02. CHGBR100 00238 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00239 10 FILLER PIC X(10) VALUE ' '. CHGBR100 00240 10 FILLER PIC X(42) VALUE SPACE. CHGBR100 00241 10 H2-RPT-TYP PIC X(26) VALUE SPACES. CHGBR100 00242 * 10 FILLER PIC X(13) VALUE ' BENEFIT CHA'. CHGBR100 00243 * 10 FILLER PIC X(13) VALUE 'RGE SPECIAL '. CHGBR100 00244 10 FILLER PIC X(49) VALUE SPACE. CHGBR100 00245 10 FILLER PIC X(02) VALUE 'TT'. CHGBR100 00246 10 WRK-PRT-EMP-TYPE PIC X(02). CHGBR100 00247 CHGBR100 00248 05 HEAD03. CHGBR100 00249 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00250 10 FILLER PIC X(10) VALUE 'ROOM 325'. CHGBR100 00251 10 FILLER PIC X(35) VALUE SPACE. CHGBR100 00252 10 FILLER PIC X(13) VALUE 'DEPARTMENT '. CHGBR100 00253 10 FILLER PIC X(13) VALUE 'OF EMPLOYME'. CHGBR100 00254 10 FILLER PIC X(13) VALUE 'NT SERVICES'. CHGBR100 00255 CHGBR100 00256 05 HEAD04. CHGBR100 00257 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00258 10 FILLER PIC X(49) VALUE SPACE. CHGBR100 00259 10 FILLER PIC X(12) VALUE 'EMPLOYER ACC'. CHGBR100 00260 10 FILLER PIC X(12) VALUE 'OUNT NUMBER '. CHGBR100 00261 10 WRK-PRT-HDR-EMP PIC 9(06) VALUE 0. CHGBR100 00262 CHGBR100 00263 05 HEAD05. CHGBR100 00264 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00265 10 FILLER PIC X(39) VALUE SPACE. CHGBR100 00266 10 FILLER PIC X(14) VALUE 'REPORT INCLUDE'. CHGBR100 00267 10 FILLER PIC X(14) VALUE 'S PERIOD FROM '. CHGBR100 00268 10 WS-REPORT-START-DATE PIC X(10) VALUE SPACES. CHGBR100 00269 10 FILLER PIC X(04) VALUE ' TO '. CHGBR100 00270 10 WS-REPORT-END-DATE PIC X(10) VALUE SPACES. CHGBR100 00271 CHGBR100 00272 05 HEAD06. CHGBR100 00273 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00274 10 FILLER PIC X(05) VALUE SPACE. CHGBR100 00275 10 FILLER PIC X(03) VALUE 'SSN'. CHGBR100 00276 10 FILLER PIC X(10) VALUE SPACE. CHGBR100 00277 10 FILLER PIC X(03) VALUE 'BYE'. CHGBR100 00278 10 FILLER PIC X(09) VALUE SPACE. CHGBR100 00279 10 FILLER PIC X(09) VALUE 'NAME OF '. CHGBR100 00280 10 FILLER PIC X(09) VALUE ' CLAIMANT'. CHGBR100 00281 10 FILLER PIC X(19) VALUE SPACE. CHGBR100 00282 10 FILLER PIC X(14) VALUE 'TOTAL BENEFITS'. CHGBR100 00283 10 FILLER PIC X(05) VALUE SPACE. CHGBR100 00284 10 FILLER PIC X(15) VALUE 'ACCOUNT CHARGES'. CHGBR100 00285 10 FILLER PIC X(04) VALUE SPACE. CHGBR100 00286 10 FILLER PIC X(23) VALUE 'CHARGE TYPE '.CHGBR100 00287 CHGBR100 00288 05 WRK-PRINT-LINE. CHGBR100 00289 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00290 10 FILLER PIC X(04) VALUE SPACE. CHGBR100 00291 10 WRK-PRT-SSN1 PIC X(03) VALUE SPACE. CHGBR100 00292 10 FILLER PIC X(01) VALUE '-'. CHGBR100 00293 10 WRK-PRT-SSN2 PIC X(02) VALUE SPACE. CHGBR100 00294 10 FILLER PIC X(01) VALUE '-'. CHGBR100 00295 10 WRK-PRT-SSN3 PIC X(04) VALUE SPACE. CHGBR100 00296 10 FILLER PIC X(02) VALUE SPACE. CHGBR100 00297 10 WRK-PRT-BYE-DATE PIC X(10) VALUE SPACE. CHGBR100 00298 10 FILLER PIC X(03) VALUE SPACE. CHGBR100 00299 10 WRK-PRT-CLMNT-NAME PIC X(32) VALUE SPACE. CHGBR100 00300 10 FILLER PIC X(02) VALUE SPACE. CHGBR100 00301 10 WRK-PRT-TOT-AMT PIC $$,$$$,$$$,$$9.99-. CHGBR100 00302 10 FILLER PIC X(02) VALUE SPACE. CHGBR100 00303 10 WRK-PRT-CURR-AMT PIC $$,$$$,$$$,$$9.99-. CHGBR100 00304 10 FILLER PIC X(02) VALUE SPACE. CHGBR100 00305 10 WRK-PRT-SOURCE-TYPE PIC X(27) VALUE SPACE. CHGBR100 00306 10 FILLER REDEFINES WRK-PRT-SOURCE-TYPE. CHGBR100 00307 15 WRK-PRINT-MSG PIC X(12). CHGBR100 00308 15 FILLER PIC X(01). CHGBR100 00309 15 WRK-SUCC-PRED-EMP-NO PIC 999999. CHGBR100 00310 15 FILLER PIC X(01). CHGBR100 00311 15 WRK-PRED-PERCENT PIC ZZZ.99. CHGBR100 00312 15 WRK-PERCENT-SIGN PIC X(01). CHGBR100 00313 CHGBR100 00314 05 WRK-PRINT-TOTAL. CHGBR100 00315 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00316 10 FILLER PIC X(34) VALUE SPACES. CHGBR100 00317 10 FILLER PIC X(20) VALUE 'GRAND TOTAL CHARGED:'. CHGBR100 00318 10 FILLER PIC X(10) VALUE SPACES. CHGBR100 00319 10 WRK-PRT-TOT-BEN PIC $$,$$$,$$$,$$9.99-. CHGBR100 00320 10 FILLER PIC X(22) VALUE SPACES. CHGBR100 00321 10 FILLER PIC X(25) VALUE CHGBR100 00322 ' ************ '. CHGBR100 00323 05 WRK-PRINT-TOTAL-ACCT. CHGBR100 00324 10 FILLER PIC X(10) VALUE SPACE. CL*20 00325 10 WRK-PRT-ACCT-EAN PIC 9(6) VALUE 0. CL*20 00326 10 FILLER PIC X(30) VALUE SPACES. CL*20 00327 10 FILLER PIC X(14) VALUE 'GRAND TOTAL AC'. CHGBR100 00328 10 FILLER PIC X(14) VALUE 'COUNT CHARGED:'. CHGBR100 00329 10 FILLER PIC X(17) VALUE SPACES. CHGBR100 00330 10 WRK-PRT-ACCT-TOT PIC $$,$$$,$$$,$$9.99-. CHGBR100 00331 10 FILLER PIC X(04) VALUE SPACES. CHGBR100 00332 10 FILLER PIC X(25) VALUE CHGBR100 00333 ' ************ '. CHGBR100 00334 CHGBR100 00335 05 WRK-PRINT-GRAND. CHGBR100 00336 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00337 10 FILLER PIC X(63) VALUE SPACES. CHGBR100 00338 10 FILLER PIC X(20) VALUE '--------------------'. CHGBR100 00339 10 FILLER PIC X(21) VALUE '---------------------'. CHGBR100 00340 CHGBR100 00341 05 WRK-PRINT-GRAND-PERIOD. CHGBR100 00342 10 FILLER PIC X(01) VALUE SPACE. CHGBR100 00343 10 FILLER PIC X(13) VALUE SPACES. CHGBR100 00344 10 FILLER PIC X(19) VALUE 'TOTAL AMOUNT CHARGE'. CHGBR100 00345 10 FILLER PIC X(18) VALUE 'D FOR THE PERIOD: '. CHGBR100 00346 10 FILLER PIC X(14) VALUE SPACES. CHGBR100 00347 10 WRK-PRT-GRAND-TOT-BEN PIC $$,$$$,$$$,$$9.99-. CHGBR100 00348 10 FILLER PIC X(02) VALUE SPACES. CHGBR100 00349 10 WRK-PRT-GRAND-TOT-CHG PIC $$,$$$,$$$,$$9.99-. CHGBR100 00350 10 FILLER PIC X(03) VALUE SPACES. CHGBR100 00351 10 FILLER PIC X(25) VALUE CHGBR100 00352 ' ************ '. CHGBR100 00353 05 DAT-PRINT-LINE. CL**3 00354 10 FILLER PIC X(01) VALUE SPACE. CL**3 00355 10 DAT-EMP-NO PIC X(06) VALUE SPACE. CL**3 00356 10 FILLEZ PIC X(01) VALUE ';'. CL**9 00357 10 DAT-PRT-SSN1 PIC X(03) VALUE SPACE. CL**3 00358 10 DAT-PRT-SSN2 PIC X(02) VALUE SPACE. CL**3 00359 10 DAT-PRT-SSN3 PIC X(04) VALUE SPACE. CL**3 00360 10 FILLER PIC X(01) VALUE ';'. CL**8 00361 10 DAT-PRT-BYE-DATE PIC X(10) VALUE SPACE. CL**3 00362 10 FILLER PIC X(01) VALUE ';'. CL**8 00363 10 DAT-PRT-CLMNT-NAME PIC X(32) VALUE SPACE. CL**3 00364 10 FILLER PIC X(01) VALUE ';'. CL**8 00365 * 10 DAT-PRT-TOT-AMT PIC $$,$$$,$$$,$$9.99-. CL*15 00366 * 10 FILLER PIC X(01) VALUE ','. CL*15 00367 10 DAT-PRT-CURR-AMT PIC $$,$$$,$$$,$$9.99-. CL**3 00368 10 FILLER PIC X(01) VALUE ';'. CL**8 00369 10 DAT-PRT-SOURCE-TYPE PIC X(27) VALUE SPACE. CL**3 00370 10 FILLER REDEFINES DAT-PRT-SOURCE-TYPE. CL**5 00371 15 DAT-PRINT-MSG PIC X(12). CL**3 00372 15 DAT-SUCC-PRED-EMP-NO PIC 999999. CL**3 00373 15 DAT-PRED-PERCENT PIC ZZZ.99. CL**3 00374 15 DAT-PERCENT-SIGN PIC X(01). CL**3 00375 CL**3 00376 05 DAT-TOTAL-LINE. CL*12 00377 10 FILLER PIC X(01) VALUE SPACE. CL*12 00378 10 DAT-TOT-EMP-NO PIC X(06) VALUE SPACE. CL*12 00379 10 FILLEY PIC X(01) VALUE ';'. CL*16 00380 * 10 FILLER PIC X(53) VALUE SPACES. CL*17 00381 10 FILLEX PIC X(01) VALUE ';'. CL*15 00382 10 DAT-TOT-CURR-AMT PIC $$,$$$,$$$,$$9.99-. CL*12 00383 10 FILLER PIC X(50) VALUE SPACES. CL*12 00384 CL*12 00385 CHGBR100 00386 01 VSCA-LINE. CHGBR100 00387 05 VSCA-DATA PIC X(133) VALUE SPACES. CHGBR100 00388 CHGBR100 00389 01 XF-CA-CNTL-LINE. CHGBR100 00390 * 05 FILLER PIC X VALUE SPACES. CHGBR100 00391 05 X1-CA-DJDE PIC X(12) VALUE '$X9700$DJDE '. CHGBR100 00392 05 X1-CA-JDL PIC X(09) VALUE 'JDL=XMOM,'. CHGBR100 00393 05 X1-CA-JDE PIC X(11) VALUE SPACES. CHGBR100 00394 05 X1-CA-LINE-END PIC X(01) VALUE ';'. CHGBR100 00395 CHGBR100 00396 01 X2-CA-CNTL-LINE. CHGBR100 00397 * 05 FILLER PIC X VALUE SPACES. CHGBR100 00398 05 X2-CA-DJDE PIC X(12) VALUE '$X9700$DJDE '. CHGBR100 00399 05 X2-CA-DUPLEX PIC X(11) VALUE 'DUPLEX=YES,'. CHGBR100 00400 05 X2-CA-LINE-END PIC X(01) VALUE ';'. CHGBR100 00401 CHGBR100 00402 01 X3-CA-CNTL-LINE. CHGBR100 00403 * 05 FILLER PIC X VALUE SPACES. CHGBR100 00404 05 X3-CA-DJDE PIC X(12) VALUE '$X9700$DJDE '. CHGBR100 00405 05 X3-CA-DATA PIC X(13) VALUE 'DATA=(0,132),'. CHGBR100 00406 05 X3-CA-ASSIGN PIC X(13) VALUE 'ASSIGN=(1,1),'. CHGBR100 00407 05 X3-CA-LINE-END PIC X(04) VALUE 'END;'. CHGBR100 00408 CHGBR100 00409 01 PAGE-HEAD01. CHGBR100 00410 05 FILLER PIC X(25) VALUE SPACES. CHGBR100 00411 05 PRT-EMP-NO PIC 999B999. CHGBR100 00412 05 FILLER PIC X(55) VALUE SPACES. CHGBR100 00413 05 PRT-END-DATE PIC X(10) VALUE SPACE. CHGBR100 00414 CHGBR100 00415 EJECT CHGBR100 00416 CHGBR100 00417 01 EMPLOYER-DETAIL-LINE. CHGBR100 00418 05 FILLER PIC X(05) VALUE SPACES. CHGBR100 00419 05 PRT-CHARGE-NAME PIC X(25) VALUE SPACE. CHGBR100 00420 05 FILLER PIC X(04) VALUE SPACES. CHGBR100 00421 05 PRT-WS-SSN1 PIC X(03) VALUE SPACE. CHGBR100 00422 05 FILLER PIC X VALUE '-'. CHGBR100 00423 05 PRT-WS-SSN2 PIC X(02) VALUE SPACE. CHGBR100 00424 05 FILLER PIC X VALUE '-'. CHGBR100 00425 05 PRT-WS-SSN3 PIC X(04) VALUE SPACE. CHGBR100 00426 05 FILLER PIC X(02) VALUE SPACES. CHGBR100 00427 05 PRT-CHARGE-CURR-AMT PIC $$$,$$$,$$9.99-. CHGBR100 00428 *RW1 CHGBR100 00429 05 FILLER PIC X(03) VALUE SPACES. CHGBR100 00430 05 PRT-PRT-SOURCE-TYPE PIC X(25) VALUE SPACE. CHGBR100 00431 05 FILLER REDEFINES PRT-PRT-SOURCE-TYPE. CHGBR100 00432 10 PRT-PRINT-MSG PIC X(17). CHGBR100 00433 10 FILLER PIC X(01). CHGBR100 00434 10 PRT-SUCC-PRED-EMP-NO PIC 999B999. CHGBR100 00435 *RW2 CHGBR100 00436 *** CHARGE-TABLE-AREA CHGBR100 00437 01 FILLER. CHGBR100 00438 05 CHG-TAB-SUB PIC S9(04) COMP VALUE 0. CHGBR100 00439 05 CHG-TAB-LEN PIC S9(04) COMP VALUE 0. CHGBR100 00440 05 CHG-TAB-MAX PIC S9(04) COMP CHGBR100 00441 VALUE +2500. CHGBR100 00442 05 CHG-TAB-ENTRY OCCURS 2500 TIMES. CHGBR100 00443 10 CHG-TAB-NAME PIC X(32) VALUE SPACE. CHGBR100 00444 10 CHG-TAB-SSN PIC S9(9) COMP-3 VALUE +0. CHGBR100 00445 10 CHG-TAB-AMT PIC S9(10)V99 VALUE +0. CHGBR100 00446 10 CHG-TAB-PRED PIC S9(07) VALUE +0. CHGBR100 00447 10 CHG-TAB-SUCC PIC S9(07) VALUE +0. CHGBR100 00448 CHGBR100 00449 01 FINAL-FOOTER. CHGBR100 00450 05 FILLER PIC X(15) VALUE SPACES. CHGBR100 00451 05 FILLER PIC X(06) VALUE 'PAGE: '. CHGBR100 00452 05 PAGE-NO PIC ZZ9. CHGBR100 00453 05 FILLER PIC X(04) VALUE ' OF '. CHGBR100 00454 05 TOTAL-PAGE-NO PIC ZZ9. CHGBR100 00455 05 FILLER PIC X(06) VALUE SPACES. CHGBR100 00456 05 PRT-MESSAGE PIC X(28) VALUE SPACE. CHGBR100 00457 *RW 05 FILLER PIC X(17) VALUE SPACES. CHGBR100 00458 05 PRT-TOTAL-EMPLOYER-CHARGES PIC $$,$$$,$$$,$$9.99-. CHGBR100 00459 CHGBR100 00460 01 CONTINUED-FOOTER. CHGBR100 00461 05 FILLER PIC X(15) VALUE SPACES. CHGBR100 00462 05 FILLER PIC X(06) VALUE 'PAGE: '. CHGBR100 00463 05 PAGE-NOC PIC ZZ9. CHGBR100 00464 05 FILLER PIC X(04) VALUE ' OF '. CHGBR100 00465 05 TOTAL-PAGE-NOC PIC ZZ9. CHGBR100 00466 05 FILLER PIC X(06) VALUE SPACES. CHGBR100 00467 05 PRT-MESSAGEC PIC X(40) VALUE SPACE. CHGBR100 00468 05 FILLER PIC X(55) VALUE SPACES. CHGBR100 00469 CHGBR100 00470 *** EMPL-ADDR-AREA CHGBR100 00471 01 FILLER. CHGBR100 00472 05 ADDR-SUB PIC S9(04) COMP VALUE +0. CHGBR100 00473 05 EMPL-ADDR-LINE OCCURS 5 TIMES. CHGBR100 00474 10 PRT-ADDR-FILLER PIC X(45) VALUE SPACES. CHGBR100 00475 10 PRT-ADDR-LINE PIC X(40) VALUE SPACES. CHGBR100 00476 CHGBR100 00477 EJECT CHGBR100 00478 01 L001-LINK-AREA. CHGBR100 00479 ++INCLUDE DTSIL001 CHGBR100 00480 EJECT CHGBR100 00481 01 L071-LINK-AREA. CHGBR100 00482 ++INCLUDE DTSIL071 CHGBR100 00483 EJECT CHGBR100 00484 LINKAGE SECTION. CHGBR100 00485 01 CHG-LINK-REC. CHGBR100 00486 ++INCLUDE CHGIL001 CHGBR100 00487 CHGBR100 00488 01 BD210-CHG-REC. CHGBR100 00489 ++INCLUDE CHGIM004 CHGBR100 00490 EJECT CHGBR100 00491 PROCEDURE DIVISION USING CHG-LINK-REC CHGBR100 00492 BD210-CHG-REC. CHGBR100 00493 CHGBR100-MAIN. CHGBR100 00494 EVALUATE TRUE CHGBR100 00495 WHEN CHG-LINK1-CMD-PROCESS-88 CHGBR100 00496 PERFORM P0000-PROCESS THRU P0000-EXIT CHGBR100 00497 PERFORM P5000-PROCESS THRU P5000-EXIT CHGBR100 00498 CHGBR100 00499 WHEN CHG-LINK1-CMD-INIT-88 CHGBR100 00500 PERFORM I0000-INITIATE THRU I0000-EXIT CHGBR100 00501 CHGBR100 00502 WHEN CHG-LINK1-CMD-CLOSE-88 CHGBR100 00503 PERFORM T0000-TERMINATE THRU T0000-EXIT CHGBR100 00504 CHGBR100 00505 WHEN OTHER CHGBR100 00506 MOVE 'INVALID CHG-LINK1-COMMAND ' TO ABEND-MSG CHGBR100 00507 PERFORM S999-ABEND THRU S999-EXIT CHGBR100 00508 END-EVALUATE. CHGBR100 00509 CHGBR100 00510 GOBACK. CHGBR100 00511 EJECT CHGBR100 00512 I0000-INITIATE. CHGBR100 00513 DISPLAY ' '. CHGBR100 00514 DISPLAY '*** CHG-LINK-REC: ' CHG-LINK-REC. CHGBR100 00515 DISPLAY ' '. CHGBR100 00516 CHGBR100 00517 MOVE ZERO TO WRK-CURR-EMP CHGBR100 00518 WRK-LINE-CNT CHGBR100 00519 WRK-TOT-AMT CHGBR100 00520 WRK-CURR-AMT CHGBR100 00521 WRK-TOTAL-BENEFITS CHGBR100 00522 WRK-ACCT-TOTAL CHGBR100 00523 WRK-GRAND-TOTAL-BENEFITS CHGBR100 00524 WRK-GRAND-TOTAL-CHARGED. CHGBR100 00525 CHGBR100 00526 EVALUATE TRUE CHGBR100 00527 WHEN CHG-LINK1-RUN-TYPE-QTRLY-88 CHGBR100 00528 MOVE WRK-RPT-SUMMARY TO H2-RPT-TYP CHGBR100 00529 CHGBR100 00530 WHEN CHG-LINK1-RUN-TYPE-ANN-88 CHGBR100 00531 MOVE WRK-RPT-ANNUAL-SUMM TO H2-RPT-TYP CHGBR100 00532 CHGBR100 00533 WHEN CHG-LINK1-RUN-TYPE-SPC-88 CHGBR100 00534 MOVE WRK-RPT-SPECIAL TO H2-RPT-TYP CHGBR100 00535 END-EVALUATE. CHGBR100 00536 CHGBR100 00537 MOVE CHG-LINK1-PERIOD-BEGIN TO L001-FED-8-DATE-9. CHGBR100 00538 SET L001-FROM-FED-8 TO TRUE. CHGBR100 00539 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR100 00540 MOVE L001-SLASH-8-DATE TO WS-REPORT-START-DATE. CHGBR100 00541 * CHGBR100 00542 MOVE CHG-LINK1-PERIOD-END TO L001-FED-8-DATE-9. CHGBR100 00543 SET L001-FROM-FED-8 TO TRUE. CHGBR100 00544 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR100 00545 MOVE L001-SLASH-8-DATE TO PRT-END-DATE CHGBR100 00546 WS-REPORT-END-DATE. CHGBR100 00547 CHGBR100 00548 IF CHG-LINK1-RUN-TYPE-QTRLY-88 CHGBR100 00549 OR CHG-LINK1-RUN-TYPE-AGTS-88 CHGBR100 00550 MOVE X1-CA-JDEQ TO X1-CA-JDE CHGBR100 00551 ** OPEN OUTPUT RATED-FILE1 CHGBR100 00552 * FISCAL-AGENT-FILE CHGBR100 00553 ** RATED-RPT CHGBR100 00554 ELSE CHGBR100 00555 IF CHG-LINK1-RUN-TYPE-ANN-88 CHGBR100 00556 MOVE X1-CA-JDEA TO X1-CA-JDE CHGBR100 00557 ** OPEN OUTPUT RATED-FILE1 CHGBR100 00558 ** RATED-RPT CHGBR100 00559 ELSE CHGBR100 00560 MOVE X1-CA-JDEQ TO X1-CA-JDE CHGBR100 00561 * OPEN OUTPUT RATED-RPT CHGBR100 00562 END-IF CHGBR100 00563 END-IF. CHGBR100 00564 CHGBR100 00565 OPEN OUTPUT RATED-FILE1 CHGBR100 00566 RATED-DATA CL**5 00567 FISCAL-AGENT-FILE CHGBR100 00568 RATED-RPT. CHGBR100 00569 WRITE RATED-PRINT-REC FROM XF-CA-CNTL-LINE CHGBR100 00570 * AFTER ADVANCING TOP-OF-PAGE. CHGBR100 00571 WRITE RATED-PRINT-REC FROM X2-CA-CNTL-LINE. CHGBR100 00572 WRITE RATED-PRINT-REC FROM X3-CA-CNTL-LINE. CHGBR100 00573 CHGBR100 00574 * WRITE RATED-PRINT-REC FROM VSCA-LINE CHGBR100 00575 * AFTER ADVANCING TOP-OF-PAGE. CHGBR100 00576 CHGBR100 00577 PERFORM I1000-INIT-TABLE THRU I1000-EXIT. CHGBR100 00578 CHGBR100 00579 I0000-EXIT. CHGBR100 00580 EXIT. CHGBR100 00581 I1000-INIT-TABLE. CHGBR100 00582 PERFORM CHGBR100 00583 VARYING CHG-TAB-SUB FROM +1 BY +1 CHGBR100 00584 UNTIL CHG-TAB-SUB > CHG-TAB-MAX CHGBR100 00585 INITIALIZE CHG-TAB-ENTRY (CHG-TAB-SUB) CHGBR100 00586 END-PERFORM. CHGBR100 00587 CHGBR100 00588 MOVE +0 TO CHG-TAB-SUB CHGBR100 00589 CHG-TAB-LEN. CHGBR100 00590 CHGBR100 00591 I1000-EXIT. CHGBR100 00592 EXIT. CHGBR100 00593 CHGBR100 00594 *I2000-INITIATE. CHGBR100 00595 * MOVE ZERO TO WRK-CURR-EMP CHGBR100 00596 * WRK-LINE-CNT CHGBR100 00597 * WRK-TOT-AMT CHGBR100 00598 * WRK-CURR-AMT CHGBR100 00599 * WRK-TOTAL-BENEFITS CHGBR100 00600 * WRK-ACCT-TOTAL CHGBR100 00601 * WRK-GRAND-TOTAL-BENEFITS CHGBR100 00602 * WRK-GRAND-TOTAL-CHARGED. CHGBR100 00603 * CHGBR100 00604 * MOVE ZERO TO WRK-CURR-EMP. CHGBR100 00605 * CHGBR100 00606 * MOVE WRK-RPT-SPECIAL TO H2-RPT-TYP. CHGBR100 00607 * MOVE CHG-LINK1-PERIOD-BEGIN TO L001-FED-8-DATE-9. CHGBR100 00608 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR100 00609 * MOVE L001-SLASH-8-DATE TO WS-REPORT-START-DATE. CHGBR100 00610 * CHGBR100 00611 * MOVE CHG-LINK1-PERIOD-END TO L001-FED-8-DATE-9. CHGBR100 00612 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR100 00613 * MOVE L001-SLASH-8-DATE TO WS-REPORT-END-DATE. CHGBR100 00614 * CHGBR100 00615 * IF CHG-LINK1-RUN-TYPE-QTRLY-88 OR CHG-LINK1-RUN-TYPE-AGTS-88 CHGBR100 00616 * OPEN OUTPUT RATED-FILE1 RATED-RPT FISCAL-AGENT-FILE CHGBR100 00617 * ELSE CHGBR100 00618 * OPEN OUTPUT RATED-RPT CHGBR100 00619 * END-IF. CHGBR100 00620 * CHGBR100 00621 *I2000-EXIT. CHGBR100 00622 * EXIT. CHGBR100 00623 * EJECT CHGBR100 00624 CHGBR100 00625 P0000-PROCESS. CHGBR100 00626 *RW1 CHGBR100 00627 IF CHG-LINK1-RUN-TYPE-AGTS-88 CHGBR100 00628 IF NOT CHG4-FISC-AG-NONE-88 CHGBR100 00629 PERFORM P4000-FISCAL-AGENT THRU P4000-EXIT CHGBR100 00630 GO TO P0000-EXIT CHGBR100 00631 ELSE CHGBR100 00632 GO TO P0000-EXIT CHGBR100 00633 END-IF CHGBR100 00634 END-IF. CHGBR100 00635 CHGBR100 00636 IF CHG-LINK1-RUN-TYPE-QTRLY-88 CHGBR100 00637 IF NOT CHG4-FISC-AG-NONE-88 CHGBR100 00638 PERFORM P4000-FISCAL-AGENT THRU P4000-EXIT CHGBR100 00639 GO TO P0000-EXIT CHGBR100 00640 END-IF CHGBR100 00641 END-IF. CHGBR100 00642 *RW2 CHGBR100 00643 IF CHG4-EMP-NO NOT = WRK-CURRENT-EMP CHGBR100 00644 IF WRK-CURRENT-EMP = ZERO CHGBR100 00645 PERFORM P1000-INIT-EMP THRU P1000-EXIT CHGBR100 00646 PERFORM P2000-ADD-REC-TO-TABLE THRU P2000-EXIT CHGBR100 00647 ELSE CHGBR100 00648 PERFORM P3000-PRINT-FORMS THRU P3000-EXIT CHGBR100 00649 PERFORM P1000-INIT-EMP THRU P1000-EXIT CHGBR100 00650 PERFORM P2000-ADD-REC-TO-TABLE THRU P2000-EXIT CHGBR100 00651 END-IF CHGBR100 00652 ELSE CHGBR100 00653 PERFORM P2000-ADD-REC-TO-TABLE THRU P2000-EXIT CHGBR100 00654 END-IF. CHGBR100 00655 CHGBR100 00656 P0000-EXIT. CHGBR100 00657 EXIT. CHGBR100 00658 CHGBR100 00659 P1000-INIT-EMP. CHGBR100 00660 MOVE CHG4-EMP-NO TO WRK-CURRENT-EMP CHGBR100 00661 PRT-EMP-NO. CHGBR100 00662 MOVE ZERO TO CHG-TAB-LEN CHGBR100 00663 WRK-EMP-TOT-AMT. CHGBR100 00664 CHGBR100 00665 ADD +1 TO WRK-PRINTED-FORM-EMP-CNT. CHGBR100 00666 CHGBR100 00667 PERFORM CHGBR100 00668 VARYING ADDR-SUB FROM +1 BY +1 CHGBR100 00669 UNTIL ADDR-SUB > +5 CHGBR100 00670 MOVE CHG4-FMT-LINE (ADDR-SUB) CHGBR100 00671 TO PRT-ADDR-LINE (ADDR-SUB) CHGBR100 00672 END-PERFORM. CHGBR100 00673 CHGBR100 00674 P1000-EXIT. CHGBR100 00675 EXIT. CHGBR100 00676 CHGBR100 00677 P2000-ADD-REC-TO-TABLE. CHGBR100 00678 ADD +1 TO CHG-TAB-LEN. CHGBR100 00679 IF CHG-TAB-LEN > CHG-TAB-MAX CHGBR100 00680 MOVE 'SIZE ERROR ON CHG-TAB' TO ABEND-MSG CHGBR100 00681 PERFORM S999-ABEND THRU S999-EXIT. CHGBR100 00682 CHGBR100 00683 MOVE CHG4-CLMNT-NAME TO CHG-TAB-NAME (CHG-TAB-LEN). CHGBR100 00684 MOVE CHG4-SSN TO CHG-TAB-SSN (CHG-TAB-LEN). CHGBR100 00685 COMPUTE WRK-EMP-CURR-AMT = CHGBR100 00686 CHG4-CURR-BEN-AMT + CHGBR100 00687 CHG4-CURR-ADJ-AMT. CHGBR100 00688 MOVE WRK-EMP-CURR-AMT TO CHG-TAB-AMT (CHG-TAB-LEN). CHGBR100 00689 MOVE CHG4-PRED-EMP-NO TO CHG-TAB-PRED (CHG-TAB-LEN). CHGBR100 00690 MOVE CHG4-SUCC-EMP-NO TO CHG-TAB-SUCC (CHG-TAB-LEN). CHGBR100 00691 CHGBR100 00692 P2000-EXIT. CHGBR100 00693 EXIT. CHGBR100 00694 EJECT CHGBR100 00695 CHGBR100 00696 P3000-PRINT-FORMS. CHGBR100 00697 *** **SELF-MAILERS** CHGBR100 00698 MOVE ZEROS TO WRK-TOTAL-PAGES CHGBR100 00699 WRK-CURR-PAGE. CHGBR100 00700 CHGBR100 00701 DIVIDE CHG-TAB-LEN BY 34 CHGBR100 00702 GIVING WRK-TOTAL-PAGES CHGBR100 00703 REMAINDER REMAINDER-CNT CHGBR100 00704 END-DIVIDE. CHGBR100 00705 CHGBR100 00706 IF REMAINDER-CNT > 0 CHGBR100 00707 ADD +1 TO WRK-TOTAL-PAGES. CHGBR100 00708 CHGBR100 00709 PERFORM P3500-PRINT-ADDRESS CHGBR100 00710 THRU P3500-EXIT. CHGBR100 00711 CHGBR100 00712 PERFORM P3100-PRINT-HEADER THRU P3100-EXIT. CHGBR100 00713 CHGBR100 00714 MOVE +0 TO CHG-TAB-SUB. CHGBR100 00715 SET WRK-PRINT-COMPLETE-NO-88 TO TRUE. CHGBR100 00716 PERFORM P3200-PRINT-LINES THRU P3200-EXIT CHGBR100 00717 UNTIL WRK-PRINT-COMPLETE-YES-88. CHGBR100 00718 CHGBR100 00719 P3000-EXIT. CHGBR100 00720 EXIT. CHGBR100 00721 CHGBR100 00722 P3100-PRINT-HEADER. CHGBR100 00723 MOVE +0 TO WRK-CURR-LINE. CHGBR100 00724 CHGBR100 00725 ADD +1 TO WRK-SELF-MAILER-CNT. CHGBR100 00726 CHGBR100 00727 MOVE SPACES TO VSCA-DATA. CHGBR100 00728 * WRITE RATED-PRINT-REC FROM VSCA-DATA CHGBR100 00729 * AFTER ADVANCING TOP-OF-PAGE. CHGBR100 00730 CHGBR100 00731 WRITE RATED-PRINT-REC FROM PAGE-HEAD01 CHGBR100 00732 AFTER ADVANCING 26 LINES. CHGBR100 00733 * AFTER ADVANCING 28 LINES. CHGBR100 00734 CHGBR100 00735 MOVE SPACES TO VSCA-DATA. CHGBR100 00736 WRITE RATED-PRINT-REC FROM VSCA-DATA CHGBR100 00737 AFTER ADVANCING 9 LINES. CHGBR100 00738 CHGBR100 00739 P3100-EXIT. CHGBR100 00740 EXIT. CHGBR100 00741 CHGBR100 00742 P3200-PRINT-LINES. CHGBR100 00743 ADD +1 TO CHG-TAB-SUB. CHGBR100 00744 IF CHG-TAB-SUB > CHG-TAB-LEN CHGBR100 00745 PERFORM P3210-FINAL-FOOTER THRU P3210-EXIT CHGBR100 00746 SET WRK-PRINT-COMPLETE-YES-88 TO TRUE CHGBR100 00747 GO TO P3200-EXIT. CHGBR100 00748 CHGBR100 00749 ADD +1 TO WRK-CURR-LINE. CHGBR100 00750 MOVE CHG-TAB-NAME (CHG-TAB-SUB) TO L071-NAM. CHGBR100 00751 PERFORM S071-NAME-CONVERSION THRU S071-EXIT. CHGBR100 00752 MOVE L071-NAM TO PRT-CHARGE-NAME. CHGBR100 00753 MOVE CHG-TAB-SSN (CHG-TAB-SUB) TO WS-SSN. CHGBR100 00754 MOVE WS-SSN1 TO PRT-WS-SSN1. CHGBR100 00755 MOVE WS-SSN2 TO PRT-WS-SSN2. CHGBR100 00756 MOVE WS-SSN3 TO PRT-WS-SSN3. CHGBR100 00757 MOVE CHG-TAB-AMT (CHG-TAB-SUB) TO PRT-CHARGE-CURR-AMT. CHGBR100 00758 ADD CHG-TAB-AMT (CHG-TAB-SUB) TO WRK-EMP-TOT-AMT. CHGBR100 00759 *RW1 CHGBR100 00760 MOVE SPACES TO PRT-PRT-SOURCE-TYPE. CHGBR100 00761 IF CHG-TAB-PRED (CHG-TAB-SUB) > 0 CHGBR100 00762 IF CHG-TAB-PRED (CHG-TAB-SUB) = WRK-CURRENT-EMP CHGBR100 00763 MOVE CHG-TAB-SUCC (CHG-TAB-SUB) TO CHGBR100 00764 PRT-SUCC-PRED-EMP-NO CHGBR100 00765 MOVE 'TRANSFERRED TO ' TO PRT-PRINT-MSG CHGBR100 00766 ELSE CHGBR100 00767 MOVE CHG-TAB-PRED (CHG-TAB-SUB) TO CHGBR100 00768 PRT-SUCC-PRED-EMP-NO CHGBR100 00769 MOVE 'TRANSFERRED FROM ' TO PRT-PRINT-MSG CHGBR100 00770 END-IF CHGBR100 00771 END-IF. CHGBR100 00772 *RW2 CHGBR100 00773 WRITE RATED-PRINT-REC FROM EMPLOYER-DETAIL-LINE AFTER 1. CHGBR100 00774 CHGBR100 00775 IF WRK-CURR-LINE < WRK-MAX-LINES-PER-PAGE CHGBR100 00776 NEXT SENTENCE CHGBR100 00777 ELSE CHGBR100 00778 IF CHG-TAB-SUB < CHG-TAB-LEN CHGBR100 00779 PERFORM P3220-CONTINUED-FOOTER THRU P3220-EXIT CHGBR100 00780 PERFORM P3500-PRINT-ADDRESS THRU P3500-EXIT CHGBR100 00781 PERFORM P3100-PRINT-HEADER THRU P3100-EXIT. CHGBR100 00782 CHGBR100 00783 P3200-EXIT. CHGBR100 00784 EXIT. CHGBR100 00785 CHGBR100 00786 P3210-FINAL-FOOTER. CHGBR100 00787 ADD 1 TO WRK-CURR-PAGE. CHGBR100 00788 MOVE WRK-CURR-PAGE TO PAGE-NO. CHGBR100 00789 MOVE WRK-TOTAL-PAGES TO TOTAL-PAGE-NO. CHGBR100 00790 CHGBR100 00791 COMPUTE ADVANCE-LINE-CNT = 37 - WRK-CURR-LINE. CHGBR100 00792 CHGBR100 00793 MOVE '*** TOTAL CHARGE OR CREDIT: ' CHGBR100 00794 TO PRT-MESSAGE. CHGBR100 00795 MOVE WRK-EMP-TOT-AMT TO PRT-TOTAL-EMPLOYER-CHARGES. CHGBR100 00796 COMPUTE WRK-RATED-TOT-AMT = CHGBR100 00797 WRK-RATED-TOT-AMT + CHGBR100 00798 WRK-EMP-TOT-AMT. CHGBR100 00799 CHGBR100 00800 WRITE RATED-PRINT-REC FROM FINAL-FOOTER CHGBR100 00801 AFTER ADVANCING ADVANCE-LINE-CNT. CHGBR100 00802 CHGBR100 00803 WRITE RATED-PRINT-REC FROM VSCA-DATA CHGBR100 00804 AFTER ADVANCING TOP-OF-PAGE. CHGBR100 00805 * PERFORM P3500-PRINT-ADDRESS CHGBR100 00806 * THRU P3500-EXIT. CHGBR100 00807 CHGBR100 00808 P3210-EXIT. CHGBR100 00809 EXIT. CHGBR100 00810 CHGBR100 00811 P3220-CONTINUED-FOOTER. CHGBR100 00812 ADD 1 TO WRK-CURR-PAGE. CHGBR100 00813 MOVE WRK-CURR-PAGE TO PAGE-NOC. CHGBR100 00814 MOVE WRK-TOTAL-PAGES TO TOTAL-PAGE-NOC. CHGBR100 00815 CHGBR100 00816 COMPUTE ADVANCE-LINE-CNT = 37 - WRK-CURR-LINE. CHGBR100 00817 CHGBR100 00818 MOVE '*** CONTINUED IN SEPARATE MAILING ***' TO PRT-MESSAGEC.CHGBR100 00819 CHGBR100 00820 WRITE RATED-PRINT-REC FROM CONTINUED-FOOTER CHGBR100 00821 AFTER ADVANCING ADVANCE-LINE-CNT. CHGBR100 00822 CHGBR100 00823 MOVE SPACES TO VSCA-DATA. CHGBR100 00824 WRITE RATED-PRINT-REC FROM VSCA-DATA CHGBR100 00825 AFTER ADVANCING TOP-OF-PAGE. CHGBR100 00826 P3220-EXIT. CHGBR100 00827 EXIT. CHGBR100 00828 CHGBR100 00829 P3500-PRINT-ADDRESS. CHGBR100 00830 MOVE SPACES TO VSCA-DATA. CHGBR100 00831 WRITE RATED-PRINT-REC FROM VSCA-DATA CHGBR100 00832 AFTER ADVANCING TOP-OF-PAGE. CHGBR100 00833 CHGBR100 00834 WRITE RATED-PRINT-REC FROM EMPL-ADDR-LINE (1) CHGBR100 00835 AFTER ADVANCING 12 LINES. CHGBR100 00836 CHGBR100 00837 PERFORM CHGBR100 00838 VARYING ADDR-SUB FROM 2 BY 1 CHGBR100 00839 UNTIL ADDR-SUB > 5 CHGBR100 00840 WRITE RATED-PRINT-REC FROM EMPL-ADDR-LINE (ADDR-SUB) CHGBR100 00841 AFTER ADVANCING 1 LINE CHGBR100 00842 END-PERFORM. CHGBR100 00843 CHGBR100 00844 P3500-EXIT. CHGBR100 00845 EXIT. CHGBR100 00846 EJECT CHGBR100 00847 P4000-FISCAL-AGENT. CHGBR100 00848 *** **FISC.AGNT FILE** CHGBR100 00849 IF CHG4-EMP-NO NOT = WRK-CURR-FISC-AGNT-EMP CHGBR100 00850 ADD +1 TO WRK-FISCAL-AGNT-EMP-CNT CHGBR100 00851 MOVE CHG4-EMP-NO TO WRK-CURR-FISC-AGNT-EMP CHGBR100 00852 END-IF. CHGBR100 00853 CHGBR100 00854 MOVE CHG4-FISCAL-AGENT-CD TO CHG8-FISCAL-AGENT-CD. CHGBR100 00855 MOVE CHG4-EMP-NO TO CHG8-EMP-NO. CHGBR100 00856 MOVE CHG4-BYE TO CHG8-BYE. CHGBR100 00857 MOVE CHG4-SSN TO CHG8-SSN. CHGBR100 00858 MOVE CHG4-CLMNT-NAME TO CHG8-CLMNT-NAME. CHGBR100 00859 COMPUTE WRK-CHG8-TOT-CHG-AMT = CHG4-CURR-BEN-AMT + CHGBR100 00860 CHG4-CURR-ADJ-AMT. CHGBR100 00861 MOVE WRK-CHG8-TOT-CHG-AMT TO CHG8-TOT-CHG-AMT. CHGBR100 00862 MOVE CHG-LINK1-PERIOD-BEGIN TO CHG8-START-DATE. CHGBR100 00863 MOVE CHG-LINK1-PERIOD-END TO CHG8-END-DATE. CHGBR100 00864 MOVE SPACES TO FILLER1. CHGBR100 00865 WRITE CHG8-REC. CHGBR100 00866 ADD 1 TO CHG8-REC-CNT. CHGBR100 00867 COMPUTE WRK-FISCAL-TOT-AMT = CHGBR100 00868 WRK-FISCAL-TOT-AMT + CHGBR100 00869 WRK-CHG8-TOT-CHG-AMT. CHGBR100 00870 CHGBR100 00871 INITIALIZE CHG8-REC. CHGBR100 00872 MOVE ZEROS TO WRK-CHG8-TOT-CHG-AMT. CHGBR100 00873 CHGBR100 00874 P4000-EXIT. CHGBR100 00875 EXIT. CHGBR100 00876 EJECT CHGBR100 00877 CHGBR100 00878 P5000-PROCESS. CHGBR100 00879 *** **DETAIL REPORT** CHGBR100 00880 PERFORM P5500-CHK-FOR-NEW-PAGE THRU P5500-EXIT CHGBR100 00881 CHGBR100 00882 EVALUATE TRUE CHGBR100 00883 WHEN CHG4-PROG-UI CHGBR100 00884 MOVE WRK-REG-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR100 00885 DAT-PRT-SOURCE-TYPE CL**3 00886 CHGBR100 00887 WHEN CHG4-PROG-EB CHGBR100 00888 MOVE WRK-EXT-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR100 00889 DAT-PRT-SOURCE-TYPE CL**3 00890 CHGBR100 00891 WHEN CHG4-PROG-TEUC CHGBR100 00892 MOVE WRK-TEUC-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR100 00893 DAT-PRT-SOURCE-TYPE CL**3 00894 CHGBR100 00895 WHEN CHG4-PROG-TEUCA CHGBR100 00896 MOVE WRK-TEUCA-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR100 00897 DAT-PRT-SOURCE-TYPE CL**3 00898 CHGBR100 00899 WHEN CHG4-PROG-FAC CHGBR100 00900 MOVE WRK-FAC-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR100 00901 DAT-PRT-SOURCE-TYPE CL**3 00902 CHGBR100 00903 WHEN OTHER CHGBR100 00904 MOVE ' UNKNOWN ' TO WRK-PRT-SOURCE-TYPE CHGBR100 00905 DAT-PRT-SOURCE-TYPE CL**3 00906 END-EVALUATE. CHGBR100 00907 CHGBR100 00908 IF CHG4-PRED-EMP-NO > 0 CHGBR100 00909 MOVE SPACES TO WRK-PRT-SOURCE-TYPE CHGBR100 00910 COMPUTE WRK-PERCENT = CHG4-PERCENT-XFER * 100 CHGBR100 00911 MOVE WRK-PERCENT TO WRK-PRED-PERCENT CHGBR100 00912 DAT-PRED-PERCENT CL**3 00913 MOVE '%' TO WRK-PERCENT-SIGN CHGBR100 00914 DAT-PERCENT-SIGN CL**3 00915 IF CHG4-PRED-EMP-NO = CHG4-EMP-NO CHGBR100 00916 MOVE CHG4-SUCC-EMP-NO TO WRK-SUCC-PRED-EMP-NO CHGBR100 00917 DAT-SUCC-PRED-EMP-NO CL**3 00918 MOVE 'TRNSFR TO:' TO WRK-PRINT-MSG CHGBR100 00919 DAT-PRINT-MSG CL**3 00920 ELSE CHGBR100 00921 MOVE CHG4-PRED-EMP-NO TO WRK-SUCC-PRED-EMP-NO CHGBR100 00922 DAT-SUCC-PRED-EMP-NO CL**3 00923 MOVE 'TRNSFR FROM:' TO WRK-PRINT-MSG CHGBR100 00924 DAT-PRINT-MSG CL**3 00925 END-IF CHGBR100 00926 END-IF. CHGBR100 00927 MOVE WRK-PRT-HDR-EMP TO DAT-EMP-NO CL*20 00928 WRK-PRT-ACCT-EAN. CL*20 00929 MOVE CHG4-SSN TO WRK-SSN. CHGBR100 00930 MOVE WRK-SSN1 TO WRK-PRT-SSN1 CL**3 00931 MOVE 'XXX' TO DAT-PRT-SSN1. CL*15 00932 MOVE WRK-SSN2 TO WRK-PRT-SSN2 CL**3 00933 MOVE 'XX' TO DAT-PRT-SSN2. CL*15 00934 MOVE WRK-SSN3 TO WRK-PRT-SSN3 CL**3 00935 DAT-PRT-SSN3. CL**3 00936 MOVE CHG4-BYE TO L001-FED-8-DATE-9. CHGBR100 00937 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR100 00938 MOVE L001-SLASH-8-DATE TO WRK-PRT-BYE-DATE CL**3 00939 DAT-PRT-BYE-DATE. CL**3 00940 MOVE CHG4-CLMNT-NAME TO WRK-PRT-CLMNT-NAME CHGBR100 00941 DAT-PRT-CLMNT-NAME. CL**3 00942 CHGBR100 00943 COMPUTE WRK-TOT-AMT = CHGBR100 00944 CHG4-TOT-BEN-AMT + CHG4-TOT-ADJ-AMT CHGBR100 00945 MOVE WRK-TOT-AMT TO WRK-PRT-TOT-AMT CL**3 00946 * DAT-PRT-TOT-AMT. CL*19 00947 CHGBR100 00948 COMPUTE WRK-CURR-AMT = CHGBR100 00949 CHG4-CURR-BEN-AMT + CHG4-CURR-ADJ-AMT CHGBR100 00950 MOVE WRK-CURR-AMT TO WRK-PRT-CURR-AMT CL**3 00951 DAT-PRT-CURR-AMT. CL**6 00952 CHGBR100 00953 IF WRK-CURR-AMT NOT = ZERO CHGBR100 00954 WRITE RATED-DAT FROM DAT-PRINT-LINE CL*18 00955 WRITE RATED-REPORT FROM WRK-PRINT-LINE CL**3 00956 AFTER ADVANCING 1 LINE CHGBR100 00957 ADD +1 TO WRK-LINE-CNT CHGBR100 00958 PERFORM P8000-TOTALS THRU P8000-EXIT CHGBR100 00959 END-IF. CHGBR100 00960 CHGBR100 00961 P5000-EXIT. CHGBR100 00962 EXIT. CHGBR100 00963 CHGBR100 00964 P5500-CHK-FOR-NEW-PAGE. CHGBR100 00965 IF CHG4-EMP-NO NOT = WRK-CURR-EMP CHGBR100 00966 *** 1ST EMPLYR CHGBR100 00967 IF WRK-CURR-EMP = ZERO CHGBR100 00968 MOVE CHG4-EMP-NO TO WRK-CURR-EMP CHGBR100 00969 WRK-PRT-HDR-EMP CHGBR100 00970 MOVE CHG4-EMP-TYPE TO WRK-PRT-EMP-TYPE CHGBR100 00971 PERFORM P6000-PRINT-HEADER THRU P6000-EXIT CHGBR100 00972 ADD +1 TO WRK-EMPLYR-CNT CHGBR100 00973 ELSE CHGBR100 00974 *** NEW EMPLYR CHGBR100 00975 PERFORM P6500-PRINT-FOOTER THRU P6500-EXIT CHGBR100 00976 MOVE CHG4-EMP-NO TO WRK-CURR-EMP CHGBR100 00977 WRK-PRT-HDR-EMP CHGBR100 00978 MOVE CHG4-EMP-TYPE TO WRK-PRT-EMP-TYPE CHGBR100 00979 PERFORM P6000-PRINT-HEADER THRU P6000-EXIT CHGBR100 00980 ADD +1 TO WRK-EMPLYR-CNT CHGBR100 00981 ELSE CHGBR100 00982 *** SAME EMPLYR CHGBR100 00983 IF WRK-LINE-CNT > +54 CHGBR100 00984 PERFORM P6000-PRINT-HEADER THRU P6000-EXIT CHGBR100 00985 END-IF CHGBR100 00986 END-IF. CHGBR100 00987 CHGBR100 00988 P5500-EXIT. CHGBR100 00989 EXIT. CHGBR100 00990 CHGBR100 00991 P6000-PRINT-HEADER. CHGBR100 00992 MOVE ZERO TO WRK-LINE-CNT CHGBR100 00993 ADD 1 TO WRK-PAGE-CNT. CHGBR100 00994 MOVE WRK-PAGE-CNT TO WRK-PRT-PAGE-CNT. CHGBR100 00995 CHGBR100 00996 MOVE HEAD01 TO WS-REC CHGBR100 00997 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING TOP-OF-PAGE CHGBR100 00998 MOVE HEAD02 TO WS-REC CHGBR100 00999 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR100 01000 MOVE HEAD03 TO WS-REC CHGBR100 01001 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR100 01002 MOVE SPACES TO WS-REC CHGBR100 01003 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR100 01004 MOVE HEAD04 TO WS-REC CHGBR100 01005 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR100 01006 MOVE SPACES TO WS-REC CHGBR100 01007 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR100 01008 MOVE HEAD05 TO WS-REC CHGBR100 01009 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR100 01010 MOVE SPACES TO WS-REC CHGBR100 01011 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR100 01012 MOVE HEAD06 TO WS-REC CHGBR100 01013 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR100 01014 MOVE SPACES TO WS-REC CHGBR100 01015 WRITE RATED-REPORT FROM WS-REC AFTER ADVANCING 1 LINE. CHGBR100 01016 CHGBR100 01017 MOVE +10 TO WRK-LINE-CNT. CHGBR100 01018 P6000-EXIT. CHGBR100 01019 EXIT. CHGBR100 01020 CHGBR100 01021 P6500-PRINT-FOOTER. CHGBR100 01022 *** JUST IN CASE CHGBR100 01023 IF WRK-LINE-CNT > +48 CHGBR100 01024 PERFORM P6000-PRINT-HEADER THRU P6000-EXIT CHGBR100 01025 END-IF CHGBR100 01026 CHGBR100 01027 MOVE WRK-TOTAL-BENEFITS TO WRK-PRT-TOT-BEN. CHGBR100 01028 MOVE WRK-ACCT-TOTAL TO WRK-PRT-ACCT-TOT. CHGBR100 01029 CHGBR100 01030 MOVE SPACES TO DAT-TOTAL-LINE CL*12 01031 MOVE '; ' TO FILLEX CL*13 01032 MOVE WRK-PRT-HDR-EMP TO DAT-TOT-EMP-NO. CL*12 01033 MOVE WRK-ACCT-TOTAL TO DAT-TOT-CURR-AMT. CL*12 01034 CL**9 01035 WRITE RATED-DAT FROM DAT-TOTAL-LINE CL*12 01036 WRITE RATED-REPORT FROM WRK-PRINT-TOTAL CHGBR100 01037 AFTER ADVANCING 4 LINE. CHGBR100 01038 WRITE RATED-REPORT FROM WRK-PRINT-TOTAL-ACCT CHGBR100 01039 AFTER ADVANCING 2 LINE. CHGBR100 01040 CHGBR100 01041 ADD WRK-TOTAL-BENEFITS TO WRK-GRAND-TOTAL-BENEFITS. CHGBR100 01042 ADD WRK-ACCT-TOTAL TO WRK-GRAND-TOTAL-CHARGED. CHGBR100 01043 CHGBR100 01044 MOVE ZERO TO WRK-TOTAL-BENEFITS CHGBR100 01045 WRK-ACCT-TOTAL. CHGBR100 01046 P6500-EXIT. CHGBR100 01047 EXIT. CHGBR100 01048 CHGBR100 01049 P8000-TOTALS. CHGBR100 01050 COMPUTE WRK-TOTAL-BENEFITS = WRK-TOTAL-BENEFITS CHGBR100 01051 + CHG4-TOT-BEN-AMT CHGBR100 01052 + CHG4-TOT-ADJ-AMT. CHGBR100 01053 CHGBR100 01054 COMPUTE WRK-ACCT-TOTAL = WRK-ACCT-TOTAL CHGBR100 01055 + CHG4-CURR-BEN-AMT CHGBR100 01056 + CHG4-CURR-ADJ-AMT. CHGBR100 01057 CHGBR100 01058 P8000-EXIT. CHGBR100 01059 EXIT. CHGBR100 01060 CHGBR100 01061 T0000-TERMINATE. CHGBR100 01062 IF NOT CHG-LINK1-RUN-TYPE-AGTS-88 CHGBR100 01063 PERFORM T1000-FOOTER-AND-TOTALS THRU T1000-EXIT CHGBR100 01064 END-IF. CHGBR100 01065 CHGBR100 01066 IF CHG-LINK1-RUN-TYPE-SPC-88 CHGBR100 01067 OR CHG-LINK1-RUN-TYPE-AGTS-88 CHGBR100 01068 NEXT SENTENCE CHGBR100 01069 ELSE CHGBR100 01070 PERFORM P3000-PRINT-FORMS THRU P3000-EXIT CHGBR100 01071 END-IF. CHGBR100 01072 CHGBR100 01073 DISPLAY '********************************************'. CHGBR100 01074 DISPLAY '*** CHGBR100 COUNTS ***'. CHGBR100 01075 DISPLAY '***'. CHGBR100 01076 DISPLAY '*** EMPLOYERS RECEIVING PRINTED FORMS: ' CHGBR100 01077 WRK-PRINTED-FORM-EMP-CNT. CHGBR100 01078 DISPLAY '*** EMPLOYERS USING FISCAL AGENTS: ' CHGBR100 01079 WRK-FISCAL-AGNT-EMP-CNT. CHGBR100 01080 DISPLAY '*** FISCAL AGENT RECORDS WRITTEN: ' CHGBR100 01081 CHG8-REC-CNT. CHGBR100 01082 DISPLAY '*** SELF MAILERS PRINTED: ' CHGBR100 01083 WRK-SELF-MAILER-CNT. CHGBR100 01084 MOVE WRK-RATED-TOT-AMT TO WRK-RATED-TOT-DISP. CHGBR100 01085 DISPLAY '*** TOTAL CURR CHARGED TO ALL RATED EMPLOYERS: ' CHGBR100 01086 WRK-RATED-TOT-DISP. CHGBR100 01087 MOVE WRK-FISCAL-TOT-AMT TO WRK-RATED-TOT-DISP. CHGBR100 01088 DISPLAY '*** GRAND TOTAL CHARGED TO ALL FISCAL AGENTS: ' CHGBR100 01089 WRK-RATED-TOT-DISP. CHGBR100 01090 DISPLAY '***'. CHGBR100 01091 DISPLAY '********************************************'. CHGBR100 01092 CHGBR100 01093 IF CHG-LINK1-RUN-TYPE-QTRLY-88 CHGBR100 01094 OR CHG-LINK1-RUN-TYPE-AGTS-88 CHGBR100 01095 CLOSE RATED-FILE1 CHGBR100 01096 FISCAL-AGENT-FILE CHGBR100 01097 RATED-RPT CHGBR100 01098 RATED-DATA CL**5 01099 ELSE CHGBR100 01100 IF CHG-LINK1-RUN-TYPE-ANN-88 CHGBR100 01101 CLOSE RATED-FILE1 CHGBR100 01102 RATED-RPT CHGBR100 01103 RATED-DATA CL**5 01104 ELSE CHGBR100 01105 CLOSE RATED-RPT CHGBR100 01106 CLOSE RATED-DATA CL**5 01107 END-IF CHGBR100 01108 END-IF. CHGBR100 01109 CHGBR100 01110 T0000-EXIT. CHGBR100 01111 EXIT. CHGBR100 01112 CHGBR100 01113 T1000-FOOTER-AND-TOTALS. CHGBR100 01114 IF WRK-EMPLYR-CNT > +0 CHGBR100 01115 PERFORM P6500-PRINT-FOOTER THRU P6500-EXIT. CHGBR100 01116 CHGBR100 01117 IF WRK-EMPLYR-CNT > +1 CHGBR100 01118 PERFORM T1100-PRINT-GRAND-TOTALS THRU T1100-EXIT CHGBR100 01119 END-IF. CHGBR100 01120 CHGBR100 01121 T1000-EXIT. CHGBR100 01122 EXIT. CHGBR100 01123 CHGBR100 01124 T1100-PRINT-GRAND-TOTALS. CHGBR100 01125 *** DO NOT NEED EMPLYR NO. ANYMORE CHGBR100 01126 MOVE SPACE TO HEAD04. CHGBR100 01127 PERFORM P6000-PRINT-HEADER THRU P6000-EXIT CHGBR100 01128 CHGBR100 01129 MOVE WRK-GRAND-TOTAL-BENEFITS TO WRK-PRT-GRAND-TOT-BEN. CHGBR100 01130 MOVE WRK-GRAND-TOTAL-CHARGED TO WRK-PRT-GRAND-TOT-CHG. CHGBR100 01131 CHGBR100 01132 WRITE RATED-REPORT FROM WRK-PRINT-GRAND-PERIOD CHGBR100 01133 AFTER ADVANCING 3. CHGBR100 01134 WRITE RATED-REPORT FROM WRK-PRINT-GRAND CHGBR100 01135 AFTER ADVANCING 2. CHGBR100 01136 T1100-EXIT. CHGBR100 01137 EXIT. CHGBR100 01138 CHGBR100 01139 S001-FROM-FED-8. CHGBR100 01140 SET L001-FROM-FED-8 TO TRUE. CHGBR100 01141 GO TO S001-DATE. CHGBR100 01142 CHGBR100 01143 S001-DATE. CHGBR100 01144 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR100 01145 CHGBR100 01146 S001-EXIT. CHGBR100 01147 EXIT. CHGBR100 01148 CHGBR100 01149 S071-NAME-CONVERSION. CHGBR100 01150 SET L071-FROM-LAST-NAME-FIRST TO TRUE. CHGBR100 01151 CHGBR100 01152 CALL 'DTSBU071' USING L071-LINK-AREA. CHGBR100 01153 CHGBR100 01154 S071-EXIT. CHGBR100 01155 EXIT. CHGBR100 01156 CHGBR100 01157 S999-ABEND. CHGBR100 01158 DISPLAY '**** CHGBR100 ABENDING ' CHGBR100 01159 ABEND-MSG. CHGBR100 01160 CHGBR100 01161 CALL 'DTSBU999' USING WRK-ABEND-CODE. CHGBR100 01162 CHGBR100 01163 S999-EXIT. CHGBR100 01164 EXIT. CHGBR100