Files
DUTAS/Batch/CHGBR120.cob
2025-07-21 11:20:11 -04:00

501 lines
40 KiB
COBOL

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