2215 lines
175 KiB
COBOL
2215 lines
175 KiB
COBOL
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
|