00001 IDENTIFICATION DIVISION. 01/13/23 00002 PROGRAM-ID. DTSBD720. DTSBD720 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV034 00004 DATE-WRITTEN. APRIL 1999. DTSBD720 00005 DATE-COMPILED. DTSBD720 00006 SKIP3 DTSBD720 00007 ***** DTSBD720 00008 ****** DTSBD720 00009 * DTSBD720 00010 * FUNCTION: TRANSFER RATING EXPERIENCE AND DELETE UNNEEDED DTSBD720 00011 * MRCT RECORD OCCURRENCES. DTSBD720 00012 * DTSBD720 00013 * DTSBD720 00014 * MODIFICATION LOG: DTSBD720 00015 * DTSBD720 00016 * 04/06/1999 WRITTEN FOR DC. DTSBD720 00017 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD720 00018 * DTSBD720 00019 * 09/25/2007 MODIFIED FOR PARTIAL TRANSFERS OF EXPERIENCE. DTSBD720 00020 * REFERENCE: PROGRAMMER: GD DTSBD720 00021 * DTSBD720 00022 * 10/14/2009 MODIFIED PROCESS THAT DETERMINES SUCCESSOR'S DTSBD720 00023 * EARLIEST LIABILITY DATE. DTSBD720 00024 * REFERENCE: PROGRAMMER: GD DTSBD720 00025 * DTSBD720 00026 * 10/24/2013 CORRECTION FOR MANUAL TRANSFERS OF EXPERIENCE. DTSBD720 00027 * DTSBD720 00028 * REFERENCE: PROGRAMMER: GD DTSBD720 00029 DTSBD720 00030 * CL*24 00031 * 11/24/2019 MODIFIED PROGRAM TO CORRECT ISSUES WITH PRED/ CL*24 00032 * SUCC ELD VEIFICATION CL*24 00033 * REFERENCE: PROGRAMMER: ZL1 CL*24 00034 CL*24 00035 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD720 00036 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD720 00037 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD720 00038 * DTSBD720 00039 * DTSBD720 00040 * DESCRIPTION: DTSBD720 00041 * DTSBD720 00042 * DTSBD720 PERFORMS THE FUNCTIONS DESCRIBED IN SECTIONS DTSBD720 00043 * 5.4.3 AND 5.4.4 OF THE DC UI TAX REQUIREMENTS DOCUMENT. DTSBD720 00044 * DTSBD720 00045 * DTSBD720 00046 ***** DTSBD720 00047 SKIP3 DTSBD720 00048 ENVIRONMENT DIVISION. DTSBD720 00049 EJECT DTSBD720 00050 INPUT-OUTPUT SECTION. DTSBD720 00051 SKIP3 DTSBD720 00052 FILE-CONTROL. DTSBD720 00053 DTSBD720 00054 SELECT RELATIONSHIP-FILE ASSIGN TO DTSFIPES DTSBD720 00055 FILE STATUS IS REL-STATUS. DTSBD720 00056 DTSBD720 00057 SELECT CHARGE-FILE ASSIGN TO DTSFCHG5 DTSBD720 00058 ORGANIZATION IS INDEXED DTSBD720 00059 ACCESS MODE IS DYNAMIC DTSBD720 00060 RECORD KEY IS CHG5-SORT-KEY-AREA DTSBD720 00061 FILE STATUS IS CHARGE-STATUS. DTSBD720 00062 DTSBD720 00063 SELECT BYPASS-FILE ASSIGN TO DTSFPASS DTSBD720 00064 FILE STATUS IS BYPASS-STATUS. DTSBD720 00065 DTSBD720 00066 DATA DIVISION. DTSBD720 00067 FILE SECTION. DTSBD720 00068 DTSBD720 00069 FD RELATIONSHIP-FILE DTSBD720 00070 RECORD CONTAINS 16 CHARACTERS DTSBD720 00071 DATA RECORD IS REL-REC. DTSBD720 00072 01 REL-REC. DTSBD720 00073 05 REL-EFF-DT PIC S9(09) COMP-3. DTSBD720 00074 05 REL-PRED PIC S9(07) COMP-3. DTSBD720 00075 05 REL-SUCC PIC S9(07) COMP-3. DTSBD720 00076 05 REL-PCT PIC S9V9(04) COMP-3. DTSBD720 00077 DTSBD720 00078 FD CHARGE-FILE DTSBD720 00079 RECORD CONTAINS 41 CHARACTERS DTSBD720 00080 DATA RECORD IS CHARGE-REC. DTSBD720 00081 01 CHARGE-REC. DTSBD720 00082 ++INCLUDE CHGIM005 DTSBD720 00083 DTSBD720 00084 FD BYPASS-FILE DTSBD720 00085 RECORD CONTAINS 46 CHARACTERS DTSBD720 00086 DATA RECORD IS BYPASS-REC. DTSBD720 00087 01 BYPASS-REC PIC X(46). DTSBD720 00088 DTSBD720 00089 WORKING-STORAGE SECTION. DTSBD720 000895 77 PAN-VALET PICTURE X(24) VALUE '034DTSBD720 01/13/23'. DTSBD720 00090 77 PAN-VALET PICTURE X(24) VALUE '055DTSBD720 12/02/13'. DTSBD720 00091 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD720 11/13/13'. DTSBD720 00092 77 PAN-VALET PICTURE X(24) VALUE '053DTSBD720 12/03/10'. DTSBD720 00093 DTSBD720 00094 DTSBD720 00095 01 WRK-AREA. DTSBD720 00096 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +720.DTSBD720 00097 DTSBD720 00098 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD720'.DTSBD720 00099 DTSBD720 00100 05 ABEND-MSG PIC X(60). DTSBD720 00101 DTSBD720 00102 DTSBD720 00103 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3. DTSBD720 00104 DTSBD720 00105 05 WRK-SYS-DATE PIC S9(09) COMP-3. DTSBD720 00106 DTSBD720 00107 05 WRK-SYS-TIME PIC S9(07) COMP-3. DTSBD720 00108 DTSBD720 00109 05 REL-STATUS PIC X(02) VALUE SPACES. DTSBD720 00110 88 REL-FILE-OK-88 VALUE '00'. DTSBD720 00111 88 REL-FILE-EOF-88 VALUE '10'. DTSBD720 00112 DTSBD720 00113 05 CHARGE-STATUS PIC X(02) VALUE SPACES. DTSBD720 00114 88 CHARGE-FILE-OK-88 VALUE '00'. DTSBD720 00115 88 CHARGE-FILE-EOF-88 VALUE '10'. DTSBD720 00116 DTSBD720 00117 05 BYPASS-STATUS PIC X(02) VALUE SPACES. DTSBD720 00118 88 BYPASS-FILE-OK-88 VALUE '00'. DTSBD720 00119 DTSBD720 00120 05 WRK-ERROR-IND PIC X(01). DTSBD720 00121 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBD720 00122 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBD720 00123 DTSBD720 00124 05 WRK-TRANSFER-IND PIC X(01). DTSBD720 00125 88 WRK-TRANSFER-YES-88 VALUE 'Y'. DTSBD720 00126 88 WRK-TRANSFER-NO-88 VALUE 'N'. DTSBD720 00127 DTSBD720 00128 05 REL-TABLE OCCURS 100 TIMES. DTSBD720 00129 10 RT-EFF-DATE PIC S9(09) COMP-3. DTSBD720 00130 10 RT-PRED PIC S9(07) COMP-3. DTSBD720 00131 10 RT-SUCC PIC S9(07) COMP-3. DTSBD720 00132 10 RT-PERCENT PIC S9V9(04) COMP-3. DTSBD720 00133 05 RSUB PIC S9(04) COMP. DTSBD720 00134 05 RT-MAX PIC S9(04) COMP DTSBD720 00135 VALUE +100. DTSBD720 00136 05 RT-LAST PIC S9(04) COMP. DTSBD720 00137 05 WRK-CURR-EFF-DT PIC S9(09) COMP-3. DTSBD720 00138 05 WRK-CURR-PRED PIC S9(07) COMP-3. DTSBD720 00139 05 WRK-CURR-SUCC PIC S9(07) COMP-3. DTSBD720 00140 05 WRK-CURR-PCT PIC S9V9(04) COMP-3. DTSBD720 00141 DTSBD720 00142 05 WRK-MRRA-ID PIC S9(03) COMP-3. DTSBD720 00143 DTSBD720 00144 05 WRK-RTE-YR-START-YRQ PIC S9(05) COMP-3. DTSBD720 00145 DTSBD720 00146 05 WRK-RTE-YR-END-YRQ PIC S9(05) COMP-3. DTSBD720 00147 DTSBD720 00148 05 WRK-RTE-YR-START-DATE PIC S9(09) COMP-3. DTSBD720 00149 DTSBD720 00150 05 WRK-RTE-YR-END-DATE PIC S9(09) COMP-3. DTSBD720 00151 DTSBD720 00152 05 WRK-PRIOR-RTE-YEAR-YRQ PIC S9(05) COMP-3. DTSBD720 00153 DTSBD720 00154 05 WRK-EXP-CUTOFF-DATE PIC S9(09) COMP-3. DTSBD720 00155 DTSBD720 00156 05 WRK-SUC-EARLIEST-LIAB-DATE PIC S9(09) COMP-3 CL**4 00157 VALUE +0. CL**4 00158 05 WRK-PRED-EARLIEST-LIAB-DATE PIC S9(09) COMP-3 DTSBD720 00159 VALUE +999999999. DTSBD720 00160 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 DTSBD720 00161 VALUE +999999999. DTSBD720 00162 05 WRK-SUC-PRIOR-EARLIEST-LIAB PIC S9(09) COMP-3 CL**4 00163 VALUE +0. CL**4 00164 DTSBD720 00165 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD720 00166 DTSBD720 00167 05 XFER-BENEFITS-AMT PIC S9(09)V99 COMP-3. DTSBD720 00168 05 XFER-UI-TAX-AMT PIC S9(09)V99 COMP-3. DTSBD720 00169 05 XFER-PRIOR-RESERVE PIC S9(09)V99 COMP-3. DTSBD720 00170 05 TOT-XFER-BENEFITS-AMT PIC S9(09)V99 COMP-3. DTSBD720 00171 05 TOT-XFER-UI-TAX-AMT PIC S9(09)V99 COMP-3. DTSBD720 00172 05 TOT-XFER-PRIOR-RESERVE PIC S9(09)V99 COMP-3. DTSBD720 00173 DTSBD720 00174 05 XW-SUB PIC S9(04) COMP. DTSBD720 00175 05 XFER-WAGE-AREA OCCURS 3 TIMES. DTSBD720 00176 10 XFER-TOT-WAGE PIC S9(11)V99 COMP-3. DTSBD720 00177 10 XFER-TAX-WAGE PIC S9(11)V99 COMP-3. DTSBD720 00178 10 TOT-XFER-TOT-WAGE PIC S9(11)V99 COMP-3. DTSBD720 00179 10 TOT-XFER-TAX-WAGE PIC S9(11)V99 COMP-3. DTSBD720 00180 DTSBD720 00181 * 05 WRK-BENEFIT-CHARGE PIC S9(09)V99 COMP-3. DTSBD720 00182 * 05 WRK-CHG-EMP PIC S9(07) COMP-3. DTSBD720 00183 * 05 WRK-CHG-TYPE PIC 9(01). DTSBD720 00184 * 88 WRK-TYPE-ORIG-88 VALUE 1. DTSBD720 00185 * 88 WRK-TYPE-PRED-88 VALUE 2. DTSBD720 00186 * 88 WRK-TYPE-SUCC-88 VALUE 3. DTSBD720 00187 DTSBD720 00188 05 WRK-CHG-REL-DT PIC S9(09) COMP-3. DTSBD720 00189 DTSBD720 00190 05 RCT-REC-DELETE-CNT PIC S9(07) COMP-3 DTSBD720 00191 VALUE +0. DTSBD720 00192 05 RCT-LIAB-DT-CHNG-CNT PIC S9(07) COMP-3 DTSBD720 00193 VALUE +0. DTSBD720 00194 05 RRA-REC-WRITE-CNT PIC S9(07) COMP-3 DTSBD720 00195 VALUE +0. DTSBD720 00196 DTSBD720 00197 05 WRK-PCT PIC S9(03)V99 COMP-3. DTSBD720 00198 05 WRK-PCT-DISP PIC --9.99. DTSBD720 00199 DTSBD720 00200 05 WRK-DATA-TO-TRANSFER-IND PIC X(01). DTSBD720 00201 88 WRK-DATA-TO-TRANSFER-NO-88 VALUE 'N'. DTSBD720 00202 88 WRK-DATA-TO-TRANSFER-YES-88 VALUE 'Y'. DTSBD720 00203 DTSBD720 00204 DTSBD720 00205 05 WRK-LIAB-IN-RTE-YR-IND PIC X(01). DTSBD720 00206 88 WRK-LIAB-IN-RTE-YR-NO-88 VALUE 'N'. DTSBD720 00207 88 WRK-LIAB-IN-RTE-YR-YES-88 VALUE 'Y'. DTSBD720 00208 DTSBD720 00209 05 WRK-PREDECESSOR-IND PIC X(01). DTSBD720 00210 88 WRK-PREDECESSOR-YES-88 VALUE 'Y'. DTSBD720 00211 88 WRK-PREDECESSOR-NO-88 VALUE 'N'. DTSBD720 00212 DTSBD720 00213 05 WRK-BYPASS-REC. DTSBD720 00214 10 BYPASS-PRED PIC 9(06). DTSBD720 00215 10 FILLER PIC X(01) VALUE ','. DTSBD720 00216 10 BYPASS-SUCC PIC 9(06). DTSBD720 00217 10 FILLER PIC X(01) VALUE ','. DTSBD720 00218 10 BYPASS-EFF-DT PIC X(10). DTSBD720 00219 10 FILLER PIC X(01) VALUE ','. DTSBD720 00220 10 BYPASS-MRCT-ESTB PIC X(10). DTSBD720 00221 10 FILLER PIC X(01) VALUE ','. DTSBD720 00222 10 BYPASS-MRCT-CHNG PIC X(10). DTSBD720 00223 DTSBD720 00224 05 WRK-DISPLAY-CNT-X PIC X(11). DTSBD720 00225 05 WRK-DISPLAY-CNT-9 REDEFINES WRK-DISPLAY-CNT-X DTSBD720 00226 PIC ZZZ,ZZZ,ZZ9. DTSBD720 00227 DTSBD720 00228 05 WRK-DISPLAY-AMT-X PIC X(17). DTSBD720 00229 05 WRK-DISPLAY-AMT-9 REDEFINES WRK-DISPLAY-AMT-X DTSBD720 00230 PIC ZZZZZ,ZZZ,ZZ9.99-. DTSBD720 00231 EJECT DTSBD720 00232 01 MSG-TABLE. DTSBD720 00233 05 MSG01-AREA. DTSBD720 00234 10 MSG01-MSG-IDENTIFIER PIC X(04) VALUE '2001'. DTSBD720 00235 10 MSG01-MSG-TEXT. DTSBD720 00236 15 FILLER PIC X(27) DTSBD720 00237 VALUE 'RATING SUCCESSOR EMPLOYER '. DTSBD720 00238 15 FILLER PIC X(40) DTSBD720 00239 VALUE ' NOT ON EMPLOYER MASTER FILE. EXPERIENC'. DTSBD720 00240 15 FILLER PIC X(20) DTSBD720 00241 VALUE 'E NOT TRANSFERRED '. DTSBD720 00242 DTSBD720 00243 05 MSG02-AREA. DTSBD720 00244 10 MSG02-MSG-IDENTIFIER PIC X(04) VALUE '2002'. DTSBD720 00245 10 MSG02-MSG-TEXT. DTSBD720 00246 15 FILLER PIC X(40) DTSBD720 00247 VALUE 'RATING PREDECESSOR EMPLOYER NOT ON MASTE'. DTSBD720 00248 15 FILLER PIC X(40) DTSBD720 00249 VALUE 'ER FILE. EXPERIENCE NOT TRANSFERRED '. DTSBD720 00250 DTSBD720 00251 05 MSG03-AREA. DTSBD720 00252 10 MSG03-MSG-IDENTIFIER PIC X(04) VALUE '2003'. DTSBD720 00253 10 MSG03-MSG-TEXT. DTSBD720 00254 15 FILLER PIC X(40) DTSBD720 00255 VALUE 'MORE THAN ONE RATING SUCCESSOR ENCOUNTER'. DTSBD720 00256 15 FILLER PIC X(40) DTSBD720 00257 VALUE 'ED - EXPERIENCE NOT TRANSFERRED TO SPECI'. DTSBD720 00258 15 FILLER PIC X(20) DTSBD720 00259 VALUE 'FIED SUCCESSOR. '. DTSBD720 00260 DTSBD720 00261 05 MSG04-AREA. DTSBD720 00262 10 MSG04-MSG-IDENTIFIER PIC X(04) VALUE '2004'. DTSBD720 00263 10 MSG04-MSG-TEXT. DTSBD720 00264 15 FILLER PIC X(40) DTSBD720 00265 VALUE 'RATING PREDECESSOR ACTIVE - EXPERIENCE N'. DTSBD720 00266 15 FILLER PIC X(40) DTSBD720 00267 VALUE 'OT TRANSFERRED. '. DTSBD720 00268 DTSBD720 00269 05 MSG05-AREA. DTSBD720 00270 10 MSG05-MSG-IDENTIFIER PIC X(04) VALUE '2005'. DTSBD720 00271 10 MSG05-MSG-TEXT. DTSBD720 00272 15 FILLER PIC X(40) DTSBD720 00273 VALUE 'EXPERIENCE TRANSFER STRING LOOPS BACK ON'. DTSBD720 00274 15 FILLER PIC X(40) DTSBD720 00275 VALUE ' ITSELF - EXPERIENCE NOT TRANSFERRED. '. DTSBD720 00276 DTSBD720 00277 05 MSG06-AREA. DTSBD720 00278 10 MSG06-MSG-IDENTIFIER PIC X(04) VALUE '2006'. DTSBD720 00279 10 MSG06-MSG-TEXT. DTSBD720 00280 15 FILLER PIC X(40) DTSBD720 00281 VALUE 'RATING SUCCESSOR IS NOT A "RATED" EMPLOY'. DTSBD720 00282 15 FILLER PIC X(40) DTSBD720 00283 VALUE 'ER - EXPERIENCE NOT TRANSFERRED. '. DTSBD720 00284 DTSBD720 00285 05 MSG07-AREA. DTSBD720 00286 10 MSG07-MSG-IDENTIFIER PIC X(04) VALUE '2007'. DTSBD720 00287 10 MSG07-MSG-TEXT. DTSBD720 00288 15 FILLER PIC X(40) DTSBD720 00289 VALUE 'NO MRCT RECORD OCCURRENCE ATTACHED TO SU'. DTSBD720 00290 15 FILLER PIC X(40) DTSBD720 00291 VALUE 'CCESSOR EMPLOYER - EXPERIENCE NOT TRANSF'. DTSBD720 00292 15 FILLER PIC X(20) DTSBD720 00293 VALUE 'ERRED. '. DTSBD720 00294 DTSBD720 00295 05 MSG08-AREA. DTSBD720 00296 10 MSG08-MSG-IDENTIFIER PIC X(04) VALUE '2008'. DTSBD720 00297 10 MSG08-MSG-TEXT. DTSBD720 00298 15 FILLER PIC X(40) DTSBD720 00299 VALUE 'MREL-PORTION-EXP-TRNSF NOT 100%. 100% T'. DTSBD720 00300 15 FILLER PIC X(40) DTSBD720 00301 VALUE 'RANSFER OF EXPERIENCE ASSUMED. '. DTSBD720 00302 DTSBD720 00303 05 MSG99-AREA. DTSBD720 00304 10 MSG99-MSG-IDENTIFIER PIC X(04) VALUE '2099'. DTSBD720 00305 10 MSG99-MSG-TEXT. DTSBD720 00306 15 FILLER PIC X(40) DTSBD720 00307 VALUE 'DESPITE BEING LOCKED AGAINST UPDATE, AN '. DTSBD720 00308 15 FILLER PIC X(40) DTSBD720 00309 VALUE 'ANNUAL RATING BATCH PROCESS UPDATED A MR'. DTSBD720 00310 15 FILLER PIC X(20) DTSBD720 00311 VALUE 'CT RECORD OCCURRENCE'. DTSBD720 00312 EJECT DTSBD720 00313 01 L910-LINK-AREA. DTSBD720 00314 ++INCLUDE DTSIL910 DTSBD720 00315 SKIP3 DTSBD720 00316 01 MSKL-REC. DTSBD720 00317 ++INCLUDE DTSIMSKL DTSBD720 00318 SKIP3 DTSBD720 00319 01 MHDR-REC. DTSBD720 00320 ++INCLUDE DTSIMHDR DTSBD720 00321 SKIP3 DTSBD720 00322 01 MPRF-REC. DTSBD720 00323 ++INCLUDE DTSIMPRF DTSBD720 00324 SKIP3 DTSBD720 00325 01 MRCT-REC. DTSBD720 00326 ++INCLUDE DTSIMRCT DTSBD720 00327 SKIP3 DTSBD720 00328 01 MREL-REC. DTSBD720 00329 ++INCLUDE DTSIMREL DTSBD720 00330 SKIP3 DTSBD720 00331 01 MSOL-REC. DTSBD720 00332 ++INCLUDE DTSIMSOL DTSBD720 00333 EJECT DTSBD720 00334 01 MRRA-REC. DTSBD720 00335 ++INCLUDE DTSIMRRA DTSBD720 00336 EJECT DTSBD720 00337 01 MRWA-REC. DTSBD720 00338 ++INCLUDE DTSIMRWA DTSBD720 00339 EJECT DTSBD720 00340 01 L921-LINK-AREA. DTSBD720 00341 ++INCLUDE DTSIL921 DTSBD720 00342 SKIP3 DTSBD720 00343 01 ISKL-REC. DTSBD720 00344 ++INCLUDE DTSIISKL DTSBD720 00345 SKIP3 DTSBD720 00346 01 IPES-REC. DTSBD720 00347 ++INCLUDE DTSIIPES DTSBD720 00348 EJECT DTSBD720 00349 01 L931-LINK-AREA. DTSBD720 00350 ++INCLUDE DTSIL931 DTSBD720 00351 SKIP3 DTSBD720 00352 01 FSKL-REC. DTSBD720 00353 ++INCLUDE DTSIFSKL DTSBD720 00354 SKIP3 DTSBD720 00355 01 FUIR-REC. DTSBD720 00356 ++INCLUDE DTSIFUIR DTSBD720 00357 EJECT DTSBD720 00358 01 R506-REC. DTSBD720 00359 ++INCLUDE DTSIR506 DTSBD720 00360 SKIP3 DTSBD720 00361 01 R507-REC. DTSBD720 00362 ++INCLUDE DTSIR507 DTSBD720 00363 EJECT DTSBD720 00364 01 L001-LINK-AREA. DTSBD720 00365 ++INCLUDE DTSIL001 DTSBD720 00366 SKIP3 DTSBD720 00367 01 L004-LINK-AREA. DTSBD720 00368 ++INCLUDE DTSIL004 DTSBD720 00369 SKIP3 DTSBD720 00370 01 L005-LINK-AREA. DTSBD720 00371 ++INCLUDE DTSIL005 DTSBD720 00372 SKIP3 DTSBD720 00373 01 L006-LINK-AREA. DTSBD720 00374 ++INCLUDE DTSIL006 DTSBD720 00375 SKIP3 DTSBD720 00376 01 L055-LINK-AREA. DTSBD720 00377 ++INCLUDE DTSIL055 DTSBD720 00378 EJECT DTSBD720 00379 01 MMAX-LITERALS. DTSBD720 00380 ++INCLUDE DTSIMMAX DTSBD720 00381 EJECT DTSBD720 00382 LINKAGE SECTION. DTSBD720 00383 SKIP3 DTSBD720 00384 01 PARM-AREA. DTSBD720 00385 05 PARM-LENGTH PIC S9(04) COMP. DTSBD720 00386 05 PARM-DATA. DTSBD720 00387 10 PARM-RTE-YR-START-YRQ-X DTSBD720 00388 PIC X(03). DTSBD720 00389 10 PARM-RTE-YR-START-YRQ DTSBD720 00390 REDEFINES PARM-RTE-YR-START-YRQ-X DTSBD720 00391 PIC 9(03). DTSBD720 00392 EJECT DTSBD720 00393 PROCEDURE DIVISION USING PARM-AREA. DTSBD720 00394 DTSBD720 00395 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD720 00396 DTSBD720 00397 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD720 00398 DTSBD720 00399 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD720 00400 DTSBD720 00401 MOVE +0 TO MSKL-EMP-NO. DTSBD720 00402 DTSBD720 00403 SET MSKL-PRF-88 TO TRUE. DTSBD720 00404 DTSBD720 00405 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD720 00406 DTSBD720 00407 PERFORM DTSBD720 00408 UNTIL L910-NO-REC-88 DTSBD720 00409 MOVE MSKL-REC TO MPRF-REC DTSBD720 00410 PERFORM P9000-CLEANUP-MRCT THRU P9000-EXIT DTSBD720 00411 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSBD720 00412 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD720 00413 END-PERFORM. DTSBD720 00414 DTSBD720 00415 DTSBD720 00416 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD720 00417 DTSBD720 00418 DTSBD720 00419 GOBACK. DTSBD720 00420 EJECT DTSBD720 00421 I0000-INITIATE. DTSBD720 00422 SET WRK-ERROR-NO-88 TO TRUE. DTSBD720 00423 DTSBD720 00424 PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBD720 00425 DTSBD720 00426 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD720 00427 DTSBD720 00428 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD720 00429 DTSBD720 00430 OPEN INPUT RELATIONSHIP-FILE. DTSBD720 00431 IF NOT REL-FILE-OK-88 DTSBD720 00432 DISPLAY 'REL FILE OPEN ERROR: ' REL-STATUS DTSBD720 00433 PERFORM S999-ABEND THRU S999-EXIT DTSBD720 00434 END-IF. DTSBD720 00435 DTSBD720 00436 OPEN INPUT CHARGE-FILE. DTSBD720 00437 IF NOT CHARGE-FILE-OK-88 DTSBD720 00438 DISPLAY 'INPUT CHARGE FILE OPEN ERROR: ' CHARGE-STATUS DTSBD720 00439 SET WRK-ERROR-YES-88 TO TRUE DTSBD720 00440 GO TO I0000-EXIT DTSBD720 00441 END-IF. DTSBD720 00442 DTSBD720 00443 OPEN OUTPUT BYPASS-FILE. DTSBD720 00444 IF NOT BYPASS-FILE-OK-88 DTSBD720 00445 DISPLAY 'BYPASS FILE OPEN ERROR: ' BYPASS-STATUS DTSBD720 00446 SET WRK-ERROR-YES-88 TO TRUE DTSBD720 00447 GO TO I0000-EXIT DTSBD720 00448 END-IF. DTSBD720 00449 DTSBD720 00450 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD720 00451 DTSBD720 00452 MOVE +0 TO MSKL-EMP-NO. DTSBD720 00453 DTSBD720 00454 SET MSKL-HDR-88 TO TRUE. DTSBD720 00455 DTSBD720 00456 PERFORM S910-READ THRU S910-EXIT. DTSBD720 00457 DTSBD720 00458 IF L910-NO-REC-88 DTSBD720 00459 MOVE 'MHDR RECORD IS MISSING' DTSBD720 00460 TO ABEND-MSG DTSBD720 00461 PERFORM S999-ABEND THRU S999-EXIT. DTSBD720 00462 DTSBD720 00463 MOVE MSKL-REC TO MHDR-REC. DTSBD720 00464 DTSBD720 00465 DTSBD720 00466 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DTSBD720 00467 DTSBD720 00468 DTSBD720 00469 PERFORM I2000-FIND-RATE-PERIOD THRU I2000-EXIT. DTSBD720 00470 DTSBD720 00471 DTSBD720 00472 PERFORM I3000-INITIALIZE-REC-CNTS THRU I3000-EXIT. DTSBD720 00473 DTSBD720 00474 DTSBD720 00475 MOVE LENGTH OF R506-REC TO R506-LENGTH. DTSBD720 00476 DTSBD720 00477 MOVE '506' TO R506-REC-TYPE. DTSBD720 00478 DTSBD720 00479 MOVE WRK-EXP-CUTOFF-DATE TO R506-EXP-CUTOFF-DATE. DTSBD720 00480 DTSBD720 00481 MOVE WRK-RTE-YR-START-YRQ TO R506-EFF-QTR. DTSBD720 00482 DTSBD720 00483 DTSBD720 00484 MOVE LENGTH OF R507-REC TO R507-LENGTH. DTSBD720 00485 DTSBD720 00486 MOVE '507' TO R507-REC-TYPE. DTSBD720 00487 DTSBD720 00488 MOVE WRK-EXP-CUTOFF-DATE TO R507-EXP-CUTOFF-DATE. DTSBD720 00489 DTSBD720 00490 MOVE WRK-RTE-YR-START-YRQ TO R507-EFF-QTR. DTSBD720 00491 DTSBD720 00492 DTSBD720 00493 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD720 00494 DTSBD720 00495 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. DTSBD720 00496 DTSBD720 00497 MOVE L005-DATE TO WRK-SYS-DATE. DTSBD720 00498 DTSBD720 00499 MOVE L005-TIME TO WRK-SYS-TIME. DTSBD720 00500 DTSBD720 00501 PERFORM I4000-INITIALIZE-REL-TBL THRU I4000-EXIT. DTSBD720 00502 DTSBD720 00503 READ RELATIONSHIP-FILE. DTSBD720 00504 DTSBD720 00505 IF REL-FILE-EOF-88 DTSBD720 00506 DISPLAY 'REL FILE EMPTY: ' REL-STATUS DTSBD720 00507 SET WRK-ERROR-YES-88 TO TRUE DTSBD720 00508 GO TO I0000-EXIT DTSBD720 00509 ELSE DTSBD720 00510 MOVE REL-EFF-DT TO WRK-CURR-EFF-DT DTSBD720 00511 MOVE REL-PRED TO WRK-CURR-PRED DTSBD720 00512 ADD +1 TO RT-LAST DTSBD720 00513 MOVE REL-REC TO REL-TABLE (RT-LAST) DTSBD720 00514 END-IF. DTSBD720 00515 DTSBD720 00516 I0000-EXIT. DTSBD720 00517 EXIT. DTSBD720 00518 EJECT DTSBD720 00519 I1000-PROCESS-PARMS. DTSBD720 00520 IF PARM-LENGTH = +3 DTSBD720 00521 NEXT SENTENCE DTSBD720 00522 ELSE DTSBD720 00523 MOVE 'PARM-LENGTH NOT EQUAL TO 3' DTSBD720 00524 TO ABEND-MSG DTSBD720 00525 PERFORM S999-ABEND THRU S999-EXIT. DTSBD720 00526 DTSBD720 00527 DTSBD720 00528 DISPLAY '***'. DTSBD720 00529 DTSBD720 00530 DISPLAY '*** ' DTSBD720 00531 WRK-MOD-NAME DTSBD720 00532 ' PARAMETERS: ' DTSBD720 00533 PARM-DATA. DTSBD720 00534 DTSBD720 00535 DISPLAY '***'. DTSBD720 00536 DTSBD720 00537 DTSBD720 00538 IF PARM-RTE-YR-START-YRQ-X = SPACES OR LOW-VALUES OR '000' DTSBD720 00539 PERFORM I1100-DEFAULT-START-YRQ THRU I1100-EXIT DTSBD720 00540 ELSE DTSBD720 00541 PERFORM I1200-EDIT-START-YRQ THRU I1200-EXIT. DTSBD720 00542 I1000-EXIT. DTSBD720 00543 EXIT. DTSBD720 00544 SKIP3 DTSBD720 00545 I1100-DEFAULT-START-YRQ. DTSBD720 00546 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSBD720 00547 DTSBD720 00548 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD720 00549 DTSBD720 00550 IF L004-INVALID-QTR DTSBD720 00551 MOVE 'LOGIC ERROR I1100-1' DTSBD720 00552 TO ABEND-MSG DTSBD720 00553 PERFORM S999-ABEND THRU S999-EXIT. DTSBD720 00554 DTSBD720 00555 DTSBD720 00556 ADD +1 TO L004-ABS-QTR. DTSBD720 00557 DTSBD720 00558 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD720 00559 DTSBD720 00560 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD720 00561 DTSBD720 00562 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD720 00563 DTSBD720 00564 IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ DTSBD720 00565 MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ DTSBD720 00566 MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ DTSBD720 00567 MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE DTSBD720 00568 MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE DTSBD720 00569 ELSE DTSBD720 00570 MOVE 'INVALID MHDR-LAST-RATE-YRQ ENCOUNTERED' DTSBD720 00571 TO ABEND-MSG DTSBD720 00572 PERFORM S999-ABEND THRU S999-EXIT. DTSBD720 00573 I1100-EXIT. DTSBD720 00574 EXIT. DTSBD720 00575 SKIP3 DTSBD720 00576 I1200-EDIT-START-YRQ. DTSBD720 00577 MOVE PARM-RTE-YR-START-YRQ-X TO L004-QTR-3. DTSBD720 00578 DTSBD720 00579 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD720 00580 DTSBD720 00581 IF L004-INVALID-QTR DTSBD720 00582 MOVE 'INVALID PARM-RTE-YR-START-YRQ-X ENCOUNTERED' DTSBD720 00583 TO ABEND-MSG DTSBD720 00584 PERFORM S999-ABEND THRU S999-EXIT. DTSBD720 00585 DTSBD720 00586 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD720 00587 DTSBD720 00588 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD720 00589 DTSBD720 00590 IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ DTSBD720 00591 MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ DTSBD720 00592 MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ DTSBD720 00593 MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE DTSBD720 00594 MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE DTSBD720 00595 ELSE DTSBD720 00596 MOVE 'PARM-RTE-YR-START-YRQ NOT FIRST QTR IN RATE YEAR' DTSBD720 00597 TO ABEND-MSG DTSBD720 00598 PERFORM S999-ABEND THRU S999-EXIT. DTSBD720 00599 I1200-EXIT. DTSBD720 00600 EXIT. DTSBD720 00601 SKIP3 DTSBD720 00602 I2000-FIND-RATE-PERIOD. DTSBD720 00603 MOVE WRK-RTE-YR-START-YRQ TO L055-EFF-YRQ. DTSBD720 00604 DTSBD720 00605 PERFORM S055-FROM-QTR THRU S055-EXIT. DTSBD720 00606 DTSBD720 00607 MOVE LOW-VALUES TO FUIR-KEY-AREA. DTSBD720 00608 DTSBD720 00609 SET FUIR-UIR-88 TO TRUE. DTSBD720 00610 DTSBD720 00611 MOVE WRK-RTE-YR-START-YRQ TO FUIR-EFF-YRQ. DTSBD720 00612 DTSBD720 00613 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBD720 00614 DTSBD720 00615 PERFORM S931-READ THRU S931-EXIT. DTSBD720 00616 DTSBD720 00617 IF L931-NO-REC-88 DTSBD720 00618 MOVE 'FUIR RECORD NOT FOUND' DTSBD720 00619 TO ABEND-MSG DTSBD720 00620 PERFORM S999-ABEND THRU S999-EXIT. DTSBD720 00621 DTSBD720 00622 MOVE FSKL-REC TO FUIR-REC. DTSBD720 00623 DTSBD720 00624 IF FUIR-RATE-CUTOFF-DATE = ZERO DTSBD720 00625 MOVE 'FUIR-RATE-CUTOFF-DATE EQUAL TO ZERO ENCOUNTERED' DTSBD720 00626 TO ABEND-MSG DTSBD720 00627 PERFORM S999-ABEND THRU S999-EXIT. DTSBD720 00628 DTSBD720 00629 MOVE FUIR-RATE-CUTOFF-DATE TO WRK-EXP-CUTOFF-DATE. DTSBD720 00630 DTSBD720 00631 MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9. DTSBD720 00632 SUBTRACT 1 FROM L004-QTR-5-YR. DTSBD720 00633 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD720 00634 MOVE L004-QTR-5-9 TO WRK-PRIOR-RTE-YEAR-YRQ. DTSBD720 00635 DISPLAY 'PRIOR RATE YR ' WRK-PRIOR-RTE-YEAR-YRQ. DTSBD720 00636 DTSBD720 00637 I2000-EXIT. DTSBD720 00638 EXIT. DTSBD720 00639 SKIP3 DTSBD720 00640 I3000-INITIALIZE-REC-CNTS. DTSBD720 00641 MOVE +0 TO RCT-REC-DELETE-CNT DTSBD720 00642 RRA-REC-WRITE-CNT. DTSBD720 00643 *& DTSBD720 00644 *** WRK-MPRF-CNT. DTSBD720 00645 *& DTSBD720 00646 I3000-EXIT. DTSBD720 00647 EXIT. DTSBD720 00648 DTSBD720 00649 I4000-INITIALIZE-REL-TBL. DTSBD720 00650 MOVE +0 TO RT-LAST. DTSBD720 00651 DTSBD720 00652 PERFORM DTSBD720 00653 VARYING RSUB FROM +1 BY +1 DTSBD720 00654 UNTIL RSUB > RT-MAX DTSBD720 00655 MOVE +0 TO RT-EFF-DATE (RSUB) DTSBD720 00656 RT-PRED (RSUB) DTSBD720 00657 RT-SUCC (RSUB) DTSBD720 00658 RT-PERCENT (RSUB) DTSBD720 00659 END-PERFORM. DTSBD720 00660 DTSBD720 00661 MOVE ZERO TO TOT-XFER-PRIOR-RESERVE DTSBD720 00662 TOT-XFER-UI-TAX-AMT. DTSBD720 00663 ** TOT-XFER-BENEFITS-AMT. DTSBD720 00664 DTSBD720 00665 PERFORM DTSBD720 00666 VARYING XW-SUB FROM +1 BY +1 DTSBD720 00667 UNTIL XW-SUB > +3 DTSBD720 00668 MOVE ZERO TO TOT-XFER-TOT-WAGE (XW-SUB) DTSBD720 00669 TOT-XFER-TAX-WAGE (XW-SUB) DTSBD720 00670 END-PERFORM. DTSBD720 00671 I4000-EXIT. DTSBD720 00672 EXIT. DTSBD720 00673 DTSBD720 00674 P0000-PROCESS. DTSBD720 00675 READ RELATIONSHIP-FILE. DTSBD720 00676 DTSBD720 00677 IF REL-FILE-EOF-88 DTSBD720 00678 PERFORM P0200-PROCESS-TABLE THRU P0200-EXIT DTSBD720 00679 GO TO P0000-EXIT DTSBD720 00680 ELSE DTSBD720 00681 PERFORM DTSBD720 00682 UNTIL REL-FILE-EOF-88 DTSBD720 00683 OR WRK-ERROR-YES-88 DTSBD720 00684 IF REL-EFF-DT = WRK-CURR-EFF-DT DTSBD720 00685 AND REL-PRED = WRK-CURR-PRED DTSBD720 00686 PERFORM P0100-ADD-TO-TABLE THRU P0100-EXIT DTSBD720 00687 ELSE DTSBD720 00688 PERFORM P0200-PROCESS-TABLE THRU P0200-EXIT DTSBD720 00689 END-IF DTSBD720 00690 READ RELATIONSHIP-FILE DTSBD720 00691 END-PERFORM DTSBD720 00692 END-IF. DTSBD720 00693 DTSBD720 00694 IF RT-LAST > +0 DTSBD720 00695 PERFORM P0200-PROCESS-TABLE THRU P0200-EXIT DTSBD720 00696 END-IF. DTSBD720 00697 DTSBD720 00698 P0000-EXIT. DTSBD720 00699 EXIT. DTSBD720 00700 DTSBD720 00701 P0100-ADD-TO-TABLE. DTSBD720 00702 ADD +1 TO RT-LAST. DTSBD720 00703 MOVE REL-REC TO REL-TABLE (RT-LAST). DTSBD720 00704 DTSBD720 00705 P0100-EXIT. DTSBD720 00706 EXIT. DTSBD720 00707 DTSBD720 00708 P0200-PROCESS-TABLE. DTSBD720 00709 PERFORM DTSBD720 00710 VARYING RSUB FROM +1 BY +1 DTSBD720 00711 UNTIL RSUB > RT-LAST DTSBD720 00712 MOVE RT-SUCC (RSUB) TO WRK-CURR-SUCC DTSBD720 00713 MOVE RT-PERCENT (RSUB) TO WRK-CURR-PCT DTSBD720 00714 PERFORM P1000-CHK-EMPLOYERS THRU P1000-EXIT DTSBD720 00715 IF WRK-TRANSFER-YES-88 DTSBD720 00716 PERFORM P2000-TRANSFER-EXP THRU P2000-EXIT DTSBD720 00717 ELSE DTSBD720 00718 PERFORM P4000-LIABILITY-DT THRU P4000-EXIT DTSBD720 00719 END-IF DTSBD720 00720 END-PERFORM. DTSBD720 00721 DTSBD720 00722 IF WRK-TRANSFER-YES-88 DTSBD720 00723 PERFORM P3000-UPD-PRED-MRCT THRU P3000-EXIT DTSBD720 00724 END-IF. DTSBD720 00725 DTSBD720 00726 PERFORM I4000-INITIALIZE-REL-TBL THRU I4000-EXIT. DTSBD720 00727 MOVE REL-EFF-DT TO WRK-CURR-EFF-DT. DTSBD720 00728 MOVE REL-PRED TO WRK-CURR-PRED. DTSBD720 00729 ADD +1 TO RT-LAST. DTSBD720 00730 MOVE REL-REC TO REL-TABLE (RT-LAST). DTSBD720 00731 MOVE WRK-ALL-NINES-DATE TO WRK-PRED-EARLIEST-LIAB-DATE.DTSBD720 00732 MOVE +0 TO WRK-SUC-PRIOR-EARLIEST-LIAB. CL**6 00733 DTSBD720 00734 P0200-EXIT. DTSBD720 00735 EXIT. DTSBD720 00736 DTSBD720 00737 P1000-CHK-EMPLOYERS. DTSBD720 00738 SET WRK-TRANSFER-YES-88 TO TRUE. DTSBD720 00739 MOVE ZERO TO XFER-PRIOR-RESERVE DTSBD720 00740 XFER-UI-TAX-AMT. DTSBD720 00741 ** XFER-BENEFITS-AMT. DTSBD720 00742 DTSBD720 00743 PERFORM DTSBD720 00744 VARYING XW-SUB FROM +1 BY +1 DTSBD720 00745 UNTIL XW-SUB > +3 DTSBD720 00746 MOVE ZERO TO XFER-TOT-WAGE (XW-SUB) DTSBD720 00747 XFER-TAX-WAGE (XW-SUB) DTSBD720 00748 END-PERFORM. DTSBD720 00749 DTSBD720 00750 PERFORM P1100-CHK-PREV-TRANSFER THRU P1100-EXIT CL**7 00751 PERFORM P1200-CHK-SUCCESSOR THRU P1200-EXIT CL**7 00752 * IF WRK-TRANSFER-YES-88 CL*11 00753 PERFORM P1300-CHK-PREDECESSOR THRU P1300-EXIT. CL*11 00754 * END-IF. CL*11 00755 CL**7 00756 *& 2203 CL**7 00757 * PERFORM P1100-CHK-PREV-TRANSFER THRU P1100-EXIT CL**7 00758 * IF WRK-TRANSFER-YES-88 CL**7 00759 * PERFORM P1200-CHK-SUCCESSOR THRU P1200-EXIT CL**7 00760 * IF WRK-TRANSFER-YES-88 CL**7 00761 * PERFORM P1300-CHK-PREDECESSOR THRU P1300-EXIT CL**7 00762 * END-IF CL**7 00763 * END-IF. CL**7 00764 *& CL**7 00765 DTSBD720 00766 P1000-EXIT. DTSBD720 00767 EXIT. DTSBD720 00768 DTSBD720 00769 P1100-CHK-PREV-TRANSFER. DTSBD720 00770 ************************************************************** DTSBD720 00771 * CHECK WHETHER THE RELATIONSHIP HAS ALREADY BEEN PROCESSED. DTSBD720 00772 * IF RELATIONSHIP WAS ESTABLISHED PRIOR TO 1/23/2007 DTSBD720 00773 * THE EXPERIENCE HAS ALREADY BEEN TRANSFERRED - BEFORE DTSBD720 00774 * THE IMPLEMENTATION OF PARTILAL EXPERIENCE TRANSFERS. DTSBD720 00775 * DTSBD720 00776 * IF THERE IS A MATCHING MRRA REC, THE EXPERIENCE HAS DTSBD720 00777 * ALREADY BEEN TRANSFERRED. DTSBD720 00778 ************************************************************** DTSBD720 00779 PERFORM P1110-MREL THRU P1110-EXIT. DTSBD720 00780 IF WRK-TRANSFER-YES-88 DTSBD720 00781 PERFORM P1120-MRRA THRU P1120-EXIT DTSBD720 00782 END-IF. DTSBD720 00783 DTSBD720 00784 P1100-EXIT. DTSBD720 00785 EXIT. DTSBD720 00786 DTSBD720 00787 P1110-MREL. DTSBD720 00788 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSBD720 00789 MOVE WRK-CURR-SUCC TO MREL-EMP-NO. DTSBD720 00790 SET MREL-REL-88 TO TRUE. DTSBD720 00791 MOVE WRK-CURR-EFF-DT TO MREL-EFF-DATE. DTSBD720 00792 MOVE WRK-CURR-PRED TO MREL-PRED-EMP-NO. DTSBD720 00793 DTSBD720 00794 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 00795 DTSBD720 00796 PERFORM S910-READ THRU S910-EXIT. DTSBD720 00797 IF L910-OK-88 DTSBD720 00798 MOVE MSKL-REC TO MREL-REC DTSBD720 00799 IF MREL-ESTB-DATE <= 20070123 DTSBD720 00800 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 00801 DISPLAY 'P1110 - EXP ALREADY TRANSFERD: ' MREL-EMP-NO CL*21 00802 END-IF DTSBD720 00803 ELSE DTSBD720 00804 DISPLAY 'CANNOT FIND MREL ' MREL-EMP-NO DTSBD720 00805 ' ' MREL-EFF-DATE ' ' MREL-PRED-EMP-NO DTSBD720 00806 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 00807 END-IF. DTSBD720 00808 DTSBD720 00809 P1110-EXIT. DTSBD720 00810 EXIT. DTSBD720 00811 DTSBD720 00812 P1120-MRRA. DTSBD720 00813 *& CHANGE FOR 2010 ONLY *** DTSBD720 00814 * IF MREL-ESTB-DATE > 20081211 DTSBD720 00815 * GO TO P1120-EXIT DTSBD720 00816 * END-IF. DTSBD720 00817 *& CHANGE FOR 2010 ONLY *** DTSBD720 00818 DTSBD720 00819 MOVE LOW-VALUES TO MRRA-KEY-AREA. DTSBD720 00820 MOVE WRK-CURR-PRED TO MRRA-EMP-NO. DTSBD720 00821 SET MRRA-RRA-88 TO TRUE. DTSBD720 00822 MOVE MRRA-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 00823 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD720 00824 IF L910-OK-88 DTSBD720 00825 PERFORM UNTIL L910-NO-REC-88 DTSBD720 00826 MOVE MSKL-REC TO MRRA-REC DTSBD720 00827 IF MRRA-REL-EFF-DATE = WRK-CURR-EFF-DT DTSBD720 00828 AND MRRA-SUCC-EMP-NO = WRK-CURR-SUCC DTSBD720 00829 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 00830 DISPLAY 'P1120 ALREADY TRANSFERRED ' CL*18 00831 WRK-CURR-PRED ' ' WRK-CURR-EFF-DT DTSBD720 00832 ' ' WRK-CURR-SUCC DTSBD720 00833 END-IF DTSBD720 00834 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD720 00835 END-PERFORM DTSBD720 00836 END-IF. DTSBD720 00837 DTSBD720 00838 P1120-EXIT. DTSBD720 00839 EXIT. DTSBD720 00840 DTSBD720 00841 P1200-CHK-SUCCESSOR. DTSBD720 00842 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBD720 00843 MOVE WRK-CURR-SUCC TO MPRF-EMP-NO. DTSBD720 00844 SET MPRF-PRF-88 TO TRUE. DTSBD720 00845 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 00846 DTSBD720 00847 PERFORM S910-READ THRU S910-EXIT. DTSBD720 00848 IF L910-OK-88 DTSBD720 00849 MOVE MSKL-REC TO MPRF-REC DTSBD720 00850 IF NOT MPRF-CLASS-RATED-88 DTSBD720 00851 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 00852 MOVE MSG06-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER DTSBD720 00853 MOVE WRK-CURR-SUCC TO R507-SUCC-EMP-NO DTSBD720 00854 MOVE WRK-CURR-PRED TO R507-PRED-EMP-NO DTSBD720 00855 MOVE MSG06-MSG-TEXT TO R507-MSG-TEXT DTSBD720 00856 PERFORM S1000-COMPLETE-R507 THRU S1000-EXIT DTSBD720 00857 GO TO P1200-EXIT DTSBD720 00858 END-IF DTSBD720 00859 ELSE DTSBD720 00860 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 00861 MOVE MSG01-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER DTSBD720 00862 MOVE WRK-CURR-SUCC TO R507-SUCC-EMP-NO DTSBD720 00863 MOVE WRK-CURR-PRED TO R507-PRED-EMP-NO DTSBD720 00864 MOVE MSG01-MSG-TEXT TO R507-MSG-TEXT DTSBD720 00865 PERFORM S1000-COMPLETE-R507 THRU S1000-EXIT DTSBD720 00866 GO TO P1200-EXIT DTSBD720 00867 END-IF. DTSBD720 00868 DTSBD720 00869 ******************************************************** DTSBD720 00870 * CHECK SUCCESSOR MRCT DTSBD720 00871 ******************************************************** DTSBD720 00872 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD720 00873 MOVE WRK-CURR-SUCC TO MRCT-EMP-NO. DTSBD720 00874 SET MRCT-RCT-88 TO TRUE. DTSBD720 00875 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD720 00876 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 00877 DTSBD720 00878 PERFORM S910-READ THRU S910-EXIT. DTSBD720 00879 IF L910-OK-88 DTSBD720 00880 NEXT SENTENCE DTSBD720 00881 ELSE DTSBD720 00882 DISPLAY 'P1200 SUCC -NO MRCT ' WRK-CURR-SUCC CL*22 00883 SET WRK-TRANSFER-NO-88 TO TRUE CL**9 00884 MOVE MSG01-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER DTSBD720 00885 MOVE WRK-CURR-SUCC TO R507-SUCC-EMP-NO DTSBD720 00886 MOVE WRK-CURR-PRED TO R507-PRED-EMP-NO DTSBD720 00887 MOVE MSG01-MSG-TEXT TO R507-MSG-TEXT DTSBD720 00888 PERFORM S1000-COMPLETE-R507 THRU S1000-EXIT DTSBD720 00889 GO TO P1200-EXIT DTSBD720 00890 END-IF. DTSBD720 00891 DTSBD720 00892 ******************************************************** DTSBD720 00893 * CHECK PRIOR RATE YEAR SUCCESSOR MRCT DTSBD720 00894 * DO NOT TRANSFER IF PRIOR YEAR MRCT WAS UPDATED MANUALLY. DTSBD720 00895 ******************************************************** DTSBD720 00896 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD720 00897 MOVE WRK-CURR-SUCC TO MRCT-EMP-NO. DTSBD720 00898 SET MRCT-RCT-88 TO TRUE. DTSBD720 00899 MOVE WRK-PRIOR-RTE-YEAR-YRQ TO MRCT-EFF-YRQ. DTSBD720 00900 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 00901 DTSBD720 00902 PERFORM S910-READ THRU S910-EXIT. DTSBD720 00903 IF L910-OK-88 DTSBD720 00904 MOVE MSKL-REC TO MRCT-REC DTSBD720 00905 *& 2203 CL**2 00906 MOVE MRCT-EARLIEST-LIAB-DATE TO CL**2 00907 WRK-SUC-PRIOR-EARLIEST-LIAB CL**2 00908 *& CL**2 00909 DISPLAY 'P1200 SUCC PRIOR EARLIEST LIAB DATE: ' CL*10 00910 WRK-CURR-SUCC ' ' WRK-SUC-PRIOR-EARLIEST-LIAB CL*10 00911 ' ' WRK-CURR-PRED CL*19 00912 * ' ' MRCT-ESTB-DATE ' ' MRCT-CHNG-DATE CL*18 00913 *& CL*10 00914 IF MRCT-CHNG-DATE > MRCT-ESTB-DATE DTSBD720 00915 PERFORM P1210-BYPASS THRU P1210-EXIT DTSBD720 00916 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 00917 DISPLAY 'P1200 SUCC -ALREADY TRANSFERRED ' CL*22 00918 WRK-CURR-SUCC ' ' WRK-CURR-EFF-DT CL*22 00919 ' ' WRK-CURR-PRED CL*22 00920 ' ' MRCT-ESTB-DATE ' ' MRCT-CHNG-DATE DTSBD720 00921 ELSE DTSBD720 00922 IF NOT MRCT-CHNG-SYSTEM-88 DTSBD720 00923 PERFORM P1210-BYPASS THRU P1210-EXIT DTSBD720 00924 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 00925 DISPLAY 'P1200 SUCC -CREATED BY STAFF ' CL*22 00926 WRK-CURR-SUCC ' ' WRK-CURR-EFF-DT CL*22 00927 ' ' WRK-CURR-PRED CL*22 00928 ' ' MRCT-ESTB-DATE ' ' MRCT-CHNG-DATE DTSBD720 00929 ' ' MRCT-CHNG-OP-ID DTSBD720 00930 END-IF DTSBD720 00931 END-IF CL*19 00932 ELSE CL*20 00933 DISPLAY 'P1200 SUCC PRIOR NOT FOUND ;;;;;;;;: ' CL*20 00934 WRK-CURR-SUCC ' ' CL*20 00935 END-IF. CL*19 00936 DTSBD720 00937 P1200-EXIT. DTSBD720 00938 EXIT. DTSBD720 00939 DTSBD720 00940 P1210-BYPASS. DTSBD720 00941 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 00942 DTSBD720 00943 DISPLAY 'P1200 TRANSFERRED MANUALLY ' DTSBD720 00944 WRK-CURR-SUCC ' ' WRK-CURR-PRED CL*22 00945 ' ' WRK-CURR-EFF-DT. DTSBD720 00946 DTSBD720 00947 MOVE WRK-CURR-PRED TO BYPASS-PRED. DTSBD720 00948 MOVE WRK-CURR-SUCC TO BYPASS-SUCC. DTSBD720 00949 DTSBD720 00950 MOVE WRK-CURR-EFF-DT TO L001-FED-8-DATE-9. DTSBD720 00951 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD720 00952 MOVE L001-SLASH-8-DATE TO BYPASS-EFF-DT. DTSBD720 00953 DTSBD720 00954 MOVE MRCT-ESTB-DATE TO L001-FED-8-DATE-9. DTSBD720 00955 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD720 00956 MOVE L001-SLASH-8-DATE TO BYPASS-MRCT-ESTB. DTSBD720 00957 DTSBD720 00958 MOVE MRCT-CHNG-DATE TO L001-FED-8-DATE-9. DTSBD720 00959 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD720 00960 MOVE L001-SLASH-8-DATE TO BYPASS-MRCT-CHNG. DTSBD720 00961 DTSBD720 00962 WRITE BYPASS-REC FROM WRK-BYPASS-REC. DTSBD720 00963 IF NOT BYPASS-FILE-OK-88 DTSBD720 00964 DISPLAY 'CANNOT WRITE BYPASS REC ' BYPASS-STATUS DTSBD720 00965 END-IF. DTSBD720 00966 DTSBD720 00967 P1210-EXIT. DTSBD720 00968 EXIT. DTSBD720 00969 DTSBD720 00970 P1300-CHK-PREDECESSOR. DTSBD720 00971 ******************************************************** DTSBD720 00972 * CHECK PREDECESSOR MPRF DTSBD720 00973 ******************************************************** DTSBD720 00974 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBD720 00975 MOVE WRK-CURR-PRED TO MPRF-EMP-NO. DTSBD720 00976 SET MPRF-PRF-88 TO TRUE. DTSBD720 00977 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 00978 DTSBD720 00979 PERFORM S910-READ THRU S910-EXIT. DTSBD720 00980 IF L910-OK-88 DTSBD720 00981 MOVE MSKL-REC TO MPRF-REC DTSBD720 00982 ELSE DTSBD720 00983 IF WRK-TRANSFER-YES-88 DTSBD720 00984 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 00985 MOVE MSG02-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER DTSBD720 00986 MOVE WRK-CURR-SUCC TO R507-SUCC-EMP-NO DTSBD720 00987 MOVE WRK-CURR-PRED TO R507-PRED-EMP-NO DTSBD720 00988 MOVE MSG02-MSG-TEXT TO R507-MSG-TEXT DTSBD720 00989 PERFORM S1000-COMPLETE-R507 THRU S1000-EXIT DTSBD720 00990 GO TO P1300-EXIT DTSBD720 00991 END-IF DTSBD720 00992 END-IF. DTSBD720 00993 DTSBD720 00994 ******************************************************** DTSBD720 00995 * GET PREDECESSOR MRCT DTSBD720 00996 ******************************************************** DTSBD720 00997 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD720 00998 MOVE WRK-CURR-PRED TO MRCT-EMP-NO. DTSBD720 00999 SET MRCT-RCT-88 TO TRUE. DTSBD720 01000 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD720 01001 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01002 DTSBD720 01003 PERFORM S910-READ THRU S910-EXIT. DTSBD720 01004 IF L910-OK-88 DTSBD720 01005 MOVE MSKL-REC TO MRCT-REC DTSBD720 01006 DISPLAY 'P1301 PRED MRCT EARLIEST LIAB DATE: ' CL*22 01007 WRK-CURR-PRED ' MRCT ' MRCT-EARLIEST-LIAB-DATE CL*22 01008 ' WORK ' WRK-PRED-EARLIEST-LIAB-DATE CL*22 01009 IF MRCT-EARLIEST-LIAB-DATE < DTSBD720 01010 WRK-PRED-EARLIEST-LIAB-DATE DTSBD720 01011 MOVE MRCT-EARLIEST-LIAB-DATE TO DTSBD720 01012 WRK-PRED-EARLIEST-LIAB-DATE DTSBD720 01013 END-IF DTSBD720 01014 ELSE DTSBD720 01015 IF WRK-TRANSFER-YES-88 DTSBD720 01016 SET WRK-TRANSFER-NO-88 TO TRUE DTSBD720 01017 MOVE MSG02-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER DTSBD720 01018 MOVE WRK-CURR-SUCC TO R507-SUCC-EMP-NO DTSBD720 01019 MOVE WRK-CURR-PRED TO R507-PRED-EMP-NO DTSBD720 01020 MOVE MSG02-MSG-TEXT TO R507-MSG-TEXT DTSBD720 01021 PERFORM S1000-COMPLETE-R507 THRU S1000-EXIT DTSBD720 01022 END-IF DTSBD720 01023 END-IF. DTSBD720 01024 CL*17 01025 DISPLAY 'P1302 PRED EARLIEST LIAB DATE: ' CL*22 01026 WRK-CURR-PRED ' ' WRK-PRED-EARLIEST-LIAB-DATE CL*17 01027 ' ' WRK-CURR-SUCC CL*17 01028 ' ' MRCT-ESTB-DATE ' ' MRCT-CHNG-DATE. CL*17 01029 *& CL*17 01030 DTSBD720 01031 P1300-EXIT. DTSBD720 01032 EXIT. DTSBD720 01033 DTSBD720 01034 P2000-TRANSFER-EXP. DTSBD720 01035 SET WRK-DATA-TO-TRANSFER-YES-88 TO TRUE. DTSBD720 01036 PERFORM P2100-GET-AMOUNTS THRU P2100-EXIT. DTSBD720 01037 IF WRK-DATA-TO-TRANSFER-YES-88 DTSBD720 01038 PERFORM P2200-UPD-PRED THRU P2200-EXIT DTSBD720 01039 PERFORM P2300-UPD-SUCC THRU P2300-EXIT DTSBD720 01040 PERFORM P2500-WRITE-R506 THRU P2500-EXIT DTSBD720 01041 ELSE CL**9 01042 PERFORM P5000-UPD-SUCC-ELD THRU P5000-EXIT CL**9 01043 DISPLAY 'P2000 NOTHING TO TRANSFER PRED ' CL**9 01044 WRK-CURR-PRED 'SUCC ' WRK-CURR-SUCC CL**9 01045 ' ' WRK-CURR-EFF-DT CL**9 01046 CL**9 01047 END-IF. DTSBD720 01048 DTSBD720 01049 P2000-EXIT. DTSBD720 01050 EXIT. DTSBD720 01051 DTSBD720 01052 P2100-GET-AMOUNTS. DTSBD720 01053 * MOVE ZERO TO XFER-PRIOR-RESERVE DTSBD720 01054 * XFER-UI-TAX-AMT. DTSBD720 01055 ** XFER-BENEFITS-AMT. DTSBD720 01056 * DTSBD720 01057 * PERFORM DTSBD720 01058 * VARYING XW-SUB FROM +1 BY +1 DTSBD720 01059 * UNTIL XW-SUB > +3 DTSBD720 01060 * MOVE ZERO TO XFER-TOT-WAGE (XW-SUB) DTSBD720 01061 * XFER-TAX-WAGE (XW-SUB) DTSBD720 01062 * END-PERFORM. DTSBD720 01063 DTSBD720 01064 ** MOVE WRK-CURR-PRED TO WRK-CHG-EMP. DTSBD720 01065 * SET WRK-TYPE-PRED-88 TO TRUE. DTSBD720 01066 * MOVE WRK-CURR-EFF-DT TO WRK-REL-EFF-DT. DTSBD720 01067 * PERFORM S2000-BENEFIT-CHARGE THRU S2000-EXIT. DTSBD720 01068 ** MOVE WRK-BENEFIT-CHARGE TO XFER-BENEFITS-AMT. DTSBD720 01069 DTSBD720 01070 COMPUTE XFER-PRIOR-RESERVE ROUNDED = DTSBD720 01071 (MRCT-PRIOR-RESERVE-AMT * WRK-CURR-PCT). DTSBD720 01072 COMPUTE XFER-UI-TAX-AMT ROUNDED = DTSBD720 01073 (MRCT-UI-TAX-PAID-AMT * WRK-CURR-PCT). DTSBD720 01074 ** COMPUTE XFER-BENEFITS-AMT ROUNDED = DTSBD720 01075 ** (MRCT-BENEFITS-CHARGED-AMT * WRK-CURR-PCT). DTSBD720 01076 DTSBD720 01077 ** IF MRCT-EMP-NO = 025207 OR 813049 DTSBD720 01078 * DISPLAY 'P2100 ' MRCT-EMP-NO DTSBD720 01079 * ' ' XFER-BENEFITS-AMT ' ' WRK-CURR-PCT DTSBD720 01080 * ' ' MRCT-BENEFITS-CHARGED-AMT DTSBD720 01081 ** END-IF. DTSBD720 01082 DTSBD720 01083 PERFORM DTSBD720 01084 VARYING MRCT-WAGES-IDX FROM 1 BY 1 DTSBD720 01085 UNTIL MRCT-WAGES-IDX > MMAX-RCT-EXP-MAX DTSBD720 01086 SET XW-SUB TO MRCT-WAGES-IDX DTSBD720 01087 COMPUTE XFER-TOT-WAGE (XW-SUB) = DTSBD720 01088 (MRCT-TOT-WAGE (MRCT-WAGES-IDX) * WRK-CURR-PCT) DTSBD720 01089 COMPUTE XFER-TAX-WAGE (XW-SUB) = DTSBD720 01090 (MRCT-TAX-WAGE (MRCT-WAGES-IDX) * WRK-CURR-PCT) DTSBD720 01091 END-PERFORM. DTSBD720 01092 DTSBD720 01093 IF XFER-PRIOR-RESERVE = ZERO DTSBD720 01094 AND XFER-UI-TAX-AMT = ZERO DTSBD720 01095 ** AND XFER-BENEFITS-AMT = ZERO DTSBD720 01096 AND XFER-TOT-WAGE (1) = ZERO DTSBD720 01097 AND XFER-TOT-WAGE (2) = ZERO DTSBD720 01098 AND XFER-TOT-WAGE (3) = ZERO DTSBD720 01099 SET WRK-DATA-TO-TRANSFER-NO-88 TO TRUE DTSBD720 01100 SET WRK-TRANSFER-NO-88 TO TRUE CL*13 01101 ELSE DTSBD720 01102 ADD XFER-UI-TAX-AMT TO TOT-XFER-UI-TAX-AMT DTSBD720 01103 ** ADD XFER-BENEFITS-AMT TO TOT-XFER-BENEFITS-AMT DTSBD720 01104 ADD XFER-TOT-WAGE (1) TO TOT-XFER-TOT-WAGE (1) DTSBD720 01105 ADD XFER-TOT-WAGE (2) TO TOT-XFER-TOT-WAGE (2) DTSBD720 01106 ADD XFER-TOT-WAGE (3) TO TOT-XFER-TOT-WAGE (3) DTSBD720 01107 ADD XFER-TAX-WAGE (1) TO TOT-XFER-TAX-WAGE (1) DTSBD720 01108 ADD XFER-TAX-WAGE (2) TO TOT-XFER-TAX-WAGE (2) DTSBD720 01109 ADD XFER-TAX-WAGE (3) TO TOT-XFER-TAX-WAGE (3) DTSBD720 01110 END-IF. DTSBD720 01111 DTSBD720 01112 * IF MRCT-EMP-NO = 025207 OR 813049 DTSBD720 01113 * DISPLAY 'P2100 - 2 ' MRCT-EMP-NO ' ' DTSBD720 01114 * XFER-BENEFITS-AMT ' ' TOT-XFER-BENEFITS-AMT DTSBD720 01115 * END-IF. DTSBD720 01116 * IF WRK-DATA-TO-TRANSFER-YES-88 DTSBD720 01117 * COMPUTE WRK-PCT = WRK-CURR-PCT * 100 DTSBD720 01118 * MOVE WRK-PCT TO WRK-PCT-DISP DTSBD720 01119 * DISPLAY 'P2100 PRED ' WRK-CURR-PRED DTSBD720 01120 * ' SUCC ' WRK-CURR-SUCC ' PCT ' WRK-PCT-DISP DTSBD720 01121 * END-IF. DTSBD720 01122 P2100-EXIT. DTSBD720 01123 EXIT. DTSBD720 01124 DTSBD720 01125 P2200-UPD-PRED. DTSBD720 01126 *** PERFORM P2210-UPDATE-MRCT THRU P2210-EXIT. DTSBD720 01127 DTSBD720 01128 PERFORM P2220-UPDATE-MRRA THRU P2220-EXIT. DTSBD720 01129 DTSBD720 01130 P2200-EXIT. DTSBD720 01131 EXIT. DTSBD720 01132 DTSBD720 01133 *P2210-UPDATE-MRCT. DTSBD720 01134 * SUBTRACT XFER-PRIOR-RESERVE DTSBD720 01135 * FROM MRCT-PRIOR-RESERVE-AMT. DTSBD720 01136 * DTSBD720 01137 * SUBTRACT XFER-UI-TAX-AMT DTSBD720 01138 * FROM MRCT-UI-TAX-PAID-AMT. DTSBD720 01139 * DTSBD720 01140 * SUBTRACT XFER-BENEFITS-AMT DTSBD720 01141 * FROM MRCT-BENEFITS-CHARGED-AMT. DTSBD720 01142 * DTSBD720 01143 * PERFORM DTSBD720 01144 * VARYING XW-SUB FROM +1 BY +1 DTSBD720 01145 * UNTIL XW-SUB > +3 DTSBD720 01146 * SUBTRACT XFER-TOT-WAGE (XW-SUB) DTSBD720 01147 * FROM MRCT-TOT-WAGE (XW-SUB) DTSBD720 01148 * SUBTRACT XFER-TAX-WAGE (XW-SUB) DTSBD720 01149 * FROM MRCT-TAX-WAGE (XW-SUB) DTSBD720 01150 * END-PERFORM. DTSBD720 01151 * DTSBD720 01152 * SET MRCT-CHNG-SYSTEM-88 TO TRUE. DTSBD720 01153 * DTSBD720 01154 * MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE. DTSBD720 01155 * DTSBD720 01156 * MOVE MRCT-REC TO MSKL-REC. DTSBD720 01157 * DTSBD720 01158 * PERFORM S910-REWRITE THRU S910-EXIT. DTSBD720 01159 * DTSBD720 01160 *P2210-EXIT. DTSBD720 01161 * EXIT. DTSBD720 01162 DTSBD720 01163 P2220-UPDATE-MRRA. DTSBD720 01164 MOVE WRK-CURR-PRED TO WRK-EMP-NO. DTSBD720 01165 PERFORM P2900-LAST-ID THRU P2900-EXIT. DTSBD720 01166 DTSBD720 01167 MOVE LOW-VALUES TO MRRA-REC. DTSBD720 01168 MOVE WRK-CURR-PRED TO MRRA-EMP-NO. DTSBD720 01169 SET MRRA-RRA-88 TO TRUE. DTSBD720 01170 MOVE WRK-RTE-YR-START-YRQ TO MRRA-RATE-EFF-YRQ. DTSBD720 01171 MOVE WRK-CURR-EFF-DT TO MRRA-REL-EFF-DATE. DTSBD720 01172 ADD +1 TO WRK-MRRA-ID. DTSBD720 01173 MOVE WRK-MRRA-ID TO MRRA-ID-NO. DTSBD720 01174 DTSBD720 01175 SET MRRA-SUB-FROM-PRED-88 TO TRUE. DTSBD720 01176 MOVE WRK-CURR-PRED TO MRRA-PRED-EMP-NO DTSBD720 01177 MOVE WRK-CURR-SUCC TO MRRA-SUCC-EMP-NO DTSBD720 01178 DTSBD720 01179 COMPUTE MRRA-PRIOR-RESERVE ROUNDED = DTSBD720 01180 (XFER-PRIOR-RESERVE * -1). DTSBD720 01181 DTSBD720 01182 COMPUTE MRRA-UI-TAX ROUNDED = DTSBD720 01183 (XFER-UI-TAX-AMT * -1). DTSBD720 01184 DTSBD720 01185 MOVE ZERO TO MRRA-BENEFITS. DTSBD720 01186 *& COMPUTE MRRA-BENEFITS ROUNDED = DTSBD720 01187 * (XFER-BENEFITS-AMT * -1). DTSBD720 01188 DTSBD720 01189 MOVE ZERO TO MRRA-INTEREST. DTSBD720 01190 DTSBD720 01191 PERFORM DTSBD720 01192 VARYING XW-SUB FROM +1 BY +1 DTSBD720 01193 UNTIL XW-SUB > +3 DTSBD720 01194 COMPUTE MRRA-TOT-WAGE (XW-SUB) = DTSBD720 01195 (XFER-TOT-WAGE (XW-SUB) * -1) DTSBD720 01196 COMPUTE MRRA-TAX-WAGE (XW-SUB) = DTSBD720 01197 (XFER-TAX-WAGE (XW-SUB) * -1) DTSBD720 01198 END-PERFORM. DTSBD720 01199 DTSBD720 01200 MOVE WRK-SYS-DATE TO MRRA-ESTB-DATE. DTSBD720 01201 DTSBD720 01202 MOVE MRRA-REC TO MSKL-REC. DTSBD720 01203 PERFORM S910-WRITE THRU S910-EXIT. DTSBD720 01204 ADD 1 TO RRA-REC-WRITE-CNT. DTSBD720 01205 DTSBD720 01206 P2220-EXIT. DTSBD720 01207 EXIT. DTSBD720 01208 DTSBD720 01209 P2300-UPD-SUCC. DTSBD720 01210 PERFORM P2310-READ-MPRF-MRCT THRU P2310-EXIT. DTSBD720 01211 DTSBD720 01212 PERFORM P2320-UPDATE-MRCT THRU P2320-EXIT. DTSBD720 01213 DTSBD720 01214 PERFORM P2330-UPDATE-MRRA THRU P2330-EXIT. DTSBD720 01215 DTSBD720 01216 P2300-EXIT. DTSBD720 01217 EXIT. DTSBD720 01218 DTSBD720 01219 P2310-READ-MPRF-MRCT. DTSBD720 01220 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBD720 01221 MOVE WRK-CURR-SUCC TO MPRF-EMP-NO. DTSBD720 01222 SET MPRF-PRF-88 TO TRUE. DTSBD720 01223 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01224 DTSBD720 01225 PERFORM S910-READ THRU S910-EXIT. DTSBD720 01226 IF L910-OK-88 DTSBD720 01227 MOVE MSKL-REC TO MPRF-REC DTSBD720 01228 ELSE DTSBD720 01229 MOVE 'P2310-01 UNEXPECTED NO REC FOUND ON MPRF READ ' DTSBD720 01230 TO ABEND-MSG DTSBD720 01231 PERFORM S999-ABEND THRU S999-EXIT DTSBD720 01232 END-IF. DTSBD720 01233 DTSBD720 01234 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD720 01235 MOVE WRK-CURR-SUCC TO MRCT-EMP-NO. DTSBD720 01236 SET MRCT-RCT-88 TO TRUE. DTSBD720 01237 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD720 01238 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01239 DTSBD720 01240 PERFORM S910-READ THRU S910-EXIT. DTSBD720 01241 IF L910-OK-88 DTSBD720 01242 MOVE MSKL-REC TO MRCT-REC DTSBD720 01243 MOVE MRCT-EARLIEST-LIAB-DATE DTSBD720 01244 TO WRK-SUC-EARLIEST-LIAB-DATE DTSBD720 01245 ELSE DTSBD720 01246 MOVE 'P2310-02 UNEXPECTED NO REC FOUND ON MRCT READ ' DTSBD720 01247 TO ABEND-MSG DTSBD720 01248 PERFORM S999-ABEND THRU S999-EXIT DTSBD720 01249 END-IF. DTSBD720 01250 DTSBD720 01251 P2310-EXIT. DTSBD720 01252 EXIT. DTSBD720 01253 DTSBD720 01254 P2320-UPDATE-MRCT. DTSBD720 01255 ADD XFER-PRIOR-RESERVE DTSBD720 01256 TO MRCT-PRIOR-RESERVE-AMT. DTSBD720 01257 DTSBD720 01258 ADD XFER-UI-TAX-AMT DTSBD720 01259 TO MRCT-UI-TAX-PAID-AMT. DTSBD720 01260 DTSBD720 01261 ** ADD XFER-BENEFITS-AMT DTSBD720 01262 ** TO MRCT-BENEFITS-CHARGED-AMT. DTSBD720 01263 DTSBD720 01264 * IF MRCT-EMP-NO = 025207 OR 813049 DTSBD720 01265 * DISPLAY 'P2320 ' MRCT-EMP-NO DTSBD720 01266 * ' ' MRCT-BENEFITS-CHARGED-AMT DTSBD720 01267 * END-IF. DTSBD720 01268 DTSBD720 01269 PERFORM DTSBD720 01270 VARYING XW-SUB FROM +1 BY +1 DTSBD720 01271 UNTIL XW-SUB > +3 DTSBD720 01272 ADD XFER-TOT-WAGE (XW-SUB) DTSBD720 01273 TO MRCT-TOT-WAGE (XW-SUB) DTSBD720 01274 ADD XFER-TAX-WAGE (XW-SUB) DTSBD720 01275 TO MRCT-TAX-WAGE (XW-SUB) DTSBD720 01276 END-PERFORM. DTSBD720 01277 DTSBD720 01278 IF MRCT-EARLIEST-LIAB-DATE > DTSBD720 01279 WRK-PRED-EARLIEST-LIAB-DATE DTSBD720 01280 MOVE WRK-PRED-EARLIEST-LIAB-DATE TO DTSBD720 01281 MRCT-EARLIEST-LIAB-DATE DTSBD720 01282 END-IF. DTSBD720 01283 DTSBD720 01284 SET MRCT-CHNG-SYSTEM-88 TO TRUE. DTSBD720 01285 DTSBD720 01286 MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE. DTSBD720 01287 DTSBD720 01288 MOVE MRCT-REC TO MSKL-REC. DTSBD720 01289 DTSBD720 01290 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD720 01291 DTSBD720 01292 P2320-EXIT. DTSBD720 01293 EXIT. DTSBD720 01294 DTSBD720 01295 P2330-UPDATE-MRRA. DTSBD720 01296 MOVE WRK-CURR-SUCC TO WRK-EMP-NO. DTSBD720 01297 PERFORM P2900-LAST-ID THRU P2900-EXIT. DTSBD720 01298 DTSBD720 01299 MOVE LOW-VALUES TO MRRA-REC. DTSBD720 01300 MOVE WRK-CURR-SUCC TO MRRA-EMP-NO. DTSBD720 01301 SET MRRA-RRA-88 TO TRUE. DTSBD720 01302 MOVE WRK-RTE-YR-START-YRQ TO MRRA-RATE-EFF-YRQ. DTSBD720 01303 MOVE WRK-CURR-EFF-DT TO MRRA-REL-EFF-DATE. DTSBD720 01304 ADD +1 TO WRK-MRRA-ID. DTSBD720 01305 MOVE WRK-MRRA-ID TO MRRA-ID-NO. DTSBD720 01306 DTSBD720 01307 SET MRRA-SUB-FROM-PRED-88 TO TRUE. DTSBD720 01308 MOVE WRK-CURR-PRED TO MRRA-PRED-EMP-NO DTSBD720 01309 MOVE WRK-CURR-SUCC TO MRRA-SUCC-EMP-NO DTSBD720 01310 DTSBD720 01311 COMPUTE MRRA-PRIOR-RESERVE ROUNDED = DTSBD720 01312 XFER-PRIOR-RESERVE. DTSBD720 01313 DTSBD720 01314 COMPUTE MRRA-UI-TAX ROUNDED = DTSBD720 01315 XFER-UI-TAX-AMT. DTSBD720 01316 DTSBD720 01317 MOVE ZERO TO MRRA-BENEFITS. DTSBD720 01318 *& COMPUTE MRRA-BENEFITS ROUNDED = DTSBD720 01319 * XFER-BENEFITS-AMT. DTSBD720 01320 DTSBD720 01321 MOVE ZERO TO MRRA-INTEREST. DTSBD720 01322 DTSBD720 01323 PERFORM DTSBD720 01324 VARYING XW-SUB FROM +1 BY +1 DTSBD720 01325 UNTIL XW-SUB > +3 DTSBD720 01326 MOVE XFER-TOT-WAGE (XW-SUB) TO DTSBD720 01327 MRRA-TOT-WAGE (XW-SUB) DTSBD720 01328 MOVE XFER-TAX-WAGE (XW-SUB) TO DTSBD720 01329 MRRA-TAX-WAGE (XW-SUB) DTSBD720 01330 IF MRRA-EMP-NO = 010021 DTSBD720 01331 DISPLAY 'P2330 ' XFER-TOT-WAGE (XW-SUB) DTSBD720 01332 ' ' MRRA-TOT-WAGE (XW-SUB) DTSBD720 01333 END-IF DTSBD720 01334 END-PERFORM. DTSBD720 01335 DTSBD720 01336 MOVE MRRA-REC TO MSKL-REC. DTSBD720 01337 PERFORM S910-WRITE THRU S910-EXIT. DTSBD720 01338 ADD 1 TO RRA-REC-WRITE-CNT. DTSBD720 01339 DTSBD720 01340 P2330-EXIT. DTSBD720 01341 EXIT. DTSBD720 01342 DTSBD720 01343 P2500-WRITE-R506. DTSBD720 01344 PERFORM P2510-BENEFITS THRU P2510-EXIT. DTSBD720 01345 PERFORM P2520-R506 THRU P2520-EXIT. DTSBD720 01346 DTSBD720 01347 P2500-EXIT. DTSBD720 01348 EXIT. DTSBD720 01349 DTSBD720 01350 P2510-BENEFITS. DTSBD720 01351 MOVE ZERO TO XFER-BENEFITS-AMT. DTSBD720 01352 MOVE LOW-VALUES TO CHG5-SORT-KEY-AREA. DTSBD720 01353 MOVE WRK-CURR-SUCC TO CHG5-EMP-NO. DTSBD720 01354 DTSBD720 01355 START CHARGE-FILE DTSBD720 01356 KEY IS >= CHG5-SORT-KEY-AREA. DTSBD720 01357 DTSBD720 01358 IF NOT CHARGE-FILE-OK-88 DTSBD720 01359 GO TO P2510-EXIT DTSBD720 01360 ELSE DTSBD720 01361 READ CHARGE-FILE NEXT DTSBD720 01362 PERFORM DTSBD720 01363 UNTIL CHARGE-FILE-EOF-88 DTSBD720 01364 OR CHG5-EMP-NO NOT = WRK-CURR-SUCC DTSBD720 01365 OR WRK-ERROR-YES-88 DTSBD720 01366 IF CHG5-TYPE-SUCC-88 DTSBD720 01367 AND CHG5-PRED-EMP-NO = WRK-CURR-PRED DTSBD720 01368 AND CHG5-REL-EFF-DT = WRK-CURR-EFF-DT DTSBD720 01369 ADD CHG5-TOT-CHG-AMT TO XFER-BENEFITS-AMT DTSBD720 01370 IF CHG5-EMP-NO = 022752 OR 048450 OR DTSBD720 01371 025207 OR 813049 OR DTSBD720 01372 061615 OR 620538 DTSBD720 01373 MOVE CHG5-TOT-CHG-AMT TO DTSBD720 01374 WRK-DISPLAY-AMT-9 DTSBD720 01375 DISPLAY 'P2510 ' CHG5-EMP-NO DTSBD720 01376 ' ' CHG5-SSN ' ' CHG5-TYPE DTSBD720 01377 ' ' CHG5-PRED-EMP-NO DTSBD720 01378 ' ' CHG5-SUCC-EMP-NO DTSBD720 01379 ' ' WRK-DISPLAY-AMT-9 DTSBD720 01380 END-IF DTSBD720 01381 END-IF DTSBD720 01382 READ CHARGE-FILE NEXT DTSBD720 01383 END-PERFORM DTSBD720 01384 END-IF. DTSBD720 01385 DTSBD720 01386 P2510-EXIT. DTSBD720 01387 EXIT. DTSBD720 01388 DTSBD720 01389 *P2510-BENEFITS. DTSBD720 01390 * MOVE LOW-VALUES TO MRRA-REC. DTSBD720 01391 * MOVE WRK-CURR-SUCC TO MRRA-EMP-NO. DTSBD720 01392 * SET MRRA-RRA-88 TO TRUE. DTSBD720 01393 * MOVE WRK-RTE-YR-START-YRQ TO MRRA-RATE-EFF-YRQ. DTSBD720 01394 * MOVE MRRA-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01395 * PERFORM S910-START-BROWSE THRU S910-EXIT DTSBD720 01396 * IF L910-OK-88 DTSBD720 01397 * PERFORM UNTIL L910-NO-REC-88 DTSBD720 01398 * MOVE MSKL-REC TO MRRA-REC DTSBD720 01399 * IF MRRA-RATE-EFF-YRQ = WRK-RTE-YR-START-YRQ DTSBD720 01400 * IF MRRA-ADD-TO-SUCC-88 DTSBD720 01401 * IF MRRA-BENEFITS-88 DTSBD720 01402 * ADD MRRA-AMOUNT TO XFER-BENEFITS-AMT DTSBD720 01403 * END-IF DTSBD720 01404 * END-IF DTSBD720 01405 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD720 01406 * ELSE DTSBD720 01407 * SET L910-NO-REC-88 TO TRUE DTSBD720 01408 * END-IF DTSBD720 01409 * END-PERFORM DTSBD720 01410 * END-IF. DTSBD720 01411 * DTSBD720 01412 *P2510-EXIT. DTSBD720 01413 * EXIT. DTSBD720 01414 DTSBD720 01415 P2520-R506. DTSBD720 01416 MOVE WRK-CURR-SUCC TO R506-SUCC-EMP-NO. DTSBD720 01417 DTSBD720 01418 MOVE WRK-CURR-PRED TO R506-PRED-EMP-NO. DTSBD720 01419 DTSBD720 01420 MOVE WRK-CURR-EFF-DT TO R506-REL-EFF-DATE. DTSBD720 01421 DTSBD720 01422 MOVE XFER-PRIOR-RESERVE TO R506-PRIOR-RESERVE-AMT. DTSBD720 01423 DTSBD720 01424 MOVE XFER-UI-TAX-AMT TO R506-UI-TAX-PAID-AMT. DTSBD720 01425 DTSBD720 01426 ** MOVE MRCT-TRUST-FUND-INTEREST-AMT DTSBD720 01427 ** TO R506-TRUST-FUND-INTEREST-AMT. DTSBD720 01428 DTSBD720 01429 MOVE XFER-BENEFITS-AMT DTSBD720 01430 TO R506-BENEFITS-CHARGED-AMT. DTSBD720 01431 *& DTSBD720 01432 IF XFER-BENEFITS-AMT NOT = ZERO DTSBD720 01433 MOVE XFER-BENEFITS-AMT TO WRK-DISPLAY-AMT-9 DTSBD720 01434 DISPLAY 'BD720 BENEFITS SUCC ' R506-SUCC-EMP-NO DTSBD720 01435 ' PRED ' R506-PRED-EMP-NO DTSBD720 01436 ' ' WRK-DISPLAY-AMT-9 DTSBD720 01437 END-IF. DTSBD720 01438 *& DTSBD720 01439 PERFORM DTSBD720 01440 VARYING R506-WAGES-IDX FROM 1 BY 1 DTSBD720 01441 UNTIL R506-WAGES-IDX > MMAX-RCT-EXP-MAX DTSBD720 01442 SET L055-WAGES-IDX TO R506-WAGES-IDX DTSBD720 01443 MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX) DTSBD720 01444 TO R506-WAGES-FROM-YRQ (R506-WAGES-IDX) DTSBD720 01445 MOVE L055-WAGES-THRU-YRQ (L055-WAGES-IDX) DTSBD720 01446 TO R506-WAGES-THRU-YRQ (R506-WAGES-IDX) DTSBD720 01447 SET XW-SUB TO R506-WAGES-IDX DTSBD720 01448 MOVE XFER-TOT-WAGE (XW-SUB) DTSBD720 01449 TO R506-TOT-WAGE (R506-WAGES-IDX) DTSBD720 01450 MOVE XFER-TAX-WAGE (XW-SUB) DTSBD720 01451 TO R506-TAX-WAGE (R506-WAGES-IDX) DTSBD720 01452 END-PERFORM. DTSBD720 01453 DTSBD720 01454 MOVE MRCT-EARLIEST-LIAB-DATE DTSBD720 01455 TO R506-EARLIEST-LIAB-DATE. DTSBD720 01456 DTSBD720 01457 MOVE MRCT-MISS-RPT-CNT TO R506-MISS-RPT-CNT. DTSBD720 01458 DTSBD720 01459 MOVE MRCT-TOT-UI-TAX-BALANCE-AMT DTSBD720 01460 TO R506-TOT-UI-TAX-BALANCE-AMT. DTSBD720 01461 DTSBD720 01462 PERFORM S946-WRITE-R506 THRU S946-EXIT. DTSBD720 01463 DTSBD720 01464 P2520-EXIT. DTSBD720 01465 EXIT. DTSBD720 01466 DTSBD720 01467 P2900-LAST-ID. DTSBD720 01468 MOVE +0 TO WRK-MRRA-ID. DTSBD720 01469 DTSBD720 01470 MOVE LOW-VALUES TO MRRA-REC. DTSBD720 01471 MOVE WRK-EMP-NO TO MRRA-EMP-NO. DTSBD720 01472 SET MRRA-RRA-88 TO TRUE. DTSBD720 01473 MOVE WRK-RTE-YR-START-YRQ TO MRRA-RATE-EFF-YRQ. DTSBD720 01474 MOVE ZERO TO MRRA-REL-EFF-DATE. DTSBD720 01475 MOVE MRRA-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01476 DTSBD720 01477 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD720 01478 IF L910-OK-88 DTSBD720 01479 PERFORM DTSBD720 01480 UNTIL L910-NO-REC-88 DTSBD720 01481 MOVE MSKL-REC TO MRRA-REC DTSBD720 01482 IF MRRA-RATE-EFF-YRQ = WRK-RTE-YR-START-YRQ DTSBD720 01483 IF MRRA-REL-EFF-DATE = WRK-CURR-EFF-DT DTSBD720 01484 IF MRRA-ID-NO > WRK-MRRA-ID DTSBD720 01485 MOVE MRRA-ID-NO TO WRK-MRRA-ID DTSBD720 01486 END-IF DTSBD720 01487 END-IF DTSBD720 01488 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD720 01489 ELSE DTSBD720 01490 SET L910-NO-REC-88 TO TRUE DTSBD720 01491 END-IF DTSBD720 01492 END-PERFORM DTSBD720 01493 END-IF. DTSBD720 01494 DTSBD720 01495 P2900-EXIT. DTSBD720 01496 EXIT. DTSBD720 01497 DTSBD720 01498 P3000-UPD-PRED-MRCT. DTSBD720 01499 ******************************************************** DTSBD720 01500 * GET PREDECESSOR MRCT DTSBD720 01501 ******************************************************** DTSBD720 01502 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD720 01503 MOVE WRK-CURR-PRED TO MRCT-EMP-NO. DTSBD720 01504 SET MRCT-RCT-88 TO TRUE. DTSBD720 01505 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD720 01506 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01507 DTSBD720 01508 PERFORM S910-READ THRU S910-EXIT. DTSBD720 01509 IF L910-OK-88 DTSBD720 01510 MOVE MSKL-REC TO MRCT-REC DTSBD720 01511 ELSE DTSBD720 01512 GO TO P3000-EXIT DTSBD720 01513 END-IF. DTSBD720 01514 DTSBD720 01515 SUBTRACT TOT-XFER-PRIOR-RESERVE DTSBD720 01516 FROM MRCT-PRIOR-RESERVE-AMT. DTSBD720 01517 DTSBD720 01518 SUBTRACT TOT-XFER-UI-TAX-AMT DTSBD720 01519 FROM MRCT-UI-TAX-PAID-AMT. DTSBD720 01520 DTSBD720 01521 ** SUBTRACT TOT-XFER-BENEFITS-AMT DTSBD720 01522 ** FROM MRCT-BENEFITS-CHARGED-AMT. DTSBD720 01523 DTSBD720 01524 IF MRCT-EMP-NO = 025207 OR 813049 DTSBD720 01525 DISPLAY 'P3000 ' MRCT-EMP-NO DTSBD720 01526 ' ' MRCT-BENEFITS-CHARGED-AMT DTSBD720 01527 END-IF. DTSBD720 01528 DTSBD720 01529 PERFORM DTSBD720 01530 VARYING XW-SUB FROM +1 BY +1 DTSBD720 01531 UNTIL XW-SUB > +3 DTSBD720 01532 SUBTRACT TOT-XFER-TOT-WAGE (XW-SUB) DTSBD720 01533 FROM MRCT-TOT-WAGE (XW-SUB) DTSBD720 01534 SUBTRACT TOT-XFER-TAX-WAGE (XW-SUB) DTSBD720 01535 FROM MRCT-TAX-WAGE (XW-SUB) DTSBD720 01536 END-PERFORM. DTSBD720 01537 DTSBD720 01538 SET MRCT-CHNG-SYSTEM-88 TO TRUE. DTSBD720 01539 DTSBD720 01540 MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE. DTSBD720 01541 DTSBD720 01542 MOVE MRCT-REC TO MSKL-REC. DTSBD720 01543 DTSBD720 01544 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD720 01545 DTSBD720 01546 P3000-EXIT. DTSBD720 01547 EXIT. DTSBD720 01548 DTSBD720 01549 P4000-LIABILITY-DT. DTSBD720 01550 PERFORM P4100-READ-MPRF-MRCT THRU P4100-EXIT. DTSBD720 01551 DTSBD720 01552 IF MPRF-CLASS-RATED-88 DTSBD720 01553 PERFORM P4200-UPDATE-MRCT THRU P4200-EXIT DTSBD720 01554 ELSE CL*17 01555 DISPLAY 'P4000 NON RATED EMPLYR - CANNOT UPD MRCT DATE: ' CL*17 01556 WRK-CURR-SUCC ' ' MRCT-EARLIEST-LIAB-DATE CL*17 01557 END-IF. CL*17 01558 *& CL*17 01559 DTSBD720 01560 P4000-EXIT. DTSBD720 01561 EXIT. DTSBD720 01562 DTSBD720 01563 P4100-READ-MPRF-MRCT. DTSBD720 01564 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBD720 01565 MOVE WRK-CURR-SUCC TO MPRF-EMP-NO. DTSBD720 01566 SET MPRF-PRF-88 TO TRUE. DTSBD720 01567 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01568 DTSBD720 01569 PERFORM S910-READ THRU S910-EXIT. DTSBD720 01570 IF L910-OK-88 DTSBD720 01571 MOVE MSKL-REC TO MPRF-REC DTSBD720 01572 ELSE DTSBD720 01573 DISPLAY 'P4100-01 UNEXPECTED NO REC FOUND ON MPRF READ ' DTSBD720 01574 WRK-CURR-SUCC DTSBD720 01575 MOVE 'P4100-01 UNEXPECTED NO REC FOUND ON MPRF READ ' DTSBD720 01576 TO ABEND-MSG DTSBD720 01577 PERFORM S999-ABEND THRU S999-EXIT DTSBD720 01578 END-IF. DTSBD720 01579 DTSBD720 01580 IF NOT MPRF-CLASS-RATED-88 DTSBD720 01581 GO TO P4100-EXIT DTSBD720 01582 END-IF. DTSBD720 01583 DTSBD720 01584 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD720 01585 MOVE WRK-CURR-SUCC TO MRCT-EMP-NO. DTSBD720 01586 SET MRCT-RCT-88 TO TRUE. DTSBD720 01587 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. CL**2 01588 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01589 DTSBD720 01590 PERFORM S910-READ THRU S910-EXIT. DTSBD720 01591 IF L910-OK-88 DTSBD720 01592 MOVE MSKL-REC TO MRCT-REC DTSBD720 01593 MOVE MRCT-EARLIEST-LIAB-DATE DTSBD720 01594 TO WRK-SUC-EARLIEST-LIAB-DATE DTSBD720 01595 ELSE DTSBD720 01596 DISPLAY 'P4100-02 UNEXPECTED NO REC FOUND ON MRCT READ ' DTSBD720 01597 WRK-CURR-SUCC DTSBD720 01598 MOVE 'P4100-02 UNEXPECTED NO REC FOUND ON MRCT READ ' DTSBD720 01599 TO ABEND-MSG DTSBD720 01600 PERFORM S999-ABEND THRU S999-EXIT DTSBD720 01601 END-IF. DTSBD720 01602 DTSBD720 01603 P4100-EXIT. DTSBD720 01604 EXIT. DTSBD720 01605 DTSBD720 01606 P4200-UPDATE-MRCT. DTSBD720 01607 *& 2203 CL**2 01608 ** IF WRK-TRANSFER-YES-88 CL**7 01609 PERFORM P4210-PRED-DATE THRU P4210-EXIT. CL*10 01610 ** ELSE CL**7 01611 * IF WRK-SUC-PRIOR-EARLIEST-LIAB = ZERO CL*10 01612 * NEXT SENTENCE CL*10 01613 * ELSE CL*10 01614 * IF MRCT-EARLIEST-LIAB-DATE > CL*10 01615 * WRK-SUC-PRIOR-EARLIEST-LIAB CL*10 01616 * PERFORM P4220-SUC-PRIOR-DATE THRU P4220-EXIT CL*10 01617 * END-IF CL*10 01618 * END-IF. CL*10 01619 ** END-IF. CL**7 01620 DTSBD720 01621 P4200-EXIT. DTSBD720 01622 EXIT. DTSBD720 01623 DTSBD720 01624 P4210-PRED-DATE. CL**5 01625 IF MRCT-EARLIEST-LIAB-DATE > CL*12 01626 WRK-PRED-EARLIEST-LIAB-DATE CL*12 01627 MOVE WRK-PRED-EARLIEST-LIAB-DATE CL**5 01628 TO MRCT-EARLIEST-LIAB-DATE CL**5 01629 ELSE CL*14 01630 IF MRCT-EARLIEST-LIAB-DATE > CL*14 01631 WRK-SUC-PRIOR-EARLIEST-LIAB CL*14 01632 MOVE WRK-SUC-PRIOR-EARLIEST-LIAB CL*14 01633 TO MRCT-EARLIEST-LIAB-DATE CL*16 01634 END-IF. CL*16 01635 CL*23 01636 IF MRCT-EMP-NO = 333074 CL*23 01637 MOVE 20020101 TO MRCT-EARLIEST-LIAB-DATE CL*23 01638 ELSE CL*23 01639 IF MRCT-EMP-NO = 184590 CL*23 01640 MOVE 20140801 TO MRCT-EARLIEST-LIAB-DATE CL*23 01641 ELSE CL*23 01642 IF MRCT-EMP-NO = 070929 CL*23 01643 MOVE 19950101 TO MRCT-EARLIEST-LIAB-DATE CL*23 01644 ELSE CL*23 01645 IF MRCT-EMP-NO = 155262 CL*23 01646 MOVE 20030725 TO MRCT-EARLIEST-LIAB-DATE CL*23 01647 ELSE CL*23 01648 IF MRCT-EMP-NO = 172865 CL*23 01649 MOVE 20110701 TO MRCT-EARLIEST-LIAB-DATE CL*23 01650 ELSE CL*23 01651 IF MRCT-EMP-NO = 325355 CL*23 01652 MOVE 19881001 TO MRCT-EARLIEST-LIAB-DATE. CL*23 01653 CL*23 01654 IF MRCT-EMP-NO = 068108 CL*25 01655 MOVE 19981001 TO MRCT-EARLIEST-LIAB-DATE CL*27 01656 ELSE CL*25 01657 IF MRCT-EMP-NO = 164531 CL*25 01658 MOVE 20090831 TO MRCT-EARLIEST-LIAB-DATE CL*29 01659 ELSE CL*25 01660 IF MRCT-EMP-NO = 315668 CL*25 01661 MOVE 20210101 TO MRCT-EARLIEST-LIAB-DATE CL*27 01662 ELSE CL*25 01663 IF MRCT-EMP-NO = 338561 CL*25 01664 MOVE 20200101 TO MRCT-EARLIEST-LIAB-DATE CL*27 01665 ELSE CL*25 01666 IF MRCT-EMP-NO = 343946 CL*25 01667 MOVE 20210101 TO MRCT-EARLIEST-LIAB-DATE CL*26 01668 ELSE CL*25 01669 IF MRCT-EMP-NO = 347106 CL*25 01670 MOVE 20210101 TO MRCT-EARLIEST-LIAB-DATE. CL*32 01671 CL*32 01672 IF MRCT-EMP-NO = 350784 CL*25 01673 MOVE 20220701 TO MRCT-EARLIEST-LIAB-DATE CL*32 01674 ELSE CL*32 01675 IF MRCT-EMP-NO = 182665 CL*27 01676 MOVE 19970115 TO MRCT-EARLIEST-LIAB-DATE CL*31 01677 ELSE CL*31 01678 IF MRCT-EMP-NO = 086215 CL*31 01679 MOVE 19980101 TO MRCT-EARLIEST-LIAB-DATE CL*33 01680 ELSE CL*33 01681 IF MRCT-EMP-NO = 343956 CL*33 01682 MOVE 20160515 TO MRCT-EARLIEST-LIAB-DATE. CL*33 01683 CL*31 01684 CL*28 01685 IF MRCT-EARLIEST-LIAB-DATE = ZEROS CL*23 01686 MOVE WRK-SUC-PRIOR-EARLIEST-LIAB TO MRCT-EARLIEST-LIAB-DATE. CL*23 01687 CL*16 01688 SET MRCT-CHNG-SYSTEM-88 TO TRUE CL**5 01689 MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE CL**5 01690 MOVE MRCT-REC TO MSKL-REC CL**5 01691 PERFORM S910-REWRITE THRU S910-EXIT. CL*16 01692 CL*10 01693 DISPLAY 'P4210 EARLIEST LIAB DATE ' WRK-CURR-SUCC CL*10 01694 ' MRCT-SUCC: ' MRCT-EARLIEST-LIAB-DATE CL*10 01695 ' ' WRK-CURR-PRED CL*10 01696 ' MRCT-PRED: ' WRK-PRED-EARLIEST-LIAB-DATE CL*10 01697 ' SUCC-PRIO: ' WRK-SUC-PRIOR-EARLIEST-LIAB. CL*14 01698 CL*10 01699 IF MRCT-EMP-NO = 086215 OR 182665 CL*32 01700 DISPLAY ' MRCT ELD ' MRCT-EARLIEST-LIAB-DATE. CL*32 01701 CL*32 01702 CL**5 01703 P4210-EXIT. CL**5 01704 EXIT. CL**5 01705 CL**5 01706 P4220-SUC-PRIOR-DATE. CL**5 01707 DISPLAY 'P4200 ' WRK-CURR-SUCC CL**5 01708 ' ' WRK-CURR-PRED ' ' WRK-CURR-EFF-DT CL**5 01709 ' RCT ' MRCT-EARLIEST-LIAB-DATE CL**5 01710 ' PRIOR ' WRK-SUC-PRIOR-EARLIEST-LIAB. CL**5 01711 CL**5 01712 MOVE WRK-SUC-PRIOR-EARLIEST-LIAB CL**5 01713 TO MRCT-EARLIEST-LIAB-DATE. CL**5 01714 CL*34 01715 IF MRCT-EMP-NO = 086215 CL*34 01716 MOVE 19980101 TO MRCT-EARLIEST-LIAB-DATE. CL*34 01717 CL*34 01718 SET MRCT-CHNG-SYSTEM-88 TO TRUE. CL**5 01719 MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE. CL**5 01720 MOVE MRCT-REC TO MSKL-REC. CL**5 01721 PERFORM S910-REWRITE THRU S910-EXIT. CL**5 01722 CL**5 01723 P4220-EXIT. CL**5 01724 EXIT. CL**5 01725 CL**5 01726 CL**9 01727 P5000-UPD-SUCC-ELD. CL**9 01728 PERFORM P4100-READ-MPRF-MRCT THRU P4100-EXIT. CL**9 01729 CL**9 01730 IF MPRF-CLASS-RATED-88 CL**9 01731 PERFORM P4210-PRED-DATE THRU P4210-EXIT CL**9 01732 END-IF. CL**9 01733 CL**9 01734 P5000-EXIT. CL**9 01735 EXIT. CL**9 01736 CL**9 01737 DTSBD720 01738 P9000-CLEANUP-MRCT. DTSBD720 01739 *****IF (MPRF-EMP-NO < 360101) DTSBD720 01740 ************OR DTSBD720 01741 ********(MPRF-EMP-NO > 360126) DTSBD720 01742 *********GO TO P9000-EXIT DTSBD720 01743 DTSBD720 01744 DTSBD720 01745 IF MPRF-CLASS-RATED-88 DTSBD720 01746 NEXT SENTENCE DTSBD720 01747 ELSE DTSBD720 01748 GO TO P9000-EXIT. DTSBD720 01749 DTSBD720 01750 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD720 01751 DTSBD720 01752 MOVE MPRF-EMP-NO TO MRCT-EMP-NO. DTSBD720 01753 DTSBD720 01754 SET MRCT-RCT-88 TO TRUE. DTSBD720 01755 DTSBD720 01756 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD720 01757 DTSBD720 01758 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01759 DTSBD720 01760 PERFORM S910-READ THRU S910-EXIT. DTSBD720 01761 DTSBD720 01762 IF L910-NO-REC-88 DTSBD720 01763 GO TO P9000-EXIT. DTSBD720 01764 DTSBD720 01765 MOVE MSKL-REC TO MRCT-REC. DTSBD720 01766 DTSBD720 01767 SET WRK-PREDECESSOR-NO-88 TO TRUE. DTSBD720 01768 DTSBD720 01769 *** PERFORM P9100-CHECK-MRRA THRU P9100-EXIT. DTSBD720 01770 * DTSBD720 01771 * PERFORM P9200-CHECK-MRWA THRU P9200-EXIT. DTSBD720 01772 * DTSBD720 01773 * IF XFER-BENEFITS-AMT = ZERO DTSBD720 01774 * AND XFER-UI-TAX-AMT = ZERO DTSBD720 01775 * AND XFER-PRIOR-RESERVE = ZERO DTSBD720 01776 * AND XFER-TOT-WAGE (1) = ZERO DTSBD720 01777 * AND XFER-TAX-WAGE (1) = ZERO DTSBD720 01778 * AND XFER-TOT-WAGE (2) = ZERO DTSBD720 01779 * AND XFER-TAX-WAGE (2) = ZERO DTSBD720 01780 * AND XFER-TOT-WAGE (3) = ZERO DTSBD720 01781 * AND XFER-TAX-WAGE (3) = ZERO DTSBD720 01782 * GO TO P9000-EXIT DTSBD720 01783 * END-IF. DTSBD720 01784 DTSBD720 01785 SET WRK-LIAB-IN-RTE-YR-NO-88 TO TRUE. DTSBD720 01786 DTSBD720 01787 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD720 01788 DTSBD720 01789 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD720 01790 DTSBD720 01791 SET MSKL-SOL-88 TO TRUE. DTSBD720 01792 DTSBD720 01793 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD720 01794 DTSBD720 01795 PERFORM DTSBD720 01796 UNTIL L910-NO-REC-88 DTSBD720 01797 MOVE MSKL-REC TO MSOL-REC DTSBD720 01798 PERFORM P9300-CHECK-MSOL THRU P9300-EXIT DTSBD720 01799 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD720 01800 END-PERFORM. DTSBD720 01801 DTSBD720 01802 IF WRK-LIAB-IN-RTE-YR-YES-88 DTSBD720 01803 NEXT SENTENCE DTSBD720 01804 *** PERFORM P9400-UPDATE-MRCT THRU P9400-EXIT DTSBD720 01805 ELSE DTSBD720 01806 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA DTSBD720 01807 PERFORM S910-DELETE THRU S910-EXIT DTSBD720 01808 ADD +1 TO RCT-REC-DELETE-CNT DTSBD720 01809 *** PERFORM S9000-EMPLOYER-UPDATED THRU S9000-EXIT DTSBD720 01810 END-IF. DTSBD720 01811 DTSBD720 01812 P9000-EXIT. DTSBD720 01813 EXIT. DTSBD720 01814 SKIP3 DTSBD720 01815 *P9100-CHECK-MRRA. DTSBD720 01816 * MOVE ZERO TO XFER-PRIOR-RESERVE DTSBD720 01817 * XFER-UI-TAX-AMT DTSBD720 01818 * XFER-BENEFITS-AMT. DTSBD720 01819 * DTSBD720 01820 * MOVE LOW-VALUES TO MRRA-REC. DTSBD720 01821 * MOVE MRCT-EMP-NO TO MRRA-EMP-NO. DTSBD720 01822 * SET MRRA-RRA-88 TO TRUE. DTSBD720 01823 * MOVE WRK-RTE-YR-START-YRQ TO MRRA-RATE-EFF-YRQ. DTSBD720 01824 * MOVE MRRA-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01825 * PERFORM S910-START-BROWSE THRU S910-EXIT DTSBD720 01826 * IF L910-OK-88 DTSBD720 01827 * PERFORM UNTIL L910-NO-REC-88 DTSBD720 01828 * MOVE MSKL-REC TO MRRA-REC DTSBD720 01829 * IF MRRA-RATE-EFF-YRQ = WRK-RTE-YR-START-YRQ DTSBD720 01830 * IF NOT MRRA-ESTB-RESERVE-88 DTSBD720 01831 * PERFORM P9110-SUM-AMOUNTS THRU P9110-EXIT DTSBD720 01832 * END-IF DTSBD720 01833 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD720 01834 * ELSE DTSBD720 01835 * SET L910-NO-REC-88 TO TRUE DTSBD720 01836 * END-IF DTSBD720 01837 * END-PERFORM DTSBD720 01838 * END-IF. DTSBD720 01839 * DTSBD720 01840 *P9100-EXIT. DTSBD720 01841 * EXIT. DTSBD720 01842 * DTSBD720 01843 *P9110-SUM-AMOUNTS. DTSBD720 01844 * IF MRRA-SUB-FROM-PRED-88 DTSBD720 01845 * SET WRK-PREDECESSOR-YES-88 TO TRUE DTSBD720 01846 * END-IF. DTSBD720 01847 * DTSBD720 01848 * EVALUATE TRUE DTSBD720 01849 * WHEN MRRA-PRIOR-RESERVE-88 DTSBD720 01850 * ADD MRRA-AMOUNT TO XFER-PRIOR-RESERVE DTSBD720 01851 * DTSBD720 01852 * WHEN MRRA-UI-TAX-88 DTSBD720 01853 * ADD MRRA-AMOUNT TO XFER-UI-TAX-AMT DTSBD720 01854 * DTSBD720 01855 * WHEN MRRA-BENEFITS-88 DTSBD720 01856 * ADD MRRA-AMOUNT TO XFER-BENEFITS-AMT DTSBD720 01857 * DTSBD720 01858 * END-EVALUATE. DTSBD720 01859 * DTSBD720 01860 *P9110-EXIT. DTSBD720 01861 * EXIT. DTSBD720 01862 * DTSBD720 01863 *P9200-CHECK-MRWA. DTSBD720 01864 * PERFORM DTSBD720 01865 * VARYING XW-SUB FROM +1 BY +1 DTSBD720 01866 * UNTIL XW-SUB > +3 DTSBD720 01867 * MOVE ZERO TO XFER-TOT-WAGE (XW-SUB) DTSBD720 01868 * XFER-TAX-WAGE (XW-SUB) DTSBD720 01869 * END-PERFORM. DTSBD720 01870 * DTSBD720 01871 * MOVE LOW-VALUES TO MRWA-REC. DTSBD720 01872 * MOVE MRCT-EMP-NO TO MRWA-EMP-NO. DTSBD720 01873 * SET MRWA-RWA-88 TO TRUE. DTSBD720 01874 * MOVE WRK-RTE-YR-START-YRQ TO MRWA-RATE-EFF-YRQ. DTSBD720 01875 * MOVE MRWA-KEY-AREA TO MSKL-KEY-AREA. DTSBD720 01876 * PERFORM S910-START-BROWSE THRU S910-EXIT DTSBD720 01877 * IF L910-OK-88 DTSBD720 01878 * PERFORM UNTIL L910-NO-REC-88 DTSBD720 01879 * MOVE MSKL-REC TO MRWA-REC DTSBD720 01880 * IF MRWA-RATE-EFF-YRQ = WRK-RTE-YR-START-YRQ DTSBD720 01881 * IF NOT MRWA-ESTB-RESERVE-88 DTSBD720 01882 * PERFORM P9210-SUM-WAGES THRU P9210-EXIT DTSBD720 01883 * END-IF DTSBD720 01884 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD720 01885 * ELSE DTSBD720 01886 * SET L910-NO-REC-88 TO TRUE DTSBD720 01887 * END-IF DTSBD720 01888 * END-PERFORM DTSBD720 01889 * END-IF. DTSBD720 01890 * DTSBD720 01891 *P9200-EXIT. DTSBD720 01892 * EXIT. DTSBD720 01893 * DTSBD720 01894 *P9210-SUM-WAGES. DTSBD720 01895 * IF MRWA-TO-SUCC-88 DTSBD720 01896 * SET WRK-PREDECESSOR-YES-88 TO TRUE DTSBD720 01897 * END-IF. DTSBD720 01898 * DTSBD720 01899 * PERFORM DTSBD720 01900 * VARYING XW-SUB FROM +1 BY +1 DTSBD720 01901 * UNTIL XW-SUB > +3 DTSBD720 01902 * ADD MRWA-TOT-WAGE (XW-SUB) DTSBD720 01903 * TO XFER-TOT-WAGE (XW-SUB) DTSBD720 01904 * ADD MRWA-TAX-WAGE (XW-SUB) DTSBD720 01905 * TO XFER-TAX-WAGE (XW-SUB) DTSBD720 01906 * END-PERFORM. DTSBD720 01907 * DTSBD720 01908 *P9210-EXIT. DTSBD720 01909 * EXIT. DTSBD720 01910 DTSBD720 01911 P9300-CHECK-MSOL. DTSBD720 01912 IF MSOL-INACT-WITHDRAWN-88 DTSBD720 01913 GO TO P9300-EXIT. DTSBD720 01914 DTSBD720 01915 IF MSOL-FIRST-LIAB-YRQ > WRK-RTE-YR-END-YRQ DTSBD720 01916 GO TO P9300-EXIT. DTSBD720 01917 DTSBD720 01918 IF MSOL-LAST-LIAB-YRQ < WRK-RTE-YR-START-YRQ DTSBD720 01919 GO TO P9300-EXIT. DTSBD720 01920 DTSBD720 01921 SET WRK-LIAB-IN-RTE-YR-YES-88 TO TRUE. DTSBD720 01922 P9300-EXIT. DTSBD720 01923 EXIT. DTSBD720 01924 DTSBD720 01925 *P9400-UPDATE-MRCT. DTSBD720 01926 * ADD XFER-PRIOR-RESERVE TO MRCT-PRIOR-RESERVE-AMT. DTSBD720 01927 * ADD XFER-UI-TAX-AMT TO MRCT-UI-TAX-PAID-AMT. DTSBD720 01928 * ADD XFER-BENEFITS-AMT TO MRCT-BENEFITS-CHARGED-AMT. DTSBD720 01929 * DTSBD720 01930 * PERFORM DTSBD720 01931 * VARYING XW-SUB FROM +1 BY +1 DTSBD720 01932 * UNTIL XW-SUB > +3 DTSBD720 01933 * ADD XFER-TOT-WAGE (XW-SUB) DTSBD720 01934 * TO MRCT-TOT-WAGE (XW-SUB) DTSBD720 01935 * ADD XFER-TAX-WAGE (XW-SUB) DTSBD720 01936 * TO MRCT-TAX-WAGE (XW-SUB) DTSBD720 01937 * END-PERFORM. DTSBD720 01938 * DTSBD720 01939 * SET MRCT-CHNG-SYSTEM-88 TO TRUE. DTSBD720 01940 * DTSBD720 01941 * MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE. DTSBD720 01942 * DTSBD720 01943 * MOVE MRCT-REC TO MSKL-REC. DTSBD720 01944 * DTSBD720 01945 * PERFORM S910-REWRITE THRU S910-EXIT. DTSBD720 01946 * DTSBD720 01947 * PERFORM S9000-EMPLOYER-UPDATED THRU S9000-EXIT. DTSBD720 01948 * DTSBD720 01949 *P9400-EXIT. DTSBD720 01950 * EXIT. DTSBD720 01951 * DTSBD720 01952 DTSBD720 01953 T0000-TERMINATE. DTSBD720 01954 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD720 01955 DTSBD720 01956 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD720 01957 DTSBD720 01958 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD720 01959 DTSBD720 01960 MOVE -1 TO R506-LENGTH. DTSBD720 01961 DTSBD720 01962 PERFORM S946-WRITE-R506 THRU S946-EXIT. DTSBD720 01963 DTSBD720 01964 CLOSE RELATIONSHIP-FILE DTSBD720 01965 CHARGE-FILE DTSBD720 01966 BYPASS-FILE. DTSBD720 01967 DTSBD720 01968 DISPLAY '***'. DTSBD720 01969 DTSBD720 01970 DISPLAY '*** ' DTSBD720 01971 WRK-MOD-NAME DTSBD720 01972 ' TERMINATION DISPLAYS'. DTSBD720 01973 DTSBD720 01974 DTSBD720 01975 MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9. DTSBD720 01976 DTSBD720 01977 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD720 01978 DTSBD720 01979 DISPLAY '*** RATE YEAR START QUARTER: ' DTSBD720 01980 L004-SLASH-5-QTR. DTSBD720 01981 DTSBD720 01982 DTSBD720 01983 DISPLAY '***'. DTSBD720 01984 DTSBD720 01985 MOVE WRK-RTE-YR-END-YRQ TO L004-QTR-5-9. DTSBD720 01986 DTSBD720 01987 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD720 01988 DTSBD720 01989 DISPLAY '*** RATE YEAR END QUARTER: ' DTSBD720 01990 L004-SLASH-5-QTR. DTSBD720 01991 DTSBD720 01992 DTSBD720 01993 DISPLAY '***'. DTSBD720 01994 DTSBD720 01995 MOVE WRK-RTE-YR-START-DATE TO L001-FED-8-DATE-9. DTSBD720 01996 DTSBD720 01997 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD720 01998 DTSBD720 01999 DISPLAY '*** RATE YEAR START DATE: ' DTSBD720 02000 L001-SLASH-8-DATE. DTSBD720 02001 DTSBD720 02002 DTSBD720 02003 DISPLAY '***'. DTSBD720 02004 DTSBD720 02005 MOVE WRK-RTE-YR-END-DATE TO L001-FED-8-DATE-9. DTSBD720 02006 DTSBD720 02007 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD720 02008 DTSBD720 02009 DISPLAY '*** RATE YEAR END DATE: ' DTSBD720 02010 L001-SLASH-8-DATE. DTSBD720 02011 DTSBD720 02012 DTSBD720 02013 DISPLAY '***'. DTSBD720 02014 DTSBD720 02015 MOVE WRK-EXP-CUTOFF-DATE TO L001-FED-8-DATE-9. DTSBD720 02016 DTSBD720 02017 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD720 02018 DTSBD720 02019 DISPLAY '*** RATING EXPERIENCE CUTOFF DATE: ' DTSBD720 02020 L001-SLASH-8-DATE. DTSBD720 02021 DTSBD720 02022 DTSBD720 02023 DISPLAY '***'. DTSBD720 02024 DTSBD720 02025 MOVE RCT-REC-DELETE-CNT TO WRK-DISPLAY-CNT-9. DTSBD720 02026 DTSBD720 02027 DISPLAY '*** NUMBER OF MRCT RECORDS DELETED: ' DTSBD720 02028 WRK-DISPLAY-CNT-X. DTSBD720 02029 DTSBD720 02030 DISPLAY '***'. DTSBD720 02031 DTSBD720 02032 MOVE RRA-REC-WRITE-CNT TO WRK-DISPLAY-CNT-9. DTSBD720 02033 DTSBD720 02034 DISPLAY '*** NUMBER OF MRRA RECORDS WRITTEN: ' DTSBD720 02035 WRK-DISPLAY-CNT-X. DTSBD720 02036 DTSBD720 02037 DTSBD720 02038 DISPLAY '***'. DTSBD720 02039 DTSBD720 02040 T0000-EXIT. DTSBD720 02041 EXIT. DTSBD720 02042 EJECT DTSBD720 02043 S1000-COMPLETE-R507. DTSBD720 02044 IF R507-SUCC-EMP-NO = +0 DTSBD720 02045 MOVE SPACES TO R507-SUCC-PRIMARY-NAME DTSBD720 02046 ELSE DTSBD720 02047 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSBD720 02048 MOVE R507-SUCC-EMP-NO TO MSKL-EMP-NO DTSBD720 02049 SET MSKL-PRF-88 TO TRUE DTSBD720 02050 PERFORM S910-READ THRU S910-EXIT DTSBD720 02051 IF L910-NO-REC-88 DTSBD720 02052 MOVE 'NOT FOUND ON EMPLOYER MASTER FILE' DTSBD720 02053 TO R507-SUCC-PRIMARY-NAME DTSBD720 02054 ELSE DTSBD720 02055 MOVE MSKL-REC TO MPRF-REC DTSBD720 02056 MOVE MPRF-PRIMARY-NAME TO R507-SUCC-PRIMARY-NAME. DTSBD720 02057 DTSBD720 02058 IF R507-PRED-EMP-NO = +0 DTSBD720 02059 MOVE SPACES TO R507-PRED-PRIMARY-NAME DTSBD720 02060 ELSE DTSBD720 02061 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSBD720 02062 MOVE R507-PRED-EMP-NO TO MSKL-EMP-NO DTSBD720 02063 SET MSKL-PRF-88 TO TRUE DTSBD720 02064 PERFORM S910-READ THRU S910-EXIT DTSBD720 02065 IF L910-NO-REC-88 DTSBD720 02066 MOVE 'NOT FOUND ON EMPLOYER MASTER FILE' DTSBD720 02067 TO R507-PRED-PRIMARY-NAME DTSBD720 02068 ELSE DTSBD720 02069 MOVE MSKL-REC TO MPRF-REC DTSBD720 02070 MOVE MPRF-PRIMARY-NAME TO R507-PRED-PRIMARY-NAME. DTSBD720 02071 DTSBD720 02072 PERFORM S946-WRITE-R507 THRU S946-EXIT. DTSBD720 02073 S1000-EXIT. DTSBD720 02074 EXIT. DTSBD720 02075 DTSBD720 02076 S9000-EMPLOYER-UPDATED. DTSBD720 02077 IF MPRF-UPDATE-ACTIVE-88 DTSBD720 02078 MOVE MSG99-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER DTSBD720 02079 MOVE MPRF-EMP-NO TO R507-SUCC-EMP-NO DTSBD720 02080 MOVE MPRF-PRIMARY-NAME TO R507-SUCC-PRIMARY-NAME DTSBD720 02081 MOVE +0 TO R507-PRED-EMP-NO DTSBD720 02082 MOVE SPACES TO R507-PRED-PRIMARY-NAME DTSBD720 02083 MOVE MSG99-MSG-TEXT TO R507-MSG-TEXT DTSBD720 02084 PERFORM S946-WRITE-R507 THRU S946-EXIT DTSBD720 02085 ELSE DTSBD720 02086 MOVE WRK-SYS-ABSTIME TO MPRF-UPDATE-END-ABSTIME DTSBD720 02087 MOVE +0 TO MPRF-UPDATE-TASK-ID DTSBD720 02088 MOVE 'BATCH' TO MPRF-UPDATE-OP-ID DTSBD720 02089 MOVE SPACES TO MPRF-UPDATE-TERMID DTSBD720 02090 MPRF-UPDATE-NETNAME DTSBD720 02091 MOVE WRK-SYS-DATE TO MPRF-UPDATE-START-DATE DTSBD720 02092 MOVE WRK-SYS-TIME TO MPRF-UPDATE-START-TIME DTSBD720 02093 MOVE SPACES TO MPRF-UPDATE-SCR-ID DTSBD720 02094 MPRF-UPDATE-FUNCTION DTSBD720 02095 MOVE MHDR-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSBD720 02096 MOVE MPRF-REC TO MSKL-REC DTSBD720 02097 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD720 02098 S9000-EXIT. DTSBD720 02099 EXIT. DTSBD720 02100 EJECT DTSBD720 02101 S001-FROM-FED-8. DTSBD720 02102 SET L001-FROM-FED-8 TO TRUE. DTSBD720 02103 GO TO S001-DATE. DTSBD720 02104 DTSBD720 02105 S001-FROM-ABS-DAY. DTSBD720 02106 SET L001-FROM-ABS-DAY TO TRUE. DTSBD720 02107 GO TO S001-DATE. DTSBD720 02108 DTSBD720 02109 S001-DATE. DTSBD720 02110 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD720 02111 S001-EXIT. DTSBD720 02112 EXIT. DTSBD720 02113 SKIP3 DTSBD720 02114 S004-FROM-5. DTSBD720 02115 SET L004-FROM-5 TO TRUE. DTSBD720 02116 GO TO S004-QTR. DTSBD720 02117 DTSBD720 02118 S004-FROM-ABS. DTSBD720 02119 SET L004-FROM-ABS TO TRUE. DTSBD720 02120 GO TO S004-QTR. DTSBD720 02121 DTSBD720 02122 S004-FROM-3. DTSBD720 02123 SET L004-FROM-3 TO TRUE. DTSBD720 02124 GO TO S004-QTR. DTSBD720 02125 DTSBD720 02126 S004-QTR. DTSBD720 02127 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD720 02128 S004-EXIT. DTSBD720 02129 EXIT. DTSBD720 02130 SKIP3 DTSBD720 02131 S005-FROM-SYS. DTSBD720 02132 SET L005-FROM-SYS TO TRUE. DTSBD720 02133 GO TO S005-ABSTIME. DTSBD720 02134 DTSBD720 02135 S005-ABSTIME. DTSBD720 02136 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD720 02137 S005-EXIT. DTSBD720 02138 EXIT. DTSBD720 02139 SKIP3 DTSBD720 02140 S006-FROM-QTR. DTSBD720 02141 SET L006-FROM-QTR TO TRUE. DTSBD720 02142 GO TO S006-UI-RATE-YEAR. DTSBD720 02143 DTSBD720 02144 S006-UI-RATE-YEAR. DTSBD720 02145 CALL 'DTSBU006' USING L006-LINK-AREA. DTSBD720 02146 S006-EXIT. DTSBD720 02147 EXIT. DTSBD720 02148 SKIP3 DTSBD720 02149 S055-FROM-QTR. DTSBD720 02150 SET L055-FROM-EFF-YRQ-88 TO TRUE. DTSBD720 02151 GO TO S055-EXP-PERIOD. DTSBD720 02152 DTSBD720 02153 S055-EXP-PERIOD. DTSBD720 02154 CALL 'DTSBU055' USING L055-LINK-AREA. DTSBD720 02155 S055-EXIT. DTSBD720 02156 EXIT. DTSBD720 02157 SKIP3 DTSBD720 02158 S910-OPEN-UPDATE. DTSBD720 02159 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD720 02160 GO TO S910-MSTR-IO. DTSBD720 02161 DTSBD720 02162 S910-READ. DTSBD720 02163 SET L910-READ-88 TO TRUE. DTSBD720 02164 GO TO S910-MSTR-IO. DTSBD720 02165 DTSBD720 02166 S910-START-BROWSE. DTSBD720 02167 SET L910-START-BROWSE-88 TO TRUE. DTSBD720 02168 GO TO S910-MSTR-IO. DTSBD720 02169 DTSBD720 02170 S910-READ-NEXT. DTSBD720 02171 SET L910-READ-NEXT-88 TO TRUE. DTSBD720 02172 GO TO S910-MSTR-IO. DTSBD720 02173 DTSBD720 02174 S910-DELETE. DTSBD720 02175 SET L910-DELETE-88 TO TRUE. DTSBD720 02176 GO TO S910-MSTR-IO. DTSBD720 02177 DTSBD720 02178 S910-REWRITE. DTSBD720 02179 SET L910-REWRITE-88 TO TRUE. DTSBD720 02180 GO TO S910-MSTR-IO. DTSBD720 02181 DTSBD720 02182 S910-WRITE. DTSBD720 02183 SET L910-WRITE-88 TO TRUE. DTSBD720 02184 GO TO S910-MSTR-IO. DTSBD720 02185 DTSBD720 02186 S910-CLOSE. DTSBD720 02187 SET L910-CLOSE-88 TO TRUE. DTSBD720 02188 GO TO S910-MSTR-IO. DTSBD720 02189 DTSBD720 02190 S910-MSTR-IO. DTSBD720 02191 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD720 02192 ** CALL 'DTSBU912' USING L910-LINK-AREA DTSBD720 02193 MSKL-REC. DTSBD720 02194 S910-EXIT. DTSBD720 02195 EXIT. DTSBD720 02196 SKIP3 DTSBD720 02197 S921-OPEN-READ. DTSBD720 02198 SET L921-OPEN-READ-88 TO TRUE. DTSBD720 02199 GO TO S921-AIX-I. DTSBD720 02200 DTSBD720 02201 S921-READ. DTSBD720 02202 SET L921-READ-88 TO TRUE. DTSBD720 02203 GO TO S921-AIX-I. DTSBD720 02204 DTSBD720 02205 S921-START-BROWSE. DTSBD720 02206 SET L921-START-BROWSE-88 TO TRUE. DTSBD720 02207 GO TO S921-AIX-I. DTSBD720 02208 DTSBD720 02209 S921-READ-NEXT. DTSBD720 02210 SET L921-READ-NEXT-88 TO TRUE. DTSBD720 02211 GO TO S921-AIX-I. DTSBD720 02212 DTSBD720 02213 S921-CLOSE. DTSBD720 02214 SET L921-CLOSE-88 TO TRUE. DTSBD720 02215 GO TO S921-AIX-I. DTSBD720 02216 DTSBD720 02217 S921-AIX-I. DTSBD720 02218 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD720 02219 ISKL-REC. DTSBD720 02220 S921-EXIT. DTSBD720 02221 EXIT. DTSBD720 02222 SKIP3 DTSBD720 02223 S931-OPEN-READ. DTSBD720 02224 SET L931-OPEN-READ-88 TO TRUE. DTSBD720 02225 GO TO S931-REF-I. DTSBD720 02226 DTSBD720 02227 S931-READ. DTSBD720 02228 SET L931-READ-88 TO TRUE. DTSBD720 02229 GO TO S931-REF-I. DTSBD720 02230 DTSBD720 02231 S931-CLOSE. DTSBD720 02232 SET L931-CLOSE-88 TO TRUE. DTSBD720 02233 GO TO S931-REF-I. DTSBD720 02234 DTSBD720 02235 S931-REF-I. DTSBD720 02236 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD720 02237 FSKL-REC. DTSBD720 02238 S931-EXIT. DTSBD720 02239 EXIT. DTSBD720 02240 SKIP3 DTSBD720 02241 S946-WRITE-R506. DTSBD720 02242 CALL 'DTSBU946' USING R506-REC. DTSBD720 02243 GO TO S946-EXIT. DTSBD720 02244 DTSBD720 02245 S946-WRITE-R507. DTSBD720 02246 CALL 'DTSBU946' USING R507-REC. DTSBD720 02247 GO TO S946-EXIT. DTSBD720 02248 DTSBD720 02249 S946-EXIT. DTSBD720 02250 EXIT. DTSBD720 02251 SKIP3 DTSBD720 02252 S999-ABEND. DTSBD720 02253 DISPLAY '***'. DTSBD720 02254 DTSBD720 02255 DISPLAY '*** ' DTSBD720 02256 WRK-MOD-NAME DTSBD720 02257 ' IS ABENDING BECAUSE ' DTSBD720 02258 ABEND-MSG. DTSBD720 02259 DTSBD720 02260 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD720 02261 S999-EXIT. DTSBD720 02262 EXIT. DTSBD720