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

1649 lines
130 KiB
COBOL

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