1166 lines
92 KiB
COBOL
1166 lines
92 KiB
COBOL
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
|