DUTAS re-platformed to Raincode - Initial Source Code

This commit is contained in:
Neeraj Kumar
2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions

488
Batch/CHGBR150.cob Normal file
View File

@ -0,0 +1,488 @@
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