2264 lines
179 KiB
COBOL
2264 lines
179 KiB
COBOL
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
|