00001 IDENTIFICATION DIVISION. 02/04/19 00002 PROGRAM-ID. DTSBD750. DTSBD750 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008 00004 DATE-WRITTEN. JANUARY 1991. DTSBD750 00005 DATE-COMPILED. DTSBD750 00006 SKIP3 DTSBD750 00007 ***** DTSBD750 00008 * DTSBD750 00009 * FUNCTION: RATE ASSIGNMENT. DTSBD750 00010 * DTSBD750 00011 * DTSBD750 00012 * MODIFICATION LOG: DTSBD750 00013 * DTSBD750 00014 * 01/28/92 INITIAL DEVELOPMENT. DTSBD750 00015 * WORK ORDER: PROGRAMMER: TCL DTSBD750 00016 * DTSBD750 00017 * 04/22/1999 REVIEWED AND MODIFIED FOR DC. DTSBD750 00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD750 00019 * DTSBD750 00020 * 07/05/2002 MODIFIED FOR ANNUAL RATING PROCESS FOR DTSBD750 00021 * HOUSEHOLD EMPLOYERS DTSBD750 00022 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD750 00023 * DTSBD750 00024 * 12/10/2002 PRINT ANNUAL RATE NOTICES ALONG WITH ALL DTSBD750 00025 * OTHERS FOR 2003 RATES. DTSBD750 00026 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD750 00027 * DTSBD750 00028 * 12/15/2003 REMOVED CODE THAT PRINTED 2003 RATES FOR ANNUAL DTSBD750 00029 * FILERS AT THE SAME TIME AS ALL OTHER EMPLOYERS. DTSBD750 00030 * FROM THIS POINT ON, ANNUAL RATE NOTICES WILL DTSBD750 00031 * PRINT SEPARATELY FROM NOTICES FOR OTHER EMPLOYERSDTSBD750 00032 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD750 00033 * DTSBD750 00034 * 06/25/2004 ADDED COUNT OF ANNUAL FILERS WITH MISSING FIRST DTSBD750 00035 * QUARTER WAGES. DTSBD750 00036 * SET MAIL DATE FOR ANNUAL RUN TO CURR MAIL DATE. DTSBD750 00037 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD750 00038 * DTSBD750 00039 * 01/19/2006 MODIFIED T0000: DO NOT UPDATE HEADER DURING DTSBD750 00040 * ANNUAL RATING RUN. DTSBD750 00041 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD750 00042 * DTSBD750 00043 * 11/08/2006 MODIFIED P0020: DO NOT DISPLAY MSG05 (MRCT DTSBD750 00044 * EXISTS BUT NOT MRTE) IS EMPLOYER IS INACTIVE. DTSBD750 00045 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD750 00046 * DTSBD750 00047 * 12/07/2006 MODIFIED TO ADD RATE TABLE TO R503 RATE DTSBD750 00048 * NOTICE REPORT RECORD. DTSBD750 00049 * REFERENCE: PROGRAMMER: GD DTSBD750 00050 * DTSBD750 00051 * 08/11/2009 MODIFIED TO ADD RATE RECORD FOR ANNUAL FILERS DTSBD750 00052 * WHEN RECORD IS MISSING. DTSBD750 00053 * REFERENCE: PROGRAMMER: ZL1 DTSBD750 00054 * DTSBD750 00055 * CL**3 00056 * 07/17/2018 MODIFIED TO ALWAYS CHECK FOR 1ST QUARTER WAGES CL**3 00057 * FOR ANNUAL FILERS, RESET EETIMATED FLAGS. CL**3 00058 * REFERENCE: PROGRAMMER: ZL1 CL**3 00059 * CL**3 00060 * 07/26/2018 MODIFIED TO CHECK ANNUAL FILES CURRENT STATUS CL**7 00061 * SET TO BYPASS IF EMPLOYER STATUS IS NOT ACTIVE. CL**7 00062 * REFERENCE: PROGRAMMER: ZL1 CL**7 00063 * CL**6 00064 * 02/04/2019 MODIFIED TO CREATE X108 RATE FILE FOR ESSP CL**7 00065 * CL**7 00066 * REFERENCE: PROGRAMMER: NH1 CL**7 00067 * CL**6 00068 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD750 00069 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD750 00070 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD750 00071 * DTSBD750 00072 * DTSBD750 00073 * DESCRIPTION: DTSBD750 00074 * DTSBD750 00075 * DTSBD750 ASSIGNS RATES AND (IF PARM-RUN-TYPE = 'F' (FINAL) DTSBD750 00076 * UPDATES THE MASTER FILE AND WRITES RATE NOTICE REPORT DTSBD750 00077 * RECORDS. DTSBD750 00078 * DTSBD750 00079 * READ THE MHDR RECORD. THE RATE YEAR FOR WHICH RATES ARE DTSBD750 00080 * BEING ASSIGNED IS MHDR-LAST-ANNUAL-RATE-END-YRQ PLUS DTSBD750 00081 * ONE YEAR. IF PARM-RUN-TYPE = 'F', THEN UPDATE THE DTSBD750 00082 * MHDR RECORD. DTSBD750 00083 * DTSBD750 00084 * READ THE MPRF RECORDS SEQUENTIALLY. DTSBD750 00085 * DTSBD750 00086 * DTSBD750 00087 * PARAMETERS INPUT: DTSBD750 00088 * DTSBD750 00089 * RUN-TYPE ('F' = FINAL; 'P' = PRELIMINARY) DTSBD750 00090 * DTSBD750 00091 * READ THE FUIR RECORD FOR THE "RATE YEAR". YOU NEED DTSBD750 00092 * FUIR-RATE-NOTICE-DATE AND FUIR-RATE-PENALTY-DATE. DTSBD750 00093 * DTSBD750 00094 * IF RUN-TYPE = 'F' AND THE FUIR RECORD DOES NOT EXIST DTSBD750 00095 * (OR ONE OF THE FUIR DATES IS EQUAL TO ZERO), THEN ABEND. DTSBD750 00096 * DTSBD750 00097 * DTSBD750 00098 * MASTER FILE RECORDS READ: DTSBD750 00099 * DTSBD750 00100 * MHDR DTSBD750 00101 * MPRF DTSBD750 00102 * MSOL DTSBD750 00103 * MRTE DTSBD750 00104 * MRCT DTSBD750 00105 * DTSBD750 00106 * DTSBD750 00107 * ALTERNATE INDEX FILE RECORDS READ: DTSBD750 00108 * DTSBD750 00109 * NONE. DTSBD750 00110 * DTSBD750 00111 * DTSBD750 00112 * REFERENCE FILE RECORDS READ: DTSBD750 00113 * DTSBD750 00114 * FUIR. DTSBD750 00115 * DTSBD750 00116 * DTSBD750 00117 * MASTER FILE RECORDS UPDATED: DTSBD750 00118 * DTSBD750 00119 * MHDR (REWRITE). DTSBD750 00120 * MPRF (REWRITE: MAINTAIN MPRF-UPDATE-* DATA ELEMENTS). DTSBD750 00121 * MRTE (WRITE). DTSBD750 00122 * DTSBD750 00123 * OBVIOUSLY, THE MASTER FILE UPDATE OCCURS ONLY WHEN DTSBD750 00124 * RUN TYPE IS EQUAL TO 'F'. DTSBD750 00125 * DTSBD750 00126 * DTSBD750 00127 * REFERENCE FILE RECORDS UPDATED: DTSBD750 00128 * DTSBD750 00129 * NONE. DTSBD750 00130 * DTSBD750 00131 * DTSBD750 00132 * REPORT RECORDS WRITTEN: DTSBD750 00133 * DTSBD750 00134 * R503 RATE NOTICE. DTSBD750 00135 * R504 PENALTY RATE LETTER. DTSBD750 00136 * R515 RATE ASSIGNMENT DETAIL LIST. DTSBD750 00137 * R516 RATE ASSIGNMENT ERROR LIST. DTSBD750 00138 * R521 RATE ASSIGNMENT SUMMARY REPORT. DTSBD750 00139 * R723 RQC EXPERIENCE RATING UNIVERSE RECORD EXPORT. DTSBD750 00140 * DTSBD750 00141 * DTSBD750 00142 * MODULES CALLED: DTSBD750 00143 * DTSBD750 00144 * DTSBU001 DATE EDIT/CONVERT. DTSBD750 00145 * DTSBU004 QUARTER EDIT/CONVERT. DTSBD750 00146 * DTSBU006 RATE QUARTER BEGIN/END. DTSBD750 00147 * DTSBU054 RATE DETERMINATION FROM RCT RECORD. DTSBD750 00148 * DTSBU055 RATING EXPERIENCE PERIOD RELATED DATES. DTSBD750 00149 * DTSBU111 ADDRESS LOOKUP. DTSBD750 00150 * DTSBU112 ADDRESS FORMAT. DTSBD750 00151 * DTSBU910 MASTER FILE I/O. DTSBD750 00152 * DTSBU931 REFERENCE FILE I/O. DTSBD750 00153 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD750 00154 * DTSBD750 00155 * DTSBD750 00156 ***** DTSBD750 00157 SKIP3 DTSBD750 00158 ENVIRONMENT DIVISION. DTSBD750 00159 SKIP3 DTSBD750 00160 DATA DIVISION. DTSBD750 00161 SKIP3 DTSBD750 00162 WORKING-STORAGE SECTION. DTSBD750 001625 77 PAN-VALET PICTURE X(24) VALUE '008DTSBD750 02/04/19'. DTSBD750 00163 77 PAN-VALET PICTURE X(24) VALUE '034DTSBD750 08/17/09'. DTSBD750 00164 DTSBD750 00165 01 WRK-AREA. DTSBD750 00166 05 AMT-DISP1 PIC ----------9.99. DTSBD750 00167 05 AMT-DISP2 PIC ----------9.99. DTSBD750 00168 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +750.DTSBD750 00169 DTSBD750 00170 05 MOD-NAME PIC X(08) VALUE 'DTSBD750'.DTSBD750 00171 DTSBD750 00172 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBD750 00173 VALUE +999999999. DTSBD750 00174 DTSBD750 00175 DTSBD750 00176 05 ABEND-MSG PIC X(60). DTSBD750 00177 DTSBD750 00178 DTSBD750 00179 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3. DTSBD750 00180 DTSBD750 00181 05 WRK-SYS-DATE PIC S9(09) COMP-3. DTSBD750 00182 DTSBD750 00183 05 WRK-SYS-TIME PIC S9(07) COMP-3. DTSBD750 00184 DTSBD750 00185 DTSBD750 00186 05 WRK-RTE-YR-START-YRQ PIC S9(05) COMP-3. DTSBD750 00187 DTSBD750 00188 05 WRK-RTE-YR-END-YRQ PIC S9(05) COMP-3. DTSBD750 00189 DTSBD750 00190 05 WRK-RTE-YR-DISP PIC X(04). DTSBD750 00191 DTSBD750 00192 05 WRK-RATE-TABLE PIC X(05). DTSBD750 00193 DTSBD750 00194 05 WRK-MAIL-DATE PIC S9(09) COMP-3. DTSBD750 00195 05 WRK-REPORT-DATE PIC S9(09) COMP-3. CL**4 00196 DTSBD750 00197 05 WRK-PENALTY-DATE PIC S9(09) COMP-3. DTSBD750 00198 DTSBD750 00199 05 WRK-UPDATE-MASTER-IND PIC X(01). DTSBD750 00200 88 WRK-UPDATE-MASTER-YES-88 VALUE 'Y'. DTSBD750 00201 88 WRK-UPDATE-MASTER-NO-88 VALUE 'N'. DTSBD750 00202 DTSBD750 00203 05 WRK-RUN-TYPE-IND PIC X(01). DTSBD750 00204 88 WRK-RUN-TYPE-REG-88 VALUE '0'. DTSBD750 00205 88 WRK-RUN-TYPE-ANN-88 VALUE '1'. DTSBD750 00206 DTSBD750 00207 * 05 WRK-ESTIM-NEEDED-IND PIC X(01). DTSBD750 00208 * 88 WRK-ESTIM-NEEDED-YES-88 VALUE 'Y'. DTSBD750 00209 * 88 WRK-ESTIM-NEEDED-NO-88 VALUE 'N'. DTSBD750 00210 DTSBD750 00211 05 WRK-ANNUAL-FILER-IND PIC X(01). DTSBD750 00212 88 WRK-ANNUAL-FILER-YES-88 VALUE 'Y'. DTSBD750 00213 88 WRK-ANNUAL-FILER-NO-88 VALUE 'N'. DTSBD750 00214 DTSBD750 00215 05 WRK-RATE-TYPE-AREA. DTSBD750 00216 10 WRK-RATE-YR-SCHED PIC X(01). DTSBD750 00217 88 WRK-RATE-YR-ANN-88 VALUE 'Y'. DTSBD750 00218 10 WRK-RATE-YR-MINUS-1-SCHED PIC X(01). DTSBD750 00219 88 WRK-RATE-YR-MINUS1-ANN-88 VALUE 'Y'. DTSBD750 00220 10 WRK-RATE-YR-MINUS-2-SCHED PIC X(01). DTSBD750 00221 88 WRK-RATE-YR-MINUS2-ANN-88 VALUE 'Y'. DTSBD750 00222 05 FILLER REDEFINES WRK-RATE-TYPE-AREA PIC X(03). DTSBD750 00223 88 WRK-ESTIM-NEEDED-88 VALUE 'YYY' 'NYY' 'NYY'. CL**3 00224 88 WRK-TRANS-NEEDED-88 VALUE 'YYN' 'NYN'. DTSBD750 00225 88 WRK-PRINT-ESTIM-88 VALUE 'NYY'. DTSBD750 00226 88 WRK-PRINT-TRANS-88 VALUE 'NYN'. DTSBD750 00227 88 WRK-INIT-VALUES-88 VALUE 'NNN'. DTSBD750 00228 DTSBD750 00229 05 WRK-INACT-CNT PIC S9(07) COMP-3 DTSBD750 00230 VALUE +0. DTSBD750 00231 05 PRF-REC-READ-CNT PIC S9(07) COMP-3 DTSBD750 00232 VALUE +0. DTSBD750 00233 DTSBD750 00234 05 PRF-REC-REWRITE-CNT PIC S9(07) COMP-3 DTSBD750 00235 VALUE +0. DTSBD750 00236 DTSBD750 00237 05 RTE-REC-WRITE-CNT PIC S9(07) COMP-3 DTSBD750 00238 VALUE +0. DTSBD750 00239 DTSBD750 00240 05 REGULAR-RATE-CNT PIC S9(07) COMP-3 DTSBD750 00241 VALUE +0. DTSBD750 00242 DTSBD750 00243 05 ESTIMATED-RATE-CNT PIC S9(07) COMP-3 DTSBD750 00244 VALUE +0. DTSBD750 00245 DTSBD750 00246 05 FINAL-RATE-CNT PIC S9(07) COMP-3 DTSBD750 00247 VALUE +0. DTSBD750 00248 DTSBD750 00249 05 TRANSITIONAL-RATE-CNT PIC S9(07) COMP-3 DTSBD750 00250 VALUE +0. DTSBD750 00251 DTSBD750 00252 05 UNCLASS-ANN-CNT PIC S9(07) COMP-3 DTSBD750 00253 VALUE +0. DTSBD750 00254 DTSBD750 00255 05 BYPASS-ANN-CNT PIC S9(07) COMP-3 DTSBD750 00256 VALUE +0. DTSBD750 00257 DTSBD750 00258 05 BYPASS-FINAL-CNT PIC S9(07) COMP-3 DTSBD750 00259 VALUE +0. DTSBD750 00260 DTSBD750 00261 05 NO-1ST-QTR-WAGE-CNT PIC S9(07) COMP-3 DTSBD750 00262 VALUE +0. DTSBD750 00263 DTSBD750 00264 05 WRK-TAX-WAGE PIC S9(11)V99 COMP-3. DTSBD750 00265 DTSBD750 00266 05 DISPLAY-CNT-X PIC X(09). DTSBD750 00267 05 DISPLAY-CNT REDEFINES DISPLAY-CNT-X DTSBD750 00268 PIC Z,ZZZ,ZZ9. DTSBD750 00269 DTSBD750 00270 DTSBD750 00271 05 ACTIVE-DURING-RATE-YR-IND PIC X(01). DTSBD750 00272 DTSBD750 00273 05 RTE-EXISTS-IND PIC X(01). DTSBD750 00274 EJECT DTSBD750 00275 01 MSG-AREA. DTSBD750 00276 05 MSG01-AREA. DTSBD750 00277 10 MSG01-MSG-IDENTIFIER PIC X(04) VALUE '5001'. DTSBD750 00278 10 MSG01-MSG-TEXT. DTSBD750 00279 15 FILLER PIC X(50) DTSBD750 00280 VALUE 'RATE REQUIRED, BUT NO RATE CUTOFF RECORD EXISTS. '.DTSBD750 00281 15 FILLER PIC X(50) DTSBD750 00282 VALUE 'PLEASE ASSIGN RATE MANUALLY. '.DTSBD750 00283 DTSBD750 00284 05 MSG02-AREA. DTSBD750 00285 10 MSG02-MSG-IDENTIFIER PIC X(04) VALUE '5002'. DTSBD750 00286 10 MSG02-MSG-TEXT. DTSBD750 00287 15 FILLER PIC X(50) DTSBD750 00288 VALUE 'BOTH RATE AND MRCT RECORD EXIST. EXISTING RATE IS'.DTSBD750 00289 15 FILLER PIC X(50) DTSBD750 00290 VALUE 'CONSISTENT WITH MRCT RECORD. RATE NOTICE NOT PRIN'.DTSBD750 00291 DTSBD750 00292 05 MSG03-AREA. DTSBD750 00293 10 MSG03-MSG-IDENTIFIER PIC X(04) VALUE '5003'. DTSBD750 00294 10 MSG03-MSG-TEXT. DTSBD750 00295 15 FILLER PIC X(50) DTSBD750 00296 VALUE 'BOTH RATE AND MRCT RECORD EXIST. EXISTING RATE IS'.DTSBD750 00297 15 FILLER PIC X(50) DTSBD750 00298 VALUE 'NOT CONSISTENT WITH MRCT RECORD. RATE NOT CHANGED'.DTSBD750 00299 DTSBD750 00300 05 MSG04-AREA. DTSBD750 00301 10 MSG04-MSG-IDENTIFIER PIC X(04) VALUE '5004'. DTSBD750 00302 10 MSG04-MSG-TEXT. DTSBD750 00303 15 FILLER PIC X(50) DTSBD750 00304 VALUE 'RATE REQUIRED, RATE CUTOFF RECORD EXISTS, BUT EXPE'.DTSBD750 00305 15 FILLER PIC X(50) DTSBD750 00306 VALUE 'RIENCE TRANSFERRED. CHECK RATE OR ASSIGN RATE. '.DTSBD750 00307 SKIP3 DTSBD750 00308 05 MSG05-AREA. DTSBD750 00309 10 MSG05-MSG-IDENTIFIER PIC X(04) VALUE '5005'. DTSBD750 00310 10 MSG05-MSG-TEXT. DTSBD750 00311 15 FILLER PIC X(50) DTSBD750 00312 VALUE 'ANNUAL FILER HAS NO RATE, BUT RATE CUTOFF RECORD E'.DTSBD750 00313 15 FILLER PIC X(50) DTSBD750 00314 VALUE 'EXISTS. CHECK RATE OR ASSIGN RATE. '.DTSBD750 00315 SKIP3 DTSBD750 00316 05 MSG06-AREA. DTSBD750 00317 10 MSG06-MSG-IDENTIFIER PIC X(04) VALUE '5006'. DTSBD750 00318 10 MSG06-MSG-TEXT. DTSBD750 00319 15 FILLER PIC X(50) DTSBD750 00320 VALUE 'ANNUAL FILER HAS NOT REPORTED FIRST QUARTER WAGES.'.DTSBD750 00321 15 FILLER PIC X(50) DTSBD750 00322 VALUE ' RATE ASSIGNED BASED ON AVAILABLE WAGES. '.DTSBD750 00323 DTSBD750 00324 05 MSG99-AREA. DTSBD750 00325 10 MSG99-MSG-IDENTIFIER PIC X(03) VALUE '991'. DTSBD750 00326 10 MSG99-MSG-TEXT. DTSBD750 00327 15 FILLER PIC X(40) DTSBD750 00328 VALUE 'DESPITE BEING LOCKED AGAINST UPDATE, THE'. DTSBD750 00329 15 FILLER PIC X(40) DTSBD750 00330 VALUE ' RATE ASSIGNMENT PROCESS UPDATED THE EMP'. DTSBD750 00331 15 FILLER PIC X(20) DTSBD750 00332 VALUE 'LOYERS RECORDS. '. DTSBD750 00333 EJECT DTSBD750 00334 01 L910-LINK-AREA. DTSBD750 00335 ++INCLUDE DTSIL910 DTSBD750 00336 SKIP3 DTSBD750 00337 01 MSKL-REC. DTSBD750 00338 ++INCLUDE DTSIMSKL DTSBD750 00339 SKIP3 DTSBD750 00340 01 MHDR-REC. DTSBD750 00341 ++INCLUDE DTSIMHDR DTSBD750 00342 SKIP3 DTSBD750 00343 01 MPRF-REC. DTSBD750 00344 ++INCLUDE DTSIMPRF DTSBD750 00345 SKIP3 DTSBD750 00346 01 MSOL-REC. DTSBD750 00347 ++INCLUDE DTSIMSOL DTSBD750 00348 SKIP3 DTSBD750 00349 01 MRTE-REC. DTSBD750 00350 ++INCLUDE DTSIMRTE DTSBD750 00351 SKIP3 DTSBD750 00352 01 MRCT-REC. DTSBD750 00353 ++INCLUDE DTSIMRCT DTSBD750 00354 SKIP3 DTSBD750 00355 01 MQTR-REC. DTSBD750 00356 ++INCLUDE DTSIMQTR DTSBD750 00357 EJECT DTSBD750 00358 SKIP3 CL**4 00359 01 MRPT-REC. CL**4 00360 ++INCLUDE DTSIMRPT CL**4 00361 EJECT CL**4 00362 01 L921-LINK-AREA. DTSBD750 00363 ++INCLUDE DTSIL921 DTSBD750 00364 SKIP3 DTSBD750 00365 01 ISKL-REC. DTSBD750 00366 ++INCLUDE DTSIISKL DTSBD750 00367 EJECT DTSBD750 00368 01 L927-LINK-AREA. DTSBD750 00369 ++INCLUDE DTSIL927 DTSBD750 00370 SKIP3 DTSBD750 00371 01 TSKL-REC. DTSBD750 00372 ++INCLUDE DTSITSKL DTSBD750 00373 SKIP3 DTSBD750 00374 01 T031-REC. DTSBD750 00375 ++INCLUDE DTSIT031 DTSBD750 00376 EJECT DTSBD750 00377 01 L931-LINK-AREA. DTSBD750 00378 ++INCLUDE DTSIL931 DTSBD750 00379 SKIP3 DTSBD750 00380 01 FSKL-REC. DTSBD750 00381 ++INCLUDE DTSIFSKL DTSBD750 00382 SKIP3 DTSBD750 00383 01 FUIR-REC. DTSBD750 00384 ++INCLUDE DTSIFUIR DTSBD750 00385 EJECT DTSBD750 00386 01 R503-REC. DTSBD750 00387 ++INCLUDE DTSIR503 DTSBD750 00388 SKIP3 DTSBD750 00389 01 R504-REC. DTSBD750 00390 ++INCLUDE DTSIR504 DTSBD750 00391 SKIP3 DTSBD750 00392 01 R515-REC. DTSBD750 00393 ++INCLUDE DTSIR515 DTSBD750 00394 SKIP3 DTSBD750 00395 01 R516-REC. DTSBD750 00396 ++INCLUDE DTSIR516 DTSBD750 00397 SKIP3 DTSBD750 00398 01 R521-REC. DTSBD750 00399 ++INCLUDE DTSIR521 DTSBD750 00400 SKIP3 DTSBD750 00401 01 R723-REC. DTSBD750 00402 ++INCLUDE DTSIR723 DTSBD750 00403 SKIP3 DTSBD750 00404 01 R907-REC. DTSBD750 00405 ++INCLUDE DTSIR907 DTSBD750 00406 EJECT DTSBD750 00407 01 L001-LINK-AREA. DTSBD750 00408 ++INCLUDE DTSIL001 DTSBD750 00409 SKIP3 DTSBD750 00410 01 L004-LINK-AREA. DTSBD750 00411 ++INCLUDE DTSIL004 DTSBD750 00412 SKIP3 DTSBD750 00413 01 L005-LINK-AREA. DTSBD750 00414 ++INCLUDE DTSIL005 DTSBD750 00415 SKIP3 DTSBD750 00416 01 L006-LINK-AREA. DTSBD750 00417 ++INCLUDE DTSIL006 DTSBD750 00418 SKIP3 DTSBD750 00419 01 L054-LINK-AREA. DTSBD750 00420 ++INCLUDE DTSIL054 DTSBD750 00421 SKIP3 DTSBD750 00422 01 L055-LINK-AREA. DTSBD750 00423 ++INCLUDE DTSIL055 DTSBD750 00424 SKIP3 DTSBD750 00425 01 L111-LINK-AREA. DTSBD750 00426 ++INCLUDE DTSIL111 DTSBD750 00427 SKIP3 DTSBD750 00428 01 L112-LINK-AREA. DTSBD750 00429 ++INCLUDE DTSIL112 DTSBD750 00430 EJECT DTSBD750 00431 01 L410-LINK-AREA. DTSBD750 00432 ++INCLUDE DTSIL410 DTSBD750 00433 EJECT DTSBD750 00434 01 MMAX-AREA. DTSBD750 00435 ++INCLUDE DTSIMMAX DTSBD750 00436 EJECT DTSBD750 00437 01 R108-REC. CL**8 00438 ++INCLUDE DTSIX108 CL**8 00439 SKIP3 CL**8 00440 LINKAGE SECTION. DTSBD750 00441 SKIP3 DTSBD750 00442 01 PARM-AREA. DTSBD750 00443 05 PARM-LENGTH PIC S9(04) COMP. DTSBD750 00444 DTSBD750 00445 05 PARM-DATA. DTSBD750 00446 10 PARM-RTE-YR-START-YRQ-X DTSBD750 00447 PIC X(03). DTSBD750 00448 10 PARM-RTE-YR-START-YRQ DTSBD750 00449 REDEFINES PARM-RTE-YR-START-YRQ-X DTSBD750 00450 PIC 9(03). DTSBD750 00451 10 FILLER PIC X(01). DTSBD750 00452 10 PARM-UPDATE-MASTER-IND PIC X(01). DTSBD750 00453 88 PARM-UPDATE-MASTER-YES-88 VALUE 'Y'. DTSBD750 00454 88 PARM-UPDATE-MASTER-NO-88 VALUE 'N'. DTSBD750 00455 10 FILLER PIC X(01). DTSBD750 00456 10 PARM-RUN-TYPE-IND PIC X(01). DTSBD750 00457 88 PARM-RUN-TYPE-REG-88 VALUE 'R'. DTSBD750 00458 88 PARM-RUN-TYPE-ANN-88 VALUE 'A'. DTSBD750 00459 EJECT DTSBD750 00460 PROCEDURE DIVISION USING PARM-AREA. DTSBD750 00461 DTSBD750 00462 DTSBD750 00463 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD750 00464 DTSBD750 00465 DTSBD750 00466 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD750 00467 DTSBD750 00468 MOVE +0 TO MSKL-EMP-NO. DTSBD750 00469 DTSBD750 00470 SET MSKL-PRF-88 TO TRUE. DTSBD750 00471 DTSBD750 00472 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD750 00473 DTSBD750 00474 PERFORM DTSBD750 00475 UNTIL L910-NO-REC-88 DTSBD750 00476 MOVE MSKL-REC TO MPRF-REC DTSBD750 00477 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD750 00478 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSBD750 00479 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD750 00480 END-PERFORM. DTSBD750 00481 DTSBD750 00482 DTSBD750 00483 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD750 00484 DTSBD750 00485 DTSBD750 00486 GOBACK. DTSBD750 00487 EJECT DTSBD750 00488 I0000-INITIATE. DTSBD750 00489 MOVE 'N' TO L910-TRACE-IND DTSBD750 00490 L921-TRACE-IND DTSBD750 00491 L927-TRACE-IND DTSBD750 00492 L931-TRACE-IND. DTSBD750 00493 DTSBD750 00494 MOVE MOD-NAME TO L910-MOD-NAME DTSBD750 00495 L921-MOD-NAME DTSBD750 00496 L927-MOD-NAME DTSBD750 00497 L931-MOD-NAME. DTSBD750 00498 DTSBD750 00499 DTSBD750 00500 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD750 00501 DTSBD750 00502 DTSBD750 00503 MOVE LOW-VALUES TO MSKL-REC. DTSBD750 00504 DTSBD750 00505 MOVE +0 TO MSKL-EMP-NO. DTSBD750 00506 DTSBD750 00507 SET MSKL-HDR-88 TO TRUE. DTSBD750 00508 DTSBD750 00509 PERFORM S910-READ THRU S910-EXIT. DTSBD750 00510 DTSBD750 00511 IF L910-NO-REC-88 DTSBD750 00512 MOVE 'MHDR RECORD IS MISSING' DTSBD750 00513 TO ABEND-MSG DTSBD750 00514 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00515 DTSBD750 00516 MOVE MSKL-REC TO MHDR-REC. DTSBD750 00517 DTSBD750 00518 DTSBD750 00519 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD750 00520 DTSBD750 00521 DTSBD750 00522 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DTSBD750 00523 DTSBD750 00524 DTSBD750 00525 IF WRK-UPDATE-MASTER-YES-88 DTSBD750 00526 PERFORM S910-OPEN-UPDATE THRU S910-EXIT DTSBD750 00527 PERFORM S921-OPEN-UPDATE THRU S921-EXIT DTSBD750 00528 ELSE DTSBD750 00529 PERFORM S910-OPEN-READ THRU S910-EXIT DTSBD750 00530 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD750 00531 DTSBD750 00532 DTSBD750 00533 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSBD750 00534 DTSBD750 00535 DTSBD750 00536 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD750 00537 DTSBD750 00538 DTSBD750 00539 PERFORM I2000-FIND-RATE-PERIOD THRU I2000-EXIT. DTSBD750 00540 DTSBD750 00541 DTSBD750 00542 PERFORM I3000-FUIR-CONSTANTS THRU I3000-EXIT. DTSBD750 00543 DTSBD750 00544 DTSBD750 00545 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD750 00546 DTSBD750 00547 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. DTSBD750 00548 DTSBD750 00549 MOVE L005-DATE TO WRK-SYS-DATE. DTSBD750 00550 DTSBD750 00551 MOVE L005-TIME TO WRK-SYS-TIME. DTSBD750 00552 DTSBD750 00553 DTSBD750 00554 DTSBD750 00555 MOVE LENGTH OF R503-REC TO R503-LENGTH. DTSBD750 00556 DTSBD750 00557 MOVE '503' TO R503-REC-TYPE. DTSBD750 00558 DTSBD750 00559 DTSBD750 00560 MOVE LENGTH OF R504-REC TO R504-LENGTH. DTSBD750 00561 DTSBD750 00562 MOVE '504' TO R504-REC-TYPE. DTSBD750 00563 DTSBD750 00564 DTSBD750 00565 MOVE LENGTH OF R515-REC TO R515-LENGTH. DTSBD750 00566 DTSBD750 00567 MOVE '515' TO R515-REC-TYPE. DTSBD750 00568 DTSBD750 00569 DTSBD750 00570 MOVE LENGTH OF R516-REC TO R516-LENGTH. DTSBD750 00571 DTSBD750 00572 MOVE '516' TO R516-REC-TYPE. DTSBD750 00573 DTSBD750 00574 DTSBD750 00575 MOVE LENGTH OF R521-REC TO R521-LENGTH. DTSBD750 00576 DTSBD750 00577 MOVE '521' TO R521-REC-TYPE. DTSBD750 00578 DTSBD750 00579 DTSBD750 00580 MOVE LENGTH OF R723-REC TO R723-LENGTH. DTSBD750 00581 DTSBD750 00582 MOVE '723' TO R723-REC-TYPE. DTSBD750 00583 DTSBD750 00584 DTSBD750 00585 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD750 00586 DTSBD750 00587 MOVE '907' TO R907-REC-TYPE. DTSBD750 00588 DTSBD750 00589 DTSBD750 00590 MOVE LENGTH OF T031-REC TO T031-LENGTH. DTSBD750 00591 DTSBD750 00592 MOVE '031' TO T031-REC-TYPE. DTSBD750 00593 I0000-EXIT. DTSBD750 00594 EXIT. DTSBD750 00595 EJECT DTSBD750 00596 I1000-PROCESS-PARMS. DTSBD750 00597 IF PARM-LENGTH = +7 DTSBD750 00598 NEXT SENTENCE DTSBD750 00599 ELSE DTSBD750 00600 MOVE 'PARM-LENGTH NOT EQUAL TO 7' DTSBD750 00601 TO ABEND-MSG DTSBD750 00602 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00603 DTSBD750 00604 DTSBD750 00605 DISPLAY '***'. DTSBD750 00606 DTSBD750 00607 DISPLAY '*** ' DTSBD750 00608 MOD-NAME DTSBD750 00609 ' PARAMETERS: ' DTSBD750 00610 PARM-DATA. DTSBD750 00611 DTSBD750 00612 DISPLAY '***'. DTSBD750 00613 DTSBD750 00614 DTSBD750 00615 IF PARM-RTE-YR-START-YRQ-X = SPACES OR ZEROS DTSBD750 00616 PERFORM I1100-DEFAULT-START-YRQ THRU I1100-EXIT DTSBD750 00617 ELSE DTSBD750 00618 PERFORM I1200-EDIT-START-YRQ THRU I1200-EXIT. DTSBD750 00619 DTSBD750 00620 DTSBD750 00621 IF PARM-UPDATE-MASTER-YES-88 DTSBD750 00622 SET WRK-UPDATE-MASTER-YES-88 TO TRUE DTSBD750 00623 ELSE DTSBD750 00624 IF PARM-UPDATE-MASTER-NO-88 DTSBD750 00625 SET WRK-UPDATE-MASTER-NO-88 TO TRUE DTSBD750 00626 ELSE DTSBD750 00627 MOVE 'PARM-UPDATE-MASTER-IND NOT VALID' TO ABEND-MSG DTSBD750 00628 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00629 DTSBD750 00630 IF PARM-RUN-TYPE-REG-88 DTSBD750 00631 SET WRK-RUN-TYPE-REG-88 TO TRUE DTSBD750 00632 ELSE DTSBD750 00633 IF PARM-RUN-TYPE-ANN-88 DTSBD750 00634 SET WRK-RUN-TYPE-ANN-88 TO TRUE DTSBD750 00635 ELSE DTSBD750 00636 MOVE 'PARM-RUN-TYPE-IND NOT VALID' TO ABEND-MSG DTSBD750 00637 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00638 I1000-EXIT. DTSBD750 00639 EXIT. DTSBD750 00640 SKIP3 DTSBD750 00641 I1100-DEFAULT-START-YRQ. DTSBD750 00642 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSBD750 00643 DTSBD750 00644 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD750 00645 DTSBD750 00646 IF L004-INVALID-QTR DTSBD750 00647 MOVE 'LOGIC ERROR I1100-01' DTSBD750 00648 TO ABEND-MSG DTSBD750 00649 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00650 DTSBD750 00651 ADD +1 TO L004-ABS-QTR. DTSBD750 00652 DTSBD750 00653 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD750 00654 DTSBD750 00655 IF L004-INVALID-QTR DTSBD750 00656 MOVE 'LOGIC ERROR I1100-02' DTSBD750 00657 TO ABEND-MSG DTSBD750 00658 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00659 DTSBD750 00660 DTSBD750 00661 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD750 00662 DTSBD750 00663 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD750 00664 DTSBD750 00665 IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ DTSBD750 00666 MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ DTSBD750 00667 MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ DTSBD750 00668 MOVE L006-RTE-YR-DISP TO WRK-RTE-YR-DISP DTSBD750 00669 ELSE DTSBD750 00670 MOVE 'INVALID MHDR-LAST-RATE-YRQ ENCOUNTERED' DTSBD750 00671 TO ABEND-MSG DTSBD750 00672 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00673 I1100-EXIT. DTSBD750 00674 EXIT. DTSBD750 00675 EJECT DTSBD750 00676 I1200-EDIT-START-YRQ. DTSBD750 00677 MOVE PARM-RTE-YR-START-YRQ-X TO L004-QTR-3. DTSBD750 00678 DTSBD750 00679 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD750 00680 DTSBD750 00681 IF L004-INVALID-QTR DTSBD750 00682 MOVE 'INVALID PARM-RTE-YR-START-YRQ-X ENCOUNTERED' DTSBD750 00683 TO ABEND-MSG DTSBD750 00684 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00685 DTSBD750 00686 MOVE L004-QTR-5-9 TO L006-YRQ. DTSBD750 00687 DTSBD750 00688 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD750 00689 DTSBD750 00690 IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ DTSBD750 00691 MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ DTSBD750 00692 MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ DTSBD750 00693 MOVE L006-RTE-YR-DISP TO WRK-RTE-YR-DISP DTSBD750 00694 ELSE DTSBD750 00695 MOVE 'PARM-RTE-YR-START-YRQ NOT FIRST QTR IN RATE YEAR' DTSBD750 00696 TO ABEND-MSG DTSBD750 00697 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00698 I1200-EXIT. DTSBD750 00699 EXIT. DTSBD750 00700 EJECT DTSBD750 00701 I2000-FIND-RATE-PERIOD. DTSBD750 00702 MOVE WRK-RTE-YR-START-YRQ TO L055-EFF-YRQ. DTSBD750 00703 DTSBD750 00704 PERFORM S055-FROM-EFF-YRQ THRU S055-EXIT. DTSBD750 00705 I2000-EXIT. DTSBD750 00706 EXIT. DTSBD750 00707 EJECT DTSBD750 00708 I3000-FUIR-CONSTANTS. DTSBD750 00709 DISPLAY 'I3000 ' WRK-RTE-YR-START-YRQ. CL**2 00710 CL**2 00711 MOVE LOW-VALUES TO FUIR-KEY-AREA. DTSBD750 00712 DTSBD750 00713 SET FUIR-UIR-88 TO TRUE. DTSBD750 00714 DTSBD750 00715 MOVE WRK-RTE-YR-START-YRQ TO FUIR-EFF-YRQ. DTSBD750 00716 DTSBD750 00717 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBD750 00718 DTSBD750 00719 PERFORM S931-READ THRU S931-EXIT. DTSBD750 00720 DTSBD750 00721 IF L931-NO-REC-88 DTSBD750 00722 MOVE 'FUIR NOT FOUND' TO ABEND-MSG DTSBD750 00723 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00724 DTSBD750 00725 MOVE FSKL-REC TO FUIR-REC. DTSBD750 00726 DTSBD750 00727 DTSBD750 00728 IF FUIR-RATE-NOTICE-DATE = +0 DTSBD750 00729 MOVE 'FUIR-RATE-NOTICE-DATE NOT AVAILABLE' DTSBD750 00730 TO ABEND-MSG DTSBD750 00731 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00732 DTSBD750 00733 *&*********************************************************** DTSBD750 00734 * THE FOLLOWING LINES COMMENTED OUT SINCE PENALTY RATES DTSBD750 00735 * ARE NOT ASSIGNED IN DC. 12/09/1999 GD DTSBD750 00736 ************************************************************* DTSBD750 00737 * IF FUIR-PENALTY-RATE-DATE = +0 DTSBD750 00738 * MOVE 'FUIR-REG-PENALTY-RATE-DATE NOT AVAILABLE' DTSBD750 00739 * TO ABEND-MSG DTSBD750 00740 * PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00741 DTSBD750 00742 IF WRK-RUN-TYPE-REG-88 DTSBD750 00743 MOVE FUIR-RATE-NOTICE-DATE TO WRK-MAIL-DATE DTSBD750 00744 ELSE DTSBD750 00745 MOVE MHDR-CURR-MAIL-DATE TO WRK-MAIL-DATE DTSBD750 00746 END-IF. DTSBD750 00747 DTSBD750 00748 MOVE FUIR-PENALTY-RATE-DATE TO WRK-PENALTY-DATE. DTSBD750 00749 DTSBD750 00750 MOVE FUIR-RATE-TABLE TO WRK-RATE-TABLE. DTSBD750 00751 DTSBD750 00752 I3000-EXIT. DTSBD750 00753 EXIT. DTSBD750 00754 EJECT DTSBD750 00755 P0000-PROCESS. DTSBD750 00756 *****IF (MPRF-EMP-NO < 360101) DTSBD750 00757 *************OR DTSBD750 00758 ********(MPRF-EMP-NO > 360126) DTSBD750 00759 *********GO TO P0000-EXIT. DTSBD750 00760 DTSBD750 00761 IF MPRF-CLASS-RATED-88 DTSBD750 00762 NEXT SENTENCE DTSBD750 00763 ELSE DTSBD750 00764 GO TO P0000-EXIT. DTSBD750 00765 DTSBD750 00766 IF WRK-RUN-TYPE-REG-88 DTSBD750 00767 PERFORM P0010-REG-PROCESS THRU P0010-EXIT DTSBD750 00768 ELSE DTSBD750 00769 PERFORM P0020-ANN-PROCESS THRU P0020-EXIT. DTSBD750 00770 DTSBD750 00771 P0000-EXIT. DTSBD750 00772 EXIT. DTSBD750 00773 DTSBD750 00774 P0010-REG-PROCESS. DTSBD750 00775 DTSBD750 00776 ADD +1 TO PRF-REC-READ-CNT. DTSBD750 00777 DTSBD750 00778 DTSBD750 00779 MOVE 'N' TO ACTIVE-DURING-RATE-YR-IND. DTSBD750 00780 DTSBD750 00781 PERFORM P1000-DETERMINE-IF-RATE THRU P1000-EXIT. DTSBD750 00782 DTSBD750 00783 IF ACTIVE-DURING-RATE-YR-IND = 'N' DTSBD750 00784 GO TO P0010-EXIT. DTSBD750 00785 DTSBD750 00786 DTSBD750 00787 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD750 00788 DTSBD750 00789 MOVE MPRF-EMP-NO TO MRCT-EMP-NO. DTSBD750 00790 DTSBD750 00791 SET MRCT-RCT-88 TO TRUE. DTSBD750 00792 DTSBD750 00793 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD750 00794 DTSBD750 00795 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD750 00796 DTSBD750 00797 PERFORM S910-READ THRU S910-EXIT. DTSBD750 00798 DTSBD750 00799 IF L910-NO-REC-88 DTSBD750 00800 MOVE MSG01-MSG-IDENTIFIER TO R516-MSG-IDENTIFIER DTSBD750 00801 MOVE MPRF-EMP-NO TO R516-EMP-NO DTSBD750 00802 MOVE WRK-RTE-YR-START-YRQ TO R516-EFF-QTR DTSBD750 00803 MOVE MPRF-PRIMARY-NAME TO R516-PRIMARY-NAME DTSBD750 00804 MOVE MSG01-MSG-TEXT TO R516-MSG-TEXT DTSBD750 00805 PERFORM S946-WRITE-R516 THRU S946-EXIT DTSBD750 00806 GO TO P0010-EXIT. DTSBD750 00807 DTSBD750 00808 MOVE MSKL-REC TO MRCT-REC. DTSBD750 00809 DTSBD750 00810 DTSBD750 00811 IF MRCT-TRANSFERRED-TO-EMP-NO = +0 DTSBD750 00812 NEXT SENTENCE DTSBD750 00813 ELSE DTSBD750 00814 MOVE MSG04-MSG-IDENTIFIER TO R516-MSG-IDENTIFIER DTSBD750 00815 MOVE MPRF-EMP-NO TO R516-EMP-NO DTSBD750 00816 MOVE WRK-RTE-YR-START-YRQ TO R516-EFF-QTR DTSBD750 00817 MOVE MPRF-PRIMARY-NAME TO R516-PRIMARY-NAME DTSBD750 00818 MOVE MSG04-MSG-TEXT TO R516-MSG-TEXT DTSBD750 00819 PERFORM S946-WRITE-R516 THRU S946-EXIT DTSBD750 00820 GO TO P0010-EXIT. DTSBD750 00821 DTSBD750 00822 ************************************************************ DTSBD750 00823 * THE FOLLOWING CODE DETERMINES THE TYPE OF RATE THE DTSBD750 00824 * EMPLOYER NEEDS, BASED ON THE CONTRIBUTION REPORT FILING DTSBD750 00825 * SCHEDULE DURING THE RATE YEAR AND THE TWO PREVIOUS YEARS. DTSBD750 00826 * DTSBD750 00827 * THE SYSTEM WILL CREATE MRTE RECORDS FOR ANNUAL FILERS, WITH DTSBD750 00828 * A RATE TYPE OF EITHER REGULAR, TRANSITIONAL OR ESTIMATED. DTSBD750 00829 * ANNUAL FILERS DO NOT RECEIVE RATE NOTICES UNTIL MID-MAY. DTSBD750 00830 * DTSBD750 00831 * WRK-ANNUAL-FILER-NO-88 IS SET TO TRUE FOR EMPLOYERS DTSBD750 00832 * WHO FILE QUARTERLY DURING THE RATING YEAR. DTSBD750 00833 * WRK-ANNUAL-FILER-YES-88 IS SET TO TRUE IF THE EMPLOYER DTSBD750 00834 * FILES ANNUALLY DURING THE RATING YEAR. DTSBD750 00835 * WRK-ESTIM-NEEDED-88 IS SET TO TRUE IF THE EMPLOYER DTSBD750 00836 * REQUIRES AN ESTIMATED RATE. DTSBD750 00837 * WRK-TRANS-NEEDED-88 IS SET TO TRUE IF THE EMPLOYER DTSBD750 00838 * IS IN THE TRANSITION YEAR, AND SO DOES NOT REQUIRE DTSBD750 00839 * AN ESTIMATED RATE. DTSBD750 00840 * DTSBD750 00841 ************************************************************ DTSBD750 00842 SET WRK-ANNUAL-FILER-NO-88 TO TRUE. DTSBD750 00843 DTSBD750 00844 PERFORM P0011-CHK-FOR-ESTIMATE THRU P0011-EXIT. DTSBD750 00845 DTSBD750 00846 IF WRK-ESTIM-NEEDED-88 DTSBD750 00847 SET L054-ESTIMATED-RATE-YES-88 TO TRUE DTSBD750 00848 ELSE DTSBD750 00849 SET L054-ESTIMATED-RATE-NO-88 TO TRUE. DTSBD750 00850 DTSBD750 00851 PERFORM S054-RATE-LOOKUP-YES THRU S054-EXIT. DTSBD750 00852 DTSBD750 00853 IF L054-NO-FUIR-88 DTSBD750 00854 MOVE DTSBD750 00855 'L054-NO-FUIR-88 ENCOUNTERED - RATES NOT LOADED CORRECTLY' DTSBD750 00856 TO ABEND-MSG DTSBD750 00857 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00858 DTSBD750 00859 IF L054-UI-PEN-RATE-UNDETER-88 DTSBD750 00860 MOVE DTSBD750 00861 'L054-UI-PEN-RATE-UNDETER-88 - RATES NOT LOADED CORRECTLY' DTSBD750 00862 TO ABEND-MSG DTSBD750 00863 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 00864 DTSBD750 00865 MOVE 'N' TO RTE-EXISTS-IND. DTSBD750 00866 DTSBD750 00867 PERFORM P2000-LOOKUP-RATE THRU P2000-EXIT. DTSBD750 00868 DTSBD750 00869 IF RTE-EXISTS-IND = 'Y' DTSBD750 00870 GO TO P0010-EXIT. DTSBD750 00871 DTSBD750 00872 DTSBD750 00873 PERFORM P3000-CONSTRUCT-MRTE THRU P3000-EXIT. DTSBD750 00874 DTSBD750 00875 DTSBD750 00876 IF WRK-UPDATE-MASTER-YES-88 DTSBD750 00877 PERFORM P4000-UPDATE-MASTER THRU P4000-EXIT. DTSBD750 00878 DTSBD750 00879 IF WRK-ANNUAL-FILER-YES-88 DTSBD750 00880 ADD +1 TO BYPASS-ANN-CNT DTSBD750 00881 ELSE DTSBD750 00882 PERFORM P5000-CONSTRUCT-WRITE-R503 THRU P5000-EXIT DTSBD750 00883 PERFORM P7100-CONSTRUCT-WRITE-R515 THRU P7100-EXIT DTSBD750 00884 PERFORM P7200-CONSTRUCT-WRITE-R521 THRU P7200-EXIT. DTSBD750 00885 DTSBD750 00886 DTSBD750 00887 IF L054-CLASSIFIED-88 DTSBD750 00888 PERFORM P8000-CONSTRUCT-WRITE-R723 THRU P8000-EXIT. DTSBD750 00889 P0010-EXIT. DTSBD750 00890 EXIT. DTSBD750 00891 DTSBD750 00892 ************************************************************* DTSBD750 00893 * IF THE EMPLOYER FILED ANNUALLY DURING THE TWO YEARS DTSBD750 00894 * PRIOR TO THE RATE YEAR, CALCULATE THE RATE USING DTSBD750 00895 * THE ESTIMATED FIRST QUARTER WAGES STORED IN THE MRCT. DTSBD750 00896 * IN ALL OTHER SITUATIONS, USE THE WAGE DATA ON FILE. DTSBD750 00897 * DTSBD750 00898 ************************************************************* DTSBD750 00899 P0011-CHK-FOR-ESTIMATE. DTSBD750 00900 SET WRK-INIT-VALUES-88 TO TRUE. DTSBD750 00901 DTSBD750 00902 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBD750 00903 NEXT SENTENCE DTSBD750 00904 ELSE DTSBD750 00905 GO TO P0011-EXIT. DTSBD750 00906 DTSBD750 00907 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSBD750 00908 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSBD750 00909 MOVE WRK-RTE-YR-START-YRQ TO L410-YRQ. DTSBD750 00910 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT. DTSBD750 00911 IF L410-ANN-SCHED-88 DTSBD750 00912 SET WRK-RATE-YR-ANN-88 TO TRUE DTSBD750 00913 SET WRK-ANNUAL-FILER-YES-88 TO TRUE. DTSBD750 00914 DTSBD750 00915 MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9. DTSBD750 00916 SUBTRACT 1 FROM L004-QTR-5-YR. DTSBD750 00917 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD750 00918 DTSBD750 00919 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSBD750 00920 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSBD750 00921 MOVE L004-QTR-5-9 TO L410-YRQ. DTSBD750 00922 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT. DTSBD750 00923 DTSBD750 00924 IF L410-ANN-SCHED-88 DTSBD750 00925 SET WRK-RATE-YR-MINUS1-ANN-88 TO TRUE. DTSBD750 00926 DTSBD750 00927 SUBTRACT 1 FROM L004-QTR-5-YR. DTSBD750 00928 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD750 00929 MOVE L004-QTR-5-9 TO L410-YRQ. DTSBD750 00930 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSBD750 00931 IF L410-ANN-SCHED-88 DTSBD750 00932 SET WRK-RATE-YR-MINUS2-ANN-88 TO TRUE. DTSBD750 00933 DTSBD750 00934 P0011-EXIT. DTSBD750 00935 EXIT. DTSBD750 00936 DTSBD750 00937 P0020-ANN-PROCESS. DTSBD750 00938 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBD750 00939 NEXT SENTENCE DTSBD750 00940 ELSE DTSBD750 00941 GO TO P0020-EXIT. DTSBD750 00942 DTSBD750 00943 IF MPRF-STATUS-ACT-88 CL**6 00944 NEXT SENTENCE CL**6 00945 ELSE CL**6 00946 GO TO P0020-EXIT. CL**6 00947 CL**6 00948 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSBD750 00949 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSBD750 00950 MOVE WRK-RTE-YR-START-YRQ TO L410-YRQ. DTSBD750 00951 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT. DTSBD750 00952 IF L410-ANN-SCHED-88 DTSBD750 00953 NEXT SENTENCE DTSBD750 00954 ELSE DTSBD750 00955 GO TO P0020-EXIT. DTSBD750 00956 DTSBD750 00957 DTSBD750 00958 ADD +1 TO PRF-REC-READ-CNT. DTSBD750 00959 DTSBD750 00960 DTSBD750 00961 MOVE 'N' TO ACTIVE-DURING-RATE-YR-IND. DTSBD750 00962 DTSBD750 00963 PERFORM P1000-DETERMINE-IF-RATE THRU P1000-EXIT. DTSBD750 00964 DTSBD750 00965 *********************************************************** DTSBD750 00966 * INACTIVE EMPLOYERS WITH ESTIMATED RATES MUST BE INCLUDED DTSBD750 00967 * IN THE ANNUAL FILER RATING PROCESS. THE MRCT RECORD MUST DTSBD750 00968 * BE UPDATED WITH WAGES REPORTED FOR THE 'MISSING' QUARTER: DTSBD750 00969 * IF THE EMPLOYER REACTIVATES DURING THE RATING YEAR, THE DTSBD750 00970 * SYSTEM CAN THEN COMPUTE A 'REGULAR' RATE FROM THE DATA DTSBD750 00971 * IN THE MRCT. DTSBD750 00972 *********************************************************** DTSBD750 00973 IF ACTIVE-DURING-RATE-YR-IND = 'N' DTSBD750 00974 ADD +1 TO WRK-INACT-CNT. DTSBD750 00975 DTSBD750 00976 DTSBD750 00977 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD750 00978 DTSBD750 00979 MOVE MPRF-EMP-NO TO MRCT-EMP-NO. DTSBD750 00980 DTSBD750 00981 SET MRCT-RCT-88 TO TRUE. DTSBD750 00982 DTSBD750 00983 MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ. DTSBD750 00984 DTSBD750 00985 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD750 00986 DTSBD750 00987 PERFORM S910-READ THRU S910-EXIT. DTSBD750 00988 DTSBD750 00989 IF L910-NO-REC-88 DTSBD750 00990 IF ACTIVE-DURING-RATE-YR-IND = 'N' DTSBD750 00991 GO TO P0020-EXIT DTSBD750 00992 ELSE DTSBD750 00993 MOVE MSG01-MSG-IDENTIFIER TO R516-MSG-IDENTIFIER DTSBD750 00994 MOVE MPRF-EMP-NO TO R516-EMP-NO DTSBD750 00995 MOVE WRK-RTE-YR-START-YRQ TO R516-EFF-QTR DTSBD750 00996 MOVE MPRF-PRIMARY-NAME TO R516-PRIMARY-NAME DTSBD750 00997 MOVE MSG01-MSG-TEXT TO R516-MSG-TEXT DTSBD750 00998 PERFORM S946-WRITE-R516 THRU S946-EXIT DTSBD750 00999 GO TO P0020-EXIT. DTSBD750 01000 DTSBD750 01001 MOVE MSKL-REC TO MRCT-REC. DTSBD750 01002 DTSBD750 01003 DTSBD750 01004 IF MRCT-TRANSFERRED-TO-EMP-NO = +0 DTSBD750 01005 NEXT SENTENCE DTSBD750 01006 ELSE DTSBD750 01007 MOVE MSG04-MSG-IDENTIFIER TO R516-MSG-IDENTIFIER DTSBD750 01008 MOVE MPRF-EMP-NO TO R516-EMP-NO DTSBD750 01009 MOVE WRK-RTE-YR-START-YRQ TO R516-EFF-QTR DTSBD750 01010 MOVE MPRF-PRIMARY-NAME TO R516-PRIMARY-NAME DTSBD750 01011 MOVE MSG04-MSG-TEXT TO R516-MSG-TEXT DTSBD750 01012 PERFORM S946-WRITE-R516 THRU S946-EXIT DTSBD750 01013 GO TO P0020-EXIT. DTSBD750 01014 DTSBD750 01015 DTSBD750 01016 MOVE 'N' TO RTE-EXISTS-IND. DTSBD750 01017 DTSBD750 01018 PERFORM P2000-LOOKUP-RATE THRU P2000-EXIT. DTSBD750 01019 DTSBD750 01020 IF RTE-EXISTS-IND = 'N' DTSBD750 01021 IF ACTIVE-DURING-RATE-YR-IND = 'N' DTSBD750 01022 GO TO P0020-EXIT DTSBD750 01023 ELSE DTSBD750 01024 MOVE MPRF-EMP-NO TO R516-EMP-NO DTSBD750 01025 MOVE WRK-RTE-YR-START-YRQ TO R516-EFF-QTR DTSBD750 01026 MOVE MPRF-PRIMARY-NAME TO R516-PRIMARY-NAME DTSBD750 01027 MOVE MSG05-MSG-TEXT TO R516-MSG-TEXT DTSBD750 01028 PERFORM S946-WRITE-R516 THRU S946-EXIT DTSBD750 01029 END-IF DTSBD750 01030 END-IF. DTSBD750 01031 DTSBD750 01032 IF MRTE-RATE-TYPE-FINAL-88 DTSBD750 01033 ADD +1 TO BYPASS-FINAL-CNT DTSBD750 01034 DISPLAY 'FINAL RATE BYPASSED ' MPRF-EMP-NO DTSBD750 01035 GO TO P0020-EXIT. DTSBD750 01036 DTSBD750 01037 ** REMOVED TEST FOR ESTIMATED ANNUAL RATES- NOT PICKING UP CL**3 01038 ** 1ST QUARTER WAGES - RATES ARE NOT ESTIMATED. ZL1 CL**3 01039 ** CL**3 01040 ** READ THE REPORT FILE TO DETERMINE IF THE WAGES WERE ALREADY CL**4 01041 ** ADDED DURING THE REGULAR RATE RUN IN DECEMBER. SOME ANNUAL CL**4 01042 ** FILERS FILE THEIR REPORT ON A QUARTERLY BASIS ZL1 CL**4 01043 ** CL**4 01044 ** CL**4 01045 * IF MRTE-RATE-TYPE-ESTIM-88 CL**3 01046 PERFORM P6900-FIND-ORG-RPT THRU P6900-EXIT. CL**4 01047 PERFORM P6000-UPDATE-WAGES THRU P6000-EXIT. CL**4 01048 DTSBD750 01049 SET L054-ESTIMATED-RATE-NO-88 TO TRUE. DTSBD750 01050 PERFORM S054-RATE-LOOKUP-YES THRU S054-EXIT. DTSBD750 01051 DTSBD750 01052 IF L054-NO-FUIR-88 DTSBD750 01053 MOVE DTSBD750 01054 'L054-NO-FUIR-88 ENCOUNTERED - RATES NOT LOADED CORRECTLY' DTSBD750 01055 TO ABEND-MSG DTSBD750 01056 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 01057 DTSBD750 01058 IF L054-UI-PEN-RATE-UNDETER-88 DTSBD750 01059 MOVE DTSBD750 01060 'L054-UI-PEN-RATE-UNDETER-88 - RATES NOT LOADED CORRECTLY' DTSBD750 01061 TO ABEND-MSG DTSBD750 01062 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 01063 DTSBD750 01064 DTSBD750 01065 DTSBD750 01066 IF RTE-EXISTS-IND = 'N' DTSBD750 01067 PERFORM P3000-CONSTRUCT-MRTE THRU P3000-EXIT DTSBD750 01068 ELSE DTSBD750 01069 PERFORM P6100-UPDATE-MRTE THRU P6100-EXIT. DTSBD750 01070 DTSBD750 01071 DTSBD750 01072 IF WRK-UPDATE-MASTER-YES-88 DTSBD750 01073 PERFORM P4000-UPDATE-MASTER THRU P4000-EXIT. DTSBD750 01074 DTSBD750 01075 IF ACTIVE-DURING-RATE-YR-IND = 'N' DTSBD750 01076 GO TO P0020-EXIT. DTSBD750 01077 DTSBD750 01078 PERFORM P5000-CONSTRUCT-WRITE-R503 THRU P5000-EXIT. DTSBD750 01079 DTSBD750 01080 DTSBD750 01081 PERFORM P7100-CONSTRUCT-WRITE-R515 THRU P7100-EXIT. DTSBD750 01082 DTSBD750 01083 DTSBD750 01084 PERFORM P7200-CONSTRUCT-WRITE-R521 THRU P7200-EXIT. DTSBD750 01085 DTSBD750 01086 DTSBD750 01087 IF L054-CLASSIFIED-88 DTSBD750 01088 PERFORM P8000-CONSTRUCT-WRITE-R723 THRU P8000-EXIT. DTSBD750 01089 P0020-EXIT. DTSBD750 01090 EXIT. DTSBD750 01091 DTSBD750 01092 P1000-DETERMINE-IF-RATE. DTSBD750 01093 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD750 01094 DTSBD750 01095 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD750 01096 DTSBD750 01097 SET MSKL-SOL-88 TO TRUE. DTSBD750 01098 DTSBD750 01099 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD750 01100 DTSBD750 01101 PERFORM P1100-MSOL-SCAN THRU P1100-EXIT DTSBD750 01102 UNTIL L910-NO-REC-88. DTSBD750 01103 P1000-EXIT. DTSBD750 01104 EXIT. DTSBD750 01105 SKIP3 DTSBD750 01106 P1100-MSOL-SCAN. DTSBD750 01107 MOVE MSKL-REC TO MSOL-REC. DTSBD750 01108 DTSBD750 01109 IF MSOL-INACT-WITHDRAWN-88 DTSBD750 01110 NEXT SENTENCE DTSBD750 01111 ELSE DTSBD750 01112 IF (MSOL-FIRST-LIAB-YRQ > WRK-RTE-YR-END-YRQ) DTSBD750 01113 OR DTSBD750 01114 (MSOL-LAST-LIAB-YRQ < WRK-RTE-YR-START-YRQ) DTSBD750 01115 NEXT SENTENCE DTSBD750 01116 ELSE DTSBD750 01117 MOVE 'Y' TO ACTIVE-DURING-RATE-YR-IND DTSBD750 01118 SET L910-NO-REC-88 TO TRUE DTSBD750 01119 GO TO P1100-EXIT. DTSBD750 01120 DTSBD750 01121 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD750 01122 P1100-EXIT. DTSBD750 01123 EXIT. DTSBD750 01124 EJECT DTSBD750 01125 P2000-LOOKUP-RATE. DTSBD750 01126 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBD750 01127 DTSBD750 01128 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBD750 01129 DTSBD750 01130 SET MRTE-RTE-88 TO TRUE. DTSBD750 01131 DTSBD750 01132 MOVE WRK-RTE-YR-START-YRQ TO MRTE-EFF-YRQ. DTSBD750 01133 DTSBD750 01134 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBD750 01135 DTSBD750 01136 PERFORM S910-READ THRU S910-EXIT. DTSBD750 01137 DTSBD750 01138 IF L910-NO-REC-88 DTSBD750 01139 GO TO P2000-EXIT. DTSBD750 01140 DTSBD750 01141 MOVE 'Y' TO RTE-EXISTS-IND. DTSBD750 01142 DTSBD750 01143 MOVE MSKL-REC TO MRTE-REC. DTSBD750 01144 DTSBD750 01145 DTSBD750 01146 IF WRK-RUN-TYPE-ANN-88 DTSBD750 01147 GO TO P2000-EXIT. DTSBD750 01148 DTSBD750 01149 IF ((L054-UI-PEN-RATE-YES-88) DTSBD750 01150 AND DTSBD750 01151 (L054-UI-PEN-RATE = MRTE-UI-RATE)) DTSBD750 01152 OR DTSBD750 01153 ((L054-UI-PEN-RATE-NO-88 OR L054-UI-PEN-RATE-INEFF-88) DTSBD750 01154 AND DTSBD750 01155 (L054-UI-CALC-RATE = MRTE-UI-RATE)) DTSBD750 01156 MOVE MSG02-MSG-IDENTIFIER TO R516-MSG-IDENTIFIER DTSBD750 01157 MOVE MPRF-EMP-NO TO R516-EMP-NO DTSBD750 01158 MOVE WRK-RTE-YR-START-YRQ TO R516-EFF-QTR DTSBD750 01159 MOVE MPRF-PRIMARY-NAME TO R516-PRIMARY-NAME DTSBD750 01160 MOVE MSG02-MSG-TEXT TO R516-MSG-TEXT DTSBD750 01161 PERFORM S946-WRITE-R516 THRU S946-EXIT DTSBD750 01162 ELSE DTSBD750 01163 MOVE MSG03-MSG-IDENTIFIER TO R516-MSG-IDENTIFIER DTSBD750 01164 MOVE MPRF-EMP-NO TO R516-EMP-NO DTSBD750 01165 MOVE WRK-RTE-YR-START-YRQ TO R516-EFF-QTR DTSBD750 01166 MOVE MPRF-PRIMARY-NAME TO R516-PRIMARY-NAME DTSBD750 01167 MOVE MSG03-MSG-TEXT TO R516-MSG-TEXT DTSBD750 01168 PERFORM S946-WRITE-R516 THRU S946-EXIT. DTSBD750 01169 P2000-EXIT. DTSBD750 01170 EXIT. DTSBD750 01171 EJECT DTSBD750 01172 P3000-CONSTRUCT-MRTE. DTSBD750 01173 DTSBD750 01174 DISPLAY 'RATE REC MISSING.... ADDING RATE REC ' MPRF-EMP-NO. DTSBD750 01175 DTSBD750 01176 MOVE LOW-VALUES TO MRTE-REC. DTSBD750 01177 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBD750 01178 DTSBD750 01179 SET MRTE-RTE-88 TO TRUE. DTSBD750 01180 DTSBD750 01181 MOVE WRK-RTE-YR-START-YRQ TO MRTE-EFF-YRQ. DTSBD750 01182 DTSBD750 01183 MOVE +0 TO MRTE-PURGE-DATE. DTSBD750 01184 DTSBD750 01185 MOVE WRK-RTE-YR-END-YRQ TO MRTE-END-YRQ. DTSBD750 01186 DTSBD750 01187 IF L054-UI-PEN-RATE-YES-88 DTSBD750 01188 MOVE L054-UI-PEN-RATE TO MRTE-UI-RATE DTSBD750 01189 ELSE DTSBD750 01190 MOVE L054-UI-CALC-RATE TO MRTE-UI-RATE. DTSBD750 01191 DTSBD750 01192 IF WRK-ANNUAL-FILER-YES-88 DTSBD750 01193 MOVE ZERO TO MRTE-NOTICE-DATE DTSBD750 01194 ELSE DTSBD750 01195 MOVE WRK-MAIL-DATE TO MRTE-NOTICE-DATE. DTSBD750 01196 DTSBD750 01197 IF L054-NONCLASSIFIED-88 DTSBD750 01198 SET MRTE-RATE-TYPE-REG-88 TO TRUE DTSBD750 01199 ELSE DTSBD750 01200 IF WRK-PRINT-ESTIM-88 DTSBD750 01201 SET MRTE-RATE-TYPE-FINAL-88 TO TRUE DTSBD750 01202 ELSE DTSBD750 01203 IF WRK-ESTIM-NEEDED-88 DTSBD750 01204 SET MRTE-RATE-TYPE-ESTIM-88 TO TRUE DTSBD750 01205 ELSE DTSBD750 01206 IF WRK-TRANS-NEEDED-88 DTSBD750 01207 SET MRTE-RATE-TYPE-TRANS-88 TO TRUE DTSBD750 01208 ELSE DTSBD750 01209 SET MRTE-RATE-TYPE-REG-88 TO TRUE. DTSBD750 01210 DTSBD750 01211 DTSBD750 01212 SET MRTE-NOT-CONVERTED-88 TO TRUE. DTSBD750 01213 DTSBD750 01214 MOVE MHDR-CURR-RUN-DATE TO MRTE-ESTB-DATE DTSBD750 01215 MRTE-CHNG-DATE. DTSBD750 01216 P3000-EXIT. DTSBD750 01217 EXIT. DTSBD750 01218 EJECT DTSBD750 01219 DTSBD750 01220 P4000-UPDATE-MASTER. DTSBD750 01221 IF WRK-RUN-TYPE-REG-88 DTSBD750 01222 PERFORM P4100-REG-RUN THRU P4100-EXIT DTSBD750 01223 ELSE DTSBD750 01224 PERFORM P4200-ANN-RUN THRU P4200-EXIT. DTSBD750 01225 DTSBD750 01226 IF MPRF-UPDATE-ACTIVE-88 DTSBD750 01227 MOVE MSG99-MSG-IDENTIFIER TO R907-MSG-ID DTSBD750 01228 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD750 01229 MOVE MSG99-MSG-TEXT TO R907-MSG-TEXT DTSBD750 01230 MOVE MOD-NAME TO R907-MODULE-NAME DTSBD750 01231 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD750 01232 ELSE DTSBD750 01233 MOVE WRK-SYS-ABSTIME TO MPRF-UPDATE-END-ABSTIME DTSBD750 01234 MOVE +0 TO MPRF-UPDATE-TASK-ID DTSBD750 01235 MOVE 'BATCH' TO MPRF-UPDATE-OP-ID DTSBD750 01236 MOVE SPACES TO MPRF-UPDATE-TERMID DTSBD750 01237 MPRF-UPDATE-NETNAME DTSBD750 01238 MOVE WRK-SYS-DATE TO MPRF-UPDATE-START-DATE DTSBD750 01239 MOVE WRK-SYS-TIME TO MPRF-UPDATE-START-TIME DTSBD750 01240 MOVE SPACES TO MPRF-UPDATE-SCR-ID DTSBD750 01241 MPRF-UPDATE-FUNCTION DTSBD750 01242 MOVE MHDR-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSBD750 01243 MOVE MPRF-REC TO MSKL-REC DTSBD750 01244 PERFORM S910-REWRITE THRU S910-EXIT DTSBD750 01245 ADD +1 TO PRF-REC-REWRITE-CNT. DTSBD750 01246 DTSBD750 01247 DTSBD750 01248 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD750 01249 DTSBD750 01250 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD750 01251 DTSBD750 01252 SET MQTR-QTR-88 TO TRUE. DTSBD750 01253 DTSBD750 01254 MOVE WRK-RTE-YR-START-YRQ TO MQTR-YRQ. DTSBD750 01255 DTSBD750 01256 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD750 01257 DTSBD750 01258 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD750 01259 DTSBD750 01260 PERFORM P4300-MQTR-SCAN THRU P4300-EXIT DTSBD750 01261 UNTIL L910-NO-REC-88. DTSBD750 01262 P4000-EXIT. DTSBD750 01263 EXIT. DTSBD750 01264 SKIP3 DTSBD750 01265 P4100-REG-RUN. DTSBD750 01266 MOVE MRTE-REC TO MSKL-REC. DTSBD750 01267 DTSBD750 01268 PERFORM S910-WRITE THRU S910-EXIT. DTSBD750 01269 DTSBD750 01270 ADD +1 TO RTE-REC-WRITE-CNT. DTSBD750 01271 DTSBD750 01272 IF MRTE-RATE-TYPE-ESTIM-88 DTSBD750 01273 ADD +1 TO ESTIMATED-RATE-CNT DTSBD750 01274 ELSE DTSBD750 01275 IF MRTE-RATE-TYPE-FINAL-88 DTSBD750 01276 ADD +1 TO FINAL-RATE-CNT DTSBD750 01277 ELSE DTSBD750 01278 IF MRTE-RATE-TYPE-TRANS-88 DTSBD750 01279 ADD +1 TO TRANSITIONAL-RATE-CNT DTSBD750 01280 ELSE DTSBD750 01281 IF MRTE-RATE-TYPE-REG-88 DTSBD750 01282 IF WRK-ANNUAL-FILER-YES-88 DTSBD750 01283 AND L054-NONCLASSIFIED-88 DTSBD750 01284 ADD +1 TO UNCLASS-ANN-CNT DTSBD750 01285 ELSE DTSBD750 01286 ADD +1 TO REGULAR-RATE-CNT. DTSBD750 01287 DTSBD750 01288 P4100-EXIT. DTSBD750 01289 EXIT. DTSBD750 01290 SKIP3 DTSBD750 01291 P4200-ANN-RUN. DTSBD750 01292 IF RTE-EXISTS-IND = 'Y' DTSBD750 01293 GO TO P4200-EXIT. DTSBD750 01294 DTSBD750 01295 IF L054-UI-PEN-RATE-YES-88 DTSBD750 01296 MOVE L054-UI-PEN-RATE TO MRTE-UI-RATE DTSBD750 01297 ELSE DTSBD750 01298 MOVE L054-UI-CALC-RATE TO MRTE-UI-RATE. DTSBD750 01299 DTSBD750 01300 MOVE WRK-MAIL-DATE TO MRTE-NOTICE-DATE. DTSBD750 01301 DTSBD750 01302 IF MRTE-RATE-TYPE-ESTIM-88 DTSBD750 01303 SET MRTE-RATE-TYPE-REG-88 TO TRUE. DTSBD750 01304 DTSBD750 01305 MOVE MRTE-REC TO MSKL-REC. DTSBD750 01306 DTSBD750 01307 PERFORM S910-WRITE THRU S910-EXIT. DTSBD750 01308 DTSBD750 01309 ADD +1 TO RTE-REC-WRITE-CNT. DTSBD750 01310 DTSBD750 01311 IF MRTE-RATE-TYPE-TRANS-88 DTSBD750 01312 ADD +1 TO TRANSITIONAL-RATE-CNT DTSBD750 01313 ELSE DTSBD750 01314 IF MRTE-RATE-TYPE-REG-88 DTSBD750 01315 IF L054-NONCLASSIFIED-88 DTSBD750 01316 ADD +1 TO UNCLASS-ANN-CNT DTSBD750 01317 ELSE DTSBD750 01318 ADD +1 TO REGULAR-RATE-CNT. DTSBD750 01319 DTSBD750 01320 P4200-EXIT. DTSBD750 01321 EXIT. DTSBD750 01322 SKIP3 DTSBD750 01323 P4300-MQTR-SCAN. DTSBD750 01324 MOVE MSKL-REC TO MQTR-REC. DTSBD750 01325 DTSBD750 01326 IF MQTR-YRQ > WRK-RTE-YR-END-YRQ DTSBD750 01327 SET L910-NO-REC-88 TO TRUE DTSBD750 01328 GO TO P4300-EXIT. DTSBD750 01329 DTSBD750 01330 IF MRTE-UI-RATE = MQTR-UI-RATE DTSBD750 01331 NEXT SENTENCE DTSBD750 01332 ELSE DTSBD750 01333 MOVE MPRF-EMP-NO TO T031-EMP-NO DTSBD750 01334 MOVE MOD-NAME TO T031-ORIGIN DTSBD750 01335 MOVE WRK-SYS-DATE TO T031-SYS-DATE DTSBD750 01336 MOVE WRK-SYS-TIME TO T031-SYS-TIME DTSBD750 01337 MOVE LOW-VALUES TO T031-DATA-AREA DTSBD750 01338 SET T031-AUTO-PROCESS TO TRUE DTSBD750 01339 MOVE MQTR-YRQ TO T031-START-YRQ DTSBD750 01340 T031-END-YRQ DTSBD750 01341 MOVE +0 TO T031-WAIVER-START-YRQ DTSBD750 01342 T031-WAIVER-END-YRQ DTSBD750 01343 T031-WAIVER-EXT-DATE DTSBD750 01344 SET T031-TRANSFER-NO-88 TO TRUE DTSBD750 01345 MOVE +0 TO T031-TRANSFER-TO-EMP-NO DTSBD750 01346 MOVE T031-REC TO TSKL-REC DTSBD750 01347 PERFORM S927-WRITE THRU S927-EXIT. DTSBD750 01348 DTSBD750 01349 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD750 01350 P4300-EXIT. DTSBD750 01351 EXIT. DTSBD750 01352 EJECT DTSBD750 01353 P5000-CONSTRUCT-WRITE-R503. DTSBD750 01354 IF WRK-RUN-TYPE-REG-88 DTSBD750 01355 IF WRK-ANNUAL-FILER-YES-88 DTSBD750 01356 GO TO P5000-EXIT. DTSBD750 01357 DTSBD750 01358 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBD750 01359 DTSBD750 01360 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBD750 01361 DTSBD750 01362 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBD750 01363 DTSBD750 01364 PERFORM S111-ADDRESS-LOOKUP THRU S111-EXIT. DTSBD750 01365 DTSBD750 01366 IF L111-ADDR-FOUND-88 DTSBD750 01367 SET L112-TAD-ADDR-88 TO TRUE DTSBD750 01368 SET L112-ANCHOR-LAST-88 TO TRUE DTSBD750 01369 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME DTSBD750 01370 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBD750 01371 PERFORM S112-ADDRESS-FORMAT THRU S112-EXIT DTSBD750 01372 ELSE DTSBD750 01373 MOVE ALL '?' TO L112-NAME-ADDRESS-AREA DTSBD750 01374 L112-MAILING-ADDRESS. DTSBD750 01375 DTSBD750 01376 DTSBD750 01377 IF L054-UI-PEN-RATE-YES-88 DTSBD750 01378 SET R503-UI-PEN-RATE-YES-88 TO TRUE DTSBD750 01379 ELSE DTSBD750 01380 SET R503-UI-PEN-RATE-NO-88 TO TRUE. DTSBD750 01381 DTSBD750 01382 DTSBD750 01383 MOVE LOW-VALUES TO R503-SORT-VAR-AREA. DTSBD750 01384 DTSBD750 01385 MOVE L112-ZIP TO R503-YRLY-ZIP. DTSBD750 01386 DTSBD750 01387 MOVE MPRF-EMP-NO TO R503-YRLY-EMP-NO. DTSBD750 01388 DTSBD750 01389 IF L054-CLASSIFIED-88 DTSBD750 01390 SET R503-CLASSIFIED-88 TO TRUE DTSBD750 01391 ELSE DTSBD750 01392 SET R503-NONCLASSIFIED-88 TO TRUE. DTSBD750 01393 DTSBD750 01394 MOVE MPRF-EMP-NO TO R503-EMP-NO. DTSBD750 01395 DTSBD750 01396 MOVE WRK-RTE-YR-START-YRQ TO R503-EFF-YRQ. DTSBD750 01397 DTSBD750 01398 MOVE WRK-RTE-YR-DISP TO R503-RATE-YEAR. DTSBD750 01399 DTSBD750 01400 MOVE WRK-MAIL-DATE TO R503-NOTICE-DATE. DTSBD750 01401 DTSBD750 01402 IF R503-UI-PEN-RATE-YES-88 DTSBD750 01403 MOVE WRK-PENALTY-DATE TO R503-PENALTY-DEADLINE-DATE DTSBD750 01404 ELSE DTSBD750 01405 MOVE +0 TO R503-PENALTY-DEADLINE-DATE. DTSBD750 01406 DTSBD750 01407 MOVE L112-MAILING-ADDRESS TO R503-FMT-ADDR. DTSBD750 01408 DTSBD750 01409 MOVE L112-ZIP TO R503-ZIP. DTSBD750 01410 DTSBD750 01411 MOVE L112-ADVANCED-BARCODE TO R503-ADVANCED-BARCODE. DTSBD750 01412 DTSBD750 01413 MOVE L054-UI-CALC-RATE TO R503-CALC-RATE. DTSBD750 01414 DTSBD750 01415 MOVE L054-UI-PEN-RATE TO R503-PEN-RATE. DTSBD750 01416 DTSBD750 01417 IF R503-UI-PEN-RATE-YES-88 DTSBD750 01418 MOVE L054-UI-PEN-RATE TO R503-UI-RATE DTSBD750 01419 ELSE DTSBD750 01420 MOVE L054-UI-CALC-RATE TO R503-UI-RATE. DTSBD750 01421 DTSBD750 01422 MOVE L055-CURRENT-RESERVE-THRU-DATE DTSBD750 01423 TO R503-CURRENT-RESERVE-THRU-DATE. DTSBD750 01424 DTSBD750 01425 MOVE L054-AVG-TAX-WAGE TO R503-AVG-TAX-WAGE. DTSBD750 01426 DTSBD750 01427 MOVE L054-RATIO TO R503-RESERVE-RATIO. DTSBD750 01428 DTSBD750 01429 MOVE MRCT-PRIOR-RESERVE-AMT TO R503-PRIOR-RESERVE-AMT. DTSBD750 01430 DTSBD750 01431 MOVE MRCT-TRUST-FUND-INTEREST-AMT DTSBD750 01432 TO R503-TRUST-FUND-INTEREST-AMT. DTSBD750 01433 DTSBD750 01434 MOVE MRCT-UI-TAX-PAID-AMT TO R503-UI-TAX-PAID-AMT. DTSBD750 01435 DTSBD750 01436 MOVE MRCT-BENEFITS-CHARGED-AMT DTSBD750 01437 TO R503-BENEFITS-CHARGED-AMT. DTSBD750 01438 DTSBD750 01439 MOVE L054-CURRENT-RESERVE-AMT DTSBD750 01440 TO R503-CURRENT-RESERVE-AMT. DTSBD750 01441 DTSBD750 01442 MOVE WRK-RATE-TABLE TO R503-RATE-TABLE. DTSBD750 01443 DTSBD750 01444 PERFORM S946-WRITE-R503 THRU S946-EXIT. DTSBD750 01445 DTSBD750 01446 DTSBD750 01447 IF R503-UI-PEN-RATE-YES-88 DTSBD750 01448 NEXT SENTENCE DTSBD750 01449 ELSE DTSBD750 01450 GO TO P5000-EXIT. DTSBD750 01451 DTSBD750 01452 DTSBD750 01453 MOVE LOW-VALUES TO R504-SORT-VAR-AREA. DTSBD750 01454 DTSBD750 01455 MOVE R503-YRLY-ZIP TO R504-YRLY-ZIP. DTSBD750 01456 DTSBD750 01457 MOVE R503-YRLY-EMP-NO TO R504-YRLY-EMP-NO. DTSBD750 01458 DTSBD750 01459 MOVE R503-EMP-NO TO R504-EMP-NO. DTSBD750 01460 DTSBD750 01461 MOVE R503-EFF-YRQ TO R504-EFF-YRQ. DTSBD750 01462 DTSBD750 01463 MOVE R503-RATE-YEAR TO R504-RATE-YEAR. DTSBD750 01464 DTSBD750 01465 MOVE R503-NOTICE-DATE TO R504-NOTICE-DATE. DTSBD750 01466 DTSBD750 01467 MOVE R503-PENALTY-DEADLINE-DATE DTSBD750 01468 TO R504-PENALTY-DEADLINE-DATE. DTSBD750 01469 DTSBD750 01470 MOVE R503-FMT-ADDR TO R504-FMT-ADDR. DTSBD750 01471 DTSBD750 01472 MOVE R503-ZIP TO R504-ZIP. DTSBD750 01473 DTSBD750 01474 MOVE R503-ADVANCED-BARCODE TO R504-ADVANCED-BARCODE. DTSBD750 01475 DTSBD750 01476 MOVE R503-CALC-RATE TO R504-CALC-RATE. DTSBD750 01477 DTSBD750 01478 MOVE R503-PEN-RATE TO R504-PEN-RATE. DTSBD750 01479 DTSBD750 01480 PERFORM S946-WRITE-R504 THRU S946-EXIT. DTSBD750 01481 P5000-EXIT. DTSBD750 01482 EXIT. DTSBD750 01483 EJECT DTSBD750 01484 P6000-UPDATE-WAGES. DTSBD750 01485 MOVE ZERO TO WRK-TAX-WAGE. DTSBD750 01486 DTSBD750 01487 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD750 01488 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD750 01489 SET MQTR-QTR-88 TO TRUE. DTSBD750 01490 MOVE L055-WAGES-THRU-YRQ (3) TO MQTR-YRQ. DTSBD750 01491 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD750 01492 DTSBD750 01493 PERFORM S910-READ THRU S910-EXIT. DTSBD750 01494 IF L910-OK-88 DTSBD750 01495 MOVE MSKL-REC TO MQTR-REC DTSBD750 01496 IF MQTR-CURR-RCVD-88 AND CL**4 01497 WRK-REPORT-DATE > FUIR-RATE-CUTOFF-DATE CL**4 01498 ADD MQTR-TOT-WAGE TO MRCT-TOT-WAGE (3) DTSBD750 01499 ADD MQTR-TAX-WAGE TO MRCT-TAX-WAGE (3) DTSBD750 01500 ELSE DTSBD750 01501 PERFORM P6020-ADDED-WAGES THRU P6020-EXIT CL**4 01502 END-IF DTSBD750 01503 ELSE DTSBD750 01504 PERFORM P6010-NO-WAGES THRU P6010-EXIT DTSBD750 01505 END-IF. DTSBD750 01506 DTSBD750 01507 MOVE ZERO TO MRCT-QTR1-ESTIM-TAX-WAGE. DTSBD750 01508 MOVE MRCT-REC TO MSKL-REC. DTSBD750 01509 DTSBD750 01510 IF WRK-UPDATE-MASTER-YES-88 DTSBD750 01511 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD750 01512 DTSBD750 01513 P6000-EXIT. DTSBD750 01514 EXIT. DTSBD750 01515 EJECT DTSBD750 01516 P6010-NO-WAGES. DTSBD750 01517 ADD +1 TO NO-1ST-QTR-WAGE-CNT. DTSBD750 01518 DISPLAY 'BD750: MISSING FIRST QTR WAGES ' MPRF-EMP-NO. DTSBD750 01519 MOVE MSG06-MSG-IDENTIFIER TO R516-MSG-IDENTIFIER. DTSBD750 01520 MOVE MPRF-EMP-NO TO R516-EMP-NO. DTSBD750 01521 MOVE WRK-RTE-YR-START-YRQ TO R516-EFF-QTR. DTSBD750 01522 MOVE MPRF-PRIMARY-NAME TO R516-PRIMARY-NAME. DTSBD750 01523 MOVE MSG06-MSG-TEXT TO R516-MSG-TEXT. DTSBD750 01524 PERFORM S946-WRITE-R516 THRU S946-EXIT. DTSBD750 01525 DTSBD750 01526 P6010-EXIT. DTSBD750 01527 EXIT. DTSBD750 01528 EJECT DTSBD750 01529 P6020-ADDED-WAGES. CL**4 01530 * ADD +1 TO NO-1ST-QTR-WAGE-CNT. CL**4 01531 DISPLAY 'BD750: 1ST QTR WAGES ALREADY ADDED ' MPRF-EMP-NO. CL**4 01532 MOVE MSG06-MSG-IDENTIFIER TO R516-MSG-IDENTIFIER. CL**4 01533 MOVE MPRF-EMP-NO TO R516-EMP-NO. CL**4 01534 MOVE WRK-RTE-YR-START-YRQ TO R516-EFF-QTR. CL**4 01535 MOVE MPRF-PRIMARY-NAME TO R516-PRIMARY-NAME. CL**4 01536 MOVE MSG06-MSG-TEXT TO R516-MSG-TEXT. CL**4 01537 PERFORM S946-WRITE-R516 THRU S946-EXIT. CL**4 01538 CL**4 01539 P6020-EXIT. CL**4 01540 EXIT. CL**4 01541 EJECT CL**4 01542 P6100-UPDATE-MRTE. DTSBD750 01543 IF L054-UI-PEN-RATE-YES-88 DTSBD750 01544 MOVE L054-UI-PEN-RATE TO MRTE-UI-RATE DTSBD750 01545 ELSE DTSBD750 01546 MOVE L054-UI-CALC-RATE TO MRTE-UI-RATE. DTSBD750 01547 DTSBD750 01548 MOVE WRK-MAIL-DATE TO MRTE-NOTICE-DATE. DTSBD750 01549 DTSBD750 01550 IF MRTE-RATE-TYPE-ESTIM-88 DTSBD750 01551 SET MRTE-RATE-TYPE-REG-88 TO TRUE. DTSBD750 01552 DTSBD750 01553 MOVE MHDR-CURR-RUN-DATE TO MRTE-CHNG-DATE. DTSBD750 01554 DTSBD750 01555 MOVE MRTE-REC TO MSKL-REC. DTSBD750 01556 DTSBD750 01557 IF WRK-UPDATE-MASTER-YES-88 DTSBD750 01558 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD750 01559 DTSBD750 01560 P6100-EXIT. DTSBD750 01561 EXIT. DTSBD750 01562 EJECT DTSBD750 01563 P6900-FIND-ORG-RPT. CL**4 01564 MOVE ZEROS TO WRK-REPORT-DATE. CL**4 01565 MOVE LOW-VALUE TO MRPT-KEY-AREA. CL**4 01566 SET MRPT-RPT-88 TO TRUE. CL**4 01567 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. CL**4 01568 MOVE L055-WAGES-THRU-YRQ (3) TO MRPT-YRQ. CL**4 01569 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. CL**4 01570 CL**4 01571 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**4 01572 IF L910-OK-88 CL**4 01573 PERFORM P6910-SCAN-MRPT THRU P6910-EXIT CL**4 01574 UNTIL L910-NO-REC-88 CL**4 01575 ELSE CL**4 01576 DISPLAY 'BD750-ORIG RPT NOT ON DUTAS- CANNOT RATE '. CL**4 01577 P6900-EXIT. CL**4 01578 EXIT. CL**4 01579 EJECT CL**4 01580 P6910-SCAN-MRPT. CL**4 01581 MOVE MSKL-REC TO MRPT-REC. CL**4 01582 IF MRPT-YRQ = L055-WAGES-THRU-YRQ (3) CL**4 01583 NEXT SENTENCE CL**4 01584 ELSE CL**4 01585 IF MRPT-YRQ > L055-WAGES-THRU-YRQ (3) CL**4 01586 SET L910-NO-REC-88 TO TRUE CL**4 01587 GO TO P6910-EXIT CL**4 01588 ELSE CL**4 01589 GO TO P6910-READ-NEXT CL**4 01590 END-IF CL**4 01591 END-IF. CL**4 01592 CL**4 01593 IF MRPT-ORIG-88 CL**4 01594 MOVE MRPT-DEPOSIT-DATE TO WRK-REPORT-DATE CL**5 01595 SET L910-NO-REC-88 TO TRUE CL**4 01596 GO TO P6910-EXIT CL**4 01597 END-IF. CL**4 01598 P6910-READ-NEXT. CL**4 01599 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**4 01600 IF L910-NO-REC-88 CL**4 01601 SET L910-NO-REC-88 TO TRUE. CL**4 01602 P6910-EXIT. CL**4 01603 EXIT. CL**4 01604 CL**4 01605 P7100-CONSTRUCT-WRITE-R515. DTSBD750 01606 ******************************************************** DTSBD750 01607 * THERE ARE SEPARATE RATE DETAIL REPORTS FOR REGULAR, DTSBD750 01608 * ESTIMATED AND FINAL RATES. THE REGULAR LISTING DTSBD750 01609 * INCLUDES TRANSITIONAL RATES. DTSBD750 01610 ******************************************************** DTSBD750 01611 IF MRTE-RATE-TYPE-ESTIM-88 DTSBD750 01612 SET R515-RPT-TYPE-ESTIM-88 TO TRUE DTSBD750 01613 ELSE DTSBD750 01614 IF MRTE-RATE-TYPE-FINAL-88 DTSBD750 01615 SET R515-RPT-TYPE-FINAL-88 TO TRUE DTSBD750 01616 ELSE DTSBD750 01617 SET R515-RPT-TYPE-REG-88 TO TRUE. DTSBD750 01618 DTSBD750 01619 IF L054-CLASSIFIED-88 DTSBD750 01620 SET R515-RATE-CLASSIFIED-88 TO TRUE DTSBD750 01621 ELSE DTSBD750 01622 SET R515-RATE-NONCLASSIFIED-88 TO TRUE. DTSBD750 01623 DTSBD750 01624 MOVE MPRF-EMP-NO TO R515-EMP-NO. DTSBD750 01625 DTSBD750 01626 MOVE LOW-VALUES TO R515-DATA-AREA. DTSBD750 01627 DTSBD750 01628 MOVE WRK-RTE-YR-START-YRQ TO R515-EFF-QTR. DTSBD750 01629 DTSBD750 01630 MOVE MPRF-PRIMARY-NAME TO R515-PRIMARY-NAME. DTSBD750 01631 DTSBD750 01632 PERFORM DTSBD750 01633 VARYING R515-WAGES-IDX FROM 1 BY 1 DTSBD750 01634 UNTIL R515-WAGES-IDX > MMAX-RCT-EXP-MAX DTSBD750 01635 SET MRCT-WAGES-IDX TO R515-WAGES-IDX DTSBD750 01636 MOVE MRCT-TAX-WAGE (MRCT-WAGES-IDX) DTSBD750 01637 TO R515-TAX-WAGE (R515-WAGES-IDX) DTSBD750 01638 SET L055-WAGES-IDX TO R515-WAGES-IDX DTSBD750 01639 MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX) DTSBD750 01640 TO R515-WAGES-FROM-YRQ (R515-WAGES-IDX) DTSBD750 01641 MOVE L055-WAGES-THRU-YRQ (L055-WAGES-IDX) DTSBD750 01642 TO R515-WAGES-THRU-YRQ (R515-WAGES-IDX) DTSBD750 01643 END-PERFORM. DTSBD750 01644 DTSBD750 01645 IF MRTE-RATE-TYPE-ESTIM-88 DTSBD750 01646 *& DTSBD750 01647 MOVE MRCT-TAX-WAGE (3) TO AMT-DISP1 DTSBD750 01648 MOVE MRCT-QTR1-ESTIM-TAX-WAGE TO AMT-DISP2 DTSBD750 01649 DISPLAY MPRF-EMP-NO DTSBD750 01650 ' ACTUAL WAGE ' AMT-DISP1 DTSBD750 01651 ' ESTIM WAGE ' AMT-DISP2 DTSBD750 01652 *& DTSBD750 01653 ADD MRCT-QTR1-ESTIM-TAX-WAGE DTSBD750 01654 TO R515-TAX-WAGE (3). DTSBD750 01655 DTSBD750 01656 MOVE L054-AVG-TAX-WAGE TO R515-AVG-TAX-WAGE. DTSBD750 01657 DTSBD750 01658 MOVE MRCT-PRIOR-RESERVE-AMT TO R515-PRIOR-RESERVE-AMT. DTSBD750 01659 DTSBD750 01660 MOVE MRCT-UI-TAX-PAID-AMT TO R515-UI-TAX-PAID-AMT. DTSBD750 01661 DTSBD750 01662 MOVE MRCT-UI-TAX-PAID-AMT TO R515-UI-TAX-PAID-AMT. DTSBD750 01663 DTSBD750 01664 MOVE MRCT-TRUST-FUND-INTEREST-AMT DTSBD750 01665 TO R515-TRUST-FUND-INTEREST-AMT. DTSBD750 01666 DTSBD750 01667 MOVE MRCT-BENEFITS-CHARGED-AMT DTSBD750 01668 TO R515-BENEFITS-CHARGED-AMT. DTSBD750 01669 DTSBD750 01670 MOVE L054-CURRENT-RESERVE-AMT DTSBD750 01671 TO R515-CURRENT-RESERVE-AMT. DTSBD750 01672 DTSBD750 01673 MOVE L054-RATIO TO R515-RESERVE-RATIO. DTSBD750 01674 DTSBD750 01675 MOVE L054-UI-CALC-RATE TO R515-COMPUTED-RATE. DTSBD750 01676 DTSBD750 01677 IF L054-UI-PEN-RATE-YES-88 DTSBD750 01678 MOVE L054-UI-PEN-RATE TO R515-PENALTY-RATE DTSBD750 01679 ELSE DTSBD750 01680 MOVE +0 TO R515-PENALTY-RATE. DTSBD750 01681 DTSBD750 01682 PERFORM S946-WRITE-R515 THRU S946-EXIT. DTSBD750 01683 P7100-EXIT. DTSBD750 01684 EXIT. DTSBD750 01685 EJECT DTSBD750 01686 P7200-CONSTRUCT-WRITE-R521. DTSBD750 01687 IF L054-CLASSIFIED-88 DTSBD750 01688 SET R521-RATE-CLASSIFIED-88 TO TRUE DTSBD750 01689 ELSE DTSBD750 01690 SET R521-RATE-NONCLASSIFIED-88 TO TRUE. DTSBD750 01691 DTSBD750 01692 MOVE L054-UI-CALC-RATE TO R521-COMPUTED-RATE. DTSBD750 01693 DTSBD750 01694 MOVE WRK-RTE-YR-START-YRQ TO R521-EFF-QTR. DTSBD750 01695 DTSBD750 01696 MOVE L055-UI-TAX-PAID-FROM-YRQ TO R521-UI-TAX-PAID-FROM-YRQ. DTSBD750 01697 DTSBD750 01698 MOVE L055-UI-TAX-PAID-THRU-YRQ TO R521-UI-TAX-PAID-THRU-YRQ. DTSBD750 01699 DTSBD750 01700 MOVE L055-TRUST-FUND-INT-FROM-YRQ DTSBD750 01701 TO R521-TRUST-FUND-INT-FROM-YRQ. DTSBD750 01702 DTSBD750 01703 MOVE L055-TRUST-FUND-INT-THRU-YRQ DTSBD750 01704 TO R521-TRUST-FUND-INT-THRU-YRQ. DTSBD750 01705 DTSBD750 01706 MOVE L055-UI-BEN-CHGD-FROM-YRQ DTSBD750 01707 TO R521-UI-BEN-CHGD-FROM-YRQ. DTSBD750 01708 DTSBD750 01709 MOVE L055-UI-BEN-CHGD-THRU-YRQ DTSBD750 01710 TO R521-UI-BEN-CHGD-THRU-YRQ. DTSBD750 01711 DTSBD750 01712 MOVE L055-CURRENT-RESERVE-THRU-DATE DTSBD750 01713 TO R521-CURRENT-RESERVE-THRU-DATE. DTSBD750 01714 DTSBD750 01715 PERFORM DTSBD750 01716 VARYING R521-WAGES-YRQ-IDX FROM 1 BY 1 DTSBD750 01717 UNTIL R521-WAGES-YRQ-IDX > MMAX-RCT-EXP-MAX DTSBD750 01718 SET L055-WAGES-IDX TO R521-WAGES-YRQ-IDX DTSBD750 01719 MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX) DTSBD750 01720 TO R521-WAGES-FROM-YRQ (R521-WAGES-YRQ-IDX) DTSBD750 01721 MOVE L055-WAGES-THRU-YRQ (L055-WAGES-IDX) DTSBD750 01722 TO R521-WAGES-THRU-YRQ (R521-WAGES-YRQ-IDX) DTSBD750 01723 END-PERFORM. DTSBD750 01724 DTSBD750 01725 MOVE MRCT-UI-TAX-PAID-AMT TO R521-UI-TAX-PAID-AMT. DTSBD750 01726 DTSBD750 01727 MOVE MRCT-TRUST-FUND-INTEREST-AMT DTSBD750 01728 TO R521-TRUST-FUND-INTEREST-AMT. DTSBD750 01729 DTSBD750 01730 MOVE MRCT-BENEFITS-CHARGED-AMT DTSBD750 01731 TO R521-BENEFITS-CHARGED-AMT. DTSBD750 01732 DTSBD750 01733 MOVE L054-CURRENT-RESERVE-AMT DTSBD750 01734 TO R521-CURRENT-RESERVE-AMT. DTSBD750 01735 DTSBD750 01736 PERFORM DTSBD750 01737 VARYING R521-TAX-WAGE-IDX FROM 1 BY 1 DTSBD750 01738 UNTIL R521-TAX-WAGE-IDX > MMAX-RCT-EXP-MAX DTSBD750 01739 SET MRCT-WAGES-IDX TO R521-TAX-WAGE-IDX DTSBD750 01740 MOVE MRCT-TAX-WAGE (MRCT-WAGES-IDX) DTSBD750 01741 TO R521-TAX-WAGE (R521-TAX-WAGE-IDX) DTSBD750 01742 END-PERFORM. DTSBD750 01743 DTSBD750 01744 PERFORM S946-WRITE-R521 THRU S946-EXIT. DTSBD750 01745 P7200-EXIT. DTSBD750 01746 EXIT. DTSBD750 01747 EJECT DTSBD750 01748 P8000-CONSTRUCT-WRITE-R723. DTSBD750 01749 MOVE MPRF-EMP-NO TO R723-EMP-NO. DTSBD750 01750 DTSBD750 01751 MOVE WRK-RTE-YR-START-YRQ TO R723-EFF-YRQ. DTSBD750 01752 DTSBD750 01753 MOVE MPRF-PRIMARY-NAME TO R723-PRIMARY-NAME. DTSBD750 01754 DTSBD750 01755 MOVE MRCT-PRIOR-RESERVE-AMT TO R723-PRIOR-RESERVE-AMT. DTSBD750 01756 DTSBD750 01757 MOVE MRCT-UI-TAX-PAID-AMT TO R723-UI-TAX-PAID-AMT. DTSBD750 01758 DTSBD750 01759 MOVE MRCT-TRUST-FUND-INTEREST-AMT DTSBD750 01760 TO R723-TRUST-FUND-INTEREST-AMT. DTSBD750 01761 DTSBD750 01762 MOVE MRCT-BENEFITS-CHARGED-AMT DTSBD750 01763 TO R723-BENEFITS-CHARGED-AMT. DTSBD750 01764 DTSBD750 01765 PERFORM DTSBD750 01766 VARYING R723-WAGES-IDX FROM 1 BY 1 DTSBD750 01767 UNTIL R723-WAGES-IDX > MMAX-RCT-EXP-MAX DTSBD750 01768 SET MRCT-WAGES-IDX TO R723-WAGES-IDX DTSBD750 01769 MOVE MRCT-TOT-WAGE (MRCT-WAGES-IDX) DTSBD750 01770 TO R723-TOT-WAGE (R723-WAGES-IDX) DTSBD750 01771 MOVE MRCT-TAX-WAGE (MRCT-WAGES-IDX) DTSBD750 01772 TO R723-TAX-WAGE (R723-WAGES-IDX) DTSBD750 01773 END-PERFORM. DTSBD750 01774 DTSBD750 01775 MOVE MRCT-EARLIEST-LIAB-DATE TO R723-EARLIEST-LIAB-DATE. DTSBD750 01776 DTSBD750 01777 MOVE MRCT-MISS-RPT-CNT TO R723-MISS-RPT-CNT. DTSBD750 01778 DTSBD750 01779 MOVE MRCT-TOT-UI-TAX-BALANCE-AMT DTSBD750 01780 TO R723-TOT-UI-TAX-BALANCE-AMT. DTSBD750 01781 DTSBD750 01782 MOVE L054-AVG-TAX-WAGE TO R723-AVG-TAX-WAGE. DTSBD750 01783 DTSBD750 01784 MOVE L054-CURRENT-RESERVE-AMT DTSBD750 01785 TO R723-CURRENT-RESERVE-AMT. DTSBD750 01786 DTSBD750 01787 MOVE L054-RATIO TO R723-RESERVE-RATIO. DTSBD750 01788 DTSBD750 01789 MOVE L054-UI-CALC-RATE TO R723-COMPUTED-RATE. DTSBD750 01790 DTSBD750 01791 IF L054-UI-PEN-RATE-YES-88 DTSBD750 01792 MOVE L054-UI-PEN-RATE TO R723-PENALTY-RATE DTSBD750 01793 ELSE DTSBD750 01794 MOVE +0 TO R723-PENALTY-RATE. DTSBD750 01795 DTSBD750 01796 DTSBD750 01797 PERFORM S946-WRITE-R723 THRU S946-EXIT. DTSBD750 01798 P8000-EXIT. DTSBD750 01799 EXIT. DTSBD750 01800 EJECT DTSBD750 01801 T0000-TERMINATE. DTSBD750 01802 IF WRK-UPDATE-MASTER-YES-88 DTSBD750 01803 IF WRK-RUN-TYPE-REG-88 DTSBD750 01804 PERFORM T1000-UPDATE-MHDR THRU T1000-EXIT DTSBD750 01805 END-IF DTSBD750 01806 END-IF. DTSBD750 01807 DTSBD750 01808 DTSBD750 01809 DISPLAY '***'. DTSBD750 01810 DTSBD750 01811 DISPLAY '*** DTSBD750 TERMINATION STATISTICS'. DTSBD750 01812 DTSBD750 01813 DISPLAY '***'. DTSBD750 01814 DTSBD750 01815 DTSBD750 01816 MOVE PRF-REC-READ-CNT TO DISPLAY-CNT. DTSBD750 01817 DTSBD750 01818 DISPLAY '*** MPRF RECORDS ENCOUNTERED: ' DTSBD750 01819 DISPLAY-CNT-X. DTSBD750 01820 DTSBD750 01821 DTSBD750 01822 DISPLAY '***'. DTSBD750 01823 DTSBD750 01824 MOVE PRF-REC-REWRITE-CNT TO DISPLAY-CNT. DTSBD750 01825 DTSBD750 01826 DISPLAY '*** MPRF RECORDS UPDATED: ' DTSBD750 01827 DISPLAY-CNT-X. DTSBD750 01828 DTSBD750 01829 DTSBD750 01830 DISPLAY '***'. DTSBD750 01831 DTSBD750 01832 MOVE RTE-REC-WRITE-CNT TO DISPLAY-CNT. DTSBD750 01833 DTSBD750 01834 DISPLAY '*** MRTE RECORDS WRITTEN: ' DTSBD750 01835 DISPLAY-CNT-X. DTSBD750 01836 DTSBD750 01837 DTSBD750 01838 DISPLAY '***'. DTSBD750 01839 DTSBD750 01840 MOVE REGULAR-RATE-CNT TO DISPLAY-CNT. DTSBD750 01841 DTSBD750 01842 DISPLAY '*** REGULAR RATES WRITTEN: ' DTSBD750 01843 DISPLAY-CNT-X. DTSBD750 01844 DTSBD750 01845 DTSBD750 01846 DISPLAY '***'. DTSBD750 01847 DTSBD750 01848 MOVE ESTIMATED-RATE-CNT TO DISPLAY-CNT. DTSBD750 01849 DTSBD750 01850 DISPLAY '*** ESTIMATED RATES WRITTEN: ' DTSBD750 01851 DISPLAY-CNT-X. DTSBD750 01852 DTSBD750 01853 DTSBD750 01854 DISPLAY '***'. DTSBD750 01855 DTSBD750 01856 MOVE FINAL-RATE-CNT TO DISPLAY-CNT. DTSBD750 01857 DTSBD750 01858 DISPLAY '*** FINAL RATES WRITTEN: ' DTSBD750 01859 DISPLAY-CNT-X. DTSBD750 01860 DTSBD750 01861 DTSBD750 01862 DISPLAY '***'. DTSBD750 01863 DTSBD750 01864 MOVE TRANSITIONAL-RATE-CNT TO DISPLAY-CNT. DTSBD750 01865 DTSBD750 01866 DISPLAY '*** TRANSITIONAL RATES WRITTEN: ' DTSBD750 01867 DISPLAY-CNT-X. DTSBD750 01868 DTSBD750 01869 DTSBD750 01870 DISPLAY '***'. DTSBD750 01871 DTSBD750 01872 MOVE UNCLASS-ANN-CNT TO DISPLAY-CNT. DTSBD750 01873 DTSBD750 01874 DISPLAY '*** UNCLASSIFIED ANNUAL RATES WRITTEN: ' DTSBD750 01875 DISPLAY-CNT-X. DTSBD750 01876 DTSBD750 01877 DTSBD750 01878 IF WRK-RUN-TYPE-REG-88 DTSBD750 01879 DISPLAY '***' DTSBD750 01880 MOVE BYPASS-ANN-CNT TO DISPLAY-CNT DTSBD750 01881 DISPLAY '*** ANNUAL FILERS: NO RATE NOTICES: ' DTSBD750 01882 DISPLAY-CNT-X. DTSBD750 01883 DTSBD750 01884 IF WRK-RUN-TYPE-ANN-88 DTSBD750 01885 DISPLAY '***' DTSBD750 01886 MOVE BYPASS-FINAL-CNT TO DISPLAY-CNT DTSBD750 01887 DISPLAY '*** FINAL RATE: NO RATE NOTICES: ' DTSBD750 01888 DISPLAY-CNT-X DTSBD750 01889 DISPLAY '***' DTSBD750 01890 MOVE NO-1ST-QTR-WAGE-CNT TO DISPLAY-CNT DTSBD750 01891 DISPLAY '*** FIRST QUARTER WAGES MISSING: ' DTSBD750 01892 DISPLAY-CNT-X. DTSBD750 01893 DTSBD750 01894 DTSBD750 01895 DISPLAY '***'. DTSBD750 01896 DTSBD750 01897 MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9. DTSBD750 01898 DTSBD750 01899 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD750 01900 DTSBD750 01901 DISPLAY '*** RATE YEAR START QUARTER: ' DTSBD750 01902 L004-SLASH-5-QTR. DTSBD750 01903 DTSBD750 01904 DTSBD750 01905 DISPLAY '***'. DTSBD750 01906 DTSBD750 01907 MOVE WRK-RTE-YR-END-YRQ TO L004-QTR-5-9. DTSBD750 01908 DTSBD750 01909 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD750 01910 DTSBD750 01911 DISPLAY '*** RATE YEAR END QUARTER: ' DTSBD750 01912 L004-SLASH-5-QTR. DTSBD750 01913 DTSBD750 01914 DTSBD750 01915 DISPLAY '***'. DTSBD750 01916 DTSBD750 01917 MOVE WRK-MAIL-DATE TO L001-FED-8-DATE-9. DTSBD750 01918 DTSBD750 01919 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD750 01920 DTSBD750 01921 DISPLAY '*** RATE NOTICE MAIL DATE: ' DTSBD750 01922 L001-SLASH-8-DATE. DTSBD750 01923 DTSBD750 01924 DTSBD750 01925 DISPLAY '***'. DTSBD750 01926 DTSBD750 01927 MOVE WRK-PENALTY-DATE TO L001-FED-8-DATE-9. DTSBD750 01928 DTSBD750 01929 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD750 01930 DTSBD750 01931 DISPLAY '*** PENALTY RATE EFFECTIVE DATE: ' DTSBD750 01932 L001-SLASH-8-DATE. DTSBD750 01933 DTSBD750 01934 DISPLAY '***'. DTSBD750 01935 DISPLAY '*** INACTIVE DURING RATE YEAR : ' DTSBD750 01936 WRK-INACT-CNT. DTSBD750 01937 DTSBD750 01938 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD750 01939 DTSBD750 01940 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD750 01941 DTSBD750 01942 PERFORM S927-CLOSE THRU S927-EXIT. DTSBD750 01943 DTSBD750 01944 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD750 01945 DTSBD750 01946 MOVE -1 TO R503-LENGTH. DTSBD750 01947 DTSBD750 01948 PERFORM S946-WRITE-R503 THRU S946-EXIT. DTSBD750 01949 T0000-EXIT. DTSBD750 01950 EXIT. DTSBD750 01951 SKIP3 DTSBD750 01952 T1000-UPDATE-MHDR. DTSBD750 01953 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD750 01954 DTSBD750 01955 PERFORM S910-READ THRU S910-EXIT. DTSBD750 01956 DTSBD750 01957 IF L910-NO-REC-88 DTSBD750 01958 MOVE 'LOGIC ERROR T1000-1' TO ABEND-MSG DTSBD750 01959 PERFORM S999-ABEND THRU S999-EXIT. DTSBD750 01960 DTSBD750 01961 MOVE MSKL-REC TO MHDR-REC. DTSBD750 01962 DTSBD750 01963 MOVE WRK-RTE-YR-END-YRQ TO MHDR-LAST-RATE-END-YRQ. DTSBD750 01964 DTSBD750 01965 MOVE MHDR-REC TO MSKL-REC. DTSBD750 01966 DTSBD750 01967 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD750 01968 T1000-EXIT. DTSBD750 01969 EXIT. DTSBD750 01970 EJECT DTSBD750 01971 S001-FROM-FED-8. DTSBD750 01972 SET L001-FROM-FED-8 TO TRUE. DTSBD750 01973 GO TO S001-DATE. DTSBD750 01974 DTSBD750 01975 *S001-FROM-ABS-DAY. DTSBD750 01976 *****SET L001-FROM-ABS-DAY TO TRUE. DTSBD750 01977 *****GO TO S001-DATE. DTSBD750 01978 DTSBD750 01979 *S001-FROM-CAL-6. DTSBD750 01980 *****SET L001-FROM-CAL-6 TO TRUE. DTSBD750 01981 *****GO TO S001-DATE. DTSBD750 01982 DTSBD750 01983 S001-DATE. DTSBD750 01984 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD750 01985 S001-EXIT. DTSBD750 01986 EXIT. DTSBD750 01987 SKIP3 DTSBD750 01988 S004-FROM-5. DTSBD750 01989 SET L004-FROM-5 TO TRUE. DTSBD750 01990 GO TO S004-QTR. DTSBD750 01991 DTSBD750 01992 S004-FROM-ABS. DTSBD750 01993 SET L004-FROM-ABS TO TRUE. DTSBD750 01994 GO TO S004-QTR. DTSBD750 01995 DTSBD750 01996 S004-FROM-3. DTSBD750 01997 SET L004-FROM-3 TO TRUE. DTSBD750 01998 GO TO S004-QTR. DTSBD750 01999 DTSBD750 02000 S004-QTR. DTSBD750 02001 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD750 02002 S004-EXIT. DTSBD750 02003 EXIT. DTSBD750 02004 SKIP3 DTSBD750 02005 DTSBD750 02006 S005-FROM-SYS. DTSBD750 02007 SET L005-FROM-SYS TO TRUE. DTSBD750 02008 GO TO S005-ABSTIME. DTSBD750 02009 DTSBD750 02010 S005-ABSTIME. DTSBD750 02011 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD750 02012 S005-EXIT. DTSBD750 02013 EXIT. DTSBD750 02014 SKIP3 DTSBD750 02015 S006-FROM-QTR. DTSBD750 02016 SET L006-FROM-QTR TO TRUE. DTSBD750 02017 GO TO S006-RATE-QTR. DTSBD750 02018 DTSBD750 02019 S006-RATE-QTR. DTSBD750 02020 CALL 'DTSBU006' USING L006-LINK-AREA. DTSBD750 02021 S006-EXIT. DTSBD750 02022 EXIT. DTSBD750 02023 SKIP3 DTSBD750 02024 S054-RATE-LOOKUP-YES. DTSBD750 02025 SET L054-RATE-LOOKUP-YES-88 TO TRUE. DTSBD750 02026 GO TO S054-RATE-DETERMINATION. DTSBD750 02027 DTSBD750 02028 S054-RATE-DETERMINATION. DTSBD750 02029 CALL 'DTSBU054' USING L054-LINK-AREA DTSBD750 02030 MRCT-REC. DTSBD750 02031 S054-EXIT. DTSBD750 02032 EXIT. DTSBD750 02033 SKIP3 DTSBD750 02034 S055-FROM-EFF-YRQ. DTSBD750 02035 SET L055-FROM-EFF-YRQ-88 TO TRUE. DTSBD750 02036 GO TO S055-EXP-PERIOD. DTSBD750 02037 DTSBD750 02038 S055-EXP-PERIOD. DTSBD750 02039 CALL 'DTSBU055' USING L055-LINK-AREA. DTSBD750 02040 S055-EXIT. DTSBD750 02041 EXIT. DTSBD750 02042 SKIP3 DTSBD750 02043 S111-ADDRESS-LOOKUP. DTSBD750 02044 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBD750 02045 S111-EXIT. DTSBD750 02046 EXIT. DTSBD750 02047 SKIP3 DTSBD750 02048 S112-ADDRESS-FORMAT. DTSBD750 02049 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBD750 02050 S112-EXIT. DTSBD750 02051 EXIT. DTSBD750 02052 SKIP3 DTSBD750 02053 S410-FILING-SCHEDULE. DTSBD750 02054 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBD750 02055 S410-EXIT. DTSBD750 02056 EXIT. DTSBD750 02057 SKIP3 DTSBD750 02058 S910-OPEN-READ. DTSBD750 02059 SET L910-OPEN-READ-88 TO TRUE. DTSBD750 02060 GO TO S910-MSTR-IO. DTSBD750 02061 DTSBD750 02062 S910-OPEN-UPDATE. DTSBD750 02063 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD750 02064 GO TO S910-MSTR-IO. DTSBD750 02065 DTSBD750 02066 S910-READ. DTSBD750 02067 SET L910-READ-88 TO TRUE. DTSBD750 02068 GO TO S910-MSTR-IO. DTSBD750 02069 DTSBD750 02070 S910-START-BROWSE. DTSBD750 02071 SET L910-START-BROWSE-88 TO TRUE. DTSBD750 02072 GO TO S910-MSTR-IO. DTSBD750 02073 DTSBD750 02074 S910-READ-NEXT. DTSBD750 02075 SET L910-READ-NEXT-88 TO TRUE. DTSBD750 02076 GO TO S910-MSTR-IO. DTSBD750 02077 DTSBD750 02078 *S910-COUNT. DTSBD750 02079 *****SET L910-COUNT-88 TO TRUE. DTSBD750 02080 *****GO TO S910-MSTR-IO. DTSBD750 02081 DTSBD750 02082 S910-WRITE. DTSBD750 02083 SET L910-WRITE-88 TO TRUE. DTSBD750 02084 GO TO S910-MSTR-IO. DTSBD750 02085 DTSBD750 02086 S910-REWRITE. DTSBD750 02087 SET L910-REWRITE-88 TO TRUE. DTSBD750 02088 GO TO S910-MSTR-IO. DTSBD750 02089 DTSBD750 02090 *S910-DELETE. DTSBD750 02091 *****SET L910-DELETE-88 TO TRUE. DTSBD750 02092 *****GO TO S910-MSTR-IO. DTSBD750 02093 DTSBD750 02094 S910-CLOSE. DTSBD750 02095 SET L910-CLOSE-88 TO TRUE. DTSBD750 02096 GO TO S910-MSTR-IO. DTSBD750 02097 DTSBD750 02098 S910-MSTR-IO. DTSBD750 02099 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD750 02100 MSKL-REC. DTSBD750 02101 S910-EXIT. DTSBD750 02102 EXIT. DTSBD750 02103 SKIP3 DTSBD750 02104 S921-OPEN-UPDATE. DTSBD750 02105 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBD750 02106 GO TO S921-ALT-IDX-IO. DTSBD750 02107 DTSBD750 02108 S921-OPEN-READ. DTSBD750 02109 SET L921-OPEN-READ-88 TO TRUE. DTSBD750 02110 GO TO S921-ALT-IDX-IO. DTSBD750 02111 DTSBD750 02112 S921-CLOSE. DTSBD750 02113 SET L921-CLOSE-88 TO TRUE. DTSBD750 02114 GO TO S921-ALT-IDX-IO. DTSBD750 02115 DTSBD750 02116 S921-ALT-IDX-IO. DTSBD750 02117 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD750 02118 ISKL-REC. DTSBD750 02119 S921-EXIT. DTSBD750 02120 EXIT. DTSBD750 02121 SKIP3 DTSBD750 02122 S927-OPEN-UPDATE. DTSBD750 02123 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBD750 02124 GO TO S927-BTC-O. DTSBD750 02125 DTSBD750 02126 S927-WRITE. DTSBD750 02127 SET L927-WRITE-88 TO TRUE. DTSBD750 02128 GO TO S927-BTC-O. DTSBD750 02129 DTSBD750 02130 S927-CLOSE. DTSBD750 02131 SET L927-CLOSE-88 TO TRUE. DTSBD750 02132 GO TO S927-BTC-O. DTSBD750 02133 DTSBD750 02134 S927-BTC-O. DTSBD750 02135 CALL 'DTSBU927' USING L927-LINK-AREA DTSBD750 02136 TSKL-REC. DTSBD750 02137 S927-EXIT. DTSBD750 02138 EXIT. DTSBD750 02139 SKIP3 DTSBD750 02140 S931-OPEN-READ. DTSBD750 02141 SET L931-OPEN-READ-88 TO TRUE. DTSBD750 02142 GO TO S931-REF-I. DTSBD750 02143 DTSBD750 02144 S931-READ. DTSBD750 02145 SET L931-READ-88 TO TRUE. DTSBD750 02146 GO TO S931-REF-I. DTSBD750 02147 DTSBD750 02148 *S931-START-BROWSE. DTSBD750 02149 *****SET L931-START-BROWSE-88 TO TRUE. DTSBD750 02150 *****GO TO S931-REF-I. DTSBD750 02151 DTSBD750 02152 *S931-READ-NEXT. DTSBD750 02153 *****SET L931-READ-NEXT-88 TO TRUE. DTSBD750 02154 *****GO TO S931-REF-I. DTSBD750 02155 DTSBD750 02156 S931-CLOSE. DTSBD750 02157 SET L931-CLOSE-88 TO TRUE. DTSBD750 02158 GO TO S931-REF-I. DTSBD750 02159 DTSBD750 02160 S931-REF-I. DTSBD750 02161 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD750 02162 FSKL-REC. DTSBD750 02163 S931-EXIT. DTSBD750 02164 EXIT. DTSBD750 02165 SKIP3 DTSBD750 02166 S946-WRITE-R503. DTSBD750 02167 CALL 'DTSBU946' USING R503-REC. DTSBD750 02168 GO TO S946-EXIT. DTSBD750 02169 DTSBD750 02170 S946-WRITE-R504. DTSBD750 02171 CALL 'DTSBU946' USING R504-REC. DTSBD750 02172 GO TO S946-EXIT. DTSBD750 02173 DTSBD750 02174 S946-WRITE-R515. DTSBD750 02175 CALL 'DTSBU946' USING R515-REC. DTSBD750 02176 GO TO S946-EXIT. DTSBD750 02177 DTSBD750 02178 S946-WRITE-R516. DTSBD750 02179 CALL 'DTSBU946' USING R516-REC. DTSBD750 02180 GO TO S946-EXIT. DTSBD750 02181 DTSBD750 02182 S946-WRITE-R521. DTSBD750 02183 CALL 'DTSBU946' USING R521-REC. DTSBD750 02184 GO TO S946-EXIT. DTSBD750 02185 DTSBD750 02186 S946-WRITE-R723. DTSBD750 02187 CALL 'DTSBU946' USING R723-REC. DTSBD750 02188 GO TO S946-EXIT. DTSBD750 02189 DTSBD750 02190 S946-WRITE-R907. DTSBD750 02191 CALL 'DTSBU946' USING R907-REC. DTSBD750 02192 GO TO S946-EXIT. DTSBD750 02193 DTSBD750 02194 S946-EXIT. DTSBD750 02195 EXIT. DTSBD750 02196 SKIP3 DTSBD750 02197 S999-ABEND. DTSBD750 02198 DISPLAY '***'. DTSBD750 02199 DTSBD750 02200 DISPLAY '*** ' DTSBD750 02201 MOD-NAME DTSBD750 02202 ' IS ABENDING BECAUSE ' DTSBD750 02203 ABEND-MSG. DTSBD750 02204 DTSBD750 02205 IF WRK-UPDATE-MASTER-YES-88 DTSBD750 02206 DISPLAY '***' DTSBD750 02207 DISPLAY '*** MASTER FILE UPDATE WAS UNDERWAY.' DTSBD750 02208 DISPLAY '***' DTSBD750 02209 DISPLAY '*** RESTORE MASTER FILE IMMEDIATELY.'. DTSBD750 02210 DTSBD750 02211 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD750 02212 S999-EXIT. DTSBD750 02213 EXIT. DTSBD750