00001 IDENTIFICATION DIVISION. 10/06/14 00002 PROGRAM-ID. CHGBD221. CHGBD221 00003 *AUTHOR. NGC. LV002 00004 *DATE-WRITTEN. JULY 2007. CHGBD221 00005 DATE-COMPILED. CHGBD221 00006 SKIP3 CHGBD221 00007 ***** CHGBD221 00008 * CHGBD221 00009 * FUNCTION: CHGBD221 00010 * CHGBD221 00011 * THIS PROGRAM IS USED FOR RATED EMPLOYERS ONLY. CHGBD220 CHGBD221 00012 * IS USED FOR ALL OTHER EMPLOYER TYPES. CHGBD221 00013 * CHGBD221 00014 * THE PROGRAM BUILDS CHGIM004 RECORDS FROM CHGIM005 RECORDSCHGBD221 00015 * ADDING THE EMPLOYER'S MAILING ADDRESS, AND WRITING CHGBD221 00016 * MAILING LABELS. CHGBD221 00017 * CHGBD221 00018 * INPUT: CHGBD221 00019 * CHGBD221 00020 * BD200CHG - CHARGE REPORT RECORDS GENERATED BY CHGBD221 00021 * CHGBD200. CHGBD221 00022 * CHGPARM - PARAMETER DATA INPUT FROM CHGBD305 CHGBD221 00023 * CHGBD221 00024 * OUTPUT: CHGBD221 00025 * BD210CHG - CHARGE REPORT RECORDS GENERATED BY CHGBD221 00026 * CHGBD220. CHGBD221 00027 * CHGBD221 00028 ***** CHGBD221 00029 CHGBD221 00030 ******************************************************************CHGBD221 00031 * MODIFICATION HISTORY: *CHGBD221 00032 * *CHGBD221 00033 * 02-02-1999 INITIAL DEVELOPMENT *CHGBD221 00034 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD221 00035 * *CHGBD221 00036 * 04-23-2002 MODIFIED TO OUTPUT TEUC RPC150R1 REPORT *CHGBD221 00037 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBD221 00038 * *CHGBD221 00039 * 04-02-2007 MODIFIED TO OUTPUT LABELS WHEN REQUESTING CWC AND *CHGBD221 00040 * FED REPORTS *CHGBD221 00041 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *CHGBD221 00042 * *CHGBD221 00043 * 05-11-2007 MODIFIED TO SEPARATE CHARGES TRANSFERRED BETWEEN *CHGBD221 00044 * PREDECESSORS AND SUCCESSORS. THESE CHARGES CANNOT *CHGBD221 00045 * BE SUMMED INTO THE TOTAL AMOUNT FOR THE SSN - THEY *CHGBD221 00046 * NEED TO BE REPORTED SEPARATLY. *CHGBD221 00047 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD221 00048 * *CHGBD221 00049 * 03-09-2009 RECOMPLIED FOR NEW VERSION OF CHGIM004. *CHGBD221 00050 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD221 00051 * *CHGBD221 00052 * *CHGBD221 00053 * 05-14-2019 RECOMPLIED FOR NEW VERSION OF CHGIM004. *CHGBD221 00054 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD221 00055 * *CHGBD221 00056 * * CL**2 00057 * 10-04-2014 RECOMPLIED FOR NEW VERSION OF CHGIM004. * CL**2 00058 * REFERENCE RFP # UCPIA AUTHOR OF CHANGE - ZL1 * CL**2 00059 * * CL**2 00060 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD221 00061 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD221 00062 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD221 00063 ******************************************************************CHGBD221 00064 CHGBD221 00065 SKIP3 CHGBD221 00066 ENVIRONMENT DIVISION. CHGBD221 00067 SKIP3 CHGBD221 00068 INPUT-OUTPUT SECTION. CHGBD221 00069 SKIP3 CHGBD221 00070 FILE-CONTROL. CHGBD221 00071 SELECT CHG-FILE-IN ASSIGN TO BD210CHG CHGBD221 00072 FILE STATUS IS CHG-IN-STATUS. CHGBD221 00073 CHGBD221 00074 SELECT CHG-FILE-OUT ASSIGN TO BD220CHG CHGBD221 00075 FILE STATUS IS CHG-OUT-STATUS. CHGBD221 00076 CHGBD221 00077 SELECT CHG-PARM-FILE ASSIGN TO CHGPARM CHGBD221 00078 FILE STATUS IS CHG-PARM-STATUS. CHGBD221 00079 EJECT CHGBD221 00080 DATA DIVISION. CHGBD221 00081 FILE SECTION. CHGBD221 00082 FD CHG-FILE-IN CHGBD221 00083 RECORDING MODE IS F CHGBD221 00084 LABEL RECORDS ARE STANDARD CHGBD221 00085 BLOCK CONTAINS 0 CHARACTERS. CHGBD221 00086 SKIP1 CHGBD221 00087 01 CHG-REC-IN. CHGBD221 00088 ++INCLUDE CHGIM004 CHGBD221 00089 CHGBD221 00090 FD CHG-FILE-OUT CHGBD221 00091 RECORDING MODE IS F CHGBD221 00092 LABEL RECORDS ARE STANDARD CHGBD221 00093 BLOCK CONTAINS 0 CHARACTERS. CHGBD221 00094 SKIP1 CHGBD221 00095 01 CHG-REC-OUT PIC X(388). CHGBD221 00096 CHGBD221 00097 FD CHG-PARM-FILE CHGBD221 00098 RECORDING MODE IS F CHGBD221 00099 BLOCK CONTAINS 0 CHARACTERS. CHGBD221 00100 SKIP1 CHGBD221 00101 01 CHG-PARM-REC. CHGBD221 00102 ++INCLUDE CHGIM003 CHGBD221 00103 CHGBD221 00104 EJECT CHGBD221 00105 WORKING-STORAGE SECTION. CHGBD221 001055 77 PAN-VALET PICTURE X(24) VALUE '002CHGBD221 10/06/14'. CHGBD221 00106 77 PAN-VALET PICTURE X(24) VALUE '005CHGBD221 05/25/10'. CHGBD221 00107 CHGBD221 00108 01 WRK-AREA. CHGBD221 00109 05 WRK-ZERO-CHG-CNT PIC 9(07) COMP-3 VALUE 0. CHGBD221 00110 05 WRK-TOT-CHG PIC S9(09)V99 COMP-3 VALUE +0. CHGBD221 00111 05 WRK-TOT-CHG-DISP PIC Z(08)9.99-. CHGBD221 00112 05 WRK-EMP-CHG PIC S9(09)V99 COMP-3 VALUE +0. CHGBD221 00113 05 WRK-DISP-AREA. CHGBD221 00114 10 WRK-EMP-DISP PIC 9(06). CHGBD221 00115 10 FILLER PIC X(02) VALUE SPACES. CHGBD221 00116 10 WRK-SSN-DISP PIC 9(09). CHGBD221 00117 10 FILLER PIC X(02) VALUE SPACES. CHGBD221 00118 10 WRK-CHG-DISP PIC Z9(08)9.99-. CHGBD221 00119 CHGBD221 00120 05 WRK-CHG-IN-CNT PIC 9(08) COMP-3 VALUE 0. CHGBD221 00121 05 WRK-CHG-OUT-CNT PIC 9(08) COMP-3 VALUE 0. CHGBD221 00122 05 WRK-CHG-SUM-CNT PIC 9(08) COMP-3 VALUE 0. CHGBD221 00123 05 WRK-LABEL-CNT PIC 9(08) COMP-3 VALUE 0. CHGBD221 00124 05 ABEND-CODE PIC S9(04) COMP CHGBD221 00125 VALUE +221. CHGBD221 00126 05 ABEND-MOD PIC X(08) CHGBD221 00127 VALUE 'DTSBU999'. CHGBD221 00128 05 ABEND-MSG PIC X(60). CHGBD221 00129 CHGBD221 00130 05 CHG-IN-STATUS PIC X(02) VALUE SPACES. CHGBD221 00131 88 CHG-IN-OK-88 VALUE ZERO. CHGBD221 00132 88 CHG-IN-EOF-88 VALUE '10'. CHGBD221 00133 CHGBD221 00134 05 CHG-OUT-STATUS PIC X(02) VALUE SPACES. CHGBD221 00135 88 CHG-OUT-OK-88 VALUE ZERO. CHGBD221 00136 CHGBD221 00137 05 CHG-PARM-STATUS PIC X(02) VALUE SPACES. CHGBD221 00138 88 CHG-PARM-FILE-OK-88 VALUE ZERO. CHGBD221 00139 88 CHG-PARM-FILE-EOF-88 VALUE '10'. CHGBD221 00140 CHGBD221 00141 05 WRK-ERROR-IND PIC X(01). CHGBD221 00142 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD221 00143 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD221 00144 CHGBD221 00145 05 WRK-LAST-LABEL-EMP PIC S9(07) COMP-3 CHGBD221 00146 VALUE ZERO. CHGBD221 00147 CHGBD221 00148 05 WRK-L030-SSN PIC 9(10). CHGBD221 00149 05 FILLER REDEFINES WRK-L030-SSN. CHGBD221 00150 10 WRK-L030-SSN-9 PIC 9(09). CHGBD221 00151 10 WRK-L030-SSN-SEQ PIC 9(01). CHGBD221 00152 CHGBD221 00153 05 WRK-CURR-RPT-TYPE PIC X(01) VALUE SPACE. CHGBD221 00154 88 WRK-CURR-RPT-RATED-88 VALUE '1'. CHGBD221 00155 88 WRK-CURR-RPT-SELF-INS-88 VALUE '2'. CHGBD221 00156 88 WRK-CURR-RPT-CWC-88 VALUE '3'. CHGBD221 00157 88 WRK-CURR-RPT-FED-88 VALUE '4'. CHGBD221 00158 CHGBD221 00159 05 WRK-LABEL-ROUTE-AREA. CHGBD221 00160 10 WRK-LABEL-ROUTE-STARS PIC X(40) VALUE CHGBD221 00161 ALL '*'. CHGBD221 00162 10 WRK-LABEL-ROUTE-SELF-INS PIC X(40) VALUE CHGBD221 00163 ' SELF-INSURED '. CHGBD221 00164 10 WRK-LABEL-ROUTE-CWC PIC X(40) VALUE CHGBD221 00165 ' CWC '. CHGBD221 00166 10 WRK-LABEL-ROUTE-FED PIC X(40) VALUE CHGBD221 00167 ' FEDERAL '. CHGBD221 00168 01 DISPLAY-PARM-REC. CHGBD221 00169 05 DISPLAY-RUN-TYPE PIC X(03). CHGBD221 00170 05 FILLER PIC X(01). CHGBD221 00171 05 DISPLAY-BEGIN-DATE PIC 9(06). CHGBD221 00172 05 FILLER PIC X(01). CHGBD221 00173 05 DISPLAY-END-DATE PIC 9(06). CHGBD221 00174 05 FILLER PIC X(01). CHGBD221 00175 05 DISPLAY-REPORT-TYPES. CHGBD221 00176 10 DISPLAY-RPT-TYPE-RATED PIC X(01). CHGBD221 00177 10 DISPLAY-RPT-TYPE-SELF-IND PIC X(01). CHGBD221 00178 10 DISPLAY-RPT-TYPE-CWC PIC X(01). CHGBD221 00179 10 DISPLAY-RPT-TYPE-FED PIC X(01). CHGBD221 00180 10 DISPLAY-RPT-TYPE-TEUC PIC X(01). CHGBD221 00181 05 FILLER PIC X(01). CHGBD221 00182 05 DISPLAY-EMP-NO PIC 9(06). CHGBD221 00183 05 FILLER PIC X(50). CHGBD221 00184 CHGBD221 00185 ** REPORT I-O SKELETAL RECORD CHGBD221 00186 01 RSKL-REC. CHGBD221 00187 ++INCLUDE DTSIRSK1 CHGBD221 00188 ** MAILING LABEL RECORD CHGBD221 00189 01 R901-REC. CHGBD221 00190 ++INCLUDE DTSIR901 CHGBD221 00191 CHGBD221 00192 01 CG-L030-LINK-AREA. CHGBD221 00193 ++INCLUDE CHGIL030 CHGBD221 00194 CHGBD221 00195 PROCEDURE DIVISION. CHGBD221 00196 SKIP2 CHGBD221 00197 CHGBD220-MAIN. CHGBD221 00198 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD221 00199 IF WRK-ERROR-YES-88 CHGBD221 00200 GO TO CHGBD220-EXIT. CHGBD221 00201 CHGBD221 00202 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD221 00203 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD221 00204 CHGBD221 00205 CHGBD220-EXIT. CHGBD221 00206 STOP RUN. CHGBD221 00207 EJECT CHGBD221 00208 I0000-INITIATE. CHGBD221 00209 CHGBD221 00210 MOVE ZERO TO WRK-CHG-IN-CNT CHGBD221 00211 WRK-CHG-OUT-CNT CHGBD221 00212 WRK-LABEL-CNT CHGBD221 00213 WRK-CHG-SUM-CNT. CHGBD221 00214 CHGBD221 00215 SET WRK-ERROR-NO-88 TO TRUE. CHGBD221 00216 CHGBD221 00217 MOVE LENGTH OF R901-REC TO R901-LENGTH. CHGBD221 00218 CHGBD221 00219 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CHGBD221 00220 CHGBD221 00221 I0000-EXIT. CHGBD221 00222 EXIT. CHGBD221 00223 CHGBD221 00224 I2000-OPEN-FILES. CHGBD221 00225 OPEN INPUT CHG-FILE-IN. CHGBD221 00226 IF NOT CHG-IN-OK-88 CHGBD221 00227 DISPLAY 'INPUT FILE OPEN ERROR: ' CHG-IN-STATUS CHGBD221 00228 PERFORM S999-ABEND THRU S999-EXIT. CHGBD221 00229 CHGBD221 00230 OPEN OUTPUT CHG-FILE-OUT. CHGBD221 00231 IF NOT CHG-OUT-OK-88 CHGBD221 00232 DISPLAY 'OUTPUT FILE OPEN ERROR: ' CHG-OUT-STATUS CHGBD221 00233 PERFORM S999-ABEND THRU S999-EXIT. CHGBD221 00234 CHGBD221 00235 OPEN INPUT CHG-PARM-FILE. CHGBD221 00236 IF NOT CHG-PARM-FILE-OK-88 CHGBD221 00237 DISPLAY 'CHARGE PARM FILE OPEN ERROR: ' CHGBD221 00238 CHG-PARM-STATUS CHGBD221 00239 PERFORM S999-ABEND THRU S999-EXIT. CHGBD221 00240 CHGBD221 00241 READ CHG-PARM-FILE. CHGBD221 00242 IF NOT CHG-PARM-FILE-OK-88 CHGBD221 00243 DISPLAY 'CHARGE PARM FILE READ ERROR: ' CHGBD221 00244 CHG-PARM-STATUS CHGBD221 00245 PERFORM S999-ABEND THRU S999-EXIT. CHGBD221 00246 CHGBD221 00247 DISPLAY '***** CHGBD220 PARM RECORD *****'. CHGBD221 00248 MOVE CHG3-RUN-TYPE TO DISPLAY-RUN-TYPE. CHGBD221 00249 MOVE CHG3-BEGIN-DATE TO DISPLAY-BEGIN-DATE. CHGBD221 00250 MOVE CHG3-END-DATE TO DISPLAY-END-DATE. CHGBD221 00251 MOVE CHG3-RPT-TYPES TO DISPLAY-REPORT-TYPES. CHGBD221 00252 MOVE CHG3-EMP-NO TO DISPLAY-EMP-NO. CHGBD221 00253 DISPLAY DISPLAY-PARM-REC. CHGBD221 00254 DISPLAY SPACE. CHGBD221 00255 CHGBD221 00256 SET CG-L030-CMND-INIT-88 TO TRUE. CHGBD221 00257 PERFORM S030-TOT-CHARGE THRU S030-EXIT. CHGBD221 00258 CHGBD221 00259 I2000-EXIT. CHGBD221 00260 EXIT. CHGBD221 00261 CHGBD221 00262 P0000-PROCESS. CHGBD221 00263 PERFORM S1000-READ-BD210 THRU S1000-EXIT. CHGBD221 00264 IF CHG-IN-EOF-88 CHGBD221 00265 DISPLAY 'CHGBD220: INPUT FILE EMPTY' CHGBD221 00266 END-IF. CHGBD221 00267 CHGBD221 00268 PERFORM P1000-PROCESS-CHARGES THRU P1000-EXIT CHGBD221 00269 UNTIL CHG-IN-EOF-88 CHGBD221 00270 OR WRK-ERROR-YES-88. CHGBD221 00271 CHGBD221 00272 P0000-EXIT. CHGBD221 00273 EXIT. CHGBD221 00274 CHGBD221 00275 P1000-PROCESS-CHARGES. CHGBD221 00276 ADD 1 TO WRK-CHG-IN-CNT. CHGBD221 00277 CHGBD221 00278 PERFORM P1200-WRITE-CHARGES THRU P1200-EXIT. CHGBD221 00279 CHGBD221 00280 PERFORM S1000-READ-BD210 THRU S1000-EXIT. CHGBD221 00281 IF CHG-IN-EOF-88 CHGBD221 00282 GO TO P1000-EXIT CHGBD221 00283 ELSE CHGBD221 00284 IF NOT CHG-IN-OK-88 CHGBD221 00285 DISPLAY 'BD210 FILE READ ERROR: ' CHG-IN-STATUS CHGBD221 00286 SET WRK-ERROR-YES-88 TO TRUE CHGBD221 00287 END-IF CHGBD221 00288 END-IF. CHGBD221 00289 CHGBD221 00290 P1000-EXIT. CHGBD221 00291 EXIT. CHGBD221 00292 CHGBD221 00293 P1200-WRITE-CHARGES. CHGBD221 00294 COMPUTE WRK-EMP-CHG = CHGBD221 00295 (CHG4-CURR-BEN-AMT CHGBD221 00296 + CHG4-CURR-ADJ-AMT). CHGBD221 00297 CHGBD221 00298 IF WRK-EMP-CHG = ZERO CHGBD221 00299 ADD +1 TO WRK-ZERO-CHG-CNT CHGBD221 00300 IF CHG4-RPT-TYPE-NULL-88 CHGBD221 00301 PERFORM S1100-WRITE-BD220 THRU S1100-EXIT CHGBD221 00302 END-IF CHGBD221 00303 ELSE CHGBD221 00304 PERFORM P1210-TOT-CHG THRU P1210-EXIT CHGBD221 00305 PERFORM S1100-WRITE-BD220 THRU S1100-EXIT CHGBD221 00306 IF CHG4-EMP-NO NOT = WRK-LAST-LABEL-EMP CHGBD221 00307 PERFORM P3000-MAILING-LABEL THRU P3000-EXIT CHGBD221 00308 END-IF CHGBD221 00309 END-IF. CHGBD221 00310 CHGBD221 00311 P1200-EXIT. CHGBD221 00312 EXIT. CHGBD221 00313 CHGBD221 00314 P1210-TOT-CHG. CHGBD221 00315 MOVE CHG4-SSN TO CG-L030-SSN. CHGBD221 00316 MOVE CHG3-BEGIN-DATE TO CG-L030-START-DATE. CHGBD221 00317 MOVE CHG3-END-DATE TO CG-L030-END-DATE. CHGBD221 00318 MOVE CHG4-BYE TO CG-L030-BYE. CHGBD221 00319 MOVE CHG4-PROGRAM TO CG-L030-PROGRAM. CHGBD221 00320 *& CHGBD221 00321 * DISPLAY 'INP ' CG-L030-SSN CHGBD221 00322 * ' ' CG-L030-START-DATE CHGBD221 00323 * ' ' CG-L030-END-DATE CHGBD221 00324 * ' ' CG-L030-BYE CHGBD221 00325 * ' ' CG-L030-PROGRAM. CHGBD221 00326 *& CHGBD221 00327 CHGBD221 00328 SET CG-L030-CMND-PROCESS-88 TO TRUE. CHGBD221 00329 PERFORM S030-TOT-CHARGE THRU S030-EXIT. CHGBD221 00330 CHGBD221 00331 MOVE CG-L030-TOT-CHG TO CHG4-TOT-BEN-AMT. CHGBD221 00332 MOVE ZERO TO CHG4-TOT-ADJ-AMT. CHGBD221 00333 *& CHGBD221 00334 * MOVE CHG4-TOT-BEN-AMT TO WRK-TOT-CHG-DISP. CHGBD221 00335 * DISPLAY 'TOT CHG ' WRK-TOT-CHG-DISP CHGBD221 00336 * ' ' CHG4-EMP-NO CHGBD221 00337 * ' ' CHG4-SSN. CHGBD221 00338 *& CHGBD221 00339 CHGBD221 00340 P1210-EXIT. CHGBD221 00341 EXIT. CHGBD221 00342 CHGBD221 00343 P3000-MAILING-LABEL. CHGBD221 00344 IF CHG3-RUN-TYPE-QTRLY-88 OR CHGBD221 00345 CHG3-RUN-TYPE-RPTS-88 CHGBD221 00346 NEXT SENTENCE CHGBD221 00347 ELSE CHGBD221 00348 GO TO P3000-EXIT. CHGBD221 00349 CHGBD221 00350 IF CHG4-RPT-TYPE-SELF-INS-88 CHGBD221 00351 OR CHG4-RPT-TYPE-CWC-88 CHGBD221 00352 OR CHG4-RPT-TYPE-FED-88 CHGBD221 00353 NEXT SENTENCE CHGBD221 00354 ELSE CHGBD221 00355 GO TO P3000-EXIT. CHGBD221 00356 CHGBD221 00357 IF CHG4-REPORT-TYPE NOT = WRK-CURR-RPT-TYPE CHGBD221 00358 MOVE CHG4-REPORT-TYPE TO WRK-CURR-RPT-TYPE CHGBD221 00359 PERFORM P3100-SEPARATOR-LABEL THRU P3100-EXIT. CHGBD221 00360 CHGBD221 00361 PERFORM P3200-PRINT-LABEL THRU P3200-EXIT. CHGBD221 00362 CHGBD221 00363 P3000-EXIT. CHGBD221 00364 EXIT. CHGBD221 00365 CHGBD221 00366 P3100-SEPARATOR-LABEL. CHGBD221 00367 SET R901-ON-REQUEST-88 TO TRUE. CHGBD221 00368 MOVE LOW-VALUE TO R901-SORT-VAR-AREA. CHGBD221 00369 MOVE SPACES TO R901-FMT-ADDR CHGBD221 00370 R901-ZIP CHGBD221 00371 R901-ADVANCED-BARCODE. CHGBD221 00372 CHGBD221 00373 IF WRK-CURR-RPT-SELF-INS-88 CHGBD221 00374 MOVE WRK-LABEL-ROUTE-SELF-INS TO R901-FMT-LINE (2) CHGBD221 00375 ELSE CHGBD221 00376 IF WRK-CURR-RPT-CWC-88 CHGBD221 00377 MOVE WRK-LABEL-ROUTE-CWC TO R901-FMT-LINE (2) CHGBD221 00378 ELSE CHGBD221 00379 IF WRK-CURR-RPT-FED-88 CHGBD221 00380 MOVE WRK-LABEL-ROUTE-FED TO R901-FMT-LINE (2) CHGBD221 00381 ELSE CHGBD221 00382 GO TO P3100-EXIT. CHGBD221 00383 CHGBD221 00384 MOVE WRK-CURR-RPT-TYPE TO R901-GRP1-OP-ID. CHGBD221 00385 MOVE 000000 TO R901-EMP-NO. CHGBD221 00386 MOVE +1 TO R901-LABEL-CNT. CHGBD221 00387 MOVE WRK-LABEL-ROUTE-STARS TO R901-FMT-LINE (1) CHGBD221 00388 R901-FMT-LINE (3). CHGBD221 00389 CHGBD221 00390 MOVE R901-REC TO RSKL-REC. CHGBD221 00391 PERFORM S946-RPT-REC-O THRU S946-EXIT. CHGBD221 00392 CHGBD221 00393 P3100-EXIT. CHGBD221 00394 EXIT. CHGBD221 00395 CHGBD221 00396 P3200-PRINT-LABEL. CHGBD221 00397 SET R901-ON-REQUEST-88 TO TRUE. CHGBD221 00398 MOVE LOW-VALUE TO R901-SORT-VAR-AREA. CHGBD221 00399 CHGBD221 00400 MOVE CHG4-REPORT-TYPE TO R901-GRP1-OP-ID. CHGBD221 00401 MOVE CHG4-EMP-NO TO R901-EMP-NO CHGBD221 00402 WRK-LAST-LABEL-EMP. CHGBD221 00403 MOVE +1 TO R901-LABEL-CNT. CHGBD221 00404 CHGBD221 00405 MOVE CHG4-FMT-ADDR TO R901-FMT-ADDR. CHGBD221 00406 MOVE CHG4-ZIP TO R901-ZIP. CHGBD221 00407 MOVE CHG4-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE. CHGBD221 00408 CHGBD221 00409 MOVE R901-REC TO RSKL-REC. CHGBD221 00410 PERFORM S946-RPT-REC-O THRU S946-EXIT. CHGBD221 00411 CHGBD221 00412 ADD +1 TO WRK-LABEL-CNT. CHGBD221 00413 CHGBD221 00414 P3200-EXIT. CHGBD221 00415 EXIT. CHGBD221 00416 CHGBD221 00417 S1000-READ-BD210. CHGBD221 00418 READ CHG-FILE-IN. CHGBD221 00419 CHGBD221 00420 S1000-EXIT. CHGBD221 00421 EXIT. CHGBD221 00422 CHGBD221 00423 S1100-WRITE-BD220. CHGBD221 00424 COMPUTE WRK-TOT-CHG = WRK-TOT-CHG CHGBD221 00425 + CHG4-CURR-BEN-AMT CHGBD221 00426 + CHG4-CURR-ADJ-AMT. CHGBD221 00427 CHGBD221 00428 WRITE CHG-REC-OUT FROM CHG-REC-IN. CHGBD221 00429 IF CHG-OUT-OK-88 CHGBD221 00430 ADD 1 TO WRK-CHG-OUT-CNT. CHGBD221 00431 CHGBD221 00432 S1100-EXIT. CHGBD221 00433 EXIT. CHGBD221 00434 CHGBD221 00435 S030-TOT-CHARGE. CHGBD221 00436 CALL 'CHGBD235' USING CG-L030-LINK-AREA. CHGBD221 00437 S030-EXIT. EXIT. CHGBD221 00438 CHGBD221 00439 ** REPORT RECORD I-O CHGBD221 00440 S946-RPT-REC-O. CHGBD221 00441 CALL 'DTSBU946' USING RSKL-REC. CHGBD221 00442 CHGBD221 00443 S946-EXIT. CHGBD221 00444 EXIT. CHGBD221 00445 CHGBD221 00446 T0000-TERMINATE. CHGBD221 00447 CLOSE CHG-FILE-IN CHGBD221 00448 CHG-FILE-OUT CHGBD221 00449 CHG-PARM-FILE. CHGBD221 00450 CHGBD221 00451 SET CG-L030-CMND-TERM-88 TO TRUE. CHGBD221 00452 PERFORM S030-TOT-CHARGE THRU S030-EXIT. CHGBD221 00453 CHGBD221 00454 DISPLAY '***********************************************'. CHGBD221 00455 DISPLAY '*** CHGBD221 COUNTS *** '. CHGBD221 00456 DISPLAY '***'. CHGBD221 00457 CHGBD221 00458 DISPLAY ' INPUT CHARGE RECORDS READ : ' CHGBD221 00459 WRK-CHG-IN-CNT. CHGBD221 00460 CHGBD221 00461 DISPLAY ' OUTPUT CHARGE RECORDS WRITTEN: ' CHGBD221 00462 WRK-CHG-OUT-CNT. CHGBD221 00463 CHGBD221 00464 DISPLAY ' TOTAL CHARGE = ZERO BYPASSED : ' CHGBD221 00465 WRK-ZERO-CHG-CNT. CHGBD221 00466 CHGBD221 00467 DISPLAY ' MAILING LABELS WRITTEN : ' CHGBD221 00468 WRK-LABEL-CNT. CHGBD221 00469 CHGBD221 00470 MOVE WRK-TOT-CHG TO WRK-TOT-CHG-DISP. CHGBD221 00471 DISPLAY ' TOTAL CHARGES : ' CHGBD221 00472 WRK-TOT-CHG-DISP. CHGBD221 00473 CHGBD221 00474 DISPLAY '***********************************************'. CHGBD221 00475 CHGBD221 00476 T0000-EXIT. CHGBD221 00477 EXIT. CHGBD221 00478 EJECT CHGBD221 00479 CHGBD221 00480 S999-ABEND. CHGBD221 00481 DISPLAY '**** CHGBD221 ABENDING ' CHGBD221 00482 ABEND-MSG. CHGBD221 00483 CALL ABEND-MOD USING ABEND-CODE. CHGBD221 00484 CHGBD221 00485 S999-EXIT. CHGBD221 00486 EXIT. CHGBD221 00487 CHGBD221