00001 IDENTIFICATION DIVISION. 01/06/11 00002 PROGRAM-ID. CHGBR150. CHGBR150 00003 *AUTHOR. TRW. LV017 00004 *DATE-WRITTEN. APRIL 2000. CHGBR150 00005 DATE-COMPILED. CHGBR150 00006 CHGBR150 00007 ***** CHGBR150 00008 * CALLING SEQUENCE: CHGBD300 CALLS CHGBR150 00009 * CHGBR150 READS CHGIM004 RECORDS CHGBR150 00010 * CHGBR150 WRITES TEUC RPT. CHGBR150 00011 * CHGBR150 00012 * FUNCTION: PRINT TEUC SUMMARY/SPECIAL REPORT CHGBR150 00013 * CHGBR150 00014 * DESCRIPTION: CHGBR150 00015 * CHGBR150 00016 * THIS MODULE GENERATES THE QUARTERLY/SPECIAL TEUC CHGBR150 00017 * SUMMARY/SPECIAL REPORT. CHGBR150 00018 * CHGBR150 00019 * RECORDS READ: CHGBR150 00020 * CHGBR150 00021 * NONE. CHGBR150 00022 * CHGBR150 00023 * INPUT: CHGBR150 00024 * CHGBR150 00025 * CHGIM004 RECORD PASSED FROM CHGBD300 CHGBR150 00026 * CHGBR150 00027 * PRINTED OUTPUTS: CHGBR150 00028 * CHGBR150 00029 * RPC150R1 - PRINT TEUC SUMMARY REPORT CHGBR150 00030 * CHGBR150 00031 * MODULES CALLED: CHGBR150 00032 * CHGBR150 00033 * DTSBU001 DATE EDIT/CONVERSION MODULE CHGBR150 00034 * CHGBR150 00035 ***** CHGBR150 00036 CHGBR150 00037 ******************************************************************CHGBR150 00038 * MODIFICATION HISTORY: *CHGBR150 00039 * *CHGBR150 00040 * 02-02-1999 MODIFIED FROM MT CHG100D *CHGBR150 00041 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBR150 00042 * *CHGBR150 00043 * 02-08-2001 ADDED A HDR TO 'GRAND TOTALS' PAGE, AND WILL NOW *CHGBR150 00044 * PRINT IT ONLY IF MORE THAN ONE EMPLOYER HAS BEEN *CHGBR150 00045 * REPORTED. FIXED OVERRUN ON 1ST PAGE. - JHP *CHGBR150 00046 * *CHGBR150 00047 * 05-14-2010 RECOMPILE FOR NEW VERSION OF CHGIM004 AND PRINT *CHGBR150 00048 * LAST 4 DIGITS OF SSN *CHGBR150 00049 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBR150 00050 * *CHGBR150 00051 * *CHGBR150 00052 * 07-28-2008 REMOVED ORLANDO NAME FROM REPORT - ZL1 *CHGBR150 00053 * *CHGBR150 00054 ******************************************************************CHGBR150 00055 CHGBR150 00056 ENVIRONMENT DIVISION. CHGBR150 00057 CONFIGURATION SECTION. CHGBR150 00058 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CHGBR150 00059 CHGBR150 00060 INPUT-OUTPUT SECTION. CHGBR150 00061 FILE-CONTROL. CHGBR150 00062 *** BEN.CHG. RPT (O) CHGBR150 00063 SELECT TEUC-RPT ASSIGN TO RPC150R1. CHGBR150 00064 EJECT CHGBR150 00065 DATA DIVISION. CHGBR150 00066 FILE SECTION. CHGBR150 00067 CHGBR150 00068 FD TEUC-RPT CHGBR150 00069 RECORDING MODE IS F CHGBR150 00070 RECORD CONTAINS 133 CHARACTERS CHGBR150 00071 BLOCK CONTAINS 0 RECORDS. CHGBR150 00072 CHGBR150 00073 01 TEUC-REPORT PIC X(133). CHGBR150 00074 CHGBR150 00075 WORKING-STORAGE SECTION. CHGBR150 000755 77 PAN-VALET PICTURE X(24) VALUE '017CHGBR150 01/06/11'. CHGBR150 00076 CHGBR150 00077 01 WRK-AREA. CHGBR150 00078 05 WRK-ABEND-CODE PIC S9(04) COMP VALUE +150. CHGBR150 00079 CHGBR150 00080 05 ABEND-MSG PIC X(60) VALUE SPACE. CHGBR150 00081 CHGBR150 00082 05 ABEND-MOD PIC X(08) VALUE 'DTSBU999'. CHGBR150 00083 CHGBR150 00084 05 WRK-REG-BEN-PAYMENT PIC X(25) CHGBR150 00085 VALUE ' REGULAR BENEFIT PAYMENT '. CHGBR150 00086 05 WRK-EXT-BEN-PAYMENT PIC X(25) CHGBR150 00087 VALUE ' EXTENDED BENEFIT PAYMENT'. CHGBR150 00088 05 WRK-TEUC-BEN-PAYMENT PIC X(25) CHGBR150 00089 VALUE ' TEUC BENEFIT PAYMENT '. CHGBR150 00090 05 WRK-TEUCA-BEN-PAYMENT PIC X(25) CHGBR150 00091 VALUE ' TEUCA BENEFIT PAYMENT '. CHGBR150 00092 05 WRK-FAC-BEN-PAYMENT PIC X(25) CHGBR150 00093 VALUE ' FED ADDL COMP PAYMENT '. CHGBR150 00094 05 WRK-ADJUSTMENTS PIC X(25) CHGBR150 00095 VALUE ' ADJUSTMENTS '. CHGBR150 00096 05 WRK-RPT-SUMMARY PIC X(26) CHGBR150 00097 VALUE 'QUARTERLY CHARGE SUMMARY'. CHGBR150 00098 05 WRK-RPT-SPECIAL PIC X(26) CHGBR150 00099 VALUE ' BENEFIT CHARGE SPECIAL '. CHGBR150 00100 CHGBR150 00101 05 WRK-SSN PIC 9(09) VALUE 0. CHGBR150 00102 05 FILLER REDEFINES WRK-SSN. CHGBR150 00103 10 WRK-SSN1 PIC 9(03). CHGBR150 00104 10 WRK-SSN2 PIC 9(02). CHGBR150 00105 10 WRK-SSN3 PIC 9(04). CHGBR150 00106 CHGBR150 00107 05 WRK-LINE-CNT PIC S9(04) COMP VALUE +0. CHGBR150 00108 05 WRK-PAGE-CNT PIC S9(04) COMP VALUE +0. CHGBR150 00109 05 WRK-EMPLYR-CNT PIC 9(07) COMP VALUE 0. CHGBR150 00110 05 WS-REC PIC X(133) VALUE SPACES. CHGBR150 00111 CHGBR150 00112 05 WRK-CURR-EMP PIC S9(07) COMP-3 VALUE +0. CHGBR150 00113 05 WRK-CURR-AMT PIC S9(07)V99 COMP-3 VALUE +0. CHGBR150 00114 05 WRK-TOT-AMT PIC S9(07)V99 COMP-3 VALUE +0. CHGBR150 00115 *RW1 CHGBR150 00116 05 WRK-CURR-AMT-HOLD PIC S9(07)V99 COMP-3 VALUE +0. CHGBR150 00117 05 WRK-TOT-AMT-HOLD PIC S9(07)V99 COMP-3 VALUE +0. CHGBR150 00118 *RW2 CHGBR150 00119 05 WRK-TOTAL-BENEFITS PIC S9(09)V99 COMP-3 VALUE +0. CHGBR150 00120 05 WRK-ACCT-TOTAL PIC S9(09)V99 COMP-3 VALUE +0. CHGBR150 00121 05 WRK-GRAND-TOTAL-BENEFITS PIC S9(10)V99 COMP-3 VALUE +0. CHGBR150 00122 05 WRK-GRAND-TOTAL-CHARGED PIC S9(10)V99 COMP-3 VALUE +0. CHGBR150 00123 05 WRK-GRAND-TOT-BEN PIC Z(13)9.99-. CHGBR150 00124 05 WRK-GRAND-TOT-CHG PIC Z(13)9.99-. CHGBR150 00125 CHGBR150 00126 CHGBR150 00127 01 REPORT-LINE-AREA. CHGBR150 00128 05 HEAD01. CHGBR150 00129 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00130 10 FILLER PIC X(08) VALUE 'CHGBR150'. CHGBR150 00131 10 FILLER PIC X(47) VALUE SPACE. CHGBR150 00132 10 FILLER PIC X(20) VALUE 'DISTRICT OF COLUMBIA'. CHGBR150 00133 10 FILLER PIC X(42) VALUE SPACE. CHGBR150 00134 10 FILLER PIC X(09) VALUE 'PAGE NO.:'. CHGBR150 00135 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00136 10 WRK-PRT-PAGE-CNT PIC ZZZ99. CHGBR150 00137 CHGBR150 00138 05 HEAD02. CHGBR150 00139 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00140 10 FILLER PIC X(10) VALUE ' '. CHGBR150 00141 10 FILLER PIC X(42) VALUE SPACE. CHGBR150 00142 10 H2-RPT-TYP PIC X(26) VALUE SPACE. CHGBR150 00143 10 FILLER PIC X(49) VALUE SPACE. CHGBR150 00144 10 FILLER PIC X(02) VALUE 'TT'. CHGBR150 00145 10 WRK-PRT-EMP-TYPE PIC X(02) VALUE SPACE. CHGBR150 00146 CHGBR150 00147 05 HEAD03. CHGBR150 00148 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00149 10 FILLER PIC X(10) VALUE 'ROOM 325'. CHGBR150 00150 10 FILLER PIC X(35) VALUE SPACE. CHGBR150 00151 10 FILLER PIC X(13) VALUE 'DEPARTMENT '. CHGBR150 00152 10 FILLER PIC X(13) VALUE 'OF EMPLOYME'. CHGBR150 00153 10 FILLER PIC X(13) VALUE 'NT SERVICES'. CHGBR150 00154 CHGBR150 00155 05 HEAD04. CHGBR150 00156 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00157 10 FILLER PIC X(49) VALUE SPACE. CHGBR150 00158 10 FILLER PIC X(12) VALUE 'EMPLOYER ACC'. CHGBR150 00159 10 FILLER PIC X(12) VALUE 'OUNT NUMBER '. CHGBR150 00160 10 WRK-PRT-HDR-EMP PIC 9(06). CHGBR150 00161 CHGBR150 00162 05 HEAD05. CHGBR150 00163 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00164 10 FILLER PIC X(39) VALUE SPACE. CHGBR150 00165 10 FILLER PIC X(14) VALUE 'REPORT INCLUDE'. CHGBR150 00166 10 FILLER PIC X(14) VALUE 'S PERIOD FROM '. CHGBR150 00167 10 WS-REPORT-START-DATE PIC X(10) VALUE SPACE. CHGBR150 00168 10 FILLER PIC X(04) VALUE ' TO '. CHGBR150 00169 10 WS-REPORT-END-DATE PIC X(10) VALUE SPACE. CHGBR150 00170 CHGBR150 00171 05 HEAD06. CHGBR150 00172 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00173 10 FILLER PIC X(05) VALUE SPACE. CHGBR150 00174 10 FILLER PIC X(03) VALUE 'SSN'. CHGBR150 00175 10 FILLER PIC X(10) VALUE SPACE. CHGBR150 00176 10 FILLER PIC X(03) VALUE 'BYE'. CHGBR150 00177 10 FILLER PIC X(09) VALUE SPACE. CHGBR150 00178 10 FILLER PIC X(09) VALUE 'NAME OF '. CHGBR150 00179 10 FILLER PIC X(09) VALUE ' CLAIMANT'. CHGBR150 00180 10 FILLER PIC X(19) VALUE SPACE. CHGBR150 00181 10 FILLER PIC X(14) VALUE 'TOTAL BENEFITS'. CHGBR150 00182 10 FILLER PIC X(05) VALUE SPACE. CHGBR150 00183 10 FILLER PIC X(15) VALUE 'ACCOUNT CHARGES'. CHGBR150 00184 10 FILLER PIC X(09) VALUE SPACE. CHGBR150 00185 10 FILLER PIC X(11) VALUE 'SOURCE TYPE'. CHGBR150 00186 CHGBR150 00187 05 WRK-PRINT-LINE. CHGBR150 00188 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00189 10 FILLER PIC X(04) VALUE SPACE. CHGBR150 00190 10 WRK-PRT-SSN1 PIC X(03) VALUE SPACE. CHGBR150 00191 10 FILLER PIC X(01) VALUE '-'. CHGBR150 00192 10 WRK-PRT-SSN2 PIC X(02) VALUE SPACE. CHGBR150 00193 10 FILLER PIC X(01) VALUE '-'. CHGBR150 00194 10 WRK-PRT-SSN3 PIC X(04) VALUE SPACE. CHGBR150 00195 10 FILLER PIC X(02) VALUE SPACE. CHGBR150 00196 10 WRK-PRT-BYE-DATE PIC X(10) VALUE SPACE. CHGBR150 00197 10 FILLER PIC X(03) VALUE SPACE. CHGBR150 00198 10 WRK-PRT-CLMNT-NAME PIC X(32) VALUE SPACE. CHGBR150 00199 10 FILLER PIC X(02) VALUE SPACE. CHGBR150 00200 10 WRK-PRT-TOT-AMT PIC $$,$$$,$$$,$$9.99-. CHGBR150 00201 10 FILLER PIC X(02) VALUE SPACE. CHGBR150 00202 10 WRK-PRT-CURR-AMT PIC $$,$$$,$$$,$$9.99-. CHGBR150 00203 10 FILLER PIC X(02) VALUE SPACE. CHGBR150 00204 10 WRK-PRT-SOURCE-TYPE PIC X(25) VALUE SPACE. CHGBR150 00205 CHGBR150 00206 05 WRK-PRINT-TOTAL. CHGBR150 00207 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00208 10 FILLER PIC X(34) VALUE SPACES. CHGBR150 00209 10 FILLER PIC X(20) VALUE 'GRAND TOTAL CHARGED:'. CHGBR150 00210 10 FILLER PIC X(10) VALUE SPACES. CHGBR150 00211 10 WRK-PRT-TOT-BEN PIC $$,$$$,$$$,$$9.99-. CHGBR150 00212 10 FILLER PIC X(22) VALUE SPACES. CHGBR150 00213 10 FILLER PIC X(25) VALUE CHGBR150 00214 ' ************ '. CHGBR150 00215 05 WRK-PRINT-TOTAL-ACCT. CHGBR150 00216 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00217 10 FILLER PIC X(39) VALUE SPACES. CHGBR150 00218 10 FILLER PIC X(14) VALUE 'GRAND TOTAL AC'. CHGBR150 00219 10 FILLER PIC X(14) VALUE 'COUNT CHARGED:'. CHGBR150 00220 10 FILLER PIC X(17) VALUE SPACES. CHGBR150 00221 10 WRK-PRT-ACCT-TOT PIC $$,$$$,$$$,$$9.99-. CHGBR150 00222 10 FILLER PIC X(04) VALUE SPACES. CHGBR150 00223 10 FILLER PIC X(25) VALUE CHGBR150 00224 ' ************ '. CHGBR150 00225 CHGBR150 00226 05 WRK-PRINT-GRAND. CHGBR150 00227 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00228 10 FILLER PIC X(64) VALUE SPACES. CHGBR150 00229 10 FILLER PIC X(20) VALUE '--------------------'. CHGBR150 00230 10 FILLER PIC X(21) VALUE '---------------------'. CHGBR150 00231 CHGBR150 00232 05 WRK-PRINT-GRAND-PERIOD. CHGBR150 00233 10 FILLER PIC X(01) VALUE SPACE. CHGBR150 00234 10 FILLER PIC X(13) VALUE SPACES. CHGBR150 00235 10 FILLER PIC X(19) VALUE 'TOTAL AMOUNT CHARGE'. CHGBR150 00236 10 FILLER PIC X(18) VALUE 'D FOR THE PERIOD: '. CHGBR150 00237 10 FILLER PIC X(14) VALUE SPACES. CHGBR150 00238 10 WRK-PRT-GRAND-TOT-BEN PIC $$,$$$,$$$,$$9.99-. CHGBR150 00239 10 FILLER PIC X(02) VALUE SPACES. CHGBR150 00240 10 WRK-PRT-GRAND-TOT-CHG PIC $$,$$$,$$$,$$9.99-. CHGBR150 00241 10 FILLER PIC X(03) VALUE SPACES. CHGBR150 00242 10 FILLER PIC X(25) VALUE CHGBR150 00243 ' ************ '. CHGBR150 00244 CHGBR150 00245 01 L001-LINK-AREA. CHGBR150 00246 ++INCLUDE DTSIL001 CHGBR150 00247 CHGBR150 00248 EJECT CHGBR150 00249 LINKAGE SECTION. CHGBR150 00250 CHGBR150 00251 01 REPORT-LINK-AREA. CHGBR150 00252 ++INCLUDE CHGIL001 CHGBR150 00253 CHGBR150 00254 01 BD210-CHG-REC. CHGBR150 00255 ++INCLUDE CHGIM004 CHGBR150 00256 EJECT CHGBR150 00257 PROCEDURE DIVISION USING REPORT-LINK-AREA CHGBR150 00258 BD210-CHG-REC. CHGBR150 00259 CHGBR150 00260 CHGBR150-MAIN. CHGBR150 00261 IF CHG-LINK1-CMD-INIT-88 CHGBR150 00262 PERFORM I0000-INITIATE THRU I0000-EXIT CHGBR150 00263 ELSE CHGBR150 00264 IF CHG-LINK1-CMD-PROCESS-88 CHGBR150 00265 PERFORM P0000-PROCESS THRU P0000-EXIT CHGBR150 00266 ELSE CHGBR150 00267 IF CHG-LINK1-CMD-CLOSE-88 CHGBR150 00268 PERFORM T0000-TERMINATE THRU T0000-EXIT CHGBR150 00269 ELSE CHGBR150 00270 MOVE 'INVALID CHG-LINK1-COMMAND VALUE' CHGBR150 00271 TO ABEND-MSG CHGBR150 00272 PERFORM S999-ABEND THRU S999-EXIT CHGBR150 00273 END-IF CHGBR150 00274 END-IF CHGBR150 00275 END-IF. CHGBR150 00276 CHGBR150 00277 CHGBR150-EXIT. CHGBR150 00278 GOBACK. CHGBR150 00279 CHGBR150 00280 I0000-INITIATE. CHGBR150 00281 IF CHG-LINK1-RUN-TYPE-SPC-88 CHGBR150 00282 MOVE WRK-RPT-SPECIAL TO H2-RPT-TYP CHGBR150 00283 ELSE CHGBR150 00284 MOVE WRK-RPT-SUMMARY TO H2-RPT-TYP CHGBR150 00285 END-IF. CHGBR150 00286 CHGBR150 00287 MOVE CHG-LINK1-PERIOD-BEGIN TO L001-FED-8-DATE-9. CHGBR150 00288 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR150 00289 MOVE L001-SLASH-8-DATE TO WS-REPORT-START-DATE. CHGBR150 00290 CHGBR150 00291 MOVE CHG-LINK1-PERIOD-END TO L001-FED-8-DATE-9. CHGBR150 00292 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR150 00293 MOVE L001-SLASH-8-DATE TO WS-REPORT-END-DATE. CHGBR150 00294 CHGBR150 00295 OPEN OUTPUT TEUC-RPT. CHGBR150 00296 CHGBR150 00297 I0000-EXIT. CHGBR150 00298 EXIT. CHGBR150 00299 EJECT CHGBR150 00300 P0000-PROCESS. CHGBR150 00301 PERFORM P1000-CHK-FOR-NEW-PAGE THRU P1000-EXIT CHGBR150 00302 CHGBR150 00303 EVALUATE TRUE CHGBR150 00304 WHEN CHG4-PROG-UI CHGBR150 00305 MOVE WRK-REG-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR150 00306 CHGBR150 00307 WHEN CHG4-PROG-EB CHGBR150 00308 MOVE WRK-EXT-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR150 00309 CHGBR150 00310 WHEN CHG4-PROG-TEUC CHGBR150 00311 MOVE WRK-TEUC-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR150 00312 CHGBR150 00313 WHEN CHG4-PROG-TEUCA CHGBR150 00314 MOVE WRK-TEUCA-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR150 00315 CHGBR150 00316 WHEN CHG4-PROG-FAC CHGBR150 00317 MOVE WRK-FAC-BEN-PAYMENT TO WRK-PRT-SOURCE-TYPE CHGBR150 00318 CHGBR150 00319 WHEN OTHER CHGBR150 00320 MOVE ' UNKNOWN ' TO WRK-PRT-SOURCE-TYPE CHGBR150 00321 END-EVALUATE. CHGBR150 00322 CHGBR150 00323 MOVE CHG4-SSN TO WRK-SSN. CHGBR150 00324 MOVE WRK-SSN1 TO WRK-PRT-SSN1. CHGBR150 00325 MOVE WRK-SSN2 TO WRK-PRT-SSN2. CHGBR150 00326 MOVE WRK-SSN3 TO WRK-PRT-SSN3. CHGBR150 00327 CHGBR150 00328 MOVE CHG4-BYE TO L001-FED-8-DATE-9. CHGBR150 00329 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CHGBR150 00330 MOVE L001-SLASH-8-DATE TO WRK-PRT-BYE-DATE. CHGBR150 00331 MOVE CHG4-CLMNT-NAME TO WRK-PRT-CLMNT-NAME. CHGBR150 00332 CHGBR150 00333 COMPUTE WRK-TOT-AMT = CHGBR150 00334 CHG4-TOT-BEN-AMT + CHG4-TOT-ADJ-AMT CHGBR150 00335 MOVE WRK-TOT-AMT TO WRK-PRT-TOT-AMT. CHGBR150 00336 CHGBR150 00337 COMPUTE WRK-CURR-AMT = CHGBR150 00338 CHG4-CURR-BEN-AMT + CHG4-CURR-ADJ-AMT CHGBR150 00339 MOVE WRK-CURR-AMT TO WRK-PRT-CURR-AMT. CHGBR150 00340 CHGBR150 00341 IF WRK-CURR-AMT NOT = ZERO CHGBR150 00342 WRITE TEUC-REPORT FROM WRK-PRINT-LINE CHGBR150 00343 AFTER ADVANCING 1 LINE CHGBR150 00344 ADD +1 TO WRK-LINE-CNT CHGBR150 00345 PERFORM P4000-TOTALS THRU P4000-EXIT CHGBR150 00346 END-IF. CHGBR150 00347 CHGBR150 00348 P0000-EXIT. CHGBR150 00349 EXIT. CHGBR150 00350 CHGBR150 00351 P1000-CHK-FOR-NEW-PAGE. CHGBR150 00352 IF CHG4-EMP-NO NOT = WRK-CURR-EMP CHGBR150 00353 IF WRK-CURR-EMP = ZERO CHGBR150 00354 *** 1ST TIME CHGBR150 00355 MOVE CHG4-EMP-NO TO WRK-CURR-EMP CHGBR150 00356 WRK-PRT-HDR-EMP CHGBR150 00357 MOVE CHG4-EMP-TYPE TO WRK-PRT-EMP-TYPE CHGBR150 00358 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT CHGBR150 00359 ADD 1 TO WRK-EMPLYR-CNT CHGBR150 00360 ELSE CHGBR150 00361 *** NEW ONE CHGBR150 00362 PERFORM P1200-PRINT-FOOTER THRU P1200-EXIT CHGBR150 00363 MOVE CHG4-EMP-NO TO WRK-CURR-EMP CHGBR150 00364 WRK-PRT-HDR-EMP CHGBR150 00365 MOVE CHG4-EMP-TYPE TO WRK-PRT-EMP-TYPE CHGBR150 00366 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT CHGBR150 00367 ADD 1 TO WRK-EMPLYR-CNT CHGBR150 00368 ELSE CHGBR150 00369 *** SAME ONE CHGBR150 00370 IF WRK-LINE-CNT > +54 CHGBR150 00371 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT CHGBR150 00372 END-IF CHGBR150 00373 END-IF. CHGBR150 00374 CHGBR150 00375 P1000-EXIT. CHGBR150 00376 EXIT. CHGBR150 00377 CHGBR150 00378 P1100-PRINT-HEADER. CHGBR150 00379 MOVE ZERO TO WRK-LINE-CNT CHGBR150 00380 ADD 1 TO WRK-PAGE-CNT. CHGBR150 00381 MOVE WRK-PAGE-CNT TO WRK-PRT-PAGE-CNT. CHGBR150 00382 MOVE HEAD01 TO WS-REC CHGBR150 00383 WRITE TEUC-REPORT FROM WS-REC AFTER ADVANCING TOP-OF-PAGE CHGBR150 00384 MOVE HEAD02 TO WS-REC CHGBR150 00385 WRITE TEUC-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR150 00386 MOVE HEAD03 TO WS-REC CHGBR150 00387 WRITE TEUC-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR150 00388 MOVE SPACES TO WS-REC CHGBR150 00389 WRITE TEUC-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR150 00390 MOVE HEAD04 TO WS-REC CHGBR150 00391 WRITE TEUC-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR150 00392 MOVE SPACES TO WS-REC CHGBR150 00393 WRITE TEUC-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR150 00394 MOVE HEAD05 TO WS-REC CHGBR150 00395 WRITE TEUC-REPORT FROM WS-REC AFTER ADVANCING 1 LINE CHGBR150 00396 MOVE HEAD06 TO WS-REC CHGBR150 00397 WRITE TEUC-REPORT FROM WS-REC AFTER ADVANCING 2 LINE CHGBR150 00398 MOVE SPACES TO WS-REC CHGBR150 00399 WRITE TEUC-REPORT FROM WS-REC AFTER ADVANCING 1 LINE. CHGBR150 00400 MOVE +10 TO WRK-LINE-CNT. CHGBR150 00401 CHGBR150 00402 P1100-EXIT. CHGBR150 00403 EXIT. CHGBR150 00404 CHGBR150 00405 P1200-PRINT-FOOTER. CHGBR150 00406 IF WRK-LINE-CNT > +48 CHGBR150 00407 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT CHGBR150 00408 END-IF CHGBR150 00409 CHGBR150 00410 MOVE WRK-TOTAL-BENEFITS TO WRK-PRT-TOT-BEN. CHGBR150 00411 MOVE WRK-ACCT-TOTAL TO WRK-PRT-ACCT-TOT. CHGBR150 00412 CHGBR150 00413 WRITE TEUC-REPORT FROM WRK-PRINT-TOTAL CHGBR150 00414 AFTER ADVANCING 4 LINE. CHGBR150 00415 WRITE TEUC-REPORT FROM WRK-PRINT-TOTAL-ACCT CHGBR150 00416 AFTER ADVANCING 2 LINE. CHGBR150 00417 CHGBR150 00418 ADD WRK-TOTAL-BENEFITS TO WRK-GRAND-TOTAL-BENEFITS. CHGBR150 00419 ADD WRK-ACCT-TOTAL TO WRK-GRAND-TOTAL-CHARGED. CHGBR150 00420 CHGBR150 00421 MOVE ZERO TO WRK-TOTAL-BENEFITS CHGBR150 00422 WRK-ACCT-TOTAL. CHGBR150 00423 P1200-EXIT. CHGBR150 00424 EXIT. CHGBR150 00425 CHGBR150 00426 P4000-TOTALS. CHGBR150 00427 COMPUTE WRK-TOTAL-BENEFITS = WRK-TOTAL-BENEFITS CHGBR150 00428 + CHG4-TOT-BEN-AMT CHGBR150 00429 + CHG4-TOT-ADJ-AMT. CHGBR150 00430 CHGBR150 00431 COMPUTE WRK-ACCT-TOTAL = WRK-ACCT-TOTAL CHGBR150 00432 + CHG4-CURR-BEN-AMT CHGBR150 00433 + CHG4-CURR-ADJ-AMT. CHGBR150 00434 CHGBR150 00435 P4000-EXIT. CHGBR150 00436 EXIT. CHGBR150 00437 EJECT CHGBR150 00438 T0000-TERMINATE. CHGBR150 00439 IF WRK-EMPLYR-CNT > 0 CHGBR150 00440 PERFORM P1200-PRINT-FOOTER THRU P1200-EXIT CHGBR150 00441 END-IF CHGBR150 00442 CHGBR150 00443 IF WRK-EMPLYR-CNT > 1 CHGBR150 00444 PERFORM T1000-PRINT-GRAND-TOTALS THRU T1000-EXIT CHGBR150 00445 END-IF CHGBR150 00446 CHGBR150 00447 PERFORM T1100-CLOSE-FILES THRU T1100-EXIT. CHGBR150 00448 T0000-EXIT. CHGBR150 00449 EXIT. CHGBR150 00450 EJECT CHGBR150 00451 T1000-PRINT-GRAND-TOTALS. CHGBR150 00452 MOVE SPACE TO HEAD04. CHGBR150 00453 PERFORM P1100-PRINT-HEADER THRU P1100-EXIT. CHGBR150 00454 CHGBR150 00455 MOVE WRK-GRAND-TOTAL-BENEFITS TO WRK-PRT-GRAND-TOT-BEN. CHGBR150 00456 MOVE WRK-GRAND-TOTAL-CHARGED TO WRK-PRT-GRAND-TOT-CHG. CHGBR150 00457 CHGBR150 00458 WRITE TEUC-REPORT FROM WRK-PRINT-GRAND-PERIOD CHGBR150 00459 AFTER ADVANCING 3. CHGBR150 00460 WRITE TEUC-REPORT FROM WRK-PRINT-GRAND CHGBR150 00461 AFTER ADVANCING 2. CHGBR150 00462 T1000-EXIT. CHGBR150 00463 EXIT. CHGBR150 00464 CHGBR150 00465 T1100-CLOSE-FILES. CHGBR150 00466 CLOSE TEUC-RPT. CHGBR150 00467 CHGBR150 00468 T1100-EXIT. CHGBR150 00469 EXIT. CHGBR150 00470 CHGBR150 00471 S001-FROM-FED-8. CHGBR150 00472 SET L001-FROM-FED-8 TO TRUE. CHGBR150 00473 GO TO S001-DATE. CHGBR150 00474 CHGBR150 00475 S001-DATE. CHGBR150 00476 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR150 00477 CHGBR150 00478 S001-EXIT. CHGBR150 00479 EXIT. CHGBR150 00480 CHGBR150 00481 S999-ABEND. CHGBR150 00482 DISPLAY '**** CHGBR150 ABENDING ' CHGBR150 00483 ABEND-MSG. CHGBR150 00484 CALL ABEND-MOD USING WRK-ABEND-CODE. CHGBR150 00485 CHGBR150 00486 S999-EXIT. CHGBR150 00487 EXIT. CHGBR150