00001 IDENTIFICATION DIVISION. 04/21/20 00002 PROGRAM-ID. CHGBD216. CHGBD216 00003 *AUTHOR. NGC. LV003 00004 *DATE-WRITTEN. NOVEMBER 2006. CHGBD216 00005 DATE-COMPILED. CHGBD216 00006 SKIP3 CHGBD216 00007 ***** CHGBD216 00008 * CHGBD216 00009 * FUNCTION: CHGBD216 00010 * CHGBD216 00011 * BUILD CHGIM004 RECORDS FOR CHARGE REPORTING PROCESS CHGBD216 00012 * FROM CHGIM005 RECORDS. CHGBD216 00013 * CHGBD216 00014 * INPUT: CHGBD216 00015 * CHGBD216 00016 * BD205CHG - CHARGE REPORT RECORDS GENERATED BY CHGBD216 00017 * CHGBD205. CHGBD216 00018 * CHGBD216 00019 * OUTPUT: CHGBD216 00020 * CHGBD216 00021 * DTSFC005 - CHGIM005 RECORDS CHGBD216 00022 * CHGBD216 00023 * CHGBD216 00024 * CHGBD216 00025 ***** CHGBD216 00026 CHGBD216 00027 ******************************************************************CHGBD216 00028 * MODIFICATION HISTORY: *CHGBD216 00029 * *CHGBD216 00030 * 11-06-2006 INITIAL DEVELOPMENT *CHGBD216 00031 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD216 00032 * *CHGBD216 00033 * 03-09-2009 RECOMPILED FOR NEW VERSIONS OF CHGIM004 AND *CHGBD216 00034 * CHGIM005. *CHGBD216 00035 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD216 00036 * *CHGBD216 00037 * 05-14-2010 RECOMPILED FOR NEW VERSIONS OF CHGIM004 AND *CHGBD216 00038 * CHGIM005. *CHGBD216 00039 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD216 00040 * * CL**2 00041 * 10-04-2014 RECOMPILED FOR NEW VERSIONS OF CHGIM004 AND * CL**2 00042 * CHGIM005. * CL**2 00043 * REFERENCE RFP # UCPIA AUTHOR OF CHANGE - ZL1 * CL**2 00044 * *CHGBD216 00045 * 04-17-2020 RECOMPILED FOR NEW VERSIONS OF CHGIM004 AND * CL**3 00046 * CHGIM005. * CL**3 00047 * REFERENCE RFP # PUA FPUC FRUR CHANGE - ZL1 * CL**3 00048 * * CL**3 00049 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD216 00050 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD216 00051 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD216 00052 ******************************************************************CHGBD216 00053 CHGBD216 00054 SKIP3 CHGBD216 00055 ENVIRONMENT DIVISION. CHGBD216 00056 SKIP3 CHGBD216 00057 INPUT-OUTPUT SECTION. CHGBD216 00058 SKIP3 CHGBD216 00059 FILE-CONTROL. CHGBD216 00060 SELECT CHARGE-FILE-IN ASSIGN TO DTSFCHG5 CHGBD216 00061 FILE STATUS IS CHG5-STATUS. CHGBD216 00062 CHGBD216 00063 SELECT BD216-CHG-FILE-OUT ASSIGN TO BD216CHG CHGBD216 00064 FILE STATUS IS BD216-CHG-STATUS. CHGBD216 00065 CHGBD216 00066 SELECT CHG-PARM-FILE ASSIGN TO CHGPARM CHGBD216 00067 FILE STATUS IS CHG-PARM-STATUS. CHGBD216 00068 CHGBD216 00069 DATA DIVISION. CHGBD216 00070 CHGBD216 00071 FILE SECTION. CHGBD216 00072 FD CHARGE-FILE-IN CHGBD216 00073 RECORDING MODE IS F CHGBD216 00074 RECORD CONTAINS 41 CHARACTERS CHGBD216 00075 DATA RECORD IS CHG5-REC. CHGBD216 00076 01 CHG5-REC. CHGBD216 00077 ++INCLUDE CHGIM005 CHGBD216 00078 CHGBD216 00079 FD BD216-CHG-FILE-OUT CHGBD216 00080 LABEL RECORDS ARE STANDARD CHGBD216 00081 RECORDING MODE IS F CHGBD216 00082 BLOCK CONTAINS 0 RECORDS. CHGBD216 00083 SKIP1 CHGBD216 00084 01 BD216-CHG-REC. CHGBD216 00085 ++INCLUDE CHGIM004 CHGBD216 00086 CHGBD216 00087 FD CHG-PARM-FILE CHGBD216 00088 RECORDING MODE IS F CHGBD216 00089 BLOCK CONTAINS 0 CHARACTERS. CHGBD216 00090 SKIP1 CHGBD216 00091 01 CHG-PARM-REC. CHGBD216 00092 ++INCLUDE CHGIM003 CHGBD216 00093 EJECT CHGBD216 00094 WORKING-STORAGE SECTION. CHGBD216 000945 77 PAN-VALET PICTURE X(24) VALUE '003CHGBD216 04/21/20'. CHGBD216 00095 77 PAN-VALET PICTURE X(24) VALUE '007CHGBD216 05/25/10'. CHGBD216 00096 CHGBD216 00097 01 WRK-AREA. CHGBD216 00098 05 WRK-DISP-AREA. CHGBD216 00099 10 WRK-DATE PIC 9999B99B99. CHGBD216 00100 10 FILLER PIC X(02) VALUE SPACES. CHGBD216 00101 10 WRK-EMP-DISP PIC 9(06). CHGBD216 00102 10 FILLER PIC X(02) VALUE SPACES. CHGBD216 00103 10 WRK-SSN-DISP PIC 9(10). CHGBD216 00104 10 FILLER PIC X(02) VALUE SPACES. CHGBD216 00105 10 WRK-CHG-AMT-DISP PIC --------9.99. CHGBD216 00106 10 WRK-CHG-AMT-DISP1 PIC --------9.99. CHGBD216 00107 10 WRK-PCT PIC S9(03)V99 COMP-3. CHGBD216 00108 10 WRK-PCT-DISP PIC 999.99. CHGBD216 00109 CHGBD216 00110 05 WRK-KEY PIC 9(10). CHGBD216 00111 05 FILLER REDEFINES WRK-KEY. CHGBD216 00112 10 WRK-SSN PIC 9(09). CHGBD216 00113 10 WRK-SSN-SEQ PIC 9(01). CHGBD216 00114 CHGBD216 00115 05 SUB PIC S9(04) COMP. CHGBD216 00116 05 WRK-TOT-CHG PIC S9(11)V99 COMP-3 CHGBD216 00117 VALUE +0. CHGBD216 00118 05 WRK-EMP-TOT-CHG PIC S9(09)V99 COMP-3 CHGBD216 00119 VALUE +0. CHGBD216 00120 05 WRK-EMP-SSN-CHG PIC S9(09)V99 COMP-3 CHGBD216 00121 VALUE +0. CHGBD216 00122 05 WRK-TOT-CHG-DISP PIC Z(08)9.99-. CHGBD216 00123 05 WRK-BYPASS-EMP PIC S9(07) COMP-3 CHGBD216 00124 VALUE +0. CHGBD216 00125 05 WRK-EMP-NO PIC S9(07) COMP-3. CHGBD216 00126 CHGBD216 00127 05 WRK-LAST-EMP-CHECKED PIC S9(07) COMP-3 CHGBD216 00128 VALUE +0. CHGBD216 00129 CHGBD216 00130 05 WRK-SSN-CONV PIC 9(10). CHGBD216 00131 05 FILLER REDEFINES WRK-SSN-CONV. CHGBD216 00132 10 WRK-SSN-9 PIC 9(09). CHGBD216 00133 10 FILLER PIC X(01). CHGBD216 00134 CHGBD216 00135 05 WRK-CHG-AMT PIC S9(09)V99 COMP-3. CHGBD216 00136 CHGBD216 00137 05 WRK-MOD-NAME PIC X(08) CHGBD216 00138 VALUE 'CHGBD216'. CHGBD216 00139 05 ABEND-CODE PIC S9(04) COMP CHGBD216 00140 VALUE +216. CHGBD216 00141 05 ABEND-MOD PIC X(08) CHGBD216 00142 VALUE 'DTSBU999'. CHGBD216 00143 05 ABEND-MSG PIC X(60). CHGBD216 00144 CHGBD216 00145 05 CHG5-STATUS PIC X(02) VALUE SPACES. CHGBD216 00146 88 CHG5-FILE-OK-88 VALUE '00'. CHGBD216 00147 88 CHG5-FILE-EOF-88 VALUE '10'. CHGBD216 00148 CHGBD216 00149 05 BD216-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD216 00150 88 BD216-FILE-OK-88 VALUE ZERO. CHGBD216 00151 88 BD216-FILE-EOF-88 VALUE '10'. CHGBD216 00152 CHGBD216 00153 05 CHG-PARM-STATUS PIC X(02) VALUE SPACES. CHGBD216 00154 88 CHG-PARM-FILE-OK-88 VALUE ZERO. CHGBD216 00155 88 CHG-PARM-FILE-EOF-88 VALUE '10'. CHGBD216 00156 CHGBD216 00157 05 WRK-EMP-VALID-IND PIC X(01). CHGBD216 00158 88 WRK-EMP-VALID-YES-88 VALUE 'Y'. CHGBD216 00159 88 WRK-EMP-VALID-NO-88 VALUE 'N'. CHGBD216 00160 CHGBD216 00161 05 WRK-SELECT-IND PIC X(01). CHGBD216 00162 88 WRK-SELECT-YES-88 VALUE 'Y'. CHGBD216 00163 88 WRK-SELECT-NO-88 VALUE 'N'. CHGBD216 00164 CHGBD216 00165 05 WRK-EMPLOYER-DATA-AREA. CHGBD216 00166 10 WRK-FISCAL-AGENT-CD PIC X(03). CHGBD216 00167 88 WRK-FISC-AG-NONE-88 VALUE SPACES. CHGBD216 00168 10 WRK-FMT-ADDR. CHGBD216 00169 15 WRK-FMT-LINE OCCURS 5 TIMES CHGBD216 00170 PIC X(40). CHGBD216 00171 15 WRK-ZIP PIC X(10). CHGBD216 00172 15 WRK-ADVANCED-BARCODE PIC X(14). CHGBD216 00173 10 WRK-EMP-NAME PIC X(40). CHGBD216 00174 10 FILLER REDEFINES WRK-EMP-NAME. CHGBD216 00175 15 WRK-EMP-NAME-CHK PIC X(04). CHGBD216 00176 15 FILLER PIC X(36). CHGBD216 00177 CHGBD216 00178 05 WRK-ERROR-IND PIC X(01). CHGBD216 00179 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD216 00180 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD216 00181 CHGBD216 00182 * 05 WRK-UPD-MASTER-IND PIC X(01). CHGBD216 00183 * 88 WRK-UPD-MASTER-YES-88 VALUE 'Y'. CHGBD216 00184 * 88 WRK-UPD-MASTER-NO-88 VALUE 'N'. CHGBD216 00185 05 WRK-RATE-YRQ PIC S9(05) COMP-3. CHGBD216 00186 * 05 WRK-MRRA-ID PIC S9(03) COMP-3 CHGBD216 00187 * VALUE +0. CHGBD216 00188 05 WRK-CHG5-CNT PIC 9(09) COMP-3 CHGBD216 00189 VALUE 0. CHGBD216 00190 05 WRK-SELECTED-CNT PIC 9(09) COMP-3 CHGBD216 00191 VALUE 0. CHGBD216 00192 05 WRK-BYPASS-PRED-CNT PIC 9(09) COMP-3 CHGBD216 00193 VALUE 0. CHGBD216 00194 CHGBD216 00195 05 WRK-BD216-NOT-LIAB-CNT PIC 9(09) COMP-3 CHGBD216 00196 VALUE 0. CHGBD216 00197 05 WRK-BD216-WRITE PIC 9(09) COMP-3 CHGBD216 00198 VALUE 0. CHGBD216 00199 CHGBD216 00200 05 WRK-057-TOT1 PIC S9(09)V99 COMP-3 CHGBD216 00201 VALUE +0. CHGBD216 00202 05 WRK-140-TOT1 PIC S9(09)V99 COMP-3 CHGBD216 00203 VALUE +0. CHGBD216 00204 05 WRK-142-TOT1 PIC S9(09)V99 COMP-3 CHGBD216 00205 VALUE +0. CHGBD216 00206 05 WRK-150-TOT1 PIC S9(09)V99 COMP-3 CHGBD216 00207 VALUE +0. CHGBD216 00208 05 WRK-057-TOT2 PIC S9(09)V99 COMP-3 CHGBD216 00209 VALUE +0. CHGBD216 00210 05 WRK-140-TOT2 PIC S9(09)V99 COMP-3 CHGBD216 00211 VALUE +0. CHGBD216 00212 05 WRK-142-TOT2 PIC S9(09)V99 COMP-3 CHGBD216 00213 VALUE +0. CHGBD216 00214 05 WRK-150-TOT2 PIC S9(09)V99 COMP-3 CHGBD216 00215 VALUE +0. CHGBD216 00216 CHGBD216 00217 05 DISPLAY-PARM-REC. CHGBD216 00218 10 DISPLAY-RUN-TYPE PIC X(03). CHGBD216 00219 10 FILLER PIC X(01). CHGBD216 00220 10 DISPLAY-BEGIN-DATE PIC 9(06). CHGBD216 00221 10 FILLER PIC X(01). CHGBD216 00222 10 DISPLAY-END-DATE PIC 9(06). CHGBD216 00223 10 FILLER PIC X(01). CHGBD216 00224 10 DISPLAY-REPORT-TYPES. CHGBD216 00225 15 DISPLAY-RPT-TYPE-RATED PIC X(01). CHGBD216 00226 15 DISPLAY-RPT-TYPE-SELF-IND PIC X(01). CHGBD216 00227 15 DISPLAY-RPT-TYPE-CWC PIC X(01). CHGBD216 00228 15 DISPLAY-RPT-TYPE-FED PIC X(01). CHGBD216 00229 15 DISPLAY-RPT-TYPE-TEUC PIC X(01). CHGBD216 00230 10 FILLER PIC X(01). CHGBD216 00231 10 DISPLAY-EMP-NO PIC 9(06). CHGBD216 00232 10 FILLER PIC X(50). CHGBD216 00233 CHGBD216 00234 ** ADD ERROR MSG TABLE SET UP CHGBD216 00235 01 MSG-TABLE. CHGBD216 00236 05 MSG1-NO-MPRF. CHGBD216 00237 10 MSG1-ID. CHGBD216 00238 15 MSG1-ID1 PIC X(08) VALUE 'CHGBD216'. CHGBD216 00239 15 MSG1-ID2 PIC X(03) VALUE '216'. CHGBD216 00240 10 MSG1-SHORT-TEXT PIC X(20) CHGBD216 00241 VALUE 'EMP NOT ON FILE : '. CHGBD216 00242 10 MSG1-LONG-TEXT. CHGBD216 00243 15 FILLER PIC X(29) CHGBD216 00244 VALUE 'EMPLOYER NOT ON MASTER FILE '. CHGBD216 00245 15 FILLER PIC X(32) VALUE SPACES. CHGBD216 00246 CHGBD216 00247 05 MSG2-NOT-LIABLE. CHGBD216 00248 10 MSG2-ID. CHGBD216 00249 15 MSG2-ID1 PIC X(08) VALUE 'CHGBD210'. CHGBD216 00250 15 MSG2-ID2 PIC X(03) VALUE '210'. CHGBD216 00251 10 MSG2-SHORT-TEXT PIC X(20) CHGBD216 00252 VALUE 'EMP NOT LIABLE : '. CHGBD216 00253 10 MSG2-LONG-TEXT. CHGBD216 00254 15 FILLER PIC X(29) CHGBD216 00255 VALUE 'EMPLOYER IS NOT LIABLE '. CHGBD216 00256 15 FILLER PIC X(32) VALUE SPACES. CHGBD216 00257 CHGBD216 00258 05 MSG4-PRINTING-TURNED-OFF. CHGBD216 00259 10 MSG4-ID. CHGBD216 00260 15 MSG4-ID1 PIC X(08) VALUE 'CHGBD216'. CHGBD216 00261 15 MSG4-ID2 PIC X(03) VALUE '216'. CHGBD216 00262 10 MSG4-SHORT-TEXT PIC X(20) CHGBD216 00263 VALUE 'CHG STMT PRINT OFF: '. CHGBD216 00264 10 MSG4-LONG-TEXT. CHGBD216 00265 15 FILLER PIC X(36) CHGBD216 00266 VALUE 'CHARGE STATEMENT PRINTING TURNED OFF'. CHGBD216 00267 15 FILLER PIC X(25) VALUE SPACES. CHGBD216 00268 CHGBD216 00269 05 MSG5-NO-ADDRESS. CHGBD216 00270 10 MSG5-ID. CHGBD216 00271 15 MSG5-ID1 PIC X(08) VALUE 'CHGBD216'. CHGBD216 00272 15 MSG5-ID2 PIC X(03) VALUE '216'. CHGBD216 00273 10 MSG5-SHORT-TEXT PIC X(20) CHGBD216 00274 VALUE 'NO ADDRESS FOUND: '. CHGBD216 00275 10 MSG5-LONG-TEXT. CHGBD216 00276 15 FILLER PIC X(29) CHGBD216 00277 VALUE 'ADDRESS NOT FOUND '. CHGBD216 00278 15 FILLER PIC X(25) CHGBD216 00279 VALUE ' MPRF EMPLOYER NUMBER = '. CHGBD216 00280 15 MSG5-EMP-NO PIC 9(07). CHGBD216 00281 CHGBD216 00282 05 MSG6-INVALID-EMP-NO. CHGBD216 00283 10 MSG6-ID. CHGBD216 00284 15 MSG6-ID1 PIC X(08) VALUE 'CHGBD216'. CHGBD216 00285 15 MSG6-ID2 PIC X(03) VALUE '216'. CHGBD216 00286 10 MSG6-SHORT-TEXT PIC X(20) CHGBD216 00287 VALUE 'INVALID EMP NO: '. CHGBD216 00288 10 MSG6-LONG-TEXT. CHGBD216 00289 15 FILLER PIC X(29) CHGBD216 00290 VALUE 'INVALID EMPLOYER NUMBER: '. CHGBD216 00291 15 MSG6-EMP-NO PIC 9(07). CHGBD216 00292 15 FILLER PIC X(25) CHGBD216 00293 VALUE ' EMP TYPE = '. CHGBD216 00294 15 MSG6-EMP-TYPE PIC 9(02). CHGBD216 00295 ** ERROR MSG OUTPUT RECORD CHGBD216 00296 CHGBD216 00297 01 RSKL-REC. CHGBD216 00298 ++INCLUDE DTSIRSK1 CHGBD216 00299 CHGBD216 00300 01 R907-REC. CHGBD216 00301 ++INCLUDE DTSIR907 CHGBD216 00302 CHGBD216 00303 01 L001-LINK-AREA. CHGBD216 00304 ++INCLUDE DTSIL001 CHGBD216 00305 CHGBD216 00306 01 L004-LINK-AREA. CHGBD216 00307 ++INCLUDE DTSIL004 CHGBD216 00308 CHGBD216 00309 01 L005-LINK-AREA. CHGBD216 00310 ++INCLUDE DTSIL005 CHGBD216 00311 CHGBD216 00312 01 L006-LINK-AREA. CHGBD216 00313 ++INCLUDE DTSIL006 CHGBD216 00314 *RW1 CHGBD216 00315 01 L081-LINK-AREA. CHGBD216 00316 ++INCLUDE DTSIL081 CHGBD216 00317 CHGBD216 00318 01 L100-LINK-AREA. CHGBD216 00319 ++INCLUDE CHGIL100 CHGBD216 00320 CHGBD216 00321 01 L111-LINK-AREA. CHGBD216 00322 ++INCLUDE DTSIL111 CHGBD216 00323 CHGBD216 00324 01 L112-LINK-AREA. CHGBD216 00325 ++INCLUDE DTSIL112 CHGBD216 00326 *RW2 CHGBD216 00327 01 L910-LINK-AREA. CHGBD216 00328 ++INCLUDE DTSIL910 CHGBD216 00329 CHGBD216 00330 01 MSKL-REC. CHGBD216 00331 ++INCLUDE DTSIMSKL CHGBD216 00332 CHGBD216 00333 01 MHDR-REC. CHGBD216 00334 ++INCLUDE DTSIMHDR CHGBD216 00335 CHGBD216 00336 01 MPRF-REC. CHGBD216 00337 ++INCLUDE DTSIMPRF CHGBD216 00338 CHGBD216 00339 01 MREL-REC. CHGBD216 00340 ++INCLUDE DTSIMREL CHGBD216 00341 CHGBD216 00342 01 MFAE-REC. CHGBD216 00343 ++INCLUDE DTSIMFAE CHGBD216 00344 CHGBD216 00345 01 L921-LINK-AREA. CHGBD216 00346 ++INCLUDE DTSIL921 CHGBD216 00347 CHGBD216 00348 01 ISKL-REC. CHGBD216 00349 ++INCLUDE DTSIISKL CHGBD216 00350 CHGBD216 00351 PROCEDURE DIVISION. CHGBD216 00352 SKIP2 CHGBD216 00353 CHGBD216-MAIN. CHGBD216 00354 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD216 00355 IF WRK-ERROR-YES-88 CHGBD216 00356 GO TO CHGBD216-EXIT. CHGBD216 00357 CHGBD216 00358 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD216 00359 CHGBD216 00360 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD216 00361 CHGBD216 00362 CHGBD216-EXIT. CHGBD216 00363 STOP RUN. CHGBD216 00364 EJECT CHGBD216 00365 I0000-INITIATE. CHGBD216 00366 SET WRK-ERROR-NO-88 TO TRUE. CHGBD216 00367 CHGBD216 00368 MOVE MSG1-ID1 TO R907-MODULE-NAME. CHGBD216 00369 MOVE LENGTH OF R907-REC TO R907-LENGTH. CHGBD216 00370 CHGBD216 00371 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. CHGBD216 00372 CHGBD216 00373 I0000-EXIT. CHGBD216 00374 EXIT. CHGBD216 00375 CHGBD216 00376 I2000-OPEN-FILES-1. CHGBD216 00377 OPEN INPUT CHARGE-FILE-IN. CHGBD216 00378 IF NOT CHG5-FILE-OK-88 CHGBD216 00379 DISPLAY 'INPUT CHARGE FILE OPEN ERROR: ' CHG5-STATUS CHGBD216 00380 SET WRK-ERROR-YES-88 TO TRUE CHGBD216 00381 GO TO I2000-EXIT CHGBD216 00382 END-IF. CHGBD216 00383 CHGBD216 00384 OPEN OUTPUT BD216-CHG-FILE-OUT. CHGBD216 00385 IF NOT BD216-FILE-OK-88 CHGBD216 00386 MOVE 'BD216 FILE OPEN ERROR: ' TO ABEND-MSG CHGBD216 00387 PERFORM S999-ABEND THRU S999-EXIT. CHGBD216 00388 CHGBD216 00389 OPEN INPUT CHG-PARM-FILE. CHGBD216 00390 IF NOT CHG-PARM-FILE-OK-88 CHGBD216 00391 DISPLAY 'CHARGE PARM FILE OPEN ERROR: ' CHGBD216 00392 CHG-PARM-STATUS CHGBD216 00393 PERFORM S999-ABEND THRU S999-EXIT CHGBD216 00394 END-IF. CHGBD216 00395 CHGBD216 00396 READ CHG-PARM-FILE. CHGBD216 00397 IF NOT CHG-PARM-FILE-OK-88 CHGBD216 00398 DISPLAY 'CHARGE PARM FILE READ ERROR: ' CHGBD216 00399 CHG-PARM-STATUS CHGBD216 00400 PERFORM S999-ABEND THRU S999-EXIT CHGBD216 00401 END-IF. CHGBD216 00402 CHGBD216 00403 DISPLAY '***** CHGBD216 PARM RECORD *****'. CHGBD216 00404 MOVE CHG3-RUN-TYPE TO DISPLAY-RUN-TYPE. CHGBD216 00405 MOVE CHG3-BEGIN-DATE TO DISPLAY-BEGIN-DATE. CHGBD216 00406 MOVE CHG3-END-DATE TO DISPLAY-END-DATE. CHGBD216 00407 MOVE CHG3-RPT-TYPES TO DISPLAY-REPORT-TYPES. CHGBD216 00408 MOVE CHG3-EMP-NO TO DISPLAY-EMP-NO. CHGBD216 00409 DISPLAY DISPLAY-PARM-REC. CHGBD216 00410 DISPLAY SPACE. CHGBD216 00411 CHGBD216 00412 PERFORM S910-OPEN-READ THRU S910-EXIT. CHGBD216 00413 CHGBD216 00414 PERFORM S921-OPEN-READ THRU S921-EXIT. CHGBD216 00415 CHGBD216 00416 I2000-EXIT. CHGBD216 00417 EXIT. CHGBD216 00418 CHGBD216 00419 P0000-PROCESS. CHGBD216 00420 READ CHARGE-FILE-IN. CHGBD216 00421 CHGBD216 00422 IF CHG5-FILE-EOF-88 CHGBD216 00423 DISPLAY 'CHARGE FILE EMPTY: ' CHG5-STATUS CHGBD216 00424 SET WRK-ERROR-YES-88 TO TRUE CHGBD216 00425 GO TO P0000-EXIT CHGBD216 00426 END-IF. CHGBD216 00427 CHGBD216 00428 PERFORM CHGBD216 00429 UNTIL CHG5-FILE-EOF-88 CHGBD216 00430 OR WRK-ERROR-YES-88 CHGBD216 00431 ADD 1 TO WRK-CHG5-CNT CHGBD216 00432 PERFORM P1000-SELECT THRU P1000-EXIT CHGBD216 00433 IF WRK-SELECT-YES-88 CHGBD216 00434 ADD 1 TO WRK-SELECTED-CNT CHGBD216 00435 IF CHG5-EMP-NO NOT = WRK-LAST-EMP-CHECKED CHGBD216 00436 MOVE CHG5-EMP-NO TO WRK-LAST-EMP-CHECKED CHGBD216 00437 PERFORM P2000-GET-ADDRESS THRU P2000-EXIT CHGBD216 00438 PERFORM P2300-FISC-AGENT THRU P2300-EXIT CHGBD216 00439 END-IF CHGBD216 00440 PERFORM P3000-BUILD-CHG4-REC THRU P3000-EXIT CHGBD216 00441 PERFORM S1100-WRITE-BD216 THRU S1100-EXIT CHGBD216 00442 END-IF CHGBD216 00443 READ CHARGE-FILE-IN CHGBD216 00444 END-PERFORM. CHGBD216 00445 CHGBD216 00446 CHGBD216 00447 P0000-EXIT. CHGBD216 00448 EXIT. CHGBD216 00449 CHGBD216 00450 P1000-SELECT. CHGBD216 00451 SET WRK-SELECT-NO-88 TO TRUE. CHGBD216 00452 CHGBD216 00453 EVALUATE TRUE CHGBD216 00454 WHEN CHG3-RUN-TYPE-QTRLY-88 CHGBD216 00455 SET WRK-SELECT-YES-88 TO TRUE CHGBD216 00456 CHGBD216 00457 WHEN CHG3-RUN-TYPE-ANN-88 CHGBD216 00458 SET WRK-SELECT-YES-88 TO TRUE CHGBD216 00459 CHGBD216 00460 WHEN CHG3-RUN-TYPE-EMP-88 CHGBD216 00461 IF CHG5-EMP-NO = CHG3-EMP-NO CHGBD216 00462 SET WRK-SELECT-YES-88 TO TRUE CHGBD216 00463 END-IF CHGBD216 00464 CHGBD216 00465 WHEN CHG3-RUN-TYPE-AGENT-88 CHGBD216 00466 SET WRK-SELECT-YES-88 TO TRUE CHGBD216 00467 CHGBD216 00468 END-EVALUATE. CHGBD216 00469 ************************************************************ CHGBD216 00470 * THE PARAGRAPH BELOW WILL PREVENT PRINTING OF CHARGE DATA CHGBD216 00471 * FOR 100% TRANSFERS. IN SOME SITUATIONS (PARTIAL TRANSFER CHGBD216 00472 * PRECEDING 100% TRANSFER) IT WILL SHOW THE PARTIALS CHGBD216 00473 * BUT NOT THE 100% THAT CLOSES THE ACCOUNT. CHGBD216 00474 * THE PARAGRAPH WAS COMMENTED OUT ON 01/08/2008 BECAUSE IT CHGBD216 00475 * IS PROBABLY BETTER TO SHOW THE COMPLETE PROCESS. CHGBD216 00476 * PREDECESSORS INVOLVED IN A 100% TRANSFER WILL RECEIVE A CHGBD216 00477 * REPORT SHOWING 0 CHARGES, DOCUMENTING THE TRANSFER TO CHGBD216 00478 * THE SUCCESSOR. GD CHGBD216 00479 ************************************************************ CHGBD216 00480 *& PERFORM P1100-BYPASS-PRED THRU P1100-EXIT. CHGBD216 00481 CHGBD216 00482 P1000-EXIT. CHGBD216 00483 EXIT. CHGBD216 00484 CHGBD216 00485 P1100-BYPASS-PRED. CHGBD216 00486 IF CHG5-PERCENT-XFER = +1 CHGBD216 00487 IF CHG5-EMP-NO = CHG5-PRED-EMP-NO CHGBD216 00488 ADD +1 TO WRK-BYPASS-PRED-CNT CHGBD216 00489 SET WRK-SELECT-NO-88 TO TRUE CHGBD216 00490 END-IF CHGBD216 00491 END-IF. CHGBD216 00492 CHGBD216 00493 P1100-EXIT. CHGBD216 00494 EXIT. CHGBD216 00495 CHGBD216 00496 P2000-GET-ADDRESS. CHGBD216 00497 MOVE SPACES TO WRK-FMT-ADDR CHGBD216 00498 WRK-ZIP CHGBD216 00499 WRK-ADVANCED-BARCODE. CHGBD216 00500 CHGBD216 00501 PERFORM P2100-FIND-ADDRESS THRU P2100-EXIT CHGBD216 00502 IF L111-ADDR-FOUND-88 CHGBD216 00503 PERFORM P2200-FORMAT-ADDRESS THRU P2200-EXIT CHGBD216 00504 ELSE CHGBD216 00505 DISPLAY 'P2000 NO ADDRESS ' CHG5-EMP-NO CHGBD216 00506 END-IF. CHGBD216 00507 CHGBD216 00508 P2000-EXIT. CHGBD216 00509 EXIT. CHGBD216 00510 CHGBD216 00511 P2100-FIND-ADDRESS. CHGBD216 00512 MOVE CHG5-EMP-NO TO L111-EMP-NO. CHGBD216 00513 SET L111-LOOKUP-TAD-88 TO TRUE. CHGBD216 00514 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. CHGBD216 00515 PERFORM S111-LOOKUP-ADDRESS THRU S111-EXIT. CHGBD216 00516 IF L111-ADDR-NOT-FOUND-88 CHGBD216 00517 SET WRK-EMP-VALID-NO-88 TO TRUE CHGBD216 00518 MOVE MSG5-ID2 TO R907-MSG-ID CHGBD216 00519 MOVE CHG5-EMP-NO TO MSG5-EMP-NO CHGBD216 00520 R907-EMP-NO CHGBD216 00521 MOVE MSG5-LONG-TEXT TO R907-MSG-TEXT CHGBD216 00522 MOVE R907-REC TO RSKL-REC CHGBD216 00523 PERFORM S946-RPT-REC-O THRU S946-EXIT CHGBD216 00524 END-IF. CHGBD216 00525 CHGBD216 00526 P2100-EXIT. CHGBD216 00527 EXIT. CHGBD216 00528 CHGBD216 00529 P2200-FORMAT-ADDRESS. CHGBD216 00530 MOVE LOW-VALUE TO MPRF-KEY-AREA. CHGBD216 00531 MOVE CHG5-EMP-NO TO MPRF-EMP-NO. CHGBD216 00532 SET MPRF-PRF-88 TO TRUE. CHGBD216 00533 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CHGBD216 00534 CHGBD216 00535 PERFORM S910-READ THRU S910-EXIT. CHGBD216 00536 IF L910-NO-REC-88 CHGBD216 00537 MOVE SPACES TO WRK-EMP-NAME CHGBD216 00538 GO TO P2200-EXIT CHGBD216 00539 ELSE CHGBD216 00540 MOVE MSKL-REC TO MPRF-REC CHGBD216 00541 MOVE MPRF-PRIMARY-NAME TO WRK-EMP-NAME CHGBD216 00542 CHGBD216 00543 END-IF. CHGBD216 00544 CHGBD216 00545 SET L112-TAD-ADDR-88 TO TRUE. CHGBD216 00546 SET L112-ANCHOR-LAST-88 TO TRUE. CHGBD216 00547 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. CHGBD216 00548 MOVE WRK-EMP-NAME TO L112-PRIMARY-NAME. CHGBD216 00549 PERFORM S112-FORMAT-ADDRESS THRU S112-EXIT. CHGBD216 00550 CHGBD216 00551 MOVE L112-MAILING-ADDRESS TO WRK-FMT-ADDR. CHGBD216 00552 MOVE L111-ZIP TO WRK-ZIP. CHGBD216 00553 MOVE L111-ADVANCED-BARCODE TO WRK-ADVANCED-BARCODE. CHGBD216 00554 CHGBD216 00555 P2200-EXIT. CHGBD216 00556 EXIT. CHGBD216 00557 CHGBD216 00558 P2300-FISC-AGENT. CHGBD216 00559 MOVE LOW-VALUE TO MFAE-KEY-AREA. CHGBD216 00560 MOVE CHG5-EMP-NO TO MFAE-EMP-NO. CHGBD216 00561 SET MFAE-FAE-88 TO TRUE. CHGBD216 00562 SET MFAE-SERVICE-BEN-CHG-88 TO TRUE. CHGBD216 00563 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. CHGBD216 00564 CHGBD216 00565 PERFORM S910-READ THRU S910-EXIT. CHGBD216 00566 IF L910-NO-REC-88 CHGBD216 00567 MOVE SPACES TO WRK-FISCAL-AGENT-CD CHGBD216 00568 GO TO P2300-EXIT CHGBD216 00569 ELSE CHGBD216 00570 MOVE MSKL-REC TO MFAE-REC CHGBD216 00571 MOVE MFAE-FISCAL-AGENT-CD TO WRK-FISCAL-AGENT-CD CHGBD216 00572 END-IF. CHGBD216 00573 CHGBD216 00574 P2300-EXIT. CHGBD216 00575 EXIT. CHGBD216 00576 CHGBD216 00577 P3000-BUILD-CHG4-REC. CHGBD216 00578 CHGBD216 00579 SET CHG4-RPT-TYPE-RATED-88 TO TRUE. CHGBD216 00580 MOVE CHG5-EMP-NO TO CHG4-EMP-NO. CHGBD216 00581 MOVE CHG5-SSN TO CHG4-SSN. CHGBD216 00582 MOVE CHG5-BYE TO CHG4-BYE. CHGBD216 00583 MOVE CHG5-PROGRAM TO CHG4-PROGRAM. CHGBD216 00584 CHGBD216 00585 MOVE CHG5-TOT-CHG-AMT TO CHG4-CURR-BEN-AMT. CHGBD216 00586 MOVE ZEROS TO CHG4-CURR-ADJ-AMT CHGBD216 00587 CHG4-TOT-BEN-AMT CHGBD216 00588 CHG4-TOT-ADJ-AMT CHGBD216 00589 CHG4-OP-RECOVER-AMT. CHGBD216 00590 CHGBD216 00591 MOVE CHG5-SUCC-EMP-NO TO CHG4-SUCC-EMP-NO. CHGBD216 00592 MOVE CHG5-PRED-EMP-NO TO CHG4-PRED-EMP-NO. CHGBD216 00593 MOVE CHG5-PERCENT-XFER TO CHG4-PERCENT-XFER. CHGBD216 00594 CHGBD216 00595 MOVE CHG5-SSN TO L081-CLAIMANT-SSN. CHGBD216 00596 PERFORM S081-CLAIMANT-NAME THRU S081-EXIT. CHGBD216 00597 IF L081-NAME-FOUND CHGBD216 00598 MOVE L081-CLAIMANT-NAME TO CHG4-CLMNT-NAME CHGBD216 00599 ELSE CHGBD216 00600 PERFORM S083-IB6-CLMNT-NAME THRU S083-EXIT CHGBD216 00601 MOVE L081-CLAIMANT-NAME TO CHG4-CLMNT-NAME. CHGBD216 00602 CHGBD216 00603 MOVE WRK-FISCAL-AGENT-CD TO CHG4-FISCAL-AGENT-CD. CHGBD216 00604 MOVE WRK-FMT-ADDR TO CHG4-FMT-ADDR. CHGBD216 00605 MOVE WRK-ZIP TO CHG4-ZIP. CHGBD216 00606 MOVE WRK-ADVANCED-BARCODE TO CHG4-ADVANCED-BARCODE. CHGBD216 00607 MOVE WRK-EMP-NAME-CHK TO CHG4-EMP-NAME-CHK. CHGBD216 00608 CHGBD216 00609 MOVE ZEROS TO CHG4-EMP-TYPE. CHGBD216 00610 MOVE SPACES TO CHG4-DATA-FILLER. CHGBD216 00611 CHGBD216 00612 P3000-EXIT. CHGBD216 00613 EXIT. CHGBD216 00614 CHGBD216 00615 S001-FROM-FED-8. CHGBD216 00616 SET L001-FROM-FED-8 TO TRUE. CHGBD216 00617 GO TO S001-DATE. CHGBD216 00618 CHGBD216 00619 S001-FROM-ABS. CHGBD216 00620 SET L001-FROM-ABS-DAY TO TRUE. CHGBD216 00621 GO TO S001-DATE. CHGBD216 00622 CHGBD216 00623 S001-DATE. CHGBD216 00624 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD216 00625 S001-EXIT. EXIT. CHGBD216 00626 CHGBD216 00627 S004-FROM-5. CHGBD216 00628 SET L004-FROM-5 TO TRUE. CHGBD216 00629 GO TO S004-YRQ. CHGBD216 00630 CHGBD216 00631 S004-FROM-3. CHGBD216 00632 SET L004-FROM-3 TO TRUE. CHGBD216 00633 GO TO S004-YRQ. CHGBD216 00634 CHGBD216 00635 S004-FROM-DATE. CHGBD216 00636 SET L004-FROM-DATE TO TRUE. CHGBD216 00637 GO TO S004-YRQ. CHGBD216 00638 CHGBD216 00639 S004-FROM-ABS. CHGBD216 00640 SET L004-FROM-ABS TO TRUE. CHGBD216 00641 GO TO S004-YRQ. CHGBD216 00642 CHGBD216 00643 S004-YRQ. CHGBD216 00644 CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD216 00645 S004-EXIT. EXIT. CHGBD216 00646 CHGBD216 00647 S005-SYSTEM-TIME. CHGBD216 00648 CALL 'DTSBU005' USING L005-LINK-AREA. CHGBD216 00649 S005-EXIT. CHGBD216 00650 EXIT. CHGBD216 00651 CHGBD216 00652 S006-FROM-QTR. CHGBD216 00653 SET L006-FROM-QTR TO TRUE. CHGBD216 00654 GO TO S006-UI-RATE-YEAR. CHGBD216 00655 CHGBD216 00656 S006-UI-RATE-YEAR. CHGBD216 00657 CALL 'DTSBU006' USING L006-LINK-AREA. CHGBD216 00658 S006-EXIT. CHGBD216 00659 EXIT. CHGBD216 00660 CHGBD216 00661 S081-CLAIMANT-NAME. CHGBD216 00662 CALL 'DTSBU081' USING L081-LINK-AREA. CHGBD216 00663 S081-EXIT. EXIT. CHGBD216 00664 CHGBD216 00665 S083-IB6-CLMNT-NAME. CHGBD216 00666 CALL 'DTSBU083' USING L081-LINK-AREA. CHGBD216 00667 S083-EXIT. EXIT. CHGBD216 00668 CHGBD216 00669 S100-CALL-CHGBU100. CHGBD216 00670 CALL 'CHGBU100' USING L100-LINK-AREA. CHGBD216 00671 S100-EXIT. EXIT. CHGBD216 00672 CHGBD216 00673 S111-LOOKUP-ADDRESS. CHGBD216 00674 CALL 'DTSBU111' USING L111-LINK-AREA. CHGBD216 00675 S111-EXIT. EXIT. CHGBD216 00676 CHGBD216 00677 S112-FORMAT-ADDRESS. CHGBD216 00678 CALL 'DTSBU112' USING L112-LINK-AREA. CHGBD216 00679 S112-EXIT. EXIT. CHGBD216 00680 CHGBD216 00681 S1100-WRITE-BD216. CHGBD216 00682 WRITE BD216-CHG-REC. CHGBD216 00683 IF BD216-FILE-OK-88 CHGBD216 00684 ADD 1 TO WRK-BD216-WRITE CHGBD216 00685 END-IF. CHGBD216 00686 CHGBD216 00687 S1100-EXIT. CHGBD216 00688 EXIT. CHGBD216 00689 CHGBD216 00690 CHGBD216 00691 S910-OPEN-READ. CHGBD216 00692 SET L910-OPEN-READ-88 TO TRUE. CHGBD216 00693 GO TO S910-MSTR-IO. CHGBD216 00694 CHGBD216 00695 S910-OPEN-UPDATE. CHGBD216 00696 SET L910-OPEN-UPDATE-88 TO TRUE. CHGBD216 00697 GO TO S910-MSTR-IO. CHGBD216 00698 CHGBD216 00699 S910-READ. CHGBD216 00700 SET L910-READ-88 TO TRUE. CHGBD216 00701 GO TO S910-MSTR-IO. CHGBD216 00702 CHGBD216 00703 S910-START-BROWSE. CHGBD216 00704 SET L910-START-BROWSE-88 TO TRUE. CHGBD216 00705 GO TO S910-MSTR-IO. CHGBD216 00706 CHGBD216 00707 S910-READ-NEXT. CHGBD216 00708 SET L910-READ-NEXT-88 TO TRUE. CHGBD216 00709 GO TO S910-MSTR-IO. CHGBD216 00710 CHGBD216 00711 S910-WRITE. CHGBD216 00712 SET L910-WRITE-88 TO TRUE. CHGBD216 00713 GO TO S910-MSTR-IO. CHGBD216 00714 CHGBD216 00715 S910-CLOSE. CHGBD216 00716 SET L910-CLOSE-88 TO TRUE. CHGBD216 00717 GO TO S910-MSTR-IO. CHGBD216 00718 CHGBD216 00719 S910-MSTR-IO. CHGBD216 00720 CALL 'DTSBU910' USING L910-LINK-AREA CHGBD216 00721 MSKL-REC. CHGBD216 00722 CHGBD216 00723 S910-EXIT. CHGBD216 00724 EXIT. CHGBD216 00725 CHGBD216 00726 S921-OPEN-READ. CHGBD216 00727 SET L921-OPEN-READ-88 TO TRUE. CHGBD216 00728 GO TO S921-AIX-IO. CHGBD216 00729 CHGBD216 00730 S921-CLOSE. CHGBD216 00731 SET L921-CLOSE-88 TO TRUE. CHGBD216 00732 GO TO S921-AIX-IO. CHGBD216 00733 CHGBD216 00734 S921-AIX-IO. CHGBD216 00735 CALL 'DTSBU921' USING L921-LINK-AREA CHGBD216 00736 ISKL-REC. CHGBD216 00737 CHGBD216 00738 S921-EXIT. CHGBD216 00739 EXIT. CHGBD216 00740 CHGBD216 00741 ** REPORT RECORD I-O CHGBD216 00742 S946-RPT-REC-O. CHGBD216 00743 CALL 'DTSBU946' USING RSKL-REC. CHGBD216 00744 CHGBD216 00745 S946-EXIT. CHGBD216 00746 EXIT. CHGBD216 00747 CHGBD216 00748 T0000-TERMINATE. CHGBD216 00749 IF WRK-BD216-WRITE = ZERO CHGBD216 00750 PERFORM T1000-WRITE-DUMMY THRU T1000-EXIT CHGBD216 00751 END-IF CHGBD216 00752 CHGBD216 00753 CLOSE CHARGE-FILE-IN BD216-CHG-FILE-OUT. CHGBD216 00754 CHGBD216 00755 PERFORM S910-CLOSE THRU S910-EXIT. CHGBD216 00756 PERFORM S921-CLOSE THRU S921-EXIT. CHGBD216 00757 CHGBD216 00758 DISPLAY '***********************************************'. CHGBD216 00759 DISPLAY '*** CHGBD216 COUNTS *** '. CHGBD216 00760 DISPLAY '***'. CHGBD216 00761 CHGBD216 00762 DISPLAY ' CHG5 RECORDS READ : ' CHGBD216 00763 WRK-CHG5-CNT. CHGBD216 00764 DISPLAY ' CHG5 RECORDS SELECTED : ' CHGBD216 00765 WRK-SELECTED-CNT. CHGBD216 00766 MOVE WRK-TOT-CHG TO WRK-CHG-AMT-DISP. CHGBD216 00767 DISPLAY 'TOTAL CHARGES ' WRK-CHG-AMT-DISP. CHGBD216 00768 DISPLAY ' '. CHGBD216 00769 DISPLAY ' CHGBD216 NOT LIABLE RECORDS PASSED: ' CHGBD216 00770 WRK-BD216-NOT-LIAB-CNT. CHGBD216 00771 DISPLAY ' 100% PREDECESSORS BYPASSED: ' CHGBD216 00772 WRK-BYPASS-PRED-CNT. CHGBD216 00773 CHGBD216 00774 DISPLAY ' CHGBD216 RECORDS WRITTEN : ' CHGBD216 00775 WRK-BD216-WRITE. CHGBD216 00776 CHGBD216 00777 DISPLAY '***********************************************'. CHGBD216 00778 CHGBD216 00779 T0000-EXIT. CHGBD216 00780 EXIT. CHGBD216 00781 * CHGBD216 00782 T1000-WRITE-DUMMY. CHGBD216 00783 INITIALIZE BD216-CHG-REC. CHGBD216 00784 SET CHG4-RPT-TYPE-NULL-88 TO TRUE. CHGBD216 00785 MOVE ZEROS TO CHG4-EMP-NO. CHGBD216 00786 CHGBD216 00787 WRITE BD216-CHG-REC. CHGBD216 00788 ADD 1 TO WRK-BD216-WRITE. CHGBD216 00789 CHGBD216 00790 T1000-EXIT. CHGBD216 00791 EXIT. CHGBD216 00792 CHGBD216 00793 S999-ABEND. CHGBD216 00794 DISPLAY '**** CHGBD216 ABENDING ' CHGBD216 00795 ABEND-MSG ' ' BD216-CHG-STATUS. CHGBD216 00796 CALL ABEND-MOD USING ABEND-CODE. CHGBD216 00797 CHGBD216 00798 S999-EXIT. CHGBD216 00799 EXIT. CHGBD216 00800 CHGBD216