Files
DUTAS/Batch/DTSBD740.cob
2025-07-21 11:20:11 -04:00

708 lines
56 KiB
COBOL

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