00001 IDENTIFICATION DIVISION. 12/24/02 00002 PROGRAM-ID. DTSBD740. DTSBD740 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV045 00004 DATE-WRITTEN. APRIL 1999. DTSBD740 00005 DATE-COMPILED. DTSBD740 00006 SKIP3 DTSBD740 00007 ***** DTSBD740 00008 * DTSBD740 00009 * FUNCTION: DETERMINE NEW EMPLOYER RATE. DTSBD740 00010 * DTSBD740 00011 * DTSBD740 00012 * MODIFICATION LOG: DTSBD740 00013 * DTSBD740 00014 * 04/21/1999 WRITTEN FOR DC. DTSBD740 00015 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD740 00016 * DTSBD740 00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD740 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD740 00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD740 00020 * DTSBD740 00021 * DTSBD740 00022 * DESCRIPTION: DTSBD740 00023 * DTSBD740 00024 * DTSBD740 PERFORMS THE FUNCTIONS DESCRIBED IN SECTION DTSBD740 00025 * 5.4.6 OF THE DC UI TAX REQUIREMENTS DOCUMENT. DTSBD740 00026 * DTSBD740 00027 * DTSBD740 00028 ***** DTSBD740 00029 SKIP3 DTSBD740 00030 ENVIRONMENT DIVISION. DTSBD740 00031 SKIP2 DTSBD740 00032 DATA DIVISION. DTSBD740 00033 SKIP3 DTSBD740 00034 WORKING-STORAGE SECTION. DTSBD740 000345 77 PAN-VALET PICTURE X(24) VALUE '045DTSBD740 12/24/02'. DTSBD740 00035 SKIP3 DTSBD740 00036 01 WRK-AREA. DTSBD740 00037 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +740.DTSBD740 00038 DTSBD740 00039 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD740'.DTSBD740 00040 DTSBD740 00041 05 ABEND-MSG PIC X(60). DTSBD740 00042 DTSBD740 00043 DTSBD740 00044 05 WRK-RTE-YR-START-YRQ PIC S9(05) COMP-3. DTSBD740 00045 DTSBD740 00046 05 WRK-RTE-YR-END-YRQ PIC S9(05) COMP-3. DTSBD740 00047 DTSBD740 00048 05 WRK-RTE-YR-START-DATE PIC S9(09) COMP-3. DTSBD740 00049 DTSBD740 00050 05 WRK-RTE-YR-END-DATE PIC S9(09) COMP-3. DTSBD740 00051 DTSBD740 00052 DTSBD740 00053 05 WRK-EXP-CUTOFF-DATE PIC S9(09) COMP-3. DTSBD740 00054 DTSBD740 00055 DTSBD740 00056 05 WRK-PRIOR-RTE-YR-START-YRQ PIC S9(05) COMP-3. DTSBD740 00057 DTSBD740 00058 05 WRK-PRIOR-RTE-YR-END-YRQ PIC S9(05) COMP-3. DTSBD740 00059 DTSBD740 00060 05 WRK-PRIOR-RTE-YR-START-DATE PIC S9(09) COMP-3. DTSBD740 00061 DTSBD740 00062 05 WRK-PRIOR-RTE-YR-END-DATE PIC S9(09) COMP-3. DTSBD740 00063 DTSBD740 00064 DTSBD740 00065 05 WRK-SUM-OF-PRIOR-RTE-YR-RATES DTSBD740 00066 PIC S9(07)V9(04) COMP-3. DTSBD740 00067 DTSBD740 00068 05 WRK-PRIOR-RTE-YR-EMP-CNT PIC S9(07) COMP-3. DTSBD740 00069 DTSBD740 00070 05 WRK-DEFAULT-NEW-EMP-RATE PIC S9(01)V9(04) COMP-3. DTSBD740 00071 DTSBD740 00072 05 WRK-DEFAULT-TRUNCATED-RATE PIC S9(01)V9(03) COMP-3. DTSBD740 00073 DTSBD740 00074 DTSBD740 00075 05 WRK-PRIOR-RTE-YR-LIABLE-IND PIC X(01). DTSBD740 00076 88 WRK-PRIOR-RTE-YR-LIABLE-NO-88 VALUE 'N'. DTSBD740 00077 88 WRK-PRIOR-RTE-YR-LIABLE-YES-88 VALUE 'Y'. DTSBD740 00078 DTSBD740 00079 DTSBD740 00080 05 WRK-DISPLAY-CNT-X PIC X(11). DTSBD740 00081 05 WRK-DISPLAY-CNT-9 REDEFINES WRK-DISPLAY-CNT-X DTSBD740 00082 PIC ZZZ,ZZZ,ZZ9. DTSBD740 00083 DTSBD740 00084 05 WRK-DISPLAY-AMT-X PIC X(17). DTSBD740 00085 05 WRK-DISPLAY-AMT-9 REDEFINES WRK-DISPLAY-AMT-X DTSBD740 00086 PIC ZZZZZ,ZZZ,ZZ9.99-. DTSBD740 00087 EJECT DTSBD740 00088 01 MSG-TABLE. DTSBD740 00089 05 MSG01-AREA. DTSBD740 00090 10 MSG01-MSG-IDENTIFIER PIC X(03) VALUE '541'. DTSBD740 00091 10 MSG01-MSG-TEXT. DTSBD740 00092 15 FILLER PIC X(40) DTSBD740 00093 VALUE ' '. DTSBD740 00094 15 FILLER PIC X(40) DTSBD740 00095 VALUE ' '. DTSBD740 00096 EJECT DTSBD740 00097 01 L910-LINK-AREA. DTSBD740 00098 ++INCLUDE DTSIL910 DTSBD740 00099 SKIP3 DTSBD740 00100 01 MSKL-REC. DTSBD740 00101 ++INCLUDE DTSIMSKL DTSBD740 00102 SKIP3 DTSBD740 00103 01 MHDR-REC. DTSBD740 00104 ++INCLUDE DTSIMHDR DTSBD740 00105 SKIP3 DTSBD740 00106 01 MPRF-REC. DTSBD740 00107 ++INCLUDE DTSIMPRF DTSBD740 00108 SKIP3 DTSBD740 00109 01 MRTE-REC. DTSBD740 00110 ++INCLUDE DTSIMRTE DTSBD740 00111 SKIP3 DTSBD740 00112 01 MSOL-REC. DTSBD740 00113 ++INCLUDE DTSIMSOL DTSBD740 00114 EJECT DTSBD740 00115 01 L931-LINK-AREA. DTSBD740 00116 ++INCLUDE DTSIL931 DTSBD740 00117 SKIP3 DTSBD740 00118 01 FSKL-REC. DTSBD740 00119 ++INCLUDE DTSIFSKL DTSBD740 00120 SKIP3 DTSBD740 00121 01 FUIR-REC. DTSBD740 00122 ++INCLUDE DTSIFUIR DTSBD740 00123 EJECT DTSBD740 00124 01 R522-REC. DTSBD740 00125 ++INCLUDE DTSIR522 DTSBD740 00126 SKIP3 DTSBD740 00127 01 R907-REC. DTSBD740 00128 ++INCLUDE DTSIR907 DTSBD740 00129 EJECT DTSBD740 00130 01 L001-LINK-AREA. DTSBD740 00131 ++INCLUDE DTSIL001 DTSBD740 00132 SKIP3 DTSBD740 00133 01 L004-LINK-AREA. DTSBD740 00134 ++INCLUDE DTSIL004 DTSBD740 00135 SKIP3 DTSBD740 00136 01 L006-LINK-AREA. DTSBD740 00137 ++INCLUDE DTSIL006 DTSBD740 00138 EJECT DTSBD740 00139 01 FMAX-LITERALS. DTSBD740 00140 ++INCLUDE DTSIFMAX DTSBD740 00141 EJECT DTSBD740 00142 LINKAGE SECTION. DTSBD740 00143 SKIP3 DTSBD740 00144 01 PARM-AREA. DTSBD740 00145 05 PARM-LENGTH PIC S9(04) COMP. DTSBD740 00146 05 PARM-DATA. DTSBD740 00147 10 PARM-RTE-YR-START-YRQ-X DTSBD740 00148 PIC X(03). DTSBD740 00149 10 PARM-RTE-YR-START-YRQ DTSBD740 00150 REDEFINES PARM-RTE-YR-START-YRQ-X DTSBD740 00151 PIC 9(03). DTSBD740 00152 EJECT DTSBD740 00153 PROCEDURE DIVISION USING PARM-AREA. DTSBD740 00154 DTSBD740 00155 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD740 00156 DTSBD740 00157 DTSBD740 00158 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD740 00159 DTSBD740 00160 MOVE +0 TO MSKL-EMP-NO. DTSBD740 00161 DTSBD740 00162 SET MSKL-PRF-88 TO TRUE. DTSBD740 00163 DTSBD740 00164 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD740 00165 DTSBD740 00166 PERFORM DTSBD740 00167 UNTIL L910-NO-REC-88 DTSBD740 00168 MOVE MSKL-REC TO MPRF-REC DTSBD740 00169 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD740 00170 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSBD740 00171 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD740 00172 END-PERFORM. DTSBD740 00173 DTSBD740 00174 DTSBD740 00175 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD740 00176 DTSBD740 00177 DTSBD740 00178 GOBACK. DTSBD740 00179 EJECT DTSBD740 00180 I0000-INITIATE. DTSBD740 00181 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD740 00182 DTSBD740 00183 PERFORM S931-OPEN-UPDATE THRU S931-EXIT. DTSBD740 00184 DTSBD740 00185 DTSBD740 00186 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD740 00187 DTSBD740 00188 MOVE +0 TO MSKL-EMP-NO. DTSBD740 00189 DTSBD740 00190 SET MSKL-HDR-88 TO TRUE. DTSBD740 00191 DTSBD740 00192 PERFORM S910-READ THRU S910-EXIT. DTSBD740 00193 DTSBD740 00194 IF L910-NO-REC-88 DTSBD740 00195 MOVE 'MHDR RECORD IS MISSING' DTSBD740 00196 TO ABEND-MSG DTSBD740 00197 PERFORM S999-ABEND THRU S999-EXIT. DTSBD740 00198 DTSBD740 00199 MOVE MSKL-REC TO MHDR-REC. DTSBD740 00200 DTSBD740 00201 DTSBD740 00202 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DTSBD740 00203 DTSBD740 00204 DTSBD740 00205 PERFORM I2000-FIND-FUIR THRU I2000-EXIT. DTSBD740 00206 DTSBD740 00207 DTSBD740 00208 PERFORM I3000-INITIALIZE-COUNTERS THRU I3000-EXIT. DTSBD740 00209 DTSBD740 00210 DTSBD740 00211 MOVE LENGTH OF R522-REC TO R522-LENGTH. DTSBD740 00212 DTSBD740 00213 MOVE '522' TO R522-REC-TYPE. DTSBD740 00214 DTSBD740 00215 DTSBD740 00216 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD740 00217 DTSBD740 00218 MOVE '907' TO R907-REC-TYPE. DTSBD740 00219 DTSBD740 00220 MOVE WRK-MOD-NAME TO R907-MODULE-NAME. DTSBD740 00221 I0000-EXIT. DTSBD740 00222 EXIT. DTSBD740 00223 EJECT DTSBD740 00224 I1000-PROCESS-PARMS. DTSBD740 00225 IF PARM-LENGTH = +3 DTSBD740 00226 NEXT SENTENCE DTSBD740 00227 ELSE DTSBD740 00228 MOVE 'PARM-LENGTH NOT EQUAL TO 3' DTSBD740 00229 TO ABEND-MSG DTSBD740 00230 PERFORM S999-ABEND THRU S999-EXIT. DTSBD740 00231 DTSBD740 00232 DTSBD740 00233 DISPLAY '***'. DTSBD740 00234 DTSBD740 00235 DISPLAY '*** ' DTSBD740 00236 WRK-MOD-NAME DTSBD740 00237 ' PARAMETERS: ' DTSBD740 00238 PARM-DATA. DTSBD740 00239 DTSBD740 00240 DISPLAY '***'. DTSBD740 00241 DTSBD740 00242 DTSBD740 00243 IF PARM-RTE-YR-START-YRQ-X = SPACES OR LOW-VALUES OR '000' DTSBD740 00244 PERFORM I1100-DEFAULT-START-YRQ THRU I1100-EXIT DTSBD740 00245 ELSE DTSBD740 00246 PERFORM I1200-EDIT-START-YRQ THRU I1200-EXIT. DTSBD740 00247 DTSBD740 00248 DTSBD740 00249 MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9. DTSBD740 00250 DTSBD740 00251 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD740 00252 DTSBD740 00253 IF L004-INVALID-QTR DTSBD740 00254 MOVE 'LOGIC ERROR I1000-01' DTSBD740 00255 TO ABEND-MSG DTSBD740 00256 PERFORM S999-ABEND THRU S999-EXIT. DTSBD740 00257 DTSBD740 00258 SUBTRACT 1 FROM L004-ABS-QTR. DTSBD740 00259 DTSBD740 00260 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD740 00261 DTSBD740 00262 IF L004-INVALID-QTR DTSBD740 00263 MOVE 'LOGIC ERROR I1000-02' DTSBD740 00264 TO ABEND-MSG DTSBD740 00265 PERFORM S999-ABEND THRU S999-EXIT. DTSBD740 00266 DTSBD740 00267 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD740 00268 DTSBD740 00269 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD740 00270 DTSBD740 00271 MOVE L006-RTE-YR-START-YRQ TO WRK-PRIOR-RTE-YR-START-YRQ. DTSBD740 00272 DTSBD740 00273 MOVE L006-RTE-YR-END-YRQ TO WRK-PRIOR-RTE-YR-END-YRQ. DTSBD740 00274 DTSBD740 00275 MOVE L006-RTE-YR-START-DATE TO WRK-PRIOR-RTE-YR-START-DATE. DTSBD740 00276 DTSBD740 00277 MOVE L006-RTE-YR-END-DATE TO WRK-PRIOR-RTE-YR-END-DATE. DTSBD740 00278 I1000-EXIT. DTSBD740 00279 EXIT. DTSBD740 00280 SKIP3 DTSBD740 00281 I1100-DEFAULT-START-YRQ. DTSBD740 00282 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSBD740 00283 DTSBD740 00284 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD740 00285 DTSBD740 00286 IF L004-INVALID-QTR DTSBD740 00287 MOVE 'LOGIC ERROR I1100-1' DTSBD740 00288 TO ABEND-MSG DTSBD740 00289 PERFORM S999-ABEND THRU S999-EXIT. DTSBD740 00290 DTSBD740 00291 DTSBD740 00292 ADD +1 TO L004-ABS-QTR. DTSBD740 00293 DTSBD740 00294 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD740 00295 DTSBD740 00296 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD740 00297 DTSBD740 00298 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD740 00299 DTSBD740 00300 IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ DTSBD740 00301 MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ DTSBD740 00302 MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ DTSBD740 00303 MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE DTSBD740 00304 MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE DTSBD740 00305 ELSE DTSBD740 00306 MOVE 'INVALID MHDR-LAST-RATE-YRQ ENCOUNTERED' DTSBD740 00307 TO ABEND-MSG DTSBD740 00308 PERFORM S999-ABEND THRU S999-EXIT. DTSBD740 00309 I1100-EXIT. DTSBD740 00310 EXIT. DTSBD740 00311 SKIP3 DTSBD740 00312 I1200-EDIT-START-YRQ. DTSBD740 00313 MOVE PARM-RTE-YR-START-YRQ-X TO L004-QTR-3. DTSBD740 00314 DTSBD740 00315 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD740 00316 DTSBD740 00317 IF L004-INVALID-QTR DTSBD740 00318 MOVE 'INVALID PARM-RTE-YR-START-YRQ-X ENCOUNTERED' DTSBD740 00319 TO ABEND-MSG DTSBD740 00320 PERFORM S999-ABEND THRU S999-EXIT. DTSBD740 00321 DTSBD740 00322 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD740 00323 DTSBD740 00324 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD740 00325 DTSBD740 00326 IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ DTSBD740 00327 MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ DTSBD740 00328 MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ DTSBD740 00329 MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE DTSBD740 00330 MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE DTSBD740 00331 ELSE DTSBD740 00332 MOVE 'PARM-RTE-YR-START-YRQ NOT FIRST QTR IN RATE YEAR' DTSBD740 00333 TO ABEND-MSG DTSBD740 00334 PERFORM S999-ABEND THRU S999-EXIT. DTSBD740 00335 I1200-EXIT. DTSBD740 00336 EXIT. DTSBD740 00337 SKIP3 DTSBD740 00338 I2000-FIND-FUIR. DTSBD740 00339 MOVE LOW-VALUES TO FUIR-KEY-AREA. DTSBD740 00340 DTSBD740 00341 SET FUIR-UIR-88 TO TRUE. DTSBD740 00342 DTSBD740 00343 MOVE WRK-RTE-YR-START-YRQ TO FUIR-EFF-YRQ. DTSBD740 00344 DTSBD740 00345 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBD740 00346 DTSBD740 00347 PERFORM S931-READ THRU S931-EXIT. DTSBD740 00348 DTSBD740 00349 IF L931-NO-REC-88 DTSBD740 00350 MOVE +0 TO WRK-EXP-CUTOFF-DATE DTSBD740 00351 ELSE DTSBD740 00352 MOVE FSKL-REC TO FUIR-REC DTSBD740 00353 MOVE FUIR-RATE-CUTOFF-DATE TO WRK-EXP-CUTOFF-DATE. DTSBD740 00354 I2000-EXIT. DTSBD740 00355 EXIT. DTSBD740 00356 SKIP3 DTSBD740 00357 I3000-INITIALIZE-COUNTERS. DTSBD740 00358 MOVE +0 TO WRK-SUM-OF-PRIOR-RTE-YR-RATES DTSBD740 00359 WRK-PRIOR-RTE-YR-EMP-CNT. DTSBD740 00360 I3000-EXIT. DTSBD740 00361 EXIT. DTSBD740 00362 EJECT DTSBD740 00363 P0000-PROCESS. DTSBD740 00364 IF MPRF-CLASS-RATED-88 DTSBD740 00365 NEXT SENTENCE DTSBD740 00366 ELSE DTSBD740 00367 GO TO P0000-EXIT. DTSBD740 00368 DTSBD740 00369 DTSBD740 00370 *****IF (MPRF-EMP-NO < 360101) DTSBD740 00371 ************OR DTSBD740 00372 ********(MPRF-EMP-NO > 360126) DTSBD740 00373 *********GO TO P0000-EXIT. DTSBD740 00374 DTSBD740 00375 DTSBD740 00376 PERFORM S1000-PRIOR-RTE-YR-LIABLE THRU S1000-EXIT. DTSBD740 00377 DTSBD740 00378 IF WRK-PRIOR-RTE-YR-LIABLE-NO-88 DTSBD740 00379 GO TO P0000-EXIT. DTSBD740 00380 DTSBD740 00381 DTSBD740 00382 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBD740 00383 DTSBD740 00384 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBD740 00385 DTSBD740 00386 SET MRTE-RTE-88 TO TRUE. DTSBD740 00387 DTSBD740 00388 MOVE WRK-PRIOR-RTE-YR-START-YRQ TO MRTE-EFF-YRQ. DTSBD740 00389 DTSBD740 00390 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBD740 00391 DTSBD740 00392 PERFORM S910-READ THRU S910-EXIT. DTSBD740 00393 DTSBD740 00394 IF L910-NO-REC-88 DTSBD740 00395 GO TO P0000-EXIT. DTSBD740 00396 DTSBD740 00397 DTSBD740 00398 MOVE MSKL-REC TO MRTE-REC. DTSBD740 00399 DTSBD740 00400 DTSBD740 00401 ADD MRTE-UI-RATE TO WRK-SUM-OF-PRIOR-RTE-YR-RATES. DTSBD740 00402 DTSBD740 00403 ADD +1 TO WRK-PRIOR-RTE-YR-EMP-CNT. DTSBD740 00404 P0000-EXIT. DTSBD740 00405 EXIT. DTSBD740 00406 EJECT DTSBD740 00407 T0000-TERMINATE. DTSBD740 00408 PERFORM T1000-DETERMINE-NEW-EMP-RATE THRU T1000-EXIT. DTSBD740 00409 DTSBD740 00410 DTSBD740 00411 MOVE WRK-RTE-YR-START-YRQ TO R522-RTE-YR-EFF-QTR. DTSBD740 00412 DTSBD740 00413 MOVE WRK-PRIOR-RTE-YR-START-YRQ TO R522-PRIOR-RTE-YR-EFF-QTR.DTSBD740 00414 DTSBD740 00415 MOVE WRK-PRIOR-RTE-YR-EMP-CNT TO R522-PRIOR-RTE-YR-EMP-CNT. DTSBD740 00416 DTSBD740 00417 MOVE WRK-SUM-OF-PRIOR-RTE-YR-RATES DTSBD740 00418 TO R522-SUM-OF-PRIOR-RTE-YR-RATES. DTSBD740 00419 DTSBD740 00420 MOVE WRK-DEFAULT-NEW-EMP-RATE TO R522-DEFAULT-NEW-EMP-RATE. DTSBD740 00421 DTSBD740 00422 PERFORM S946-WRITE-R522 THRU S946-EXIT. DTSBD740 00423 DTSBD740 00424 DTSBD740 00425 MOVE LOW-VALUE TO FUIR-KEY-AREA. DTSBD740 00426 DTSBD740 00427 SET FUIR-UIR-88 TO TRUE. DTSBD740 00428 DTSBD740 00429 MOVE WRK-RTE-YR-START-YRQ TO FUIR-EFF-YRQ. DTSBD740 00430 DTSBD740 00431 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBD740 00432 DTSBD740 00433 PERFORM S931-READ THRU S931-EXIT. DTSBD740 00434 DTSBD740 00435 IF L931-OK-88 DTSBD740 00436 MOVE FSKL-REC TO FUIR-REC DTSBD740 00437 MOVE WRK-DEFAULT-NEW-EMP-RATE DTSBD740 00438 TO FUIR-DEFAULT-NEW-EMP-RATE DTSBD740 00439 MOVE MHDR-CURR-RUN-DATE TO FUIR-CHNG-DATE DTSBD740 00440 MOVE FUIR-REC TO FSKL-REC DTSBD740 00441 PERFORM S931-REWRITE THRU S931-EXIT DTSBD740 00442 ELSE DTSBD740 00443 PERFORM T2000-CONSTRUCT-FUIR THRU T2000-EXIT. DTSBD740 00444 DTSBD740 00445 DTSBD740 00446 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD740 00447 DTSBD740 00448 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD740 00449 DTSBD740 00450 MOVE -1 TO R907-LENGTH. DTSBD740 00451 DTSBD740 00452 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBD740 00453 DTSBD740 00454 DTSBD740 00455 DISPLAY '***'. DTSBD740 00456 DTSBD740 00457 DISPLAY '*** ' DTSBD740 00458 WRK-MOD-NAME DTSBD740 00459 ' TERMINATION DISPLAYS'. DTSBD740 00460 DTSBD740 00461 DTSBD740 00462 MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9. DTSBD740 00463 DTSBD740 00464 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD740 00465 DTSBD740 00466 DISPLAY '*** RATE YEAR START QUARTER: ' DTSBD740 00467 L004-SLASH-5-QTR. DTSBD740 00468 DTSBD740 00469 DTSBD740 00470 DISPLAY '***'. DTSBD740 00471 DTSBD740 00472 MOVE WRK-RTE-YR-END-YRQ TO L004-QTR-5-9. DTSBD740 00473 DTSBD740 00474 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD740 00475 DTSBD740 00476 DISPLAY '*** RATE YEAR END QUARTER: ' DTSBD740 00477 L004-SLASH-5-QTR. DTSBD740 00478 DTSBD740 00479 DTSBD740 00480 DISPLAY '***'. DTSBD740 00481 DTSBD740 00482 MOVE WRK-RTE-YR-START-DATE TO L001-FED-8-DATE-9. DTSBD740 00483 DTSBD740 00484 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD740 00485 DTSBD740 00486 DISPLAY '*** RATE YEAR START DATE: ' DTSBD740 00487 L001-SLASH-8-DATE. DTSBD740 00488 DTSBD740 00489 DTSBD740 00490 DISPLAY '***'. DTSBD740 00491 DTSBD740 00492 MOVE WRK-RTE-YR-END-DATE TO L001-FED-8-DATE-9. DTSBD740 00493 DTSBD740 00494 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD740 00495 DTSBD740 00496 DISPLAY '*** RATE YEAR END DATE: ' DTSBD740 00497 L001-SLASH-8-DATE. DTSBD740 00498 DTSBD740 00499 DTSBD740 00500 DISPLAY '***'. DTSBD740 00501 DTSBD740 00502 MOVE WRK-EXP-CUTOFF-DATE TO L001-FED-8-DATE-9. DTSBD740 00503 DTSBD740 00504 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD740 00505 DTSBD740 00506 DISPLAY '*** RATING EXPERIENCE CUTOFF DATE: ' DTSBD740 00507 L001-SLASH-8-DATE. DTSBD740 00508 T0000-EXIT. DTSBD740 00509 EXIT. DTSBD740 00510 SKIP3 DTSBD740 00511 T1000-DETERMINE-NEW-EMP-RATE. DTSBD740 00512 COMPUTE WRK-DEFAULT-NEW-EMP-RATE ROUNDED DTSBD740 00513 = WRK-SUM-OF-PRIOR-RTE-YR-RATES DTSBD740 00514 / WRK-PRIOR-RTE-YR-EMP-CNT DTSBD740 00515 ON SIZE ERROR DTSBD740 00516 MOVE +0 TO WRK-DEFAULT-NEW-EMP-RATE. DTSBD740 00517 DTSBD740 00518 ADD +0.0005 TO WRK-DEFAULT-NEW-EMP-RATE. DTSBD740 00519 DTSBD740 00520 MOVE WRK-DEFAULT-NEW-EMP-RATE DTSBD740 00521 TO WRK-DEFAULT-TRUNCATED-RATE. DTSBD740 00522 DTSBD740 00523 MOVE WRK-DEFAULT-TRUNCATED-RATE DTSBD740 00524 TO WRK-DEFAULT-NEW-EMP-RATE. DTSBD740 00525 DTSBD740 00526 IF WRK-DEFAULT-NEW-EMP-RATE < 0.0270 DTSBD740 00527 MOVE 0.0270 TO WRK-DEFAULT-NEW-EMP-RATE. DTSBD740 00528 T1000-EXIT. DTSBD740 00529 EXIT. DTSBD740 00530 SKIP3 DTSBD740 00531 T2000-CONSTRUCT-FUIR. DTSBD740 00532 MOVE LOW-VALUES TO FUIR-DATA-AREA. DTSBD740 00533 DTSBD740 00534 DTSBD740 00535 MOVE SPACES TO FUIR-RATE-TABLE. DTSBD740 00536 DTSBD740 00537 MOVE +0 TO FUIR-TOT-TRUST-FUND-INT-AMT DTSBD740 00538 FUIR-TOT-POS-RESERVE-BAL-AMT DTSBD740 00539 FUIR-TOT-POS-RESERVE-EMP-CNT DTSBD740 00540 FUIR-DIST-TRUST-FUND-INT-AMT. DTSBD740 00541 DTSBD740 00542 MOVE WRK-DEFAULT-NEW-EMP-RATE TO FUIR-DEFAULT-NEW-EMP-RATE. DTSBD740 00543 DTSBD740 00544 MOVE +0 TO FUIR-RATE-CNT. DTSBD740 00545 DTSBD740 00546 PERFORM DTSBD740 00547 VARYING FUIR-RATE-IDX FROM 1 BY 1 DTSBD740 00548 UNTIL FUIR-RATE-IDX > FMAX-UIR-RATE-RATIO-MAX DTSBD740 00549 MOVE +0 TO FUIR-UI-RATE (FUIR-RATE-IDX) DTSBD740 00550 FUIR-MIN-RATIO (FUIR-RATE-IDX) DTSBD740 00551 FUIR-MAX-RATIO (FUIR-RATE-IDX) DTSBD740 00552 END-PERFORM. DTSBD740 00553 DTSBD740 00554 MOVE MHDR-CURR-RUN-DATE TO FUIR-ESTB-DATE DTSBD740 00555 FUIR-CHNG-DATE. DTSBD740 00556 DTSBD740 00557 DTSBD740 00558 MOVE FUIR-REC TO FSKL-REC. DTSBD740 00559 DTSBD740 00560 PERFORM S931-WRITE THRU S931-EXIT. DTSBD740 00561 T2000-EXIT. DTSBD740 00562 EXIT. DTSBD740 00563 EJECT DTSBD740 00564 S1000-PRIOR-RTE-YR-LIABLE. DTSBD740 00565 SET WRK-PRIOR-RTE-YR-LIABLE-NO-88 TO TRUE. DTSBD740 00566 DTSBD740 00567 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD740 00568 DTSBD740 00569 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD740 00570 DTSBD740 00571 SET MSKL-SOL-88 TO TRUE. DTSBD740 00572 DTSBD740 00573 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD740 00574 DTSBD740 00575 PERFORM DTSBD740 00576 UNTIL L910-NO-REC-88 DTSBD740 00577 MOVE MSKL-REC TO MSOL-REC DTSBD740 00578 PERFORM S1100-EXAMINE-MSOL THRU S1100-EXIT DTSBD740 00579 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD740 00580 END-PERFORM. DTSBD740 00581 S1000-EXIT. DTSBD740 00582 EXIT. DTSBD740 00583 SKIP3 DTSBD740 00584 S1100-EXAMINE-MSOL. DTSBD740 00585 IF MSOL-INACT-WITHDRAWN-88 DTSBD740 00586 GO TO S1100-EXIT. DTSBD740 00587 DTSBD740 00588 IF MSOL-FIRST-LIAB-YRQ > WRK-PRIOR-RTE-YR-END-YRQ DTSBD740 00589 GO TO S1100-EXIT. DTSBD740 00590 DTSBD740 00591 IF MSOL-LAST-LIAB-YRQ < WRK-PRIOR-RTE-YR-START-YRQ DTSBD740 00592 GO TO S1100-EXIT. DTSBD740 00593 DTSBD740 00594 SET WRK-PRIOR-RTE-YR-LIABLE-YES-88 TO TRUE. DTSBD740 00595 S1100-EXIT. DTSBD740 00596 EXIT. DTSBD740 00597 EJECT DTSBD740 00598 S001-FROM-FED-8. DTSBD740 00599 SET L001-FROM-FED-8 TO TRUE. DTSBD740 00600 GO TO S001-DATE. DTSBD740 00601 DTSBD740 00602 S001-DATE. DTSBD740 00603 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD740 00604 S001-EXIT. DTSBD740 00605 EXIT. DTSBD740 00606 SKIP3 DTSBD740 00607 S004-FROM-5. DTSBD740 00608 SET L004-FROM-5 TO TRUE. DTSBD740 00609 GO TO S004-QTR. DTSBD740 00610 DTSBD740 00611 S004-FROM-ABS. DTSBD740 00612 SET L004-FROM-ABS TO TRUE. DTSBD740 00613 GO TO S004-QTR. DTSBD740 00614 DTSBD740 00615 S004-FROM-3. DTSBD740 00616 SET L004-FROM-3 TO TRUE. DTSBD740 00617 GO TO S004-QTR. DTSBD740 00618 DTSBD740 00619 S004-QTR. DTSBD740 00620 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD740 00621 S004-EXIT. DTSBD740 00622 EXIT. DTSBD740 00623 SKIP3 DTSBD740 00624 S006-FROM-QTR. DTSBD740 00625 SET L006-FROM-QTR TO TRUE. DTSBD740 00626 GO TO S006-UI-RATE-YEAR. DTSBD740 00627 DTSBD740 00628 S006-UI-RATE-YEAR. DTSBD740 00629 CALL 'DTSBU006' USING L006-LINK-AREA. DTSBD740 00630 S006-EXIT. DTSBD740 00631 EXIT. DTSBD740 00632 SKIP3 DTSBD740 00633 S910-OPEN-READ. DTSBD740 00634 SET L910-OPEN-READ-88 TO TRUE. DTSBD740 00635 GO TO S910-MSTR-IO. DTSBD740 00636 DTSBD740 00637 S910-READ. DTSBD740 00638 SET L910-READ-88 TO TRUE. DTSBD740 00639 GO TO S910-MSTR-IO. DTSBD740 00640 DTSBD740 00641 S910-START-BROWSE. DTSBD740 00642 SET L910-START-BROWSE-88 TO TRUE. DTSBD740 00643 GO TO S910-MSTR-IO. DTSBD740 00644 DTSBD740 00645 S910-READ-NEXT. DTSBD740 00646 SET L910-READ-NEXT-88 TO TRUE. DTSBD740 00647 GO TO S910-MSTR-IO. DTSBD740 00648 DTSBD740 00649 S910-CLOSE. DTSBD740 00650 SET L910-CLOSE-88 TO TRUE. DTSBD740 00651 GO TO S910-MSTR-IO. DTSBD740 00652 DTSBD740 00653 S910-MSTR-IO. DTSBD740 00654 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD740 00655 MSKL-REC. DTSBD740 00656 S910-EXIT. DTSBD740 00657 EXIT. DTSBD740 00658 SKIP3 DTSBD740 00659 S931-OPEN-UPDATE. DTSBD740 00660 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBD740 00661 GO TO S931-REF-IO. DTSBD740 00662 DTSBD740 00663 S931-READ. DTSBD740 00664 SET L931-READ-88 TO TRUE. DTSBD740 00665 GO TO S931-REF-IO. DTSBD740 00666 DTSBD740 00667 S931-REWRITE. DTSBD740 00668 SET L931-REWRITE-88 TO TRUE. DTSBD740 00669 GO TO S931-REF-IO. DTSBD740 00670 DTSBD740 00671 S931-WRITE. DTSBD740 00672 SET L931-WRITE-88 TO TRUE. DTSBD740 00673 GO TO S931-REF-IO. DTSBD740 00674 DTSBD740 00675 S931-CLOSE. DTSBD740 00676 SET L931-CLOSE-88 TO TRUE. DTSBD740 00677 GO TO S931-REF-IO. DTSBD740 00678 DTSBD740 00679 S931-REF-IO. DTSBD740 00680 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD740 00681 FSKL-REC. DTSBD740 00682 S931-EXIT. DTSBD740 00683 EXIT. DTSBD740 00684 SKIP3 DTSBD740 00685 S946-WRITE-R522. DTSBD740 00686 CALL 'DTSBU946' USING R522-REC. DTSBD740 00687 GO TO S946-EXIT. DTSBD740 00688 DTSBD740 00689 S946-WRITE-R907. DTSBD740 00690 CALL 'DTSBU946' USING R907-REC. DTSBD740 00691 GO TO S946-EXIT. DTSBD740 00692 DTSBD740 00693 S946-EXIT. DTSBD740 00694 EXIT. DTSBD740 00695 SKIP3 DTSBD740 00696 S999-ABEND. DTSBD740 00697 DISPLAY '***'. DTSBD740 00698 DTSBD740 00699 DISPLAY '*** ' DTSBD740 00700 WRK-MOD-NAME DTSBD740 00701 ' IS ABENDING BECAUSE ' DTSBD740 00702 ABEND-MSG. DTSBD740 00703 DTSBD740 00704 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD740 00705 S999-EXIT. DTSBD740 00706 EXIT. DTSBD740