00001 IDENTIFICATION DIVISION. 12/08/23 00002 PROGRAM-ID. DTSBD710. DTSBD710 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV010 00004 DATE-WRITTEN. APRIL 1999. DTSBD710 00005 DATE-COMPILED. DTSBD710 00006 SKIP3 DTSBD710 00007 ***** DTSBD710 00008 * DTSBD710 00009 * FUNCTION: INITIALIZE ANNUAL RATING CUTOFF RECORD DTSBD710 00010 * OCCURRENCES. DTSBD710 00011 * DTSBD710 00012 * DTSBD710 00013 * MODIFICATION LOG: DTSBD710 00014 * DTSBD710 00015 * 04/01/1999 WRITTEN FOR DC. DTSBD710 00016 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD710 00017 * DTSBD710 00018 * 12/22/1999 MODIFIED TO BYPASS BAD JOURNAL ENTRIES DTSBD710 00019 * REFERENCE: PROGRAMMER: GD DTSBD710 00020 * DTSBD710 00021 * 07/03/2002 MODIFIED TO READ BENEFIT CHARGE DISK FILE DTSBD710 00022 * AND TO HANDLE HOUSEHOLD EMPLOYERS FILING DTSBD710 00023 * ANNUALLY. DTSBD710 00024 * REFERENCE: PROGRAMMER: GD DTSBD710 00025 * DTSBD710 00026 * 12/12/2003 MODIFIED TO SELECT MJRN RECORDS BASED ON DTSBD710 00027 * RECEIVED DATE RATHER THAN PROCESSED DATE. DTSBD710 00028 * NEEDED TO ACCOMMODATE ANNUAL FILING. DTSBD710 00029 * REFERENCE: PROGRAMMER: GD DTSBD710 00030 * DTSBD710 00031 * 09/17/2008 MODIFIED TO SELECT ONLY ANNUAL FILING DTSBD710 00032 * WHEN RUNNING ANNUAL FILERS TAX RATE NOTICES. DTSBD710 00033 * PROGRAM WILL NOT DELETE ANY RATE RECORDS THAT DTSBD710 00034 * WAS CREATED BY THE EXPERIENCE RATINGS JOB DTSBD710 00035 * IT WILL CREATE A RATE RECORD FOR ALL ANNUAL DTSBD710 00036 * FILERS WHO DO NOT HAVE ONE. DTSBD710 00037 * REFERENCE: PROGRAMMER: ZL1 DTSBD710 00038 * DTSBD710 00039 * 07/07/2009 RESTORED CODE IN P0000 TO SELECT ONLY RATED DTSBD710 00040 * EMPLOYERS. THIS WAS ACCIDENTALLY LEFT OUT DTSBD710 00041 * DURING THE SEPTEMBER 2008 REWRITE. DTSBD710 00042 * REFERENCE: PROGRAMMER: GD DTSBD710 00043 * DTSBD710 00044 * 07/11/2019 MODIFIED TO LIST EARLIST LIAB DATE OF LAST CL**5 00045 * YEAR RATE. THIS WILL BE USED BY BD720 TO CORRECT CL**5 00046 * ELD DATE DURING THE RATE PROCESS. CL**5 00047 * REFERENCE: PROGRAMMER: ZL1 CL**5 00048 * CL**5 00049 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD710 00050 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD710 00051 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD710 00052 * DTSBD710 00053 * DTSBD710 00054 * DESCRIPTION: DTSBD710 00055 * DTSBD710 00056 * DTSBD710 PERFORMS THE FUNCTIONS DESCRIBED IN SECTION DTSBD710 00057 * 5.4.2 OF THE DC UI TAX REQUIREMENTS DOCUMENT. DTSBD710 00058 * DTSBD710 00059 * ADDITIONAL PROCESSING IS NEEDED FOR HOUSEHOLD EMPLOYERS DTSBD710 00060 * FILING ANNUALLY: DTSBD710 00061 * DTSBD710 00062 * AT THE TIME THE RATING PROCESS RUNS, HOUSEHOLD DTSBD710 00063 * EMPLOYERS FILING ANNUALLY WILL NOT HAVE DTSBD710 00064 * REPORTED THE FIRST QUARTER WAGES FOR THE YEAR DTSBD710 00065 * PRECEDING THE RATE YEAR. THE MISSING WAGES DTSBD710 00066 * NEED TO BE ESTIMATED FOR THESE EMPLOYERS. DTSBD710 00067 * FOR RATE YEAR 2004, WAGES FOR 2003/1 WILL NOT BE DTSBD710 00068 * REPORTED UNTIL APRIL 2004. DTSBD710 00069 * DTSBD710 00070 * THE FIRST QUARTER TAXABLE WAGE AMOUNT REPORTED DTSBD710 00071 * FOR THE PREVIOUS YEAR IS THE 'ESTIMATE' FOR THE DTSBD710 00072 * MISSING FIRST QUARTER. USE 2002/1 AS AN ESTIMATE DTSBD710 00073 * FOR THE WAGES NOT YET REPORTED FOR 2003/1. DTSBD710 00074 * DTSBD710 00075 * THE PROGRAM CALCULATES THE QUARTER USED FOR THE DTSBD710 00076 * ESTIMATE IN I4000. DTSBD710 00077 * DTSBD710 00078 * P1400, WHICH SETS THE WAGE AMOUNTS IN THE MRCT DTSBD710 00079 * RECORD, ALSO SAVES THE TAXABLE WAGES REPORTED DTSBD710 00080 * IN THE QUARTER USED FOR THE ESTIMATE, AND MOVES DTSBD710 00081 * THIS AMOUNT TO MRCT-QTR1-ESTIM-TAX-WAGE. DTSBD710 00082 * DTSBD710 00083 * THE PROGRAM ONLY STORES THE ESTIMATED WAGES FOR DTSBD710 00084 * HOUSEHOLD EMPLOYERS. THE FIELD IS SET TO ZERO DTSBD710 00085 * FOR ALL OTHER EMPLOYERS. DTSBD710 00086 * DTSBD710 00087 * ANY PROGRAM THAT USES MRCT WAGE DATA CAN DECIDE DTSBD710 00088 * WHETHER TO USE THE ESTIMATED WAGE AMOUNT OR NOT. DTSBD710 00089 * DTSBD710 00090 * DURING THE FINAL RUN THAT SENDS RATE NOTICES TO DTSBD710 00091 * ANNUAL FILERS, THE PROGRAM REBUILDS THE WAGE DATA DTSBD710 00092 * ON THE MRCT RECORD, SO ANY WAGES REPORTED FOR THE DTSBD710 00093 * MISSING QUARTER WILL NOW BE INCLUDED IN THE RATE DTSBD710 00094 * CALCULATION. THE PROGRAM WILL EXCLUDE WAGES FROM DTSBD710 00095 * REPORTS SUBMITTED AFTER THE ORIGINAL RATING RUN, DTSBD710 00096 * EXCEPT FOR THE MISSING FIRST QUARTER REPORT. DTSBD710 00097 * DTSBD710 00098 ***** DTSBD710 00099 SKIP3 DTSBD710 00100 ENVIRONMENT DIVISION. DTSBD710 00101 SKIP2 DTSBD710 00102 INPUT-OUTPUT SECTION. DTSBD710 00103 DTSBD710 00104 FILE-CONTROL. DTSBD710 00105 SELECT CHARGE-FILE ASSIGN TO DTSFCHG5 DTSBD710 00106 ORGANIZATION IS INDEXED DTSBD710 00107 ACCESS MODE IS DYNAMIC DTSBD710 00108 RECORD KEY IS CHG5-SORT-KEY-AREA DTSBD710 00109 FILE STATUS IS CHG5-STATUS. DTSBD710 00110 DTSBD710 00111 DATA DIVISION. DTSBD710 00112 SKIP3 DTSBD710 00113 FILE SECTION. DTSBD710 00114 SKIP2 DTSBD710 00115 FD CHARGE-FILE DTSBD710 00116 RECORD CONTAINS 41 CHARACTERS DTSBD710 00117 DATA RECORD IS CHG5-REC. DTSBD710 00118 01 CHG5-REC. DTSBD710 00119 ++INCLUDE CHGIM005 DTSBD710 00120 DTSBD710 00121 WORKING-STORAGE SECTION. DTSBD710 001215 77 PAN-VALET PICTURE X(24) VALUE '010DTSBD710 12/08/23'. DTSBD710 00122 77 PAN-VALET PICTURE X(24) VALUE '061DTSBD710 12/09/09'. DTSBD710 00123 SKIP3 DTSBD710 00124 01 WRK-AREA. DTSBD710 00125 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +710.DTSBD710 00126 DTSBD710 00127 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD710'.DTSBD710 00128 DTSBD710 00129 05 ALL-NINES-EMP-NO PIC S9(07) COMP-3 DTSBD710 00130 VALUE +9999999. DTSBD710 00131 DTSBD710 00132 05 ABEND-MSG PIC X(60). DTSBD710 00133 DTSBD710 00134 DTSBD710 00135 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3. DTSBD710 00136 DTSBD710 00137 05 WRK-SYS-DATE PIC S9(09) COMP-3. DTSBD710 00138 DTSBD710 00139 05 WRK-SYS-TIME PIC S9(07) COMP-3. DTSBD710 00140 DTSBD710 00141 DTSBD710 00142 05 WRK-PURGE-MRCT-IND PIC X(01). DTSBD710 00143 DTSBD710 00144 05 WRK-RTE-YR-START-YRQ PIC S9(05) COMP-3. DTSBD710 00145 DTSBD710 00146 05 WRK-RTE-YR-END-YRQ PIC S9(05) COMP-3. DTSBD710 00147 DTSBD710 00148 05 WRK-RTE-YR-START-DATE PIC S9(09) COMP-3. DTSBD710 00149 DTSBD710 00150 05 WRK-RTE-YR-END-DATE PIC S9(09) COMP-3. DTSBD710 00151 DTSBD710 00152 05 WRK-EXP-CUTOFF-DATE PIC S9(09) COMP-3. DTSBD710 00153 DTSBD710 00154 05 WRK-PRIOR-RTE-YR-START-YRQ PIC S9(05) COMP-3. DTSBD710 00155 DTSBD710 00156 05 WRK-ESTIMATED-WAGE-AREA. DTSBD710 00157 10 WRK-ESTIM-WAGE-YRQ PIC S9(05) COMP-3 DTSBD710 00158 VALUE +0. DTSBD710 00159 10 WRK-ESTIM-TAX-WAGE PIC S9(11)V9(02) COMP-3 DTSBD710 00160 VALUE +0. DTSBD710 00161 10 WRK-ESTIM-WAGE-CNT PIC S9(07) COMP-3 DTSBD710 00162 VALUE +0. DTSBD710 00163 10 WRK-ESTIM-TOT-WAGE1 PIC S9(11)V9(02) COMP-3 DTSBD710 00164 VALUE +0. DTSBD710 00165 10 WRK-ESTIM-TAX-WAGE1 PIC S9(11)V9(02) COMP-3 DTSBD710 00166 VALUE +0. DTSBD710 00167 DTSBD710 00168 05 CHG5-STATUS PIC X(02). DTSBD710 00169 88 CHG5-FILE-OK-88 VALUE '00'. DTSBD710 00170 88 CHG5-FILE-EOF-88 VALUE '10'. DTSBD710 00171 DTSBD710 00172 05 WRK-ERROR-IND PIC X(01). DTSBD710 00173 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBD710 00174 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBD710 00175 DTSBD710 00176 05 BCF-REC-CNT PIC S9(09) COMP-3. DTSBD710 00177 DTSBD710 00178 05 WRK-TOT-CHARGE PIC S9(11)V9(02) COMP-3. DTSBD710 00179 ** 05 BCF-CHARGE-CURR-AMT PIC S9(11)V9(02) COMP-3. DTSBD710 00180 DTSBD710 00181 DTSBD710 00182 05 WRK-REC-SELECTED-IND PIC X(01). DTSBD710 00183 88 WRK-REC-SELECTED-YES-88 VALUE 'Y'. DTSBD710 00184 88 WRK-REC-SELECTED-NO-88 VALUE 'N'. DTSBD710 00185 DTSBD710 00186 05 WRK-ANNUAL-FILER-IND PIC X(01). DTSBD710 00187 88 WRK-ANNUAL-FILER-YES-88 VALUE 'Y'. DTSBD710 00188 88 WRK-ANNUAL-FILER-NO-88 VALUE 'N'. DTSBD710 00189 DTSBD710 00190 05 WRK-UPDATE-MASTER-IND PIC X(01). DTSBD710 00191 88 WRK-UPDATE-MASTER-YES-88 VALUE 'Y'. DTSBD710 00192 88 WRK-UPDATE-MASTER-NO-88 VALUE 'N'. DTSBD710 00193 DTSBD710 00194 05 WRK-RUN-TYPE-IND PIC X(01). DTSBD710 00195 88 WRK-RUN-TYPE-REG-88 VALUE '0'. DTSBD710 00196 88 WRK-RUN-TYPE-ANN-88 VALUE '1'. DTSBD710 00197 DTSBD710 00198 05 RCT-REC-DELETE-CNT PIC S9(07) COMP-3. DTSBD710 00199 DTSBD710 00200 05 RCT-REC-WRITE-CNT PIC S9(07) COMP-3. DTSBD710 00201 DTSBD710 00202 05 RRA-REC-DELETE-CNT PIC S9(07) COMP-3. DTSBD710 00203 DTSBD710 00204 DTSBD710 00205 05 BCF-HOLD-CHARGE-EMPL-ACCT PIC 9(06). DTSBD710 00206 DTSBD710 00207 05 BCF-HOLD-CHARGE-CURR-AMT PIC S9(09)V9(02) COMP-3. DTSBD710 00208 DTSBD710 00209 05 WRK-CHARGE PIC S9(09)V9(02) COMP-3. DTSBD710 00210 DTSBD710 00211 05 WRK-AVG-WAGE PIC S9(13)V9(02) COMP-3. DTSBD710 00212 DTSBD710 00213 05 WRK-EMP-NO PIC 9(06). DTSBD710 00214 88 WRK-POOL-ACCT-88 VALUE 999000 THRU 999992 DTSBD710 00215 028411. DTSBD710 00216 DTSBD710 00217 05 WRK-EMP-TYPE PIC 9(02). DTSBD710 00218 88 WRK-EMP-TYPE-RATED-88 VALUE 00. DTSBD710 00219 DTSBD710 00220 05 WRK-DISPLAY-CNT-X PIC X(11). DTSBD710 00221 05 WRK-DISPLAY-CNT-9 REDEFINES WRK-DISPLAY-CNT-X DTSBD710 00222 PIC ZZZ,ZZZ,ZZ9. DTSBD710 00223 DTSBD710 00224 05 WRK-DISPLAY-AMT-X PIC X(17). DTSBD710 00225 05 WRK-DISPLAY-AMT-9 REDEFINES WRK-DISPLAY-AMT-X DTSBD710 00226 PIC ZZZZZ,ZZZ,ZZ9.99-. DTSBD710 00227 05 WRK-DISPLAY-AMT-9A PIC ZZZZZ,ZZZ,ZZ9.99-. DTSBD710 00228 05 WRK-DISPLAY-AMT-9B PIC ZZZZZ,ZZZ,ZZ9.99-. DTSBD710 00229 DTSBD710 00230 DTSBD710 00231 05 WRK-PRIOR-RESERVE-AMT PIC S9(09)V9(02) COMP-3. DTSBD710 00232 EJECT DTSBD710 00233 01 MSG-TABLE. DTSBD710 00234 05 MSG01-AREA. DTSBD710 00235 10 MSG01-MSG-IDENTIFIER PIC X(04) VALUE '1001'. DTSBD710 00236 10 MSG01-MSG-TEXT. DTSBD710 00237 15 FILLER PIC X(40) DTSBD710 00238 VALUE 'EMPLOYER NOT ON UI TAX EMPLOYER MASTER F'. DTSBD710 00239 15 FILLER PIC X(43) DTSBD710 00240 VALUE 'ILE. BENEFIT CHARGES BYPASSED. CHRG AMT: '. DTSBD710 00241 15 MSG01-CHARGE-TOT-AMT PIC ----,---,--9.99. DTSBD710 00242 DTSBD710 00243 05 MSG02-AREA. DTSBD710 00244 10 MSG02-MSG-IDENTIFIER PIC X(04) VALUE '1002'. DTSBD710 00245 10 MSG02-MSG-TEXT. DTSBD710 00246 15 FILLER PIC X(40) DTSBD710 00247 VALUE 'EMPLOYER NOT A RATED EMPLOYER. RATED BE'. DTSBD710 00248 15 FILLER PIC X(41) DTSBD710 00249 VALUE 'NEFIT CHARGES BYPASSED. CHARGED AMOUNT: '. DTSBD710 00250 15 MSG02-CHARGE-TOT-AMT PIC ----,---,--9.99. DTSBD710 00251 DTSBD710 00252 05 MSG03-AREA. DTSBD710 00253 10 MSG03-MSG-IDENTIFIER PIC X(04) VALUE '1003'. DTSBD710 00254 10 MSG03-MSG-TEXT. DTSBD710 00255 15 FILLER PIC X(40) DTSBD710 00256 VALUE 'RATE CUTOFF RECORD FOR RATE YEAR ALREADY'. DTSBD710 00257 15 FILLER PIC X(41) DTSBD710 00258 VALUE ' EXISTS. RATE CUTOFF RECORD NOT UPDATED.'. DTSBD710 00259 DTSBD710 00260 05 MSG04-AREA. DTSBD710 00261 10 MSG04-MSG-IDENTIFIER PIC X(04) VALUE '1004'. DTSBD710 00262 10 MSG04-MSG-TEXT. DTSBD710 00263 15 FILLER PIC X(40) DTSBD710 00264 VALUE 'DESPITE BEING LOCKED AGAINST UPDATE, AN '. DTSBD710 00265 15 FILLER PIC X(40) DTSBD710 00266 VALUE 'ANNUAL RATING BATCH PROCESS UPDATED A MR'. DTSBD710 00267 15 FILLER PIC X(20) DTSBD710 00268 VALUE 'CT RECORD OCCURRENCE'. DTSBD710 00269 DTSBD710 00270 05 MSG05-AREA. DTSBD710 00271 10 MSG05-MSG-IDENTIFIER PIC X(04) VALUE '1005'. DTSBD710 00272 10 MSG05-MSG-TEXT. DTSBD710 00273 15 FILLER PIC X(40) DTSBD710 00274 VALUE 'TAXABLE WAGE AND TOTAL WAGE INFORMATION '. DTSBD710 00275 15 FILLER PIC X(40) DTSBD710 00276 VALUE 'REQUIRED FOR ANNUAL RATING MAY BE ARCHIV'. DTSBD710 00277 15 FILLER PIC X(20) DTSBD710 00278 VALUE 'ED. '. DTSBD710 00279 DTSBD710 00280 EJECT DTSBD710 00281 01 L910-LINK-AREA. DTSBD710 00282 ++INCLUDE DTSIL910 DTSBD710 00283 SKIP3 DTSBD710 00284 01 MSKL-REC. DTSBD710 00285 ++INCLUDE DTSIMSKL DTSBD710 00286 SKIP3 DTSBD710 00287 01 MHDR-REC. DTSBD710 00288 ++INCLUDE DTSIMHDR DTSBD710 00289 SKIP3 DTSBD710 00290 01 MPRF-REC. DTSBD710 00291 ++INCLUDE DTSIMPRF DTSBD710 00292 SKIP3 DTSBD710 00293 01 MRCT-REC. DTSBD710 00294 ++INCLUDE DTSIMRCT DTSBD710 00295 SKIP3 DTSBD710 00296 01 MRRA-REC. DTSBD710 00297 ++INCLUDE DTSIMRRA DTSBD710 00298 SKIP3 DTSBD710 00299 01 MJRN-REC. DTSBD710 00300 ++INCLUDE DTSIMJRN DTSBD710 00301 SKIP3 DTSBD710 00302 01 MQTR-REC. DTSBD710 00303 ++INCLUDE DTSIMQTR DTSBD710 00304 SKIP3 DTSBD710 00305 01 MSOL-REC. DTSBD710 00306 ++INCLUDE DTSIMSOL DTSBD710 00307 EJECT DTSBD710 00308 01 L931-LINK-AREA. DTSBD710 00309 ++INCLUDE DTSIL931 DTSBD710 00310 SKIP3 DTSBD710 00311 01 FSKL-REC. DTSBD710 00312 ++INCLUDE DTSIFSKL DTSBD710 00313 SKIP3 DTSBD710 00314 01 FUIR-REC. DTSBD710 00315 ++INCLUDE DTSIFUIR DTSBD710 00316 EJECT DTSBD710 00317 01 R507-REC. DTSBD710 00318 ++INCLUDE DTSIR507 DTSBD710 00319 EJECT DTSBD710 00320 01 L001-LINK-AREA. DTSBD710 00321 ++INCLUDE DTSIL001 DTSBD710 00322 SKIP3 DTSBD710 00323 01 L004-LINK-AREA. DTSBD710 00324 ++INCLUDE DTSIL004 DTSBD710 00325 SKIP3 DTSBD710 00326 01 L005-LINK-AREA. DTSBD710 00327 ++INCLUDE DTSIL005 DTSBD710 00328 SKIP3 DTSBD710 00329 01 L006-LINK-AREA. DTSBD710 00330 ++INCLUDE DTSIL006 DTSBD710 00331 SKIP3 DTSBD710 00332 01 L055-LINK-AREA. DTSBD710 00333 ++INCLUDE DTSIL055 DTSBD710 00334 EJECT DTSBD710 00335 01 L410-LINK-AREA. DTSBD710 00336 ++INCLUDE DTSIL410 DTSBD710 00337 EJECT DTSBD710 00338 01 MMAX-LITERALS. DTSBD710 00339 ++INCLUDE DTSIMMAX DTSBD710 00340 SKIP3 DTSBD710 00341 01 FMAX-LITERALS. DTSBD710 00342 ++INCLUDE DTSIFMAX DTSBD710 00343 EJECT DTSBD710 00344 LINKAGE SECTION. DTSBD710 00345 SKIP3 DTSBD710 00346 01 PARM-AREA. DTSBD710 00347 05 PARM-LENGTH PIC S9(04) COMP. DTSBD710 00348 05 PARM-DATA. DTSBD710 00349 10 PARM-RTE-YR-START-YRQ-X DTSBD710 00350 PIC X(03). DTSBD710 00351 10 PARM-RTE-YR-START-YRQ DTSBD710 00352 REDEFINES PARM-RTE-YR-START-YRQ-X DTSBD710 00353 PIC 9(03). DTSBD710 00354 10 FILLER PIC X(01). DTSBD710 00355 10 PARM-PURGE-MRCT-IND PIC X(01). DTSBD710 00356 10 FILLER PIC X(01). DTSBD710 00357 10 PARM-UPDATE-MASTER-IND PIC X(01). DTSBD710 00358 88 PARM-UPDATE-MASTER-YES-88 VALUE 'Y'. DTSBD710 00359 88 PARM-UPDATE-MASTER-NO-88 VALUE 'N'. DTSBD710 00360 10 FILLER PIC X(01). DTSBD710 00361 10 PARM-RUN-TYPE-IND PIC X(01). DTSBD710 00362 88 PARM-RUN-TYPE-REG-88 VALUE 'R'. DTSBD710 00363 88 PARM-RUN-TYPE-ANN-88 VALUE 'A'. DTSBD710 00364 EJECT DTSBD710 00365 PROCEDURE DIVISION USING PARM-AREA. DTSBD710 00366 DTSBD710 00367 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD710 00368 DTSBD710 00369 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD710 00370 DTSBD710 00371 MOVE +0 TO MSKL-EMP-NO. DTSBD710 00372 DTSBD710 00373 SET MSKL-PRF-88 TO TRUE. DTSBD710 00374 DTSBD710 00375 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD710 00376 DTSBD710 00377 IF L910-OK-88 DTSBD710 00378 MOVE MSKL-REC TO MPRF-REC. DTSBD710 00379 DTSBD710 00380 DTSBD710 00381 *** PERFORM S1300-SBCF-READ-NEXT THRU S1300-EXIT. DTSBD710 00382 DTSBD710 00383 DTSBD710 00384 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD710 00385 DTSBD710 00386 DTSBD710 00387 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD710 00388 DTSBD710 00389 DTSBD710 00390 GOBACK. DTSBD710 00391 EJECT DTSBD710 00392 I0000-INITIATE. DTSBD710 00393 OPEN INPUT CHARGE-FILE. DTSBD710 00394 IF NOT CHG5-FILE-OK-88 DTSBD710 00395 DISPLAY 'CHARGE FILE OPEN ERROR: ' CHG5-STATUS DTSBD710 00396 PERFORM S999-ABEND THRU S999-EXIT DTSBD710 00397 END-IF. DTSBD710 00398 DTSBD710 00399 PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBD710 00400 DTSBD710 00401 PERFORM S931-OPEN-UPDATE THRU S931-EXIT. DTSBD710 00402 DTSBD710 00403 *** PERFORM S1100-SBCF-OPEN THRU S1100-EXIT. DTSBD710 00404 DTSBD710 00405 DTSBD710 00406 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD710 00407 DTSBD710 00408 MOVE +0 TO MSKL-EMP-NO. DTSBD710 00409 DTSBD710 00410 SET MSKL-HDR-88 TO TRUE. DTSBD710 00411 DTSBD710 00412 PERFORM S910-READ THRU S910-EXIT. DTSBD710 00413 DTSBD710 00414 IF L910-NO-REC-88 DTSBD710 00415 MOVE 'MHDR RECORD IS MISSING' DTSBD710 00416 TO ABEND-MSG DTSBD710 00417 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00418 DTSBD710 00419 MOVE MSKL-REC TO MHDR-REC. DTSBD710 00420 DTSBD710 00421 DTSBD710 00422 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DTSBD710 00423 DTSBD710 00424 DTSBD710 00425 PERFORM I2000-FIND-RATE-PERIOD THRU I2000-EXIT. DTSBD710 00426 DTSBD710 00427 DTSBD710 00428 PERFORM I3000-INITIALIZE-REC-CNTS THRU I3000-EXIT. DTSBD710 00429 DTSBD710 00430 DTSBD710 00431 PERFORM I4000-SET-ESTIM-WAGE-YRQ THRU I4000-EXIT. DTSBD710 00432 DTSBD710 00433 DTSBD710 00434 MOVE LENGTH OF R507-REC TO R507-LENGTH. DTSBD710 00435 DTSBD710 00436 MOVE '507' TO R507-REC-TYPE. DTSBD710 00437 DTSBD710 00438 MOVE WRK-EXP-CUTOFF-DATE TO R507-EXP-CUTOFF-DATE. DTSBD710 00439 DTSBD710 00440 MOVE WRK-RTE-YR-START-YRQ TO R507-EFF-QTR. DTSBD710 00441 DTSBD710 00442 DTSBD710 00443 MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9. DTSBD710 00444 DTSBD710 00445 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD710 00446 DTSBD710 00447 SUBTRACT 1 FROM L004-ABS-QTR. DTSBD710 00448 DTSBD710 00449 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD710 00450 DTSBD710 00451 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD710 00452 DTSBD710 00453 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD710 00454 DTSBD710 00455 MOVE L006-RTE-YR-START-YRQ TO WRK-PRIOR-RTE-YR-START-YRQ. DTSBD710 00456 DTSBD710 00457 DTSBD710 00458 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD710 00459 DTSBD710 00460 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. DTSBD710 00461 DTSBD710 00462 MOVE L005-DATE TO WRK-SYS-DATE. DTSBD710 00463 DTSBD710 00464 MOVE L005-TIME TO WRK-SYS-TIME. DTSBD710 00465 DTSBD710 00466 DTSBD710 00467 IF WRK-PURGE-MRCT-IND = 'Y' DTSBD710 00468 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSBD710 00469 MOVE +0 TO MSKL-EMP-NO DTSBD710 00470 SET MSKL-PRF-88 TO TRUE DTSBD710 00471 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBD710 00472 PERFORM DTSBD710 00473 UNTIL L910-NO-REC-88 DTSBD710 00474 MOVE MSKL-REC TO MPRF-REC DTSBD710 00475 PERFORM I9000-DELETE-MRCT THRU I9000-EXIT DTSBD710 00476 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSBD710 00477 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD710 00478 END-PERFORM. DTSBD710 00479 I0000-EXIT. DTSBD710 00480 EXIT. DTSBD710 00481 EJECT DTSBD710 00482 I1000-PROCESS-PARMS. DTSBD710 00483 IF PARM-LENGTH = +9 DTSBD710 00484 NEXT SENTENCE DTSBD710 00485 ELSE DTSBD710 00486 MOVE 'PARM-LENGTH NOT EQUAL TO 9' DTSBD710 00487 TO ABEND-MSG DTSBD710 00488 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00489 DTSBD710 00490 DTSBD710 00491 DISPLAY '***'. DTSBD710 00492 DTSBD710 00493 DISPLAY '*** ' DTSBD710 00494 WRK-MOD-NAME DTSBD710 00495 ' PARAMETERS: ' DTSBD710 00496 PARM-DATA. DTSBD710 00497 DTSBD710 00498 DISPLAY '***'. DTSBD710 00499 DTSBD710 00500 DTSBD710 00501 IF PARM-RTE-YR-START-YRQ-X = SPACES OR LOW-VALUES OR '000' DTSBD710 00502 PERFORM I1100-DEFAULT-START-YRQ THRU I1100-EXIT DTSBD710 00503 ELSE DTSBD710 00504 PERFORM I1200-EDIT-START-YRQ THRU I1200-EXIT. DTSBD710 00505 DTSBD710 00506 DTSBD710 00507 IF PARM-PURGE-MRCT-IND = SPACES OR LOW-VALUES DTSBD710 00508 MOVE 'N' TO WRK-PURGE-MRCT-IND DTSBD710 00509 ELSE DTSBD710 00510 IF PARM-PURGE-MRCT-IND = 'N' OR 'Y' DTSBD710 00511 MOVE PARM-PURGE-MRCT-IND TO WRK-PURGE-MRCT-IND DTSBD710 00512 ELSE DTSBD710 00513 MOVE 'INVALID PARM-PURGE-MRCT-IND VALUE ENCOUNTERED' DTSBD710 00514 TO ABEND-MSG DTSBD710 00515 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00516 DTSBD710 00517 IF PARM-UPDATE-MASTER-YES-88 DTSBD710 00518 SET WRK-UPDATE-MASTER-YES-88 TO TRUE DTSBD710 00519 ELSE DTSBD710 00520 IF PARM-UPDATE-MASTER-NO-88 DTSBD710 00521 SET WRK-UPDATE-MASTER-NO-88 TO TRUE DTSBD710 00522 ELSE DTSBD710 00523 MOVE 'PARM-UPDATE-MASTER-IND NOT VALID' TO ABEND-MSG DTSBD710 00524 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00525 DTSBD710 00526 IF PARM-RUN-TYPE-REG-88 DTSBD710 00527 SET WRK-RUN-TYPE-REG-88 TO TRUE DTSBD710 00528 ELSE DTSBD710 00529 IF PARM-RUN-TYPE-ANN-88 DTSBD710 00530 SET WRK-RUN-TYPE-ANN-88 TO TRUE DTSBD710 00531 ELSE DTSBD710 00532 MOVE 'PARM-RUN-TYPE-IND NOT VALID' TO ABEND-MSG DTSBD710 00533 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00534 I1000-EXIT. DTSBD710 00535 EXIT. DTSBD710 00536 SKIP3 DTSBD710 00537 I1100-DEFAULT-START-YRQ. DTSBD710 00538 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSBD710 00539 DTSBD710 00540 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD710 00541 DTSBD710 00542 IF L004-INVALID-QTR DTSBD710 00543 MOVE 'LOGIC ERROR I1100-1' DTSBD710 00544 TO ABEND-MSG DTSBD710 00545 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00546 DTSBD710 00547 DTSBD710 00548 ADD +1 TO L004-ABS-QTR. DTSBD710 00549 DTSBD710 00550 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD710 00551 DTSBD710 00552 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD710 00553 DTSBD710 00554 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD710 00555 DTSBD710 00556 IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ DTSBD710 00557 MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ DTSBD710 00558 MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ DTSBD710 00559 MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE DTSBD710 00560 MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE DTSBD710 00561 ELSE DTSBD710 00562 MOVE 'INVALID MHDR-LAST-RATE-YRQ ENCOUNTERED' DTSBD710 00563 TO ABEND-MSG DTSBD710 00564 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00565 I1100-EXIT. DTSBD710 00566 EXIT. DTSBD710 00567 SKIP3 DTSBD710 00568 I1200-EDIT-START-YRQ. DTSBD710 00569 MOVE PARM-RTE-YR-START-YRQ-X TO L004-QTR-3. DTSBD710 00570 DTSBD710 00571 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD710 00572 DTSBD710 00573 IF L004-INVALID-QTR DTSBD710 00574 MOVE 'INVALID PARM-RTE-YR-START-YRQ-X ENCOUNTERED' DTSBD710 00575 TO ABEND-MSG DTSBD710 00576 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00577 DTSBD710 00578 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD710 00579 DTSBD710 00580 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD710 00581 DTSBD710 00582 IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ DTSBD710 00583 MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ DTSBD710 00584 MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ DTSBD710 00585 MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE DTSBD710 00586 MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE DTSBD710 00587 ELSE DTSBD710 00588 MOVE 'PARM-RTE-YR-START-YRQ NOT FIRST QTR IN RATE YEAR' DTSBD710 00589 TO ABEND-MSG DTSBD710 00590 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00591 I1200-EXIT. DTSBD710 00592 EXIT. DTSBD710 00593 SKIP3 DTSBD710 00594 I2000-FIND-RATE-PERIOD. DTSBD710 00595 MOVE MHDR-PRIOR-RUN-DATE TO WRK-EXP-CUTOFF-DATE. DTSBD710 00596 DTSBD710 00597 MOVE WRK-RTE-YR-START-YRQ TO L055-EFF-YRQ. DTSBD710 00598 DTSBD710 00599 PERFORM S055-FROM-QTR THRU S055-EXIT. DTSBD710 00600 DTSBD710 00601 DTSBD710 00602 IF MHDR-LAST-MJRN-PURGE-DATE < L055-UI-TAX-PAID-FROM-DATE DTSBD710 00603 NEXT SENTENCE DTSBD710 00604 ELSE DTSBD710 00605 MOVE DTSBD710 00606 'MHDR-LAST-MJRN-PURGE-DATE/UI-TAX-PAID-FROM-DATE CONFLICT' DTSBD710 00607 TO ABEND-MSG DTSBD710 00608 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00609 I2000-EXIT. DTSBD710 00610 EXIT. DTSBD710 00611 SKIP3 DTSBD710 00612 I3000-INITIALIZE-REC-CNTS. DTSBD710 00613 MOVE +0 TO BCF-REC-CNT DTSBD710 00614 *** BCF-CHARGE-CURR-AMT DTSBD710 00615 RCT-REC-DELETE-CNT DTSBD710 00616 RCT-REC-WRITE-CNT DTSBD710 00617 RRA-REC-DELETE-CNT. DTSBD710 00618 I3000-EXIT. DTSBD710 00619 EXIT. DTSBD710 00620 SKIP3 DTSBD710 00621 ************************************************************* DTSBD710 00622 * WHEN CREATING A PRELIMINARY RATE FOR A HOUSEHOLD EMPLOYER DTSBD710 00623 * DTSBD710 USES THE FIRST QUARTER WAGES FROM THE PRIOR YEAR DTSBD710 00624 * AS AN ESTIMATE OF THE MISSING FIRST QUARTER WAGES. DTSBD710 00625 * THE FOLLOWING PARAGRAPH CALCULATES THE QUARTER WHOSE WAGES DTSBD710 00626 * ARE THE BASIS OF THE ESTIMATE. DTSBD710 00627 ************************************************************* DTSBD710 00628 I4000-SET-ESTIM-WAGE-YRQ. DTSBD710 00629 MOVE L055-WAGES-THRU-YRQ (3) TO L004-QTR-5-9. DTSBD710 00630 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD710 00631 DTSBD710 00632 IF L004-INVALID-QTR DTSBD710 00633 MOVE 'LOGIC ERROR I4000-1' DTSBD710 00634 TO ABEND-MSG DTSBD710 00635 PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 00636 DTSBD710 00637 DTSBD710 00638 SUBTRACT +1 FROM L004-QTR-5-YR. DTSBD710 00639 DTSBD710 00640 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD710 00641 DTSBD710 00642 MOVE L004-QTR-5-9 TO WRK-ESTIM-WAGE-YRQ. DTSBD710 00643 DTSBD710 00644 DISPLAY 'DTSBD710 I4000 L055 THRU YRQ ' DTSBD710 00645 L055-WAGES-THRU-YRQ (3) DTSBD710 00646 ' EST WAGE YRQ ' WRK-ESTIM-WAGE-YRQ. DTSBD710 00647 DTSBD710 00648 I4000-EXIT. DTSBD710 00649 EXIT. DTSBD710 00650 SKIP3 DTSBD710 00651 I9000-DELETE-MRCT. DTSBD710 00652 PERFORM I9100-MRCT THRU I9100-EXIT. DTSBD710 00653 PERFORM I9200-MRRA THRU I9200-EXIT. DTSBD710 00654 DTSBD710 00655 PERFORM S9000-EMPLOYER-UPDATED THRU S9000-EXIT. DTSBD710 00656 DTSBD710 00657 I9000-EXIT. DTSBD710 00658 EXIT. DTSBD710 00659 DTSBD710 00660 I9100-MRCT. DTSBD710 00661 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD710 00662 MOVE MPRF-EMP-NO TO MRCT-EMP-NO. DTSBD710 00663 SET MRCT-RCT-88 TO TRUE. DTSBD710 00664 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD710 00665 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD710 00666 PERFORM S910-READ THRU S910-EXIT. DTSBD710 00667 IF L910-NO-REC-88 DTSBD710 00668 GO TO I9100-EXIT DTSBD710 00669 ELSE DTSBD710 00670 PERFORM S910-DELETE THRU S910-EXIT DTSBD710 00671 END-IF. DTSBD710 00672 DTSBD710 00673 ADD +1 TO RCT-REC-DELETE-CNT. DTSBD710 00674 DTSBD710 00675 I9100-EXIT. DTSBD710 00676 EXIT. DTSBD710 00677 DTSBD710 00678 I9200-MRRA. DTSBD710 00679 MOVE LOW-VALUES TO MRRA-KEY-AREA. DTSBD710 00680 MOVE MPRF-EMP-NO TO MRRA-EMP-NO. DTSBD710 00681 SET MRRA-RRA-88 TO TRUE. DTSBD710 00682 MOVE WRK-RTE-YR-START-YRQ TO MRRA-RATE-EFF-YRQ. DTSBD710 00683 MOVE MRRA-KEY-AREA TO MSKL-KEY-AREA. DTSBD710 00684 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD710 00685 IF L910-OK-88 DTSBD710 00686 PERFORM UNTIL L910-NO-REC-88 DTSBD710 00687 MOVE MSKL-REC TO MRRA-REC DTSBD710 00688 IF MRRA-RATE-EFF-YRQ = WRK-RTE-YR-START-YRQ DTSBD710 00689 PERFORM S910-DELETE THRU S910-EXIT DTSBD710 00690 ADD +1 TO RRA-REC-DELETE-CNT DTSBD710 00691 END-IF DTSBD710 00692 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD710 00693 DTSBD710 00694 END-PERFORM DTSBD710 00695 END-IF. DTSBD710 00696 DTSBD710 00697 I9200-EXIT. DTSBD710 00698 EXIT. DTSBD710 00699 DTSBD710 00700 P0000-PROCESS. DTSBD710 00701 PERFORM UNTIL L910-NO-REC-88 DTSBD710 00702 MOVE MSKL-REC TO MPRF-REC DTSBD710 00703 IF MPRF-CLASS-RATED-88 DTSBD710 00704 PERFORM P1000-PROCESS-MPRF THRU P1000-EXIT DTSBD710 00705 END-IF DTSBD710 00706 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSBD710 00707 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD710 00708 END-PERFORM. DTSBD710 00709 DTSBD710 00710 P0000-EXIT. DTSBD710 00711 EXIT. DTSBD710 00712 EJECT DTSBD710 00713 P1000-PROCESS-MPRF. DTSBD710 00714 IF WRK-RUN-TYPE-ANN-88 DTSBD710 00715 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBD710 00716 SET L410-MODE-INPUT-YRQ-88 TO TRUE DTSBD710 00717 MOVE MPRF-EMP-NO TO L410-EMP-NO DTSBD710 00718 MOVE WRK-RTE-YR-START-YRQ TO L410-YRQ DTSBD710 00719 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSBD710 00720 IF L410-ANN-SCHED-88 DTSBD710 00721 NEXT SENTENCE DTSBD710 00722 ELSE DTSBD710 00723 GO TO P1000-EXIT DTSBD710 00724 END-IF DTSBD710 00725 ELSE DTSBD710 00726 GO TO P1000-EXIT DTSBD710 00727 END-IF DTSBD710 00728 END-IF. DTSBD710 00729 DTSBD710 00730 DTSBD710 00731 DTSBD710 00732 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD710 00733 DTSBD710 00734 MOVE MPRF-EMP-NO TO MRCT-EMP-NO. DTSBD710 00735 DTSBD710 00736 SET MRCT-RCT-88 TO TRUE. DTSBD710 00737 DTSBD710 00738 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD710 00739 DTSBD710 00740 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD710 00741 DTSBD710 00742 PERFORM S910-READ THRU S910-EXIT. DTSBD710 00743 DTSBD710 00744 IF L910-OK-88 DTSBD710 00745 MOVE MPRF-EMP-NO TO R507-SUCC-EMP-NO DTSBD710 00746 MOVE MPRF-PRIMARY-NAME TO R507-SUCC-PRIMARY-NAME DTSBD710 00747 MOVE +0 TO R507-PRED-EMP-NO DTSBD710 00748 MOVE SPACES TO R507-PRED-PRIMARY-NAME DTSBD710 00749 MOVE MSG03-MSG-TEXT TO R507-MSG-TEXT DTSBD710 00750 PERFORM S946-WRITE-R507 THRU S946-EXIT DTSBD710 00751 GO TO P1000-EXIT. DTSBD710 00752 DTSBD710 00753 DTSBD710 00754 MOVE +0 TO WRK-PRIOR-RESERVE-AMT. DTSBD710 00755 DTSBD710 00756 PERFORM P1100-PRIOR-RESERVE-AMT THRU P1100-EXIT. DTSBD710 00757 DTSBD710 00758 DTSBD710 00759 PERFORM P1200-INITIALIZE-MRCT THRU P1200-EXIT. DTSBD710 00760 DTSBD710 00761 DTSBD710 00762 IF MPRF-STATUS-ACT-88 DTSBD710 00763 SET MRCT-EMP-ACTIVE-YES-88 TO TRUE DTSBD710 00764 ELSE DTSBD710 00765 SET MRCT-EMP-ACTIVE-NO-88 TO TRUE. DTSBD710 00766 DTSBD710 00767 DTSBD710 00768 MOVE WRK-PRIOR-RESERVE-AMT TO MRCT-PRIOR-RESERVE-AMT. DTSBD710 00769 DTSBD710 00770 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD710 00771 DTSBD710 00772 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD710 00773 DTSBD710 00774 SET MSKL-JRN-88 TO TRUE. DTSBD710 00775 DTSBD710 00776 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD710 00777 DTSBD710 00778 PERFORM DTSBD710 00779 UNTIL L910-NO-REC-88 DTSBD710 00780 MOVE MSKL-REC TO MJRN-REC DTSBD710 00781 PERFORM P1300-PROCESS-MJRN THRU P1300-EXIT DTSBD710 00782 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD710 00783 END-PERFORM. DTSBD710 00784 DTSBD710 00785 DTSBD710 00786 PERFORM P2000-BENEFIT-CHARGE THRU P2000-EXIT. DTSBD710 00787 MOVE WRK-TOT-CHARGE TO MRCT-BENEFITS-CHARGED-AMT. DTSBD710 00788 *** MOVE BCF-HOLD-CHARGE-CURR-AMT TO MRCT-BENEFITS-CHARGED-AMT. DTSBD710 00789 DTSBD710 00790 DTSBD710 00791 IF MPRF-LAST-ARCHIVED-YRQ < L055-WAGES-FROM-YRQ (1) DTSBD710 00792 NEXT SENTENCE DTSBD710 00793 ELSE DTSBD710 00794 MOVE MSG05-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER DTSBD710 00795 MOVE MPRF-EMP-NO TO R507-SUCC-EMP-NO DTSBD710 00796 MOVE MPRF-PRIMARY-NAME TO R507-SUCC-PRIMARY-NAME DTSBD710 00797 MOVE +0 TO R507-PRED-EMP-NO DTSBD710 00798 MOVE SPACES TO R507-PRED-PRIMARY-NAME DTSBD710 00799 MOVE MSG05-MSG-TEXT TO R507-MSG-TEXT DTSBD710 00800 PERFORM S946-WRITE-R507 THRU S946-EXIT. DTSBD710 00801 DTSBD710 00802 DTSBD710 00803 MOVE ZERO TO WRK-ESTIM-TAX-WAGE. DTSBD710 00804 DTSBD710 00805 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD710 00806 DTSBD710 00807 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD710 00808 DTSBD710 00809 SET MQTR-QTR-88 TO TRUE. DTSBD710 00810 DTSBD710 00811 MOVE L055-WAGES-FROM-YRQ (1) TO MQTR-YRQ. DTSBD710 00812 DTSBD710 00813 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD710 00814 DTSBD710 00815 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD710 00816 DTSBD710 00817 PERFORM DTSBD710 00818 UNTIL L910-NO-REC-88 DTSBD710 00819 MOVE MSKL-REC TO MQTR-REC DTSBD710 00820 PERFORM P1400-PROCESS-MQTR THRU P1400-EXIT DTSBD710 00821 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD710 00822 END-PERFORM. DTSBD710 00823 DTSBD710 00824 DTSBD710 00825 IF WRK-RUN-TYPE-REG-88 DTSBD710 00826 PERFORM P1450-CHECK-HOUSEHOLD THRU P1450-EXIT. DTSBD710 00827 DTSBD710 00828 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD710 00829 DTSBD710 00830 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD710 00831 DTSBD710 00832 SET MSKL-SOL-88 TO TRUE. DTSBD710 00833 DTSBD710 00834 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD710 00835 DTSBD710 00836 PERFORM DTSBD710 00837 UNTIL (L910-NO-REC-88) DTSBD710 00838 OR DTSBD710 00839 (MRCT-EARLIEST-LIAB-DATE > +0) DTSBD710 00840 MOVE MSKL-REC TO MSOL-REC DTSBD710 00841 PERFORM P1500-PROCESS-MSOL THRU P1500-EXIT DTSBD710 00842 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD710 00843 END-PERFORM. DTSBD710 00844 DTSBD710 00845 IF MRCT-EARLIEST-LIAB-DATE = +0 DTSBD710 00846 DISPLAY ' ELD DATE = ZEROS ' MRCT-EMP-NO CL**4 00847 MOVE WRK-EXP-CUTOFF-DATE TO MRCT-EARLIEST-LIAB-DATE. DTSBD710 00848 DTSBD710 00849 MOVE MPRF-PURSUED-RPT-CNT TO MRCT-MISS-RPT-CNT. DTSBD710 00850 DTSBD710 00851 DTSBD710 00852 IF MPRF-TOT-BALANCE-AMT > +0 DTSBD710 00853 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSBD710 00854 MOVE MPRF-EMP-NO TO MSKL-EMP-NO DTSBD710 00855 SET MSKL-QTR-88 TO TRUE DTSBD710 00856 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBD710 00857 PERFORM DTSBD710 00858 UNTIL L910-NO-REC-88 DTSBD710 00859 MOVE MSKL-REC TO MQTR-REC DTSBD710 00860 PERFORM P1600-PROCESS-MQTR THRU P1600-EXIT DTSBD710 00861 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD710 00862 END-PERFORM. DTSBD710 00863 DTSBD710 00864 DTSBD710 00865 SET MRCT-PRED-DUE-NO-88 TO TRUE. DTSBD710 00866 DTSBD710 00867 DTSBD710 00868 MOVE +0 TO MRCT-TRANSFERRED-TO-EMP-NO. DTSBD710 00869 DTSBD710 00870 DTSBD710 00871 SET MRCT-CHNG-SYSTEM-88 TO TRUE. DTSBD710 00872 DTSBD710 00873 DTSBD710 00874 MOVE MRCT-REC TO MSKL-REC. DTSBD710 00875 DTSBD710 00876 PERFORM S910-WRITE THRU S910-EXIT. DTSBD710 00877 DTSBD710 00878 DISPLAY 'BD710 -MSOL/MRCT ELD DATE ' MPRF-EMP-NO ' ' CL**3 00879 MRCT-EARLIEST-LIAB-DATE. CL**3 00880 CL**3 00881 ADD +1 TO RCT-REC-WRITE-CNT. DTSBD710 00882 DTSBD710 00883 PERFORM S9000-EMPLOYER-UPDATED THRU S9000-EXIT. DTSBD710 00884 P1000-EXIT. DTSBD710 00885 EXIT. DTSBD710 00886 DTSBD710 00887 P1100-PRIOR-RESERVE-AMT. DTSBD710 00888 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD710 00889 DTSBD710 00890 MOVE MPRF-EMP-NO TO MRCT-EMP-NO. DTSBD710 00891 DTSBD710 00892 SET MRCT-RCT-88 TO TRUE. DTSBD710 00893 DTSBD710 00894 MOVE WRK-PRIOR-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD710 00895 DTSBD710 00896 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD710 00897 DTSBD710 00898 PERFORM S910-READ THRU S910-EXIT. DTSBD710 00899 DTSBD710 00900 IF L910-NO-REC-88 DTSBD710 00901 NEXT SENTENCE CL**6 00902 ELSE CL**6 00903 GO TO P1100-PRIOR-RESERVE-AMT-CONT. CL**6 00904 CL**6 00905 MOVE 20221 TO MRCT-EFF-YRQ. CL*10 00906 CL**6 00907 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. CL**6 00908 CL**6 00909 PERFORM S910-READ THRU S910-EXIT. CL**6 00910 CL**6 00911 IF L910-NO-REC-88 CL**6 00912 NEXT SENTENCE CL**9 00913 ELSE CL**9 00914 DISPLAY ' USING 2022 RESERVE BAL ' MRCT-EMP-NO CL*10 00915 GO TO P1100-PRIOR-RESERVE-AMT-CONT. CL**9 00916 CL**7 00917 MOVE 20211 TO MRCT-EFF-YRQ. CL*10 00918 CL**9 00919 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. CL**9 00920 CL**9 00921 PERFORM S910-READ THRU S910-EXIT. CL**9 00922 CL**9 00923 IF L910-NO-REC-88 CL**9 00924 NEXT SENTENCE CL*10 00925 ELSE CL**9 00926 DISPLAY ' USING 2021 RESERVE BAL ' MRCT-EMP-NO CL*10 00927 GO TO P1100-PRIOR-RESERVE-AMT-CONT. CL**9 00928 CL**9 00929 MOVE 20201 TO MRCT-EFF-YRQ. CL*10 00930 CL*10 00931 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. CL*10 00932 CL*10 00933 PERFORM S910-READ THRU S910-EXIT. CL*10 00934 CL*10 00935 IF L910-NO-REC-88 CL*10 00936 NEXT SENTENCE CL*10 00937 ELSE CL*10 00938 DISPLAY ' USING 2020 RESERVE BAL ' MRCT-EMP-NO CL*10 00939 GO TO P1100-PRIOR-RESERVE-AMT-CONT. CL*10 00940 CL*10 00941 MOVE 20191 TO MRCT-EFF-YRQ. CL*10 00942 CL*10 00943 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. CL*10 00944 CL*10 00945 PERFORM S910-READ THRU S910-EXIT. CL*10 00946 CL*10 00947 IF L910-NO-REC-88 CL*10 00948 DISPLAY ' ******** NO RESERVE BAL FOUND ' MRCT-EMP-NO CL*10 00949 GO TO P1100-EXIT CL*10 00950 ELSE CL*10 00951 DISPLAY ' USING 2020 RESERVE BAL ' MRCT-EMP-NO CL*10 00952 GO TO P1100-PRIOR-RESERVE-AMT-CONT. CL*10 00953 P1100-PRIOR-RESERVE-AMT-CONT. CL**6 00954 MOVE MSKL-REC TO MRCT-REC. DTSBD710 00955 DTSBD710 00956 DTSBD710 00957 IF MRCT-TRANSFERRED-TO-EMP-NO = +0 DTSBD710 00958 NEXT SENTENCE DTSBD710 00959 ELSE DTSBD710 00960 GO TO P1100-EXIT. DTSBD710 00961 DTSBD710 00962 DTSBD710 00963 COMPUTE WRK-PRIOR-RESERVE-AMT DTSBD710 00964 = MRCT-PRIOR-RESERVE-AMT DTSBD710 00965 + MRCT-UI-TAX-PAID-AMT DTSBD710 00966 + MRCT-TRUST-FUND-INTEREST-AMT DTSBD710 00967 - MRCT-BENEFITS-CHARGED-AMT. DTSBD710 00968 P1100-EXIT. DTSBD710 00969 EXIT. DTSBD710 00970 EJECT DTSBD710 00971 P1200-INITIALIZE-MRCT. DTSBD710 00972 MOVE LOW-VALUES TO MRCT-REC. DTSBD710 00973 DTSBD710 00974 MOVE MPRF-EMP-NO TO MRCT-EMP-NO. DTSBD710 00975 DTSBD710 00976 SET MRCT-RCT-88 TO TRUE. DTSBD710 00977 DTSBD710 00978 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD710 00979 DTSBD710 00980 MOVE +0 TO MRCT-PURGE-DATE. DTSBD710 00981 DTSBD710 00982 SET MRCT-EMP-ACTIVE-NO-88 TO TRUE. DTSBD710 00983 DTSBD710 00984 MOVE +0 TO MRCT-PRIOR-RESERVE-AMT DTSBD710 00985 MRCT-UI-TAX-PAID-AMT DTSBD710 00986 MRCT-TRUST-FUND-INTEREST-AMT DTSBD710 00987 MRCT-BENEFITS-CHARGED-AMT DTSBD710 00988 MRCT-QTR1-ESTIM-TAX-WAGE. DTSBD710 00989 DTSBD710 00990 PERFORM DTSBD710 00991 VARYING MRCT-WAGES-IDX FROM 1 BY 1 DTSBD710 00992 UNTIL MRCT-WAGES-IDX > MMAX-RCT-EXP-MAX DTSBD710 00993 MOVE +0 TO MRCT-TOT-WAGE (MRCT-WAGES-IDX) DTSBD710 00994 MRCT-TAX-WAGE (MRCT-WAGES-IDX) DTSBD710 00995 END-PERFORM. DTSBD710 00996 DTSBD710 00997 MOVE +0 TO MRCT-EARLIEST-LIAB-DATE DTSBD710 00998 MRCT-MISS-RPT-CNT DTSBD710 00999 MRCT-TOT-UI-TAX-BALANCE-AMT. DTSBD710 01000 DTSBD710 01001 SET MRCT-PRED-DUE-NO-88 TO TRUE. DTSBD710 01002 DTSBD710 01003 MOVE +0 TO MRCT-TRANSFERRED-TO-EMP-NO. DTSBD710 01004 DTSBD710 01005 SET MRCT-CHNG-SYSTEM-88 TO TRUE. DTSBD710 01006 DTSBD710 01007 SET MRCT-NOT-CONVERTED-88 TO TRUE. DTSBD710 01008 DTSBD710 01009 MOVE MHDR-CURR-RUN-DATE TO MRCT-ESTB-DATE DTSBD710 01010 MRCT-CHNG-DATE. DTSBD710 01011 P1200-EXIT. DTSBD710 01012 EXIT. DTSBD710 01013 EJECT DTSBD710 01014 P1300-PROCESS-MJRN. DTSBD710 01015 ***> CHANGED TO INCLUDE JRN RECORDS BASED ON RECEIVED DTSBD710 01016 ***> DATE RATHER THAN PROCESSED DATE. 12/12/2003 GD DTSBD710 01017 IF (MJRN-RECEIVED-DATE < L055-UI-TAX-PAID-FROM-DATE) DTSBD710 01018 OR DTSBD710 01019 (MJRN-RECEIVED-DATE > L055-UI-TAX-PAID-THRU-DATE) DTSBD710 01020 GO TO P1300-EXIT. DTSBD710 01021 DTSBD710 01022 * IF (MJRN-ESTB-DATE < L055-UI-TAX-PAID-FROM-DATE) DTSBD710 01023 * OR DTSBD710 01024 * (MJRN-ESTB-DATE > L055-UI-TAX-PAID-THRU-DATE) DTSBD710 01025 * GO TO P1300-EXIT. DTSBD710 01026 DTSBD710 01027 DTSBD710 01028 PERFORM DTSBD710 01029 VARYING MJRN-OCC-IDX FROM 1 BY 1 DTSBD710 01030 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBD710 01031 IF (MJRN-ROW-UI-88 (MJRN-OCC-IDX)) DTSBD710 01032 AND DTSBD710 01033 (MJRN-COL-PAID-88 (MJRN-OCC-IDX)) DTSBD710 01034 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBD710 01035 TO MRCT-UI-TAX-PAID-AMT DTSBD710 01036 END-IF DTSBD710 01037 END-PERFORM. DTSBD710 01038 P1300-EXIT. DTSBD710 01039 EXIT. DTSBD710 01040 P1400-PROCESS-MQTR. DTSBD710 01041 PERFORM DTSBD710 01042 VARYING L055-WAGES-IDX FROM 1 BY 1 DTSBD710 01043 UNTIL L055-WAGES-IDX > MMAX-RCT-EXP-MAX DTSBD710 01044 IF (MQTR-YRQ >= L055-WAGES-FROM-YRQ (L055-WAGES-IDX)) DTSBD710 01045 AND DTSBD710 01046 (MQTR-YRQ <= L055-WAGES-THRU-YRQ (L055-WAGES-IDX)) DTSBD710 01047 SET MRCT-WAGES-IDX TO L055-WAGES-IDX DTSBD710 01048 ADD MQTR-TOT-WAGE DTSBD710 01049 TO MRCT-TOT-WAGE (MRCT-WAGES-IDX) DTSBD710 01050 ADD MQTR-TAX-WAGE DTSBD710 01051 TO MRCT-TAX-WAGE (MRCT-WAGES-IDX) DTSBD710 01052 END-IF DTSBD710 01053 IF MQTR-YRQ = WRK-ESTIM-WAGE-YRQ DTSBD710 01054 MOVE MQTR-TAX-WAGE TO WRK-ESTIM-TAX-WAGE DTSBD710 01055 END-IF DTSBD710 01056 END-PERFORM. DTSBD710 01057 DTSBD710 01058 P1400-EXIT. DTSBD710 01059 EXIT. DTSBD710 01060 EJECT DTSBD710 01061 ************************************************************* DTSBD710 01062 * FOR HOUSEHOLD EMPLOYERS ONLY, SAVE THE TAXABLE WAGE DTSBD710 01063 * AMOUNT FROM THE QUARTER THAT IS USED TO ESTIMATE THE DTSBD710 01064 * MISSING QUARTER. DTSBD710 01065 * DTSBD710 01066 ************************************************************** DTSBD710 01067 P1450-CHECK-HOUSEHOLD. DTSBD710 01068 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBD710 01069 MOVE WRK-ESTIM-TAX-WAGE TO MRCT-QTR1-ESTIM-TAX-WAGE DTSBD710 01070 ADD +1 TO WRK-ESTIM-WAGE-CNT DTSBD710 01071 ELSE DTSBD710 01072 MOVE ZERO TO MRCT-QTR1-ESTIM-TAX-WAGE. DTSBD710 01073 DTSBD710 01074 P1450-EXIT. DTSBD710 01075 EXIT. DTSBD710 01076 DTSBD710 01077 DTSBD710 01078 P1500-PROCESS-MSOL. DTSBD710 01079 IF MSOL-INACT-WITHDRAWN-88 DTSBD710 01080 NEXT SENTENCE DTSBD710 01081 ELSE DTSBD710 01082 MOVE MSOL-LIAB-DATE TO MRCT-EARLIEST-LIAB-DATE. DTSBD710 01083 P1500-EXIT. DTSBD710 01084 EXIT. DTSBD710 01085 EJECT DTSBD710 01086 P1600-PROCESS-MQTR. DTSBD710 01087 PERFORM DTSBD710 01088 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD710 01089 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD710 01090 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD710 01091 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD710 01092 TO MRCT-TOT-UI-TAX-BALANCE-AMT DTSBD710 01093 END-IF DTSBD710 01094 END-PERFORM. DTSBD710 01095 P1600-EXIT. DTSBD710 01096 EXIT. DTSBD710 01097 DTSBD710 01098 P2000-BENEFIT-CHARGE. DTSBD710 01099 MOVE ZERO TO WRK-TOT-CHARGE. DTSBD710 01100 MOVE LOW-VALUES TO CHG5-SORT-KEY-AREA. DTSBD710 01101 MOVE MPRF-EMP-NO TO CHG5-EMP-NO. DTSBD710 01102 DTSBD710 01103 START CHARGE-FILE DTSBD710 01104 KEY IS >= CHG5-SORT-KEY-AREA. DTSBD710 01105 DTSBD710 01106 IF NOT CHG5-FILE-OK-88 DTSBD710 01107 GO TO P2000-EXIT DTSBD710 01108 ** DISPLAY 'CHARGE FILE START ERROR: ' CHG5-STATUS DTSBD710 01109 ** ' ' CHG5-EMP-NO DTSBD710 01110 ELSE DTSBD710 01111 READ CHARGE-FILE NEXT DTSBD710 01112 PERFORM DTSBD710 01113 UNTIL CHG5-FILE-EOF-88 DTSBD710 01114 OR CHG5-EMP-NO NOT = MPRF-EMP-NO DTSBD710 01115 OR WRK-ERROR-YES-88 DTSBD710 01116 ADD CHG5-TOT-CHG-AMT TO WRK-TOT-CHARGE DTSBD710 01117 READ CHARGE-FILE NEXT DTSBD710 01118 END-PERFORM DTSBD710 01119 END-IF. DTSBD710 01120 DTSBD710 01121 P2000-EXIT. DTSBD710 01122 EXIT. DTSBD710 01123 DTSBD710 01124 T0000-TERMINATE. DTSBD710 01125 DTSBD710 01126 IF WRK-RUN-TYPE-ANN-88 DTSBD710 01127 GO TO T0000-TERMINATE-ANN. DTSBD710 01128 DTSBD710 01129 MOVE LOW-VALUE TO FUIR-KEY-AREA. DTSBD710 01130 DTSBD710 01131 SET FUIR-UIR-88 TO TRUE. DTSBD710 01132 DTSBD710 01133 MOVE WRK-RTE-YR-START-YRQ TO FUIR-EFF-YRQ. DTSBD710 01134 DTSBD710 01135 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBD710 01136 DTSBD710 01137 PERFORM S931-READ THRU S931-EXIT. DTSBD710 01138 DTSBD710 01139 IF L931-OK-88 DTSBD710 01140 MOVE FSKL-REC TO FUIR-REC DTSBD710 01141 MOVE WRK-EXP-CUTOFF-DATE TO FUIR-RATE-CUTOFF-DATE DTSBD710 01142 MOVE MHDR-CURR-RUN-DATE TO FUIR-CHNG-DATE DTSBD710 01143 MOVE FUIR-REC TO FSKL-REC DTSBD710 01144 PERFORM S931-REWRITE THRU S931-EXIT DTSBD710 01145 ELSE DTSBD710 01146 PERFORM T1000-NEW-FUIR THRU T1000-EXIT. DTSBD710 01147 DTSBD710 01148 T0000-TERMINATE-ANN. DTSBD710 01149 DTSBD710 01150 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD710 01151 DTSBD710 01152 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD710 01153 DTSBD710 01154 CLOSE CHARGE-FILE. DTSBD710 01155 DTSBD710 01156 *** PERFORM S1400-SBCF-CLOSE THRU S1400-EXIT. DTSBD710 01157 DTSBD710 01158 MOVE -1 TO R507-LENGTH. DTSBD710 01159 DTSBD710 01160 PERFORM S946-WRITE-R507 THRU S946-EXIT. DTSBD710 01161 DTSBD710 01162 DTSBD710 01163 DISPLAY '***'. DTSBD710 01164 DTSBD710 01165 DISPLAY '*** ' DTSBD710 01166 WRK-MOD-NAME DTSBD710 01167 ' TERMINATION DISPLAYS'. DTSBD710 01168 DTSBD710 01169 DTSBD710 01170 MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9. DTSBD710 01171 DTSBD710 01172 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD710 01173 DTSBD710 01174 DISPLAY '*** RATE YEAR START QUARTER: ' DTSBD710 01175 L004-SLASH-5-QTR. DTSBD710 01176 DTSBD710 01177 DTSBD710 01178 DISPLAY '***'. DTSBD710 01179 DTSBD710 01180 MOVE WRK-RTE-YR-END-YRQ TO L004-QTR-5-9. DTSBD710 01181 DTSBD710 01182 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD710 01183 DTSBD710 01184 DISPLAY '*** RATE YEAR END QUARTER: ' DTSBD710 01185 L004-SLASH-5-QTR. DTSBD710 01186 DTSBD710 01187 DTSBD710 01188 DISPLAY '***'. DTSBD710 01189 DTSBD710 01190 MOVE WRK-RTE-YR-START-DATE TO L001-FED-8-DATE-9. DTSBD710 01191 DTSBD710 01192 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD710 01193 DTSBD710 01194 DISPLAY '*** RATE YEAR START DATE: ' DTSBD710 01195 L001-SLASH-8-DATE. DTSBD710 01196 DTSBD710 01197 DTSBD710 01198 DISPLAY '***'. DTSBD710 01199 DTSBD710 01200 MOVE WRK-RTE-YR-END-DATE TO L001-FED-8-DATE-9. DTSBD710 01201 DTSBD710 01202 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD710 01203 DTSBD710 01204 DISPLAY '*** RATE YEAR END DATE: ' DTSBD710 01205 L001-SLASH-8-DATE. DTSBD710 01206 DTSBD710 01207 DTSBD710 01208 DISPLAY '***'. DTSBD710 01209 DTSBD710 01210 MOVE WRK-EXP-CUTOFF-DATE TO L001-FED-8-DATE-9. DTSBD710 01211 DTSBD710 01212 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD710 01213 DTSBD710 01214 DISPLAY '*** RATING EXPERIENCE CUTOFF DATE: ' DTSBD710 01215 L001-SLASH-8-DATE. DTSBD710 01216 DTSBD710 01217 DTSBD710 01218 DISPLAY '***'. DTSBD710 01219 DTSBD710 01220 MOVE WRK-PRIOR-RTE-YR-START-YRQ TO L004-QTR-5-9. DTSBD710 01221 DTSBD710 01222 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD710 01223 DTSBD710 01224 DISPLAY '*** PRIOR RATE YEAR START QUARTER: ' DTSBD710 01225 L004-SLASH-5-QTR. DTSBD710 01226 DTSBD710 01227 DTSBD710 01228 DISPLAY '***'. DTSBD710 01229 DTSBD710 01230 MOVE L055-UI-BEN-CHGD-FROM-DATE TO L001-FED-8-DATE-9. DTSBD710 01231 DTSBD710 01232 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD710 01233 DTSBD710 01234 DISPLAY '*** UI BENEFITS CHARGED FROM DATE: ' DTSBD710 01235 L001-SLASH-8-DATE. DTSBD710 01236 DTSBD710 01237 DTSBD710 01238 DISPLAY '***'. DTSBD710 01239 DTSBD710 01240 MOVE L055-UI-BEN-CHGD-THRU-DATE TO L001-FED-8-DATE-9. DTSBD710 01241 DTSBD710 01242 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD710 01243 DTSBD710 01244 DISPLAY '*** UI BENEFITS CHARGED THRU DATE: ' DTSBD710 01245 L001-SLASH-8-DATE. DTSBD710 01246 DTSBD710 01247 DTSBD710 01248 DISPLAY '***'. DTSBD710 01249 DTSBD710 01250 MOVE BCF-REC-CNT TO WRK-DISPLAY-CNT-9. DTSBD710 01251 DTSBD710 01252 DISPLAY '*** CHARGE DETAIL RECORDS INPUT: ' DTSBD710 01253 WRK-DISPLAY-CNT-X. DTSBD710 01254 DTSBD710 01255 DTSBD710 01256 DISPLAY '***'. DTSBD710 01257 DTSBD710 01258 ** MOVE BCF-CHARGE-CURR-AMT TO WRK-DISPLAY-AMT-9. DTSBD710 01259 * DTSBD710 01260 * DISPLAY '*** CHARGE CURRENT AMOUNT INPUT: ' DTSBD710 01261 ** WRK-DISPLAY-AMT-X. DTSBD710 01262 DTSBD710 01263 DTSBD710 01264 DTSBD710 01265 DISPLAY '***'. DTSBD710 01266 DTSBD710 01267 MOVE RCT-REC-DELETE-CNT TO WRK-DISPLAY-CNT-9. DTSBD710 01268 DTSBD710 01269 DISPLAY '*** MRCT RECORD OCCURRENCES DELETED: ' DTSBD710 01270 WRK-DISPLAY-CNT-X. DTSBD710 01271 DTSBD710 01272 DTSBD710 01273 DISPLAY '***'. DTSBD710 01274 DTSBD710 01275 MOVE RCT-REC-WRITE-CNT TO WRK-DISPLAY-CNT-9. DTSBD710 01276 DTSBD710 01277 DISPLAY '*** MRCT RECORD OCCURRENCES WRITTEN: ' DTSBD710 01278 WRK-DISPLAY-CNT-X. DTSBD710 01279 DTSBD710 01280 DISPLAY '***'. DTSBD710 01281 DTSBD710 01282 MOVE WRK-ESTIM-WAGE-CNT TO WRK-DISPLAY-CNT-9. DTSBD710 01283 DTSBD710 01284 DISPLAY '*** EMPLOYERS WITH ESTIMATED WAGES: ' DTSBD710 01285 WRK-DISPLAY-CNT-X. DTSBD710 01286 DTSBD710 01287 T0000-EXIT. DTSBD710 01288 EXIT. DTSBD710 01289 SKIP3 DTSBD710 01290 T1000-NEW-FUIR. DTSBD710 01291 MOVE LOW-VALUES TO FUIR-DATA-AREA. DTSBD710 01292 DTSBD710 01293 DTSBD710 01294 MOVE SPACES TO FUIR-RATE-TABLE. DTSBD710 01295 DTSBD710 01296 MOVE +0 TO FUIR-TOT-TRUST-FUND-INT-AMT DTSBD710 01297 FUIR-TOT-POS-RESERVE-BAL-AMT DTSBD710 01298 FUIR-TOT-POS-RESERVE-EMP-CNT DTSBD710 01299 FUIR-DIST-TRUST-FUND-INT-AMT. DTSBD710 01300 DTSBD710 01301 MOVE 999999999.99 TO FUIR-MIN-TAX-BAL-DUE-AMT. DTSBD710 01302 DTSBD710 01303 MOVE 999 TO FUIR-MIN-MISS-RPT-CNT. DTSBD710 01304 DTSBD710 01305 MOVE WRK-EXP-CUTOFF-DATE TO FUIR-RATE-CUTOFF-DATE. DTSBD710 01306 DTSBD710 01307 MOVE +0 TO FUIR-RATE-NOTICE-DATE DTSBD710 01308 FUIR-PENALTY-RATE-DATE DTSBD710 01309 FUIR-DEFAULT-NEW-EMP-RATE DTSBD710 01310 FUIR-RATE-CNT. DTSBD710 01311 DTSBD710 01312 PERFORM DTSBD710 01313 VARYING FUIR-RATE-IDX FROM 1 BY 1 DTSBD710 01314 UNTIL FUIR-RATE-IDX > FMAX-UIR-RATE-RATIO-MAX DTSBD710 01315 MOVE +0 TO FUIR-UI-RATE (FUIR-RATE-IDX) DTSBD710 01316 FUIR-MIN-RATIO (FUIR-RATE-IDX) DTSBD710 01317 FUIR-MAX-RATIO (FUIR-RATE-IDX) DTSBD710 01318 END-PERFORM. DTSBD710 01319 DTSBD710 01320 MOVE MHDR-CURR-RUN-DATE TO FUIR-ESTB-DATE DTSBD710 01321 FUIR-CHNG-DATE. DTSBD710 01322 DTSBD710 01323 MOVE FUIR-REC TO FSKL-REC. DTSBD710 01324 DTSBD710 01325 PERFORM S931-WRITE THRU S931-EXIT. DTSBD710 01326 T1000-EXIT. DTSBD710 01327 EXIT. DTSBD710 01328 EJECT DTSBD710 01329 *S1000-ACCUM-BEN-CHARGE. DTSBD710 01330 * MOVE CHG4-EMP-NO TO BCF-HOLD-CHARGE-EMPL-ACCT. DTSBD710 01331 * DTSBD710 01332 * MOVE +0 TO BCF-HOLD-CHARGE-CURR-AMT. DTSBD710 01333 * DTSBD710 01334 * PERFORM DTSBD710 01335 * UNTIL (BCF-FILE-NO-REC-88) DTSBD710 01336 * OR DTSBD710 01337 * (CHG4-EMP-NO NOT = BCF-HOLD-CHARGE-EMPL-ACCT) DTSBD710 01338 * COMPUTE BCF-HOLD-CHARGE-CURR-AMT = DTSBD710 01339 * BCF-HOLD-CHARGE-CURR-AMT + DTSBD710 01340 * WRK-CHARGE DTSBD710 01341 * PERFORM S1300-SBCF-READ-NEXT THRU S1300-EXIT DTSBD710 01342 * END-PERFORM. DTSBD710 01343 * DTSBD710 01344 *S1000-EXIT. DTSBD710 01345 * EXIT. DTSBD710 01346 * DTSBD710 01347 *S1100-SBCF-OPEN. DTSBD710 01348 * OPEN INPUT BENEFIT-CHARGE-FILE. DTSBD710 01349 * DTSBD710 01350 * IF BCF-FILE-OK-88 DTSBD710 01351 * NEXT SENTENCE DTSBD710 01352 * ELSE DTSBD710 01353 * MOVE 'OPEN' TO FILE-COMMAND DTSBD710 01354 * PERFORM S1900-SBCF-FILE-ERROR DTSBD710 01355 * THRU S1900-EXIT DTSBD710 01356 * GO TO S1100-EXIT. DTSBD710 01357 * DTSBD710 01358 *S1100-EXIT. DTSBD710 01359 * EXIT. DTSBD710 01360 * DTSBD710 01361 *S1300-SBCF-READ-NEXT. DTSBD710 01362 * MOVE ZERO TO WRK-CHARGE. DTSBD710 01363 * READ BENEFIT-CHARGE-FILE. DTSBD710 01364 * DTSBD710 01365 * IF BCF-FILE-NO-REC-88 DTSBD710 01366 * MOVE ALL-NINES-EMP-NO TO CHG4-EMP-NO DTSBD710 01367 * GO TO S1300-EXIT DTSBD710 01368 * END-IF. DTSBD710 01369 * DTSBD710 01370 * IF BCF-FILE-OK-88 DTSBD710 01371 * ADD +1 TO BCF-REC-CNT DTSBD710 01372 * COMPUTE WRK-CHARGE = DTSBD710 01373 * CHG4-CURR-BEN-AMT + DTSBD710 01374 * CHG4-CURR-ADJ-AMT DTSBD710 01375 * COMPUTE BCF-CHARGE-CURR-AMT = DTSBD710 01376 * (BCF-CHARGE-CURR-AMT + DTSBD710 01377 * WRK-CHARGE) DTSBD710 01378 * ELSE DTSBD710 01379 * MOVE 'READ NEXT' TO FILE-COMMAND DTSBD710 01380 * PERFORM S1900-SBCF-FILE-ERROR DTSBD710 01381 * THRU S1900-EXIT. DTSBD710 01382 * DTSBD710 01383 *S1300-EXIT. DTSBD710 01384 * EXIT. DTSBD710 01385 * DTSBD710 01386 *S1400-SBCF-CLOSE. DTSBD710 01387 * CLOSE BENEFIT-CHARGE-FILE. DTSBD710 01388 * DTSBD710 01389 * IF BCF-FILE-OK-88 DTSBD710 01390 * GO TO S1400-EXIT DTSBD710 01391 * ELSE DTSBD710 01392 * MOVE 'CLOSE' TO FILE-COMMAND DTSBD710 01393 * PERFORM S1900-SBCF-FILE-ERROR DTSBD710 01394 * THRU S1900-EXIT. DTSBD710 01395 * DTSBD710 01396 *S1400-EXIT. DTSBD710 01397 * EXIT. DTSBD710 01398 * DTSBD710 01399 *S1900-SBCF-FILE-ERROR. DTSBD710 01400 * MOVE SPACES TO ABEND-MSG. DTSBD710 01401 * DTSBD710 01402 * STRING DTSBD710 01403 * 'UNEXPECTED BENEFIT CLAIM FILE STATUS ON ' DTSBD710 01404 * DELIMITED BY SIZE DTSBD710 01405 * FILE-COMMAND DTSBD710 01406 * DELIMITED BY ' ' DTSBD710 01407 * ': ' DTSBD710 01408 * DELIMITED BY SIZE DTSBD710 01409 * BCF-FILE-STATUS DTSBD710 01410 * DELIMITED BY SIZE DTSBD710 01411 * INTO DTSBD710 01412 * ABEND-MSG. DTSBD710 01413 * DTSBD710 01414 * PERFORM S999-ABEND THRU S999-EXIT. DTSBD710 01415 *S1900-EXIT. DTSBD710 01416 * EXIT. DTSBD710 01417 * SKIP3 DTSBD710 01418 * EJECT DTSBD710 01419 *S2000-ORPHAN-CHARGES-MSG. DTSBD710 01420 * MOVE MSG01-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER. DTSBD710 01421 * DTSBD710 01422 * MOVE BCF-HOLD-CHARGE-EMPL-ACCT TO R507-SUCC-EMP-NO. DTSBD710 01423 * DTSBD710 01424 * MOVE 'NOT FOUND ON EMPLOYER MASTER FILE' DTSBD710 01425 * TO R507-SUCC-PRIMARY-NAME. DTSBD710 01426 * DTSBD710 01427 * MOVE +0 TO R507-PRED-EMP-NO. DTSBD710 01428 * DTSBD710 01429 * MOVE SPACES TO R507-PRED-PRIMARY-NAME. DTSBD710 01430 * DTSBD710 01431 * MOVE BCF-HOLD-CHARGE-CURR-AMT TO MSG01-CHARGE-TOT-AMT. DTSBD710 01432 * DTSBD710 01433 * MOVE MSG01-MSG-TEXT TO R507-MSG-TEXT. DTSBD710 01434 * DTSBD710 01435 * PERFORM S946-WRITE-R507 THRU S946-EXIT. DTSBD710 01436 *S2000-EXIT. DTSBD710 01437 * EXIT. DTSBD710 01438 * EJECT DTSBD710 01439 *S3000-ORPHAN-CHARGES-MSG. DTSBD710 01440 * MOVE MSG02-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER. DTSBD710 01441 * DTSBD710 01442 * MOVE BCF-HOLD-CHARGE-EMPL-ACCT TO R507-SUCC-EMP-NO. DTSBD710 01443 * DTSBD710 01444 * MOVE 'NOT FOUND ON EMPLOYER MASTER FILE' DTSBD710 01445 * TO R507-SUCC-PRIMARY-NAME. DTSBD710 01446 * DTSBD710 01447 * MOVE +0 TO R507-PRED-EMP-NO. DTSBD710 01448 * DTSBD710 01449 * MOVE SPACES TO R507-PRED-PRIMARY-NAME. DTSBD710 01450 * DTSBD710 01451 * MOVE BCF-HOLD-CHARGE-CURR-AMT TO MSG02-CHARGE-TOT-AMT. DTSBD710 01452 * DTSBD710 01453 * MOVE MSG02-MSG-TEXT TO R507-MSG-TEXT. DTSBD710 01454 * DTSBD710 01455 * PERFORM S946-WRITE-R507 THRU S946-EXIT. DTSBD710 01456 *S3000-EXIT. DTSBD710 01457 * EXIT. DTSBD710 01458 * EJECT DTSBD710 01459 S9000-EMPLOYER-UPDATED. DTSBD710 01460 IF MPRF-UPDATE-ACTIVE-88 DTSBD710 01461 MOVE MSG04-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER DTSBD710 01462 MOVE MPRF-EMP-NO TO R507-SUCC-EMP-NO DTSBD710 01463 MOVE MPRF-PRIMARY-NAME TO R507-SUCC-PRIMARY-NAME DTSBD710 01464 MOVE +0 TO R507-PRED-EMP-NO DTSBD710 01465 MOVE SPACES TO R507-PRED-PRIMARY-NAME DTSBD710 01466 MOVE MSG04-MSG-TEXT TO R507-MSG-TEXT DTSBD710 01467 PERFORM S946-WRITE-R507 THRU S946-EXIT DTSBD710 01468 ELSE DTSBD710 01469 MOVE WRK-SYS-ABSTIME TO MPRF-UPDATE-END-ABSTIME DTSBD710 01470 MOVE +0 TO MPRF-UPDATE-TASK-ID DTSBD710 01471 MOVE 'RATES' TO MPRF-UPDATE-OP-ID CL**3 01472 MOVE SPACES TO MPRF-UPDATE-TERMID DTSBD710 01473 MPRF-UPDATE-NETNAME DTSBD710 01474 MOVE WRK-SYS-DATE TO MPRF-UPDATE-START-DATE DTSBD710 01475 MOVE WRK-SYS-TIME TO MPRF-UPDATE-START-TIME DTSBD710 01476 MOVE SPACES TO MPRF-UPDATE-SCR-ID DTSBD710 01477 MPRF-UPDATE-FUNCTION DTSBD710 01478 MOVE MHDR-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSBD710 01479 MOVE MPRF-REC TO MSKL-REC DTSBD710 01480 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD710 01481 S9000-EXIT. DTSBD710 01482 EXIT. DTSBD710 01483 EJECT DTSBD710 01484 S001-FROM-FED-8. DTSBD710 01485 SET L001-FROM-FED-8 TO TRUE. DTSBD710 01486 GO TO S001-DATE. DTSBD710 01487 DTSBD710 01488 S001-FROM-ABS-DAY. DTSBD710 01489 SET L001-FROM-ABS-DAY TO TRUE. DTSBD710 01490 GO TO S001-DATE. DTSBD710 01491 DTSBD710 01492 S001-FROM-CAL-6. DTSBD710 01493 SET L001-FROM-CAL-6 TO TRUE. DTSBD710 01494 GO TO S001-DATE. DTSBD710 01495 DTSBD710 01496 S001-FROM-FED-6. DTSBD710 01497 SET L001-FROM-FED-6 TO TRUE. DTSBD710 01498 GO TO S001-DATE. DTSBD710 01499 DTSBD710 01500 S001-DATE. DTSBD710 01501 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD710 01502 S001-EXIT. DTSBD710 01503 EXIT. DTSBD710 01504 SKIP3 DTSBD710 01505 S004-FROM-5. DTSBD710 01506 SET L004-FROM-5 TO TRUE. DTSBD710 01507 GO TO S004-QTR. DTSBD710 01508 DTSBD710 01509 S004-FROM-ABS. DTSBD710 01510 SET L004-FROM-ABS TO TRUE. DTSBD710 01511 GO TO S004-QTR. DTSBD710 01512 DTSBD710 01513 S004-FROM-3. DTSBD710 01514 SET L004-FROM-3 TO TRUE. DTSBD710 01515 GO TO S004-QTR. DTSBD710 01516 DTSBD710 01517 S004-QTR. DTSBD710 01518 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD710 01519 S004-EXIT. DTSBD710 01520 EXIT. DTSBD710 01521 SKIP3 DTSBD710 01522 S005-FROM-SYS. DTSBD710 01523 SET L005-FROM-SYS TO TRUE. DTSBD710 01524 GO TO S005-ABSTIME. DTSBD710 01525 DTSBD710 01526 S005-ABSTIME. DTSBD710 01527 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD710 01528 S005-EXIT. DTSBD710 01529 EXIT. DTSBD710 01530 SKIP3 DTSBD710 01531 S006-FROM-QTR. DTSBD710 01532 SET L006-FROM-QTR TO TRUE. DTSBD710 01533 GO TO S006-UI-RATE-YEAR. DTSBD710 01534 DTSBD710 01535 S006-UI-RATE-YEAR. DTSBD710 01536 CALL 'DTSBU006' USING L006-LINK-AREA. DTSBD710 01537 S006-EXIT. DTSBD710 01538 EXIT. DTSBD710 01539 SKIP3 DTSBD710 01540 S055-FROM-QTR. DTSBD710 01541 SET L055-FROM-EFF-YRQ-88 TO TRUE. DTSBD710 01542 GO TO S055-EXP-PERIOD. DTSBD710 01543 DTSBD710 01544 S055-EXP-PERIOD. DTSBD710 01545 CALL 'DTSBU055' USING L055-LINK-AREA. DTSBD710 01546 S055-EXIT. DTSBD710 01547 EXIT. DTSBD710 01548 DTSBD710 01549 S410-FILING-SCHEDULE. DTSBD710 01550 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBD710 01551 S410-EXIT. DTSBD710 01552 EXIT. DTSBD710 01553 DTSBD710 01554 S910-OPEN-UPDATE. DTSBD710 01555 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD710 01556 GO TO S910-MSTR-IO. DTSBD710 01557 DTSBD710 01558 S910-READ. DTSBD710 01559 SET L910-READ-88 TO TRUE. DTSBD710 01560 GO TO S910-MSTR-IO. DTSBD710 01561 DTSBD710 01562 S910-START-BROWSE. DTSBD710 01563 SET L910-START-BROWSE-88 TO TRUE. DTSBD710 01564 GO TO S910-MSTR-IO. DTSBD710 01565 DTSBD710 01566 S910-READ-NEXT. DTSBD710 01567 SET L910-READ-NEXT-88 TO TRUE. DTSBD710 01568 GO TO S910-MSTR-IO. DTSBD710 01569 DTSBD710 01570 S910-DELETE. DTSBD710 01571 SET L910-DELETE-88 TO TRUE. DTSBD710 01572 GO TO S910-MSTR-IO. DTSBD710 01573 DTSBD710 01574 S910-REWRITE. DTSBD710 01575 SET L910-REWRITE-88 TO TRUE. DTSBD710 01576 GO TO S910-MSTR-IO. DTSBD710 01577 DTSBD710 01578 S910-WRITE. DTSBD710 01579 SET L910-WRITE-88 TO TRUE. DTSBD710 01580 GO TO S910-MSTR-IO. DTSBD710 01581 DTSBD710 01582 S910-CLOSE. DTSBD710 01583 SET L910-CLOSE-88 TO TRUE. DTSBD710 01584 GO TO S910-MSTR-IO. DTSBD710 01585 DTSBD710 01586 S910-MSTR-IO. DTSBD710 01587 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD710 01588 MSKL-REC. DTSBD710 01589 S910-EXIT. DTSBD710 01590 EXIT. DTSBD710 01591 SKIP3 DTSBD710 01592 S931-OPEN-UPDATE. DTSBD710 01593 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBD710 01594 GO TO S931-REF-IO. DTSBD710 01595 DTSBD710 01596 S931-READ. DTSBD710 01597 SET L931-READ-88 TO TRUE. DTSBD710 01598 GO TO S931-REF-IO. DTSBD710 01599 DTSBD710 01600 S931-START-BROWSE. DTSBD710 01601 SET L931-START-BROWSE-88 TO TRUE. DTSBD710 01602 GO TO S931-REF-IO. DTSBD710 01603 DTSBD710 01604 S931-READ-NEXT. DTSBD710 01605 SET L931-READ-NEXT-88 TO TRUE. DTSBD710 01606 GO TO S931-REF-IO. DTSBD710 01607 DTSBD710 01608 S931-DELETE. DTSBD710 01609 SET L931-DELETE-88 TO TRUE. DTSBD710 01610 GO TO S931-REF-IO. DTSBD710 01611 DTSBD710 01612 S931-REWRITE. DTSBD710 01613 SET L931-REWRITE-88 TO TRUE. DTSBD710 01614 GO TO S931-REF-IO. DTSBD710 01615 DTSBD710 01616 S931-WRITE. DTSBD710 01617 SET L931-WRITE-88 TO TRUE. DTSBD710 01618 GO TO S931-REF-IO. DTSBD710 01619 DTSBD710 01620 S931-CLOSE. DTSBD710 01621 SET L931-CLOSE-88 TO TRUE. DTSBD710 01622 GO TO S931-REF-IO. DTSBD710 01623 DTSBD710 01624 S931-REF-IO. DTSBD710 01625 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD710 01626 FSKL-REC. DTSBD710 01627 S931-EXIT. DTSBD710 01628 EXIT. DTSBD710 01629 SKIP3 DTSBD710 01630 S946-WRITE-R507. DTSBD710 01631 CALL 'DTSBU946' USING R507-REC. DTSBD710 01632 GO TO S946-EXIT. DTSBD710 01633 DTSBD710 01634 S946-EXIT. DTSBD710 01635 EXIT. DTSBD710 01636 SKIP3 DTSBD710 01637 S999-ABEND. DTSBD710 01638 DISPLAY '***'. DTSBD710 01639 DTSBD710 01640 DISPLAY '*** ' DTSBD710 01641 WRK-MOD-NAME DTSBD710 01642 ' IS ABENDING BECAUSE ' DTSBD710 01643 ABEND-MSG. DTSBD710 01644 DTSBD710 01645 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD710 01646 S999-EXIT. DTSBD710 01647 EXIT. DTSBD710