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