00001 IDENTIFICATION DIVISION. 12/26/02 00002 PROGRAM-ID. DTSBD610. DTSBD610 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV021 00004 DATE-WRITTEN. DECEMBER 1991. DTSBD610 00005 DATE-COMPILED. DTSBD610 00006 SKIP3 DTSBD610 00007 ***** DTSBD610 00008 * DTSBD610 00009 * FUNCTION: FUTA CERTIFICATION PROCESSING. DTSBD610 00010 * DTSBD610 00011 * DTSBD610 00012 * MODIFICATION LOG: DTSBD610 00013 * DTSBD610 00014 * 01/28/92 INITIAL DEVELOPMENT. DTSBD610 00015 * WORK ORDER: PROGRAMMER: TCL DTSBD610 00016 * DTSBD610 00017 * 12/05/94 REWRITE FOR 1994/MONTANA. DTSBD610 00018 * WORK ORDER: PROGRAMMER: RHC DTSBD610 00019 * DTSBD610 00020 * 01/07/97 REQUEST-CITY INCREASED TO 25 BYTES, DTSBD610 00021 * REQUEST-FORM-INDICATOR ADDED. DTSBD610 00022 * WORK ORDER:FUTA DOC 6581 PROGRAMMER: SFW DTSBD610 00023 * DTSBD610 00024 * 01/07/97 ENHANCED TO SEARCH ON REQUEST-EMP-NO IF NO MATCH DTSBD610 00025 * FOUND ON REQUEST-FEIN. DTSBD610 00026 * WORK ORDER:FUTA DOC 6581 PROGRAMMER: SFW DTSBD610 00027 * DTSBD610 00028 * 01/10/97 ADDITIONAL CHANGE TO MOVE MPRF-FEIN INSTEAD OF DTSBD610 00029 * REQUEST-FEIN TO REPLY-FEIN AND R704-FEIN WHEN A DTSBD610 00030 * MATCH IS FOUND ON REQUEST-EMP-NO INSTEAD OF DTSBD610 00031 * REQUEST-FEIN. DTSBD610 00032 * WORK ORDER:ANNETTE RINEHART PROGRAMMER: SFW DTSBD610 00033 * DTSBD610 00034 * 11/13/97 TAX YEAR 1996 MODIFICATIONS. INCREASED RECORD DTSBD610 00035 * LENGTHS, FOUR DIGIT YEAR, FORM-IND ADDED TO DTSBD610 00036 * CERTIFICATION REPLY RECORD AND XREF-FEIN ADDED DTSBD610 00037 * TO CERTIFICATION REPLY RECORD. REQUEST-EMP-NO DTSBD610 00038 * LOGIC ENHANCED. DTSBD610 00039 * WORK ORDER: TCL 222 PROGRAMMER: EHH DTSBD610 00040 * DTSBD610 00041 * 10/16/1998 ADD TWO NEW "PAYMENT" DATA ELEMENTS ('THRU 4/15' DTSBD610 00042 * & 'AFTER 4/15'). DTSBD610 00043 * WORK ORDER: TCL 237 PROGRAMMER: KDN DTSBD610 00044 * DTSBD610 00045 * 02/17/1999 REVIEWED AND MODIFIED FOR DC. DTSBD610 00046 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD610 00047 * DTSBD610 00048 * 02/27/1999 ADDED OPEN/CLOSE OF REFERENCE FILE. DTSBU516 DTSBD610 00049 * MODIFIED TO READ REFERENCE FILE. DTSBD610 00050 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD610 00051 * DTSBD610 00052 * 01/07/2000 ADD CODE TO DETECT DUP FEIN + TAX PERIOD CERT. DTSBD610 00053 * REQUEST RECORDS. IF DUP FOUND, REPLY TO ONLY THE DTSBD610 00054 * FIRST RECORD WITH A NON ZERO CERTIFICATION REPLY DTSBD610 00055 * RECORD AND REPLY TO EACH ADDITIONAL DUP'D RECORD DTSBD610 00056 * WITH A ZERO CERTIFICATION REPLY RECORD. ALSO, DTSBD610 00057 * OUTPUT THE FIRST 50 ZERO CERT. REPLY RECORDS DTSBD610 00058 * GENERATED AND THE FIRST 50 NON ZERO CERT. REPLY DTSBD610 00059 * RECORDS GENERATED. DTSBD610 00060 * REFERENCE: DC MAINTENANCE PROGRAMMER: EHH DTSBD610 00061 * DTSBD610 00062 * 10/24/2001 INCREASE THE SIZE OF THE REQUEST-TAXABLE-WAGES FIELDTSBD610 00063 * IN THE IDENTIFICATION DATA RECORD BY TWO BYTES. DTSBD610 00064 * ALSO, ZERO FILL REPLY-SIC-AREA. DTSBD610 00065 * PER FUTA DOCUMENT 6581 (REV. 9-2001) DTSBD610 00066 * REFERENCE: DC MAINTENANCE PROGRAMMER: GAB DTSBD610 00067 * DTSBD610 00068 * 08/14/2002 RECOMPILED FOR NEW VERSION OF DTSIL516. NO CHANGES DTSBD610 00069 * NEEDED FOR ESTIMATED RATES. DTSBD610 00070 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD610 00071 * DTSBD610 00072 * DTSBD610 00073 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD610 00074 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD610 00075 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD610 00076 * DTSBD610 00077 * DTSBD610 00078 * DESCRIPTION: DTSBD610 00079 * DTSBD610 00080 * DTSBD610 DOES THE ANNUAL IRS FUTA CERTIFICATION PROCESSING.DTSBD610 00081 * SEE IRS DOCUMENT 6581 ("SPECIFICATIONS FOR THE NATIONWIDE DTSBD610 00082 * SYSTEM FOR COMPUTERIZED CERTIFICATION OF STATE FUTA DTSBD610 00083 * CREDITS"). DTSBD610 00084 * DTSBD610 00085 * READ THE IRS FUTA CERTIFICATION REQUESTS TAPE. DTSBD610 00086 * DTSBD610 00087 * FOR EACH RECORD ON THE IRS FUTA CERTIFICATION REQUESTS DTSBD610 00088 * TAPE, EVALUATE THE MONTANA UI TAX SYSTEM RECORDS AND DTSBD610 00089 * WRITE AN "IRS FUTA CERTIFICATION REPLY" RECORD. DTSBD610 00090 * DTSBD610 00091 * A CERTIFICATION REPLY MAY INDICATE "SUCCESSFUL CERTIFIC- DTSBD610 00092 * ATION" OR "UNSUCCESSFUL CERTIFICATION". DTSBD610 00093 * DTSBD610 00094 * CERTIFICATION WILL BE UNSUCCESSFUL IF: DTSBD610 00095 * DTSBD610 00096 * . FEIN NOT FOUND. DTSBD610 00097 * DTSBD610 00098 * . FEIN EXISTS FOR MORE THAN ONE EMPLOYER WHO WAS LIABLE DTSBD610 00099 * DURING THE PERIOD BEING CERTIFIED. DTSBD610 00100 * DTSBD610 00101 * . FOR AN FEIN, NO EMPLOYERS WERE LIABLE AND MULTIPLE DTSBD610 00102 * . EMPLOYERS NOT LIABLE DURING PERIOD BEING CERTIFIED. DTSBD610 00103 * DTSBD610 00104 * . RECORDS FOR THE PERIOD BEING CERTIFIED DO NOT EXIST ON DTSBD610 00105 * THE MASTER FILE (HAVE BEEN PURGED OR ARE NOT YET DUE). DTSBD610 00106 * DTSBD610 00107 * . EMPLOYER CLASS IS REIMBURSABLE OR GOVERNMENT. DTSBD610 00108 * DTSBD610 00109 * DTSBD610 00110 * DTSBD610 00111 * CERTIFICATION WILL BE CONSIDERED SUCCESSFUL IF ANY: DTSBD610 00112 * DTSBD610 00113 * . EMPLOYER WAS LIABLE DURING PERIOD BEING CERTIFIED. DTSBD610 00114 * DTSBD610 00115 * . EMPLOYER WAS NOT LIABLE DURING PERIOD BEING CERTIFIED. DTSBD610 00116 * DTSBD610 00117 * . NO QUARTERLY REPORTS HAVE BEEN COLLECTED DURING THE DTSBD610 00118 * PERIOD BEING CERTIFIED. IGNORE ESTIMATED REPORTS. DTSBD610 00119 * DTSBD610 00120 * DTSBD610 00121 * DTSBD610 00122 * DTSBD610 00123 * IF CERTIFICATION IS SUCCESSFUL: DTSBD610 00124 * DTSBD610 00125 * . WRITE A IRS FUTA CERTIFICATION REPLY RECORD. DTSBD610 00126 * IGNORE ESTIMATED REPORTS AND PAYMENTS AGAINST ESTIMATEDDTSBD610 00127 * REPORTS. DTSBD610 00128 * DTSBD610 00129 * . WRITE A R704 RECORD. DTSBD610 00130 * DTSBD610 00131 * . IF THE TAX YEAR BEING CERTIFIED IS EQUAL TO PARM-YEAR DTSBD610 00132 * THEN WRITE A "EMPLOYERS CERTIFIED FOR CURRENT YEAR" DTSBD610 00133 * RECORD. DTSBD610 00134 * DTSBD610 00135 * IF CERTIFICATION IS NOT SUCCESSFUL: DTSBD610 00136 * DTSBD610 00137 * . WRITE A IRS FUTA CERTIFICATION REPLY RECORD. DTSBD610 00138 * DTSBD610 00139 * . WRITE A R705 RECORD. DTSBD610 00140 * DTSBD610 00141 * DTSBD610 00142 * PARAMETERS INPUT: DTSBD610 00143 * DTSBD610 00144 * CURRENT CERTIFICATION YEAR. DTSBD610 00145 * DTSBD610 00146 * DTSBD610 00147 * TAPES INPUT: DTSBD610 00148 * DTSBD610 00149 * IRS FUTA CERTIFICATION REQUESTS. DTSBD610 00150 * DTSBD610 00151 * DTSBD610 00152 * MASTER FILE RECORDS READ: DTSBD610 00153 * DTSBD610 00154 * MPRF DTSBD610 00155 * MSOL DTSBD610 00156 * MQTR DTSBD610 00157 * MDST DTSBD610 00158 * DTSBD610 00159 * DTSBD610 00160 * ALTERNATE INDEX FILE RECORDS READ: DTSBD610 00161 * DTSBD610 00162 * IEIN DTSBD610 00163 * DTSBD610 00164 * DTSBD610 00165 * MASTER FILE RECORDS UPDATED: DTSBD610 00166 * DTSBD610 00167 * NONE. DTSBD610 00168 * DTSBD610 00169 * DTSBD610 00170 * REPORT RECORDS WRITTEN: DTSBD610 00171 * DTSBD610 00172 * R704 SUCCESSFUL FUTA CERTIFICATION. DTSBD610 00173 * R705 FAILED FUTA CERTIFICATION. DTSBD610 00174 * DTSBD610 00175 * DTSBD610 00176 * TAPES WRITTEN: DTSBD610 00177 * DTSBD610 00178 * IRS FUTA CERTIFICATION REPLY DTSBD610 00179 * DTSBD610 00180 * SEE IRS DOCUMENT 6581 "SPECIFICATIONS FOR THE DTSBD610 00181 * NATIONWIDE SYSTEM FOR COMPUTERIZED CERTIFICATION DTSBD610 00182 * OF STATE FUTA CREDITS" FOR FORMAT. DTSBD610 00183 * DTSBD610 00184 * DTSBD610 00185 * DISK DATASETS WRITTEN: DTSBD610 00186 * DTSBD610 00187 * EMPLOYERS CERTIFIED FOR CURRENT YEAR DTSBD610 00188 * DTSBD610 00189 * ONE RECORD FOR EACH EMPLOYER FOR WHOM A PARM-YEAR DTSBD610 00190 * RECORD WAS WRITTEN TO THE "IRS FUTA CERTIFICATION DTSBD610 00191 * REPLY" TAPE. DATA ELEMENTS ARE EMP-NO, TAX-PERIOD, DTSBD610 00192 * AND FEIN. THESE RECORDS WILL BE LOADED INTO A DTSBD610 00193 * TEMPORARY VSAM KSDS ("EMPLOYERS CERTIFIED FOR DTSBD610 00194 * THE CURRENT YEAR") WHOSE KEY IS EMP-NO. DTSBD610 00195 * DTSBD610 00196 * DTSBD610 00197 * MODULES CALLED: DTSBD610 00198 * DTSBD610 00199 * DTSBU007 YEAR EDIT/CONVERSION. DTSBD610 00200 * DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE FOR DTSBD610 00201 * A GIVEN QUARTER. DTSBD610 00202 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD610 00203 * DTSBU921 ALTERNATE INDEX FILE I/O. DTSBD610 00204 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD610 00205 * DTSBD610 00206 ***** DTSBD610 00207 SKIP3 DTSBD610 00208 ENVIRONMENT DIVISION. DTSBD610 00209 SKIP2 DTSBD610 00210 INPUT-OUTPUT SECTION. DTSBD610 00211 DTSBD610 00212 FILE-CONTROL. DTSBD610 00213 SELECT CERT-REQUEST-FILE ASSIGN TO DTSFRQST. DTSBD610 00214 SELECT CERT-REPLY-FILE ASSIGN TO DTSFRPLY. DTSBD610 00215 SELECT ZERO-CERT-REPLY-FILE ASSIGN TO DTSFZ50. DTSBD610 00216 SELECT NON-ZERO-CERT-REPLY-FILE ASSIGN TO DTSFNZ50. DTSBD610 00217 SELECT CURRENT-YEAR-CERT-FILE ASSIGN TO DTSFCURR. DTSBD610 00218 SKIP3 DTSBD610 00219 DATA DIVISION. DTSBD610 00220 SKIP3 DTSBD610 00221 FILE SECTION. DTSBD610 00222 SKIP2 DTSBD610 00223 FD CERT-REQUEST-FILE DTSBD610 00224 RECORDING MODE IS F DTSBD610 00225 BLOCK CONTAINS 0 RECORDS DTSBD610 00226 LABEL RECORDS ARE STANDARD. DTSBD610 00227 DTSBD610 00228 01 REQUEST-REC. DTSBD610 00229 05 REQUEST-CHAR-CNT PIC S9(04) COMP. DTSBD610 00230 05 REQUEST-HEX-ZERO PIC S9(04) COMP. DTSBD610 00231 05 REQUEST-STATE-CD PIC X(02). DTSBD610 00232 05 REQUEST-FEIN PIC 9(09). DTSBD610 00233 05 REQUEST-FEIN-X REDEFINES REQUEST-FEIN DTSBD610 00234 PIC X(09). DTSBD610 00235 05 REQUEST-DOC-LOC-NUMBER PIC X(14). DTSBD610 00236 05 REQUEST-TAX-PERIOD PIC 9(06). DTSBD610 00237 05 REQUEST-TAX-PERIOD-X DTSBD610 00238 REDEFINES REQUEST-TAX-PERIOD. DTSBD610 00239 10 REQUEST-TAX-YEAR PIC 9(04). DTSBD610 00240 10 REQUEST-TAX-MONTH PIC 9(02). DTSBD610 00241 05 REQUEST-CHECK-DIGIT PIC X(02). DTSBD610 00242 05 REQUEST-TAXABLE-WAGES PIC 9(13)V9(02). DTSBD610 00243 05 REQUEST-ADDRESS-AREA. DTSBD610 00244 10 REQUEST-ZIP PIC X(12). DTSBD610 00245 10 REQUEST-STATE PIC X(02). DTSBD610 00246 10 REQUEST-CITY PIC X(25). DTSBD610 00247 10 REQUEST-STREET PIC X(35). DTSBD610 00248 10 REQUEST-NAME-1 PIC X(35). DTSBD610 00249 10 REQUEST-NAME-2 PIC X(35). DTSBD610 00250 10 REQUEST-NAME-3 PIC X(35). DTSBD610 00251 10 REQUEST-NAME-4 PIC X(35). DTSBD610 00252 05 REQUEST-NAME-CONTROL PIC X(04). DTSBD610 00253 05 REQUEST-XREF-FEIN PIC X(09). DTSBD610 00254 05 REQUEST-EMP-NO-AREA PIC X(15). DTSBD610 00255 05 REQUEST-FORM-INDICATOR PIC X(01). DTSBD610 00256 EJECT DTSBD610 00257 FD CERT-REPLY-FILE DTSBD610 00258 RECORDING MODE IS F DTSBD610 00259 BLOCK CONTAINS 0 RECORDS DTSBD610 00260 LABEL RECORDS ARE STANDARD. DTSBD610 00261 DTSBD610 00262 01 REPLY-REC. DTSBD610 00263 05 REPLY-CHAR-CNT PIC S9(04) COMP. DTSBD610 00264 05 REPLY-HEX-ZERO PIC S9(04) COMP. DTSBD610 00265 05 REPLY-STATE-CD PIC X(02). DTSBD610 00266 05 REPLY-FEIN-X. DTSBD610 00267 10 REPLY-FEIN PIC 9(09). DTSBD610 00268 05 REPLY-DOC-LOC-NUMBER PIC X(13). DTSBD610 00269 05 REPLY-TAX-PERIOD PIC 9(06). DTSBD610 00270 05 FILLER REDEFINES REPLY-TAX-PERIOD. DTSBD610 00271 10 REPLY-TAX-YEAR PIC 9(04). DTSBD610 00272 10 REPLY-TAX-MONTH PIC 9(02). DTSBD610 00273 05 REPLY-CHECK-DIGIT PIC X(02). DTSBD610 00274 05 REPLY-RATE-AREA OCCURS 4 TIMES. DTSBD610 00275 10 REPLY-TAXABLE-WAGES PIC 9(11)V9(02). DTSBD610 00276 10 REPLY-ZERO-IND PIC X(01). DTSBD610 00277 10 REPLY-RATE PIC V9(06). DTSBD610 00278 05 REPLY-PAID-PRIOR-2-1 PIC 9(11)V9(02). DTSBD610 00279 05 REPLY-PAID-2-1-THRU-2-10 PIC 9(11)V9(02). DTSBD610 00280 05 REPLY-PAID-AFTER-2-10 PIC 9(11)V9(02). DTSBD610 00281 05 REPLY-RESPONSE-IND PIC X(01). DTSBD610 00282 05 REPLY-EMP-NO-AREA. DTSBD610 00283 10 REPLY-EMP-NO PIC 9(06). DTSBD610 00284 10 FILLER PIC X(09). DTSBD610 00285 05 REPLY-FORM-INDICATOR PIC X(01). DTSBD610 00286 88 REPLY-FORM-940-88 VALUE '1'. DTSBD610 00287 88 REPLY-FORM-1041-88 VALUE '2'. DTSBD610 00288 88 REPLY-FORM-1040-88 VALUE '3'. DTSBD610 00289 05 REPLY-XREF-FEIN-X. DTSBD610 00290 10 REPLY-XREF-FEIN PIC 9(09). DTSBD610 00291 05 REPLY-PAID-THRU-4-15 PIC 9(11)V9(02). DTSBD610 00292 05 REPLY-PAID-AFTER-4-15 PIC 9(11)V9(02). DTSBD610 00293 05 REPLY-NAME-CONTROL PIC X(04). DTSBD610 00294 05 REPLY-TOTAL-EMPLOYEES PIC 9(05). DTSBD610 00295 05 REPLY-SIC-AREA OCCURS 5 TIMES. DTSBD610 00296 10 REPLY-SIC PIC X(04). DTSBD610 00297 10 REPLY-SIC-EMPLOYEES PIC 9(05). DTSBD610 00298 10 REPLY-SIC-TAXABLE-WAGES PIC 9(11)V9(02). DTSBD610 00299 EJECT DTSBD610 00300 FD ZERO-CERT-REPLY-FILE DTSBD610 00301 RECORDING MODE IS F DTSBD610 00302 BLOCK CONTAINS 0 RECORDS DTSBD610 00303 LABEL RECORDS ARE STANDARD. DTSBD610 00304 DTSBD610 00305 01 ZERO-CERT-REPLY-REC PIC X(326). DTSBD610 00306 EJECT DTSBD610 00307 FD NON-ZERO-CERT-REPLY-FILE DTSBD610 00308 RECORDING MODE IS F DTSBD610 00309 BLOCK CONTAINS 0 RECORDS DTSBD610 00310 LABEL RECORDS ARE STANDARD. DTSBD610 00311 DTSBD610 00312 01 NON-ZERO-CERT-REPLY-REC PIC X(326). DTSBD610 00313 EJECT DTSBD610 00314 FD CURRENT-YEAR-CERT-FILE DTSBD610 00315 RECORDING MODE IS F DTSBD610 00316 BLOCK CONTAINS 0 RECORDS DTSBD610 00317 LABEL RECORDS ARE STANDARD. DTSBD610 00318 DTSBD610 00319 01 CURRENT-YEAR-CERT-REC. DTSBD610 00320 ++INCLUDE DTSIX971 DTSBD610 00321 EJECT DTSBD610 00322 WORKING-STORAGE SECTION. DTSBD610 003225 77 PAN-VALET PICTURE X(24) VALUE '021DTSBD610 12/26/02'. DTSBD610 00323 SKIP3 DTSBD610 00324 01 WRK-AREA. DTSBD610 00325 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +610.DTSBD610 00326 DTSBD610 00327 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD610'.DTSBD610 00328 DTSBD610 00329 05 WRK-REPLY-CHAR-CNT PIC S9(04) COMP VALUE +326.DTSBD610 00330 DTSBD610 00331 DTSBD610 00332 05 WRK-PARM-CURRENT-YEAR PIC 9(04). DTSBD610 00333 DTSBD610 00334 DTSBD610 00335 05 WRK-BROWSE-EMP-NO PIC S9(07) COMP-3. DTSBD610 00336 DTSBD610 00337 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD610 00338 DTSBD610 00339 05 WRK-FEIN PIC S9(09) COMP-3. DTSBD610 00340 DTSBD610 00341 DTSBD610 00342 05 WRK-PREV-REQUEST-FEIN-X PIC X(09). DTSBD610 00343 DTSBD610 00344 05 WRK-PREV-REQUEST-TAX-PERIOD-X PIC X(06). DTSBD610 00345 DTSBD610 00346 DTSBD610 00347 05 WRK-EMP-CLASS-RATED-IND PIC X(01). DTSBD610 00348 DTSBD610 00349 05 WRK-LIABLE-IND PIC X(01). DTSBD610 00350 DTSBD610 00351 05 WRK-LIAB-CNT PIC S9(04) COMP. DTSBD610 00352 DTSBD610 00353 05 WRK-NOT-LIAB-CNT PIC S9(04) COMP. DTSBD610 00354 DTSBD610 00355 DTSBD610 00356 05 CERT-REQUEST-EOF-IND PIC X(01). DTSBD610 00357 DTSBD610 00358 05 CERT-REQUEST-REC-CNT PIC S9(07) COMP-3. DTSBD610 00359 DTSBD610 00360 05 CERT-REPLY-MATCHED-REC-CNT PIC S9(07) COMP-3. DTSBD610 00361 DTSBD610 00362 05 CERT-REPLY-NOT-ONLINE-REC-CNT PIC S9(07) COMP-3. DTSBD610 00363 DTSBD610 00364 05 CERT-REPLY-UNMATCHED-REC-CNT PIC S9(07) COMP-3. DTSBD610 00365 DTSBD610 00366 05 CERT-REPLY-TOT-REC-CNT PIC S9(07) COMP-3. DTSBD610 00367 DTSBD610 00368 05 ZERO-CERT-REPLY-CNT PIC S9(07) COMP-3. DTSBD610 00369 DTSBD610 00370 05 NON-ZERO-CERT-REPLY-CNT PIC S9(07) COMP-3. DTSBD610 00371 DTSBD610 00372 05 CURR-YEAR-CERT-REC-CNT PIC S9(07) COMP-3. DTSBD610 00373 DTSBD610 00374 05 HOLD-REPLY-REC PIC X(326). DTSBD610 00375 DTSBD610 00376 05 ZERO-FILL-SIC PIC 9. DTSBD610 00377 DTSBD610 00378 05 WRK-DATE-9 PIC 9(08). DTSBD610 00379 05 WRK-DATE-X REDEFINES WRK-DATE-9. DTSBD610 00380 10 WRK-YR PIC 9(04). DTSBD610 00381 10 WRK-MO PIC 9(02). DTSBD610 00382 10 WRK-DA PIC 9(02). DTSBD610 00383 DTSBD610 00384 05 WRK-QTR-9 PIC 9(05). DTSBD610 00385 05 WRK-QTR-X REDEFINES WRK-QTR-9. DTSBD610 00386 10 WRK-QTR-YR PIC 9(04). DTSBD610 00387 10 WRK-QTR-Q PIC 9(01). DTSBD610 00388 DTSBD610 00389 DTSBD610 00390 05 WRK-CERT-YEAR-MONTH. DTSBD610 00391 10 WRK-CERT-YEAR PIC 9(04). DTSBD610 00392 10 WRK-CERT-MONTH PIC 9(02). DTSBD610 00393 DTSBD610 00394 05 WRK-CERT-FEB-1-DATE PIC S9(09) COMP-3. DTSBD610 00395 DTSBD610 00396 05 WRK-CERT-FEB-10-DATE PIC S9(09) COMP-3. DTSBD610 00397 DTSBD610 00398 05 WRK-CERT-APR-15-DATE PIC S9(09) COMP-3. DTSBD610 00399 DTSBD610 00400 DTSBD610 00401 05 RATE-CNT PIC S9(04) COMP. DTSBD610 00402 DTSBD610 00403 05 RATE-SUB PIC S9(04) COMP. DTSBD610 00404 DTSBD610 00405 05 RATE-MATCH PIC X(01). DTSBD610 00406 DTSBD610 00407 DTSBD610 00408 05 WRK-PAID-PRIOR-2-1 PIC S9(09)V9(02) COMP-3. DTSBD610 00409 DTSBD610 00410 05 WRK-PAID-2-1-THRU-2-10 PIC S9(09)V9(02) COMP-3. DTSBD610 00411 DTSBD610 00412 05 WRK-PAID-AFTER-2-10 PIC S9(09)V9(02) COMP-3. DTSBD610 00413 DTSBD610 00414 05 WRK-PAID-THRU-4-15 PIC S9(09)V9(02) COMP-3. DTSBD610 00415 DTSBD610 00416 05 WRK-PAID-AFTER-4-15 PIC S9(09)V9(02) COMP-3. DTSBD610 00417 DTSBD610 00418 DTSBD610 00419 05 WRK-YRQ-SUB PIC S9(04) COMP. DTSBD610 00420 DTSBD610 00421 05 WRK-YRQ-AREA OCCURS 4 TIMES DTSBD610 00422 INDEXED BY WRK-YRQ-IDX. DTSBD610 00423 10 WRK-YRQ PIC S9(05) COMP-3. DTSBD610 00424 10 WRK-YRQ-LIABLE-IND PIC X(01). DTSBD610 00425 10 WRK-RPT-FILED-IND PIC X(01). DTSBD610 00426 10 WRK-RATE PIC S9(01)V9(04) COMP-3. DTSBD610 00427 10 WRK-TAXABLE-WAGES PIC S9(11)V9(02) COMP-3. DTSBD610 00428 DTSBD610 00429 DTSBD610 00430 05 WRK-REQUEST-EMP-NO-AREA. DTSBD610 00431 10 WRK-REQUEST-EMP-NO PIC 9(06). DTSBD610 00432 10 FILLER REDEFINES WRK-REQUEST-EMP-NO. DTSBD610 00433 15 WRK-REQUEST-EMP-NO-CHAR DTSBD610 00434 OCCURS 6 TIMES PIC X(01). DTSBD610 00435 DTSBD610 00436 10 WRK-REQUEST-EMP-NO-CHAR-SUB PIC S9(04) COMP. DTSBD610 00437 DTSBD610 00438 10 REQUEST-EMP-NO-CHAR-SUB PIC S9(04) COMP. DTSBD610 00439 EJECT DTSBD610 00440 01 MSG-AREA. DTSBD610 00441 05 MSG01-NO-MATCH. DTSBD610 00442 10 FILLER PIC X(40) DTSBD610 00443 VALUE 'NO MATCH ON FEIN OR EMP NO '. DTSBD610 00444 10 FILLER PIC X(40) DTSBD610 00445 VALUE ' '. DTSBD610 00446 DTSBD610 00447 05 MSG02-MULTIPLE-EMP. DTSBD610 00448 10 FILLER PIC X(40) DTSBD610 00449 VALUE 'MULTIPLE EMPLOYERS WITH SAME FEIN ACTIVE'. DTSBD610 00450 10 FILLER PIC X(40) DTSBD610 00451 VALUE 'DURING REPORT PERIOD '. DTSBD610 00452 DTSBD610 00453 *****05 MSG03-NOT-LIABLE. DTSBD610 00454 *********10 FILLER PIC X(40) DTSBD610 00455 ***************VALUE 'EMPLOYER NOT LIABLE DURING CERTIFICATION'. DTSBD610 00456 *********10 FILLER PIC X(40) DTSBD610 00457 ***************VALUE 'PERIOD '. DTSBD610 00458 DTSBD610 00459 05 MSG04-INFO-NOT-AVAILABLE. DTSBD610 00460 10 FILLER PIC X(40) DTSBD610 00461 VALUE 'INFORMATION NOT AVAILABLE '. DTSBD610 00462 10 FILLER PIC X(40) DTSBD610 00463 VALUE ' '. DTSBD610 00464 DTSBD610 00465 *****05 MSG05-NO-RPTS-FILED. DTSBD610 00466 *********10 FILLER PIC X(40) DTSBD610 00467 ***************VALUE 'EMPLOYER HAS NOT FILED ANY REPORTS COVER'. DTSBD610 00468 *********10 FILLER PIC X(40) DTSBD610 00469 ***************VALUE 'ING CERTIFICATION PERIOD '. DTSBD610 00470 DTSBD610 00471 05 MSG06-SELF-INSURED. DTSBD610 00472 10 FILLER PIC X(40) DTSBD610 00473 VALUE 'CERTIFICATION REQUESTED FOR SELF INSURED'. DTSBD610 00474 10 FILLER PIC X(40) DTSBD610 00475 VALUE ' EMPLOYER '. DTSBD610 00476 DTSBD610 00477 05 MSG07-MULTIPLE-INACT. DTSBD610 00478 10 FILLER PIC X(40) DTSBD610 00479 VALUE 'MULTIPLE EMPLOYERS FOR FEIN DURING '. DTSBD610 00480 10 FILLER PIC X(40) DTSBD610 00481 VALUE 'REPORT PERIOD - ALL ARE INACTIVE '. DTSBD610 00482 DTSBD610 00483 05 MSG08-DUP-FEIN-AND-TAX-PERIOD. DTSBD610 00484 10 FILLER PIC X(40) DTSBD610 00485 VALUE 'DUPLICATE FEIN + TAX PERIOD '. DTSBD610 00486 10 FILLER PIC X(40) DTSBD610 00487 VALUE ' '. DTSBD610 00488 EJECT DTSBD610 00489 01 L910-LINK-AREA. DTSBD610 00490 ++INCLUDE DTSIL910 DTSBD610 00491 SKIP3 DTSBD610 00492 01 MSKL-REC. DTSBD610 00493 ++INCLUDE DTSIMSKL DTSBD610 00494 SKIP3 DTSBD610 00495 01 MHDR-REC. DTSBD610 00496 ++INCLUDE DTSIMHDR DTSBD610 00497 SKIP3 DTSBD610 00498 01 MPRF-REC. DTSBD610 00499 ++INCLUDE DTSIMPRF DTSBD610 00500 SKIP3 DTSBD610 00501 01 MSOL-REC. DTSBD610 00502 ++INCLUDE DTSIMSOL DTSBD610 00503 SKIP3 DTSBD610 00504 01 MQTR-REC. DTSBD610 00505 ++INCLUDE DTSIMQTR DTSBD610 00506 SKIP3 DTSBD610 00507 01 MDST-REC. DTSBD610 00508 ++INCLUDE DTSIMDST DTSBD610 00509 EJECT DTSBD610 00510 01 L921-LINK-AREA. DTSBD610 00511 ++INCLUDE DTSIL921 DTSBD610 00512 SKIP3 DTSBD610 00513 01 ISKL-REC. DTSBD610 00514 ++INCLUDE DTSIISKL DTSBD610 00515 SKIP3 DTSBD610 00516 01 IEIN-REC. DTSBD610 00517 ++INCLUDE DTSIIEIN DTSBD610 00518 EJECT DTSBD610 00519 01 L931-LINK-AREA. DTSBD610 00520 ++INCLUDE DTSIL931 DTSBD610 00521 SKIP3 DTSBD610 00522 01 FSKL-REC. DTSBD610 00523 ++INCLUDE DTSIFSKL DTSBD610 00524 EJECT DTSBD610 00525 01 RSK1-REC. DTSBD610 00526 ++INCLUDE DTSIRSK1 DTSBD610 00527 SKIP3 DTSBD610 00528 01 R704-REC. DTSBD610 00529 ++INCLUDE DTSIR704 DTSBD610 00530 EJECT DTSBD610 00531 01 R705-REC. DTSBD610 00532 ++INCLUDE DTSIR705 DTSBD610 00533 EJECT DTSBD610 00534 01 L007-LINK-AREA. DTSBD610 00535 ++INCLUDE DTSIL007 DTSBD610 00536 EJECT DTSBD610 00537 01 L516-LINK-AREA. DTSBD610 00538 ++INCLUDE DTSIL516 DTSBD610 00539 EJECT DTSBD610 00540 LINKAGE SECTION. DTSBD610 00541 DTSBD610 00542 01 PARM-AREA. DTSBD610 00543 05 PARM-LENGTH PIC S9(04) COMP. DTSBD610 00544 05 PARM-CERT-CURRENT-YEAR PIC X(02). DTSBD610 00545 EJECT DTSBD610 00546 PROCEDURE DIVISION USING PARM-AREA. DTSBD610 00547 DTSBD610 00548 DTSBD610 00549 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DTSBD610 00550 DTSBD610 00551 DTSBD610 00552 PERFORM I2000-INIT-FILES-AND-COUNTS THRU I2000-EXIT. DTSBD610 00553 DTSBD610 00554 DTSBD610 00555 PERFORM I3000-EDIT-CERT-CURRENT-YEAR THRU I3000-EXIT. DTSBD610 00556 DTSBD610 00557 DTSBD610 00558 MOVE 'N' TO CERT-REQUEST-EOF-IND. DTSBD610 00559 DTSBD610 00560 PERFORM P0000-CERT-REQUEST THRU P0000-EXIT DTSBD610 00561 UNTIL CERT-REQUEST-EOF-IND = 'Y'. DTSBD610 00562 DTSBD610 00563 DTSBD610 00564 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD610 00565 DTSBD610 00566 DTSBD610 00567 GOBACK. DTSBD610 00568 EJECT DTSBD610 00569 I1000-PROCESS-PARMS. DTSBD610 00570 IF PARM-LENGTH = +2 DTSBD610 00571 NEXT SENTENCE DTSBD610 00572 ELSE DTSBD610 00573 DISPLAY 'PARM-LENGTH NOT EQUAL TO 2' DTSBD610 00574 PERFORM S999-ABEND THRU S999-EXIT. DTSBD610 00575 DTSBD610 00576 DTSBD610 00577 IF PARM-CERT-CURRENT-YEAR NOT NUMERIC DTSBD610 00578 DISPLAY 'PARM-CERT-CURRENT-YEAR NOT NUMERIC' DTSBD610 00579 PERFORM S999-ABEND THRU S999-EXIT. DTSBD610 00580 DTSBD610 00581 DTSBD610 00582 MOVE PARM-CERT-CURRENT-YEAR TO L007-YR-2-X. DTSBD610 00583 DTSBD610 00584 PERFORM S007-FROM-YEAR-2 THRU S007-EXIT. DTSBD610 00585 DTSBD610 00586 IF L007-NOT-VALID-YR DTSBD610 00587 DISPLAY 'PARM-CERT-CURRENT-YEAR NOT VALID' DTSBD610 00588 PERFORM S999-ABEND THRU S999-EXIT. DTSBD610 00589 DTSBD610 00590 MOVE L007-YR-4-9 TO WRK-PARM-CURRENT-YEAR. DTSBD610 00591 I1000-EXIT. DTSBD610 00592 EXIT. DTSBD610 00593 EJECT DTSBD610 00594 I2000-INIT-FILES-AND-COUNTS. DTSBD610 00595 MOVE 'N' TO L910-TRACE-IND DTSBD610 00596 L921-TRACE-IND DTSBD610 00597 L921-TRACE-IND DTSBD610 00598 L516-TRACE-IND. DTSBD610 00599 DTSBD610 00600 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD610 00601 L921-MOD-NAME DTSBD610 00602 L931-MOD-NAME. DTSBD610 00603 DTSBD610 00604 DTSBD610 00605 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD610 00606 DTSBD610 00607 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD610 00608 DTSBD610 00609 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD610 00610 DTSBD610 00611 OPEN INPUT CERT-REQUEST-FILE. DTSBD610 00612 DTSBD610 00613 OPEN OUTPUT CERT-REPLY-FILE DTSBD610 00614 ZERO-CERT-REPLY-FILE DTSBD610 00615 NON-ZERO-CERT-REPLY-FILE DTSBD610 00616 CURRENT-YEAR-CERT-FILE. DTSBD610 00617 DTSBD610 00618 DTSBD610 00619 MOVE +0 TO CERT-REQUEST-REC-CNT DTSBD610 00620 CERT-REPLY-MATCHED-REC-CNT DTSBD610 00621 CERT-REPLY-NOT-ONLINE-REC-CNT DTSBD610 00622 CERT-REPLY-UNMATCHED-REC-CNT DTSBD610 00623 CERT-REPLY-TOT-REC-CNT DTSBD610 00624 CURR-YEAR-CERT-REC-CNT DTSBD610 00625 ZERO-CERT-REPLY-CNT DTSBD610 00626 ZERO-FILL-SIC DTSBD610 00627 NON-ZERO-CERT-REPLY-CNT. DTSBD610 00628 DTSBD610 00629 DTSBD610 00630 MOVE SPACES TO WRK-PREV-REQUEST-FEIN-X DTSBD610 00631 WRK-PREV-REQUEST-TAX-PERIOD-X. DTSBD610 00632 DTSBD610 00633 DTSBD610 00634 MOVE LENGTH OF R704-REC TO R704-LENGTH. DTSBD610 00635 DTSBD610 00636 MOVE LENGTH OF R705-REC TO R705-LENGTH. DTSBD610 00637 I2000-EXIT. DTSBD610 00638 EXIT. DTSBD610 00639 EJECT DTSBD610 00640 I3000-EDIT-CERT-CURRENT-YEAR. DTSBD610 00641 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD610 00642 DTSBD610 00643 MOVE +0 TO MSKL-EMP-NO. DTSBD610 00644 DTSBD610 00645 SET MSKL-HDR-88 TO TRUE. DTSBD610 00646 DTSBD610 00647 PERFORM S910-READ THRU S910-EXIT. DTSBD610 00648 DTSBD610 00649 IF L910-NO-REC-88 DTSBD610 00650 DISPLAY 'MASTER HEADER RECORD NOT FOUND' DTSBD610 00651 PERFORM S999-ABEND THRU S999-EXIT. DTSBD610 00652 DTSBD610 00653 DTSBD610 00654 MOVE MSKL-REC TO MHDR-REC. DTSBD610 00655 DTSBD610 00656 DTSBD610 00657 MOVE WRK-PARM-CURRENT-YEAR TO WRK-QTR-YR. DTSBD610 00658 DTSBD610 00659 MOVE 4 TO WRK-QTR-Q. DTSBD610 00660 DTSBD610 00661 IF WRK-QTR-9 > MHDR-LAST-UC30-DEL-MAIL-YRQ DTSBD610 00662 DISPLAY 'TOO EARLY TO CERTIFY SPECIFIED YEAR' DTSBD610 00663 PERFORM S999-ABEND THRU S999-EXIT. DTSBD610 00664 I3000-EXIT. DTSBD610 00665 EXIT. DTSBD610 00666 EJECT DTSBD610 00667 P0000-CERT-REQUEST. DTSBD610 00668 READ CERT-REQUEST-FILE DTSBD610 00669 AT END DTSBD610 00670 MOVE 'Y' TO CERT-REQUEST-EOF-IND DTSBD610 00671 GO TO P0000-EXIT. DTSBD610 00672 DTSBD610 00673 DTSBD610 00674 ADD +1 TO CERT-REQUEST-REC-CNT. DTSBD610 00675 DTSBD610 00676 DTSBD610 00677 PERFORM P1100-INIT-WRK THRU P1100-EXIT. DTSBD610 00678 DTSBD610 00679 PERFORM P1200-INIT-REPLY THRU P1200-EXIT. DTSBD610 00680 DTSBD610 00681 PERFORM P1300-INIT-R704 THRU P1300-EXIT. DTSBD610 00682 DTSBD610 00683 PERFORM P1400-INIT-R705 THRU P1400-EXIT. DTSBD610 00684 DTSBD610 00685 DTSBD610 00686 MOVE +0 TO WRK-EMP-NO WRK-FEIN. DTSBD610 00687 DTSBD610 00688 MOVE 'N' TO WRK-EMP-CLASS-RATED-IND. DTSBD610 00689 DTSBD610 00690 PERFORM P3000-DETERMINE-EMP-NO THRU P3000-EXIT. DTSBD610 00691 DTSBD610 00692 IF WRK-EMP-NO NOT = +0 DTSBD610 00693 PERFORM P5000-PROCESS-EMP-NO THRU P5000-EXIT. DTSBD610 00694 DTSBD610 00695 DTSBD610 00696 PERFORM P6100-WRITE-REPLY THRU P6100-EXIT. DTSBD610 00697 DTSBD610 00698 DTSBD610 00699 IF R705-MSG-TEXT = SPACES DTSBD610 00700 MOVE WRK-EMP-NO TO R704-EMP-NO DTSBD610 00701 IF WRK-FEIN NOT = +0 DTSBD610 00702 MOVE WRK-FEIN TO R704-FEIN DTSBD610 00703 END-IF DTSBD610 00704 MOVE WRK-PAID-PRIOR-2-1 TO R704-ONTIME DTSBD610 00705 MOVE WRK-PAID-2-1-THRU-2-10 TO R704-GRACE DTSBD610 00706 MOVE WRK-PAID-AFTER-2-10 TO R704-LATE DTSBD610 00707 MOVE WRK-PAID-THRU-4-15 TO R704-ONTIME-SCHED-H DTSBD610 00708 MOVE WRK-PAID-AFTER-4-15 TO R704-LATE-SCHED-H DTSBD610 00709 MOVE RATE-CNT TO R704-WAGE-RATE-CNT DTSBD610 00710 PERFORM S946-WRITE-R704 THRU S946-EXIT DTSBD610 00711 ELSE DTSBD610 00712 MOVE WRK-EMP-NO TO R705-EMP-NO DTSBD610 00713 PERFORM S946-WRITE-R705 THRU S946-EXIT. DTSBD610 00714 DTSBD610 00715 DTSBD610 00716 MOVE REQUEST-FEIN-X TO WRK-PREV-REQUEST-FEIN-X. DTSBD610 00717 DTSBD610 00718 MOVE REQUEST-TAX-PERIOD-X TO WRK-PREV-REQUEST-TAX-PERIOD-X. DTSBD610 00719 DTSBD610 00720 DTSBD610 00721 *& DTSBD610 00722 IF MPRF-EMP-NO NUMERIC DTSBD610 00723 IF MPRF-EMP-NO = 073415 DTSBD610 00724 DISPLAY 'P0000 ONTIME ' R704-ONTIME DTSBD610 00725 ' GRACE ' R704-GRACE DTSBD610 00726 ' LATE ' R704-LATE. DTSBD610 00727 *& DTSBD610 00728 P0000-EXIT. DTSBD610 00729 EXIT. DTSBD610 00730 EJECT DTSBD610 00731 P1100-INIT-WRK. DTSBD610 00732 MOVE REQUEST-TAX-YEAR TO L007-YR-4-X. DTSBD610 00733 DTSBD610 00734 PERFORM S007-FROM-YEAR-4 THRU S007-EXIT. DTSBD610 00735 DTSBD610 00736 MOVE L007-YR-4-9 TO WRK-CERT-YEAR DTSBD610 00737 DTSBD610 00738 MOVE REQUEST-TAX-MONTH TO WRK-CERT-MONTH. DTSBD610 00739 DTSBD610 00740 DTSBD610 00741 MOVE WRK-CERT-YEAR-MONTH TO WRK-DATE-X. DTSBD610 00742 DTSBD610 00743 ADD +1 TO WRK-YR. DTSBD610 00744 DTSBD610 00745 MOVE 02 TO WRK-MO. DTSBD610 00746 DTSBD610 00747 MOVE 01 TO WRK-DA. DTSBD610 00748 DTSBD610 00749 MOVE WRK-DATE-9 TO WRK-CERT-FEB-1-DATE. DTSBD610 00750 DTSBD610 00751 MOVE 10 TO WRK-DA. DTSBD610 00752 DTSBD610 00753 MOVE WRK-DATE-9 TO WRK-CERT-FEB-10-DATE. DTSBD610 00754 DTSBD610 00755 MOVE 04 TO WRK-MO. DTSBD610 00756 DTSBD610 00757 MOVE 15 TO WRK-DA. DTSBD610 00758 DTSBD610 00759 MOVE WRK-DATE-9 TO WRK-CERT-APR-15-DATE. DTSBD610 00760 DTSBD610 00761 DTSBD610 00762 PERFORM P1110-INIT-WRK-YRQ THRU P1110-EXIT DTSBD610 00763 VARYING WRK-YRQ-SUB FROM 1 BY 1 DTSBD610 00764 UNTIL WRK-YRQ-SUB > 4. DTSBD610 00765 DTSBD610 00766 MOVE +0 TO WRK-PAID-PRIOR-2-1 DTSBD610 00767 WRK-PAID-2-1-THRU-2-10 DTSBD610 00768 WRK-PAID-AFTER-2-10 DTSBD610 00769 WRK-PAID-THRU-4-15 DTSBD610 00770 WRK-PAID-AFTER-4-15. DTSBD610 00771 P1100-EXIT. DTSBD610 00772 EXIT. DTSBD610 00773 SKIP3 DTSBD610 00774 P1110-INIT-WRK-YRQ. DTSBD610 00775 MOVE WRK-CERT-YEAR TO WRK-QTR-YR. DTSBD610 00776 DTSBD610 00777 MOVE WRK-YRQ-SUB TO WRK-QTR-Q. DTSBD610 00778 DTSBD610 00779 MOVE WRK-QTR-9 TO WRK-YRQ (WRK-YRQ-SUB). DTSBD610 00780 DTSBD610 00781 MOVE 'N' TO WRK-YRQ-LIABLE-IND (WRK-YRQ-SUB) DTSBD610 00782 WRK-RPT-FILED-IND (WRK-YRQ-SUB). DTSBD610 00783 DTSBD610 00784 MOVE +0 TO WRK-RATE (WRK-YRQ-SUB) DTSBD610 00785 WRK-TAXABLE-WAGES (WRK-YRQ-SUB). DTSBD610 00786 P1110-EXIT. DTSBD610 00787 EXIT. DTSBD610 00788 EJECT DTSBD610 00789 P1200-INIT-REPLY. DTSBD610 00790 MOVE ZEROS TO REPLY-REC. DTSBD610 00791 DTSBD610 00792 DTSBD610 00793 MOVE WRK-REPLY-CHAR-CNT TO REPLY-CHAR-CNT. DTSBD610 00794 DTSBD610 00795 MOVE +0 TO REPLY-HEX-ZERO. DTSBD610 00796 DTSBD610 00797 MOVE 'DC' TO REPLY-STATE-CD. DTSBD610 00798 DTSBD610 00799 MOVE REQUEST-FEIN-X TO REPLY-FEIN-X. DTSBD610 00800 DTSBD610 00801 MOVE REQUEST-DOC-LOC-NUMBER TO REPLY-DOC-LOC-NUMBER. DTSBD610 00802 DTSBD610 00803 MOVE REQUEST-TAX-PERIOD TO REPLY-TAX-PERIOD. DTSBD610 00804 DTSBD610 00805 MOVE REQUEST-CHECK-DIGIT TO REPLY-CHECK-DIGIT. DTSBD610 00806 DTSBD610 00807 MOVE SPACE TO REPLY-RESPONSE-IND DTSBD610 00808 REPLY-EMP-NO-AREA. DTSBD610 00809 DTSBD610 00810 MOVE REQUEST-NAME-CONTROL TO REPLY-NAME-CONTROL. DTSBD610 00811 DTSBD610 00812 MOVE REQUEST-FORM-INDICATOR TO REPLY-FORM-INDICATOR. DTSBD610 00813 DTSBD610 00814 DTSBD610 00815 ***** DTSBD610 00816 * THE TAX YEAR 1997 IRS SPECIFICATION STATES "COPY DTSBD610 00817 * POSITIONS 269-277 OF THE FUTA IDENTIFICATION DTSBD610 00818 * RECORD". DTSBD610 00819 ***** DTSBD610 00820 DTSBD610 00821 MOVE REQUEST-XREF-FEIN TO REPLY-XREF-FEIN-X. DTSBD610 00822 P1200-EXIT. DTSBD610 00823 EXIT. DTSBD610 00824 SKIP3 DTSBD610 00825 P1300-INIT-R704. DTSBD610 00826 IF REQUEST-FEIN NUMERIC DTSBD610 00827 MOVE REQUEST-FEIN TO R704-FEIN DTSBD610 00828 ELSE DTSBD610 00829 MOVE +0 TO R704-FEIN. DTSBD610 00830 DTSBD610 00831 MOVE WRK-CERT-YEAR-MONTH TO R704-TAX-YEAR-MONTH. DTSBD610 00832 DTSBD610 00833 DTSBD610 00834 INITIALIZE R704-DATA-AREA. DTSBD610 00835 DTSBD610 00836 DTSBD610 00837 MOVE REQUEST-DOC-LOC-NUMBER TO R704-DOC-LOC-NO. DTSBD610 00838 DTSBD610 00839 MOVE REQUEST-CHECK-DIGIT TO R704-CHECK-DIGIT. DTSBD610 00840 DTSBD610 00841 MOVE REQUEST-FORM-INDICATOR TO R704-FORM-INDICATOR. DTSBD610 00842 P1300-EXIT. DTSBD610 00843 EXIT. DTSBD610 00844 SKIP3 DTSBD610 00845 P1400-INIT-R705. DTSBD610 00846 IF REQUEST-FEIN NUMERIC DTSBD610 00847 MOVE REQUEST-FEIN TO R705-FEIN DTSBD610 00848 ELSE DTSBD610 00849 MOVE +0 TO R705-FEIN. DTSBD610 00850 DTSBD610 00851 MOVE WRK-CERT-YEAR-MONTH TO R705-TAX-YEAR-MONTH. DTSBD610 00852 DTSBD610 00853 DTSBD610 00854 INITIALIZE R705-DATA-AREA. DTSBD610 00855 DTSBD610 00856 DTSBD610 00857 MOVE REQUEST-ADDRESS-AREA TO R705-ADDRESS-AREA. DTSBD610 00858 DTSBD610 00859 MOVE REQUEST-XREF-FEIN TO R705-XREF-FEIN. DTSBD610 00860 DTSBD610 00861 MOVE REQUEST-NAME-CONTROL TO R705-NAME-CONTROL. DTSBD610 00862 P1400-EXIT. DTSBD610 00863 EXIT. DTSBD610 00864 EJECT DTSBD610 00865 P3000-DETERMINE-EMP-NO. DTSBD610 00866 IF (REQUEST-FEIN-X = WRK-PREV-REQUEST-FEIN-X) DTSBD610 00867 AND DTSBD610 00868 (REQUEST-TAX-PERIOD-X = WRK-PREV-REQUEST-TAX-PERIOD-X) DTSBD610 00869 MOVE MSG08-DUP-FEIN-AND-TAX-PERIOD TO R705-MSG-TEXT DTSBD610 00870 GO TO P3000-EXIT. DTSBD610 00871 DTSBD610 00872 DTSBD610 00873 MOVE +0 TO WRK-LIAB-CNT DTSBD610 00874 WRK-NOT-LIAB-CNT. DTSBD610 00875 DTSBD610 00876 IF REQUEST-FEIN NOT NUMERIC DTSBD610 00877 OR DTSBD610 00878 REQUEST-FEIN = 0 DTSBD610 00879 PERFORM P3110-CHECK-REQUEST-EMP-NO THRU P3110-EXIT DTSBD610 00880 ELSE DTSBD610 00881 MOVE LOW-VALUE TO IEIN-KEY-AREA DTSBD610 00882 SET IEIN-EIN-88 TO TRUE DTSBD610 00883 MOVE REQUEST-FEIN TO IEIN-FEIN DTSBD610 00884 MOVE +0 TO IEIN-EMP-NO DTSBD610 00885 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DTSBD610 00886 PERFORM S921-START-BROWSE THRU S921-EXIT DTSBD610 00887 MOVE ISKL-REC TO IEIN-REC DTSBD610 00888 PERFORM P3300-IEIN-BROWSE THRU P3300-EXIT DTSBD610 00889 UNTIL L921-NO-REC-88 DTSBD610 00890 OR DTSBD610 00891 IEIN-FEIN NOT = REQUEST-FEIN DTSBD610 00892 PERFORM P3100-CHECK-LIAB-MULTIPLE THRU P3100-EXIT. DTSBD610 00893 P3000-EXIT. DTSBD610 00894 EXIT. DTSBD610 00895 EJECT DTSBD610 00896 P3100-CHECK-LIAB-MULTIPLE. DTSBD610 00897 *****DISPLAY DTSBD610 00898 ********' P3100 REQUEST-EMP-NO WRK-EMP-NO WRK-LIAB-CNT : ' DTSBD610 00899 ********REQUEST-EMP-NO WRK-EMP-NO WRK-LIAB-CNT. DTSBD610 00900 DTSBD610 00901 IF WRK-LIAB-CNT = +1 DTSBD610 00902 IF WRK-EMP-CLASS-RATED-IND = 'N' DTSBD610 00903 MOVE MSG06-SELF-INSURED TO R705-MSG-TEXT DTSBD610 00904 ELSE DTSBD610 00905 NEXT SENTENCE DTSBD610 00906 ELSE DTSBD610 00907 IF WRK-LIAB-CNT > +1 DTSBD610 00908 MOVE +0 TO WRK-EMP-NO DTSBD610 00909 MOVE MSG02-MULTIPLE-EMP TO R705-MSG-TEXT DTSBD610 00910 ELSE DTSBD610 00911 IF WRK-NOT-LIAB-CNT = +1 DTSBD610 00912 IF WRK-EMP-CLASS-RATED-IND = 'N' DTSBD610 00913 MOVE MSG06-SELF-INSURED TO R705-MSG-TEXT DTSBD610 00914 ELSE DTSBD610 00915 NEXT SENTENCE DTSBD610 00916 ELSE DTSBD610 00917 IF WRK-NOT-LIAB-CNT > +1 DTSBD610 00918 MOVE +0 TO WRK-EMP-NO DTSBD610 00919 MOVE MSG07-MULTIPLE-INACT TO R705-MSG-TEXT DTSBD610 00920 ELSE DTSBD610 00921 IF R705-MSG-TEXT = SPACES DTSBD610 00922 PERFORM P3110-CHECK-REQUEST-EMP-NO THRU P3110-EXIT. DTSBD610 00923 P3100-EXIT. DTSBD610 00924 EXIT. DTSBD610 00925 EJECT DTSBD610 00926 P3110-CHECK-REQUEST-EMP-NO. DTSBD610 00927 MOVE ZERO TO WRK-REQUEST-EMP-NO. DTSBD610 00928 DTSBD610 00929 MOVE +7 TO WRK-REQUEST-EMP-NO-CHAR-SUB. DTSBD610 00930 DTSBD610 00931 PERFORM P3111-EXAMINE-CHARACTER THRU P3111-EXIT DTSBD610 00932 VARYING REQUEST-EMP-NO-CHAR-SUB FROM 15 BY -1 DTSBD610 00933 UNTIL REQUEST-EMP-NO-CHAR-SUB < +1. DTSBD610 00934 DTSBD610 00935 IF WRK-REQUEST-EMP-NO = ZERO DTSBD610 00936 MOVE MSG01-NO-MATCH TO R705-MSG-TEXT DTSBD610 00937 GO TO P3110-EXIT. DTSBD610 00938 DTSBD610 00939 DTSBD610 00940 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD610 00941 DTSBD610 00942 MOVE WRK-REQUEST-EMP-NO TO MSKL-EMP-NO. DTSBD610 00943 DTSBD610 00944 SET MSKL-PRF-88 TO TRUE. DTSBD610 00945 DTSBD610 00946 PERFORM S910-READ THRU S910-EXIT. DTSBD610 00947 DTSBD610 00948 IF L910-NO-REC-88 DTSBD610 00949 MOVE MSG01-NO-MATCH TO R705-MSG-TEXT DTSBD610 00950 GO TO P3110-EXIT. DTSBD610 00951 DTSBD610 00952 DTSBD610 00953 MOVE MSKL-REC TO MPRF-REC. DTSBD610 00954 DTSBD610 00955 DTSBD610 00956 IF MPRF-PRIMARY-NAME (1:4) DTSBD610 00957 = REQUEST-NAME-1 (1:4) DTSBD610 00958 OR REQUEST-NAME-CONTROL DTSBD610 00959 MOVE WRK-REQUEST-EMP-NO TO WRK-BROWSE-EMP-NO DTSBD610 00960 PERFORM P3400-BROWSE-MASTER THRU P3400-EXIT DTSBD610 00961 PERFORM P3200-CHECK-LIAB-SINGLE THRU P3200-EXIT DTSBD610 00962 ******** DISPLAY 'REQUEST-FEIN-X = ' DTSBD610 00963 *****************REQUEST-FEIN-X DTSBD610 00964 *****************' WRK-REQUEST-EMP-NO = ' DTSBD610 00965 *****************WRK-REQUEST-EMP-NO DTSBD610 00966 ELSE DTSBD610 00967 MOVE MSG01-NO-MATCH TO R705-MSG-TEXT. DTSBD610 00968 P3110-EXIT. DTSBD610 00969 EXIT. DTSBD610 00970 SKIP3 DTSBD610 00971 P3111-EXAMINE-CHARACTER. DTSBD610 00972 IF REQUEST-EMP-NO-AREA (REQUEST-EMP-NO-CHAR-SUB:1) NUMERIC DTSBD610 00973 CONTINUE DTSBD610 00974 ELSE DTSBD610 00975 GO TO P3111-EXIT. DTSBD610 00976 DTSBD610 00977 SUBTRACT 1 FROM WRK-REQUEST-EMP-NO-CHAR-SUB. DTSBD610 00978 DTSBD610 00979 IF WRK-REQUEST-EMP-NO-CHAR-SUB < +1 DTSBD610 00980 GO TO P3111-EXIT. DTSBD610 00981 DTSBD610 00982 MOVE REQUEST-EMP-NO-AREA (REQUEST-EMP-NO-CHAR-SUB:1) DTSBD610 00983 TO WRK-REQUEST-EMP-NO-CHAR (WRK-REQUEST-EMP-NO-CHAR-SUB). DTSBD610 00984 P3111-EXIT. DTSBD610 00985 EXIT. DTSBD610 00986 EJECT DTSBD610 00987 P3200-CHECK-LIAB-SINGLE. DTSBD610 00988 *****DISPLAY DTSBD610 00989 ********' P3200 REQUEST-EMP-NO WRK-EMP-NO WRK-LIAB-CNT : ' DTSBD610 00990 ********REQUEST-EMP-NO WRK-EMP-NO WRK-LIAB-CNT. DTSBD610 00991 DTSBD610 00992 IF WRK-LIAB-CNT = +1 DTSBD610 00993 IF WRK-EMP-CLASS-RATED-IND = 'N' DTSBD610 00994 MOVE MSG06-SELF-INSURED TO R705-MSG-TEXT DTSBD610 00995 ELSE DTSBD610 00996 NEXT SENTENCE DTSBD610 00997 ELSE DTSBD610 00998 IF WRK-NOT-LIAB-CNT = +1 DTSBD610 00999 IF WRK-EMP-CLASS-RATED-IND = 'N' DTSBD610 01000 MOVE MSG06-SELF-INSURED TO R705-MSG-TEXT DTSBD610 01001 ELSE DTSBD610 01002 NEXT SENTENCE DTSBD610 01003 ELSE DTSBD610 01004 IF R705-MSG-TEXT = SPACES DTSBD610 01005 MOVE MSG01-NO-MATCH TO R705-MSG-TEXT. DTSBD610 01006 P3200-EXIT. DTSBD610 01007 EXIT. DTSBD610 01008 EJECT DTSBD610 01009 P3300-IEIN-BROWSE. DTSBD610 01010 MOVE IEIN-EMP-NO TO WRK-BROWSE-EMP-NO. DTSBD610 01011 DTSBD610 01012 PERFORM P3400-BROWSE-MASTER THRU P3400-EXIT. DTSBD610 01013 DTSBD610 01014 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA. DTSBD610 01015 DTSBD610 01016 PERFORM S921-READ THRU S921-EXIT. DTSBD610 01017 DTSBD610 01018 IF L921-NO-REC-88 DTSBD610 01019 PERFORM S999-ABEND THRU S999-EXIT. DTSBD610 01020 DTSBD610 01021 PERFORM S921-READ-NEXT THRU S921-EXIT. DTSBD610 01022 DTSBD610 01023 MOVE ISKL-REC TO IEIN-REC. DTSBD610 01024 P3300-EXIT. DTSBD610 01025 EXIT. DTSBD610 01026 EJECT DTSBD610 01027 P3400-BROWSE-MASTER. DTSBD610 01028 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD610 01029 DTSBD610 01030 MOVE WRK-BROWSE-EMP-NO TO MSKL-EMP-NO. DTSBD610 01031 DTSBD610 01032 SET MSKL-PRF-88 TO TRUE. DTSBD610 01033 DTSBD610 01034 PERFORM S910-READ THRU S910-EXIT. DTSBD610 01035 DTSBD610 01036 IF L910-NO-REC-88 DTSBD610 01037 GO TO P3400-EXIT. DTSBD610 01038 DTSBD610 01039 MOVE MSKL-REC TO MPRF-REC. DTSBD610 01040 DTSBD610 01041 DTSBD610 01042 MOVE 'N' TO WRK-LIABLE-IND. DTSBD610 01043 DTSBD610 01044 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD610 01045 DTSBD610 01046 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD610 01047 DTSBD610 01048 SET MSKL-SOL-88 TO TRUE. DTSBD610 01049 DTSBD610 01050 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD610 01051 DTSBD610 01052 MOVE MSKL-REC TO MSOL-REC. DTSBD610 01053 DTSBD610 01054 PERFORM UNTIL L910-NO-REC-88 DTSBD610 01055 OR WRK-LIABLE-IND = 'Y' DTSBD610 01056 IF WRK-YRQ (4) < MSOL-FIRST-LIAB-YRQ DTSBD610 01057 OR WRK-YRQ (1) > MSOL-LAST-LIAB-YRQ DTSBD610 01058 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD610 01059 MOVE MSKL-REC TO MSOL-REC DTSBD610 01060 ELSE DTSBD610 01061 MOVE 'Y' TO WRK-LIABLE-IND DTSBD610 01062 END-IF DTSBD610 01063 END-PERFORM. DTSBD610 01064 DTSBD610 01065 IF WRK-LIABLE-IND = 'Y' DTSBD610 01066 ADD +1 TO WRK-LIAB-CNT DTSBD610 01067 MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBD610 01068 PERFORM P3410-EMP-CLASS THRU P3410-EXIT DTSBD610 01069 ELSE DTSBD610 01070 ADD +1 TO WRK-NOT-LIAB-CNT DTSBD610 01071 IF WRK-EMP-NO = +0 DTSBD610 01072 MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBD610 01073 PERFORM P3410-EMP-CLASS THRU P3410-EXIT. DTSBD610 01074 P3400-EXIT. DTSBD610 01075 EXIT. DTSBD610 01076 SKIP3 DTSBD610 01077 P3410-EMP-CLASS. DTSBD610 01078 IF NOT MPRF-CLASS-RATED-88 DTSBD610 01079 MOVE 'N' TO WRK-EMP-CLASS-RATED-IND DTSBD610 01080 ELSE DTSBD610 01081 MOVE 'Y' TO WRK-EMP-CLASS-RATED-IND. DTSBD610 01082 P3410-EXIT. DTSBD610 01083 EXIT. DTSBD610 01084 EJECT DTSBD610 01085 P5000-PROCESS-EMP-NO. DTSBD610 01086 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD610 01087 DTSBD610 01088 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSBD610 01089 DTSBD610 01090 SET MSKL-PRF-88 TO TRUE. DTSBD610 01091 DTSBD610 01092 PERFORM S910-READ THRU S910-EXIT. DTSBD610 01093 DTSBD610 01094 IF L910-NO-REC-88 DTSBD610 01095 PERFORM S999-ABEND THRU S999-EXIT. DTSBD610 01096 DTSBD610 01097 DTSBD610 01098 MOVE MSKL-REC TO MPRF-REC. DTSBD610 01099 DTSBD610 01100 DTSBD610 01101 MOVE MPRF-FEIN TO WRK-FEIN. DTSBD610 01102 DTSBD610 01103 DTSBD610 01104 PERFORM P5100-SET-YRQ-LIABLE THRU P5100-EXIT DTSBD610 01105 VARYING WRK-YRQ-IDX FROM 1 BY 1 DTSBD610 01106 UNTIL WRK-YRQ-IDX > 4. DTSBD610 01107 DTSBD610 01108 DTSBD610 01109 IF R705-MSG-TEXT NOT = SPACES DTSBD610 01110 GO TO P5000-EXIT. DTSBD610 01111 DTSBD610 01112 DTSBD610 01113 PERFORM P5200-MQTR-READ THRU P5200-EXIT DTSBD610 01114 VARYING WRK-YRQ-IDX FROM 1 BY 1 DTSBD610 01115 UNTIL WRK-YRQ-IDX > 4. DTSBD610 01116 DTSBD610 01117 DTSBD610 01118 MOVE LOW-VALUE TO MDST-KEY-AREA. DTSBD610 01119 DTSBD610 01120 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD610 01121 DTSBD610 01122 SET MDST-DST-88 TO TRUE. DTSBD610 01123 DTSBD610 01124 MOVE WRK-YRQ (1) TO MDST-YRQ. DTSBD610 01125 DTSBD610 01126 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD610 01127 DTSBD610 01128 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD610 01129 DTSBD610 01130 MOVE MSKL-REC TO MDST-REC. DTSBD610 01131 DTSBD610 01132 PERFORM P5300-MDST-BROWSE THRU P5300-EXIT DTSBD610 01133 UNTIL L910-NO-REC-88 DTSBD610 01134 OR DTSBD610 01135 MDST-YRQ > WRK-YRQ (4). DTSBD610 01136 P5000-EXIT. DTSBD610 01137 EXIT. DTSBD610 01138 SKIP3 DTSBD610 01139 P5100-SET-YRQ-LIABLE. DTSBD610 01140 MOVE WRK-YRQ (WRK-YRQ-IDX) TO L516-YRQ. DTSBD610 01141 DTSBD610 01142 IF MPRF-CLASS-SUB-88 DTSBD610 01143 PERFORM S516-LIABILITY THRU S516-EXIT DTSBD610 01144 ELSE DTSBD610 01145 SET L516-NOT-LIABLE-88 TO TRUE DTSBD610 01146 SET L516-NO-RATE-88 TO TRUE DTSBD610 01147 MOVE +0 TO L516-DEFAULT-TAX-DUE-DATE DTSBD610 01148 L516-DEFAULT-RPT-DUE-DATE DTSBD610 01149 L516-UI-RATE. DTSBD610 01150 DTSBD610 01151 IF L516-LIABLE-88 DTSBD610 01152 IF WRK-YRQ (WRK-YRQ-IDX) NOT > MPRF-LAST-ARCHIVED-YRQ DTSBD610 01153 OR DTSBD610 01154 WRK-YRQ (WRK-YRQ-IDX) > MHDR-LAST-UC30-DEL-MAIL-YRQ DTSBD610 01155 MOVE MSG04-INFO-NOT-AVAILABLE TO R705-MSG-TEXT DTSBD610 01156 MOVE '3' TO REPLY-RESPONSE-IND DTSBD610 01157 ELSE DTSBD610 01158 MOVE 'Y' TO WRK-YRQ-LIABLE-IND (WRK-YRQ-IDX). DTSBD610 01159 P5100-EXIT. DTSBD610 01160 EXIT. DTSBD610 01161 SKIP3 DTSBD610 01162 P5200-MQTR-READ. DTSBD610 01163 *& DTSBD610 01164 IF MPRF-EMP-NO NUMERIC DTSBD610 01165 IF MPRF-EMP-NO = 073415 DTSBD610 01166 DISPLAY 'P5200'. DTSBD610 01167 *& DTSBD610 01168 IF WRK-YRQ-LIABLE-IND (WRK-YRQ-IDX) = 'N' DTSBD610 01169 GO TO P5200-EXIT. DTSBD610 01170 DTSBD610 01171 DTSBD610 01172 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD610 01173 DTSBD610 01174 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD610 01175 DTSBD610 01176 SET MQTR-QTR-88 TO TRUE. DTSBD610 01177 DTSBD610 01178 MOVE WRK-YRQ (WRK-YRQ-IDX) TO MQTR-YRQ. DTSBD610 01179 DTSBD610 01180 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD610 01181 DTSBD610 01182 PERFORM S910-READ THRU S910-EXIT. DTSBD610 01183 DTSBD610 01184 IF L910-NO-REC-88 DTSBD610 01185 GO TO P5200-EXIT. DTSBD610 01186 DTSBD610 01187 DTSBD610 01188 MOVE MSKL-REC TO MQTR-REC. DTSBD610 01189 DTSBD610 01190 DTSBD610 01191 IF NOT MQTR-CURR-RCVD-88 DTSBD610 01192 GO TO P5200-EXIT. DTSBD610 01193 DTSBD610 01194 DTSBD610 01195 MOVE 'Y' TO WRK-RPT-FILED-IND (WRK-YRQ-IDX). DTSBD610 01196 DTSBD610 01197 DTSBD610 01198 *** NOTE ZERO RATE AS EXCEPTIONAL CONDITION TO THE FEDS. DTSBD610 01199 *****IF MQTR-UI-RATE = +0 DTSBD610 01200 *********MOVE '1' TO REPLY-ZERO-IND (1). DTSBD610 01201 DTSBD610 01202 DTSBD610 01203 MOVE MQTR-UI-RATE TO WRK-RATE (WRK-YRQ-IDX). DTSBD610 01204 DTSBD610 01205 DTSBD610 01206 MOVE MQTR-TAX-WAGE TO WRK-TAXABLE-WAGES (WRK-YRQ-IDX). DTSBD610 01207 P5200-EXIT. DTSBD610 01208 EXIT. DTSBD610 01209 SKIP3 DTSBD610 01210 P5300-MDST-BROWSE. DTSBD610 01211 *& DTSBD610 01212 IF MPRF-EMP-NO NUMERIC DTSBD610 01213 IF MPRF-EMP-NO = 073415 DTSBD610 01214 DISPLAY 'P5300'. DTSBD610 01215 *& DTSBD610 01216 MOVE MDST-YRQ TO WRK-QTR-9. DTSBD610 01217 DTSBD610 01218 IF WRK-RPT-FILED-IND (WRK-QTR-Q) = 'Y' DTSBD610 01219 PERFORM P5310-DSTRB-DATA-LOOP THRU P5310-EXIT DTSBD610 01220 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD610 01221 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD610 01222 DTSBD610 01223 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD610 01224 DTSBD610 01225 MOVE MSKL-REC TO MDST-REC. DTSBD610 01226 P5300-EXIT. DTSBD610 01227 EXIT. DTSBD610 01228 SKIP3 DTSBD610 01229 P5310-DSTRB-DATA-LOOP. DTSBD610 01230 IF NOT MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBD610 01231 GO TO P5310-EXIT. DTSBD610 01232 DTSBD610 01233 *& DTSBD610 01234 IF MPRF-EMP-NO NUMERIC DTSBD610 01235 IF MPRF-EMP-NO = 073415 DTSBD610 01236 DISPLAY 'P5310 FORM IND ' REQUEST-FORM-INDICATOR DTSBD610 01237 ' MDST RCVD ' MDST-RECEIVED-DATE DTSBD610 01238 ' WRK APR15 ' WRK-CERT-APR-15-DATE DTSBD610 01239 ' WRK FEB ' WRK-CERT-FEB-1-DATE DTSBD610 01240 ' MDST AMT ' MDST-AMT (MDST-ACCT-IDX). DTSBD610 01241 *& DTSBD610 01242 IF REQUEST-FORM-INDICATOR = '2' OR '3' DTSBD610 01243 IF MDST-RECEIVED-DATE > WRK-CERT-APR-15-DATE DTSBD610 01244 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-AFTER-4-15 DTSBD610 01245 ELSE DTSBD610 01246 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-THRU-4-15 DTSBD610 01247 ELSE DTSBD610 01248 IF MDST-RECEIVED-DATE < WRK-CERT-FEB-1-DATE DTSBD610 01249 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-PRIOR-2-1 DTSBD610 01250 ELSE DTSBD610 01251 IF MDST-RECEIVED-DATE > WRK-CERT-FEB-10-DATE DTSBD610 01252 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-AFTER-2-10 DTSBD610 01253 ELSE DTSBD610 01254 ADD MDST-AMT (MDST-ACCT-IDX) DTSBD610 01255 TO WRK-PAID-2-1-THRU-2-10. DTSBD610 01256 *& DTSBD610 01257 IF MPRF-EMP-NO NUMERIC DTSBD610 01258 IF MPRF-EMP-NO = 073415 DTSBD610 01259 DISPLAY 'P5310 PRIOR ' WRK-PAID-PRIOR-2-1 DTSBD610 01260 ' AFTER ' WRK-PAID-AFTER-2-10 DTSBD610 01261 ' THRU ' WRK-PAID-2-1-THRU-2-10. DTSBD610 01262 *& DTSBD610 01263 P5310-EXIT. DTSBD610 01264 EXIT. DTSBD610 01265 EJECT DTSBD610 01266 P6100-WRITE-REPLY. DTSBD610 01267 ADD +1 TO CERT-REPLY-TOT-REC-CNT. DTSBD610 01268 DTSBD610 01269 DTSBD610 01270 PERFORM P6125-ZERO-FILL-REPLY-SIC-AREA THRU P6125-EXIT DTSBD610 01271 VARYING ZERO-FILL-SIC FROM 1 BY 1 DTSBD610 01272 UNTIL ZERO-FILL-SIC > 5. DTSBD610 01273 DTSBD610 01274 IF R705-MSG-TEXT = SPACE DTSBD610 01275 NEXT SENTENCE DTSBD610 01276 ELSE DTSBD610 01277 IF REPLY-RESPONSE-IND = '3' DTSBD610 01278 ADD +1 TO CERT-REPLY-NOT-ONLINE-REC-CNT DTSBD610 01279 ELSE DTSBD610 01280 ADD +1 TO CERT-REPLY-UNMATCHED-REC-CNT DTSBD610 01281 END-IF DTSBD610 01282 MOVE REPLY-REC TO HOLD-REPLY-REC DTSBD610 01283 WRITE REPLY-REC DTSBD610 01284 IF ZERO-CERT-REPLY-CNT < +50 DTSBD610 01285 ADD +1 TO ZERO-CERT-REPLY-CNT DTSBD610 01286 WRITE ZERO-CERT-REPLY-REC FROM HOLD-REPLY-REC DTSBD610 01287 END-IF DTSBD610 01288 GO TO P6100-EXIT. DTSBD610 01289 DTSBD610 01290 DTSBD610 01291 MOVE +0 TO RATE-CNT. DTSBD610 01292 DTSBD610 01293 PERFORM P6110-WRK-YRQ-LOOP THRU P6110-EXIT DTSBD610 01294 VARYING WRK-YRQ-IDX FROM 1 BY 1 DTSBD610 01295 UNTIL WRK-YRQ-IDX > +4. DTSBD610 01296 DTSBD610 01297 MOVE WRK-PAID-PRIOR-2-1 TO REPLY-PAID-PRIOR-2-1. DTSBD610 01298 DTSBD610 01299 MOVE WRK-PAID-2-1-THRU-2-10 TO REPLY-PAID-2-1-THRU-2-10. DTSBD610 01300 DTSBD610 01301 MOVE WRK-PAID-AFTER-2-10 TO REPLY-PAID-AFTER-2-10. DTSBD610 01302 DTSBD610 01303 MOVE WRK-PAID-THRU-4-15 TO REPLY-PAID-THRU-4-15. DTSBD610 01304 DTSBD610 01305 MOVE WRK-PAID-AFTER-4-15 TO REPLY-PAID-AFTER-4-15. DTSBD610 01306 DTSBD610 01307 MOVE WRK-EMP-NO TO REPLY-EMP-NO. DTSBD610 01308 DTSBD610 01309 DTSBD610 01310 ***** DTSBD610 01311 * THE TAX YEAR 1997 IRS SPECIFICATION STATES "COPY DTSBD610 01312 * POSITIONS 269-277 OF THE FUTA IDENTIFICATION DTSBD610 01313 * RECORD". HENCE THE FOLLOWING SENTENCE IS COMMENTED OUT. DTSBD610 01314 ***** DTSBD610 01315 DTSBD610 01316 *****IF WRK-FEIN NOT = +0 DTSBD610 01317 *********MOVE WRK-FEIN TO REPLY-XREF-FEIN. DTSBD610 01318 DTSBD610 01319 DTSBD610 01320 ADD +1 TO CERT-REPLY-MATCHED-REC-CNT. DTSBD610 01321 DTSBD610 01322 DTSBD610 01323 MOVE REPLY-REC TO HOLD-REPLY-REC. DTSBD610 01324 DTSBD610 01325 PERFORM P6115-FIRST-50-RECORDS THRU P6115-EXIT. DTSBD610 01326 DTSBD610 01327 DTSBD610 01328 WRITE REPLY-REC. DTSBD610 01329 DTSBD610 01330 DTSBD610 01331 PERFORM P6120-WRITE-CURR-YR-CERT THRU P6120-EXIT. DTSBD610 01332 P6100-EXIT. DTSBD610 01333 EXIT. DTSBD610 01334 SKIP3 DTSBD610 01335 P6110-WRK-YRQ-LOOP. DTSBD610 01336 IF WRK-RPT-FILED-IND (WRK-YRQ-IDX) = 'N' DTSBD610 01337 OR DTSBD610 01338 WRK-TAXABLE-WAGES (WRK-YRQ-IDX) = +0 DTSBD610 01339 GO TO P6110-EXIT. DTSBD610 01340 DTSBD610 01341 DTSBD610 01342 MOVE 'N' TO RATE-MATCH. DTSBD610 01343 DTSBD610 01344 PERFORM VARYING RATE-SUB FROM 1 BY 1 DTSBD610 01345 UNTIL RATE-SUB > RATE-CNT DTSBD610 01346 OR DTSBD610 01347 RATE-MATCH = 'Y' DTSBD610 01348 IF WRK-RATE (WRK-YRQ-IDX) = REPLY-RATE (RATE-SUB) DTSBD610 01349 MOVE 'Y' TO RATE-MATCH DTSBD610 01350 END-IF DTSBD610 01351 END-PERFORM. DTSBD610 01352 DTSBD610 01353 IF RATE-MATCH = 'Y' DTSBD610 01354 SUBTRACT 1 FROM RATE-SUB DTSBD610 01355 ADD WRK-TAXABLE-WAGES (WRK-YRQ-IDX) DTSBD610 01356 TO REPLY-TAXABLE-WAGES (RATE-SUB) DTSBD610 01357 R704-TAXABLE-WAGES (RATE-SUB) DTSBD610 01358 ELSE DTSBD610 01359 ADD +1 TO RATE-CNT DTSBD610 01360 MOVE WRK-RATE (WRK-YRQ-IDX) DTSBD610 01361 TO REPLY-RATE (RATE-CNT) DTSBD610 01362 R704-RATE (RATE-CNT) DTSBD610 01363 MOVE WRK-TAXABLE-WAGES (WRK-YRQ-IDX) DTSBD610 01364 TO REPLY-TAXABLE-WAGES (RATE-CNT) DTSBD610 01365 R704-TAXABLE-WAGES (RATE-CNT). DTSBD610 01366 P6110-EXIT. DTSBD610 01367 EXIT. DTSBD610 01368 DTSBD610 01369 DTSBD610 01370 DTSBD610 01371 P6115-FIRST-50-RECORDS. DTSBD610 01372 IF (REPLY-TAXABLE-WAGES (1) = ZERO) DTSBD610 01373 AND DTSBD610 01374 (REPLY-TAXABLE-WAGES (2) = ZERO) DTSBD610 01375 AND DTSBD610 01376 (REPLY-TAXABLE-WAGES (3) = ZERO) DTSBD610 01377 AND DTSBD610 01378 (REPLY-TAXABLE-WAGES (4) = ZERO) DTSBD610 01379 IF ZERO-CERT-REPLY-CNT < +50 DTSBD610 01380 ADD +1 TO ZERO-CERT-REPLY-CNT DTSBD610 01381 WRITE ZERO-CERT-REPLY-REC FROM HOLD-REPLY-REC DTSBD610 01382 ELSE DTSBD610 01383 NEXT SENTENCE DTSBD610 01384 ELSE DTSBD610 01385 IF NON-ZERO-CERT-REPLY-CNT < +50 DTSBD610 01386 ADD +1 TO NON-ZERO-CERT-REPLY-CNT DTSBD610 01387 WRITE NON-ZERO-CERT-REPLY-REC FROM HOLD-REPLY-REC DTSBD610 01388 ELSE DTSBD610 01389 NEXT SENTENCE. DTSBD610 01390 P6115-EXIT. DTSBD610 01391 EXIT. DTSBD610 01392 EJECT DTSBD610 01393 P6120-WRITE-CURR-YR-CERT. DTSBD610 01394 IF WRK-CERT-YEAR = WRK-PARM-CURRENT-YEAR DTSBD610 01395 MOVE WRK-EMP-NO TO X971-EMP-NO DTSBD610 01396 MOVE WRK-PARM-CURRENT-YEAR TO X971-CERT-YEAR DTSBD610 01397 WRITE CURRENT-YEAR-CERT-REC DTSBD610 01398 ADD +1 TO CURR-YEAR-CERT-REC-CNT. DTSBD610 01399 P6120-EXIT. DTSBD610 01400 EXIT. DTSBD610 01401 P6125-ZERO-FILL-REPLY-SIC-AREA. DTSBD610 01402 MOVE ZEROS TO REPLY-SIC-AREA (ZERO-FILL-SIC). DTSBD610 01403 P6125-EXIT. DTSBD610 01404 EXIT. DTSBD610 01405 EJECT DTSBD610 01406 T0000-TERMINATE. DTSBD610 01407 MOVE +0 TO X971-EMP-NO. DTSBD610 01408 DTSBD610 01409 MOVE WRK-PARM-CURRENT-YEAR TO X971-CERT-YEAR. DTSBD610 01410 DTSBD610 01411 WRITE CURRENT-YEAR-CERT-REC. DTSBD610 01412 DTSBD610 01413 ADD +1 TO CURR-YEAR-CERT-REC-CNT. DTSBD610 01414 DTSBD610 01415 DTSBD610 01416 DISPLAY ' '. DTSBD610 01417 DTSBD610 01418 DISPLAY '*** DTSBD610 TERMINATION STATISTICS'. DTSBD610 01419 DTSBD610 01420 DISPLAY ' '. DTSBD610 01421 DTSBD610 01422 DISPLAY '*** ' DTSBD610 01423 CERT-REQUEST-REC-CNT DTSBD610 01424 ' CERTIFICATION REQUEST RECORDS RECEIVED FROM IRS'. DTSBD610 01425 DTSBD610 01426 DISPLAY '*** '. DTSBD610 01427 DTSBD610 01428 DISPLAY '*** ' DTSBD610 01429 CERT-REPLY-MATCHED-REC-CNT DTSBD610 01430 ' A. MATCHED RECORDS RETURNED TO MCC'. DTSBD610 01431 DTSBD610 01432 DISPLAY '*** '. DTSBD610 01433 DTSBD610 01434 DISPLAY '*** ' DTSBD610 01435 CERT-REPLY-NOT-ONLINE-REC-CNT DTSBD610 01436 ' B. UNMATCHED RECORDS RETURNED - RATE IND 1 OR 3'. DTSBD610 01437 DTSBD610 01438 DISPLAY '*** '. DTSBD610 01439 DTSBD610 01440 DISPLAY '*** ' DTSBD610 01441 CERT-REPLY-UNMATCHED-REC-CNT DTSBD610 01442 ' C. UNMATCHED RECORDS RETURNED - RATE IND BLANK'. DTSBD610 01443 DTSBD610 01444 DISPLAY '*** '. DTSBD610 01445 DTSBD610 01446 DISPLAY '*** ' DTSBD610 01447 CERT-REPLY-TOT-REC-CNT DTSBD610 01448 ' D. TOTAL IDENTIFICATION RECORDS RETURNED TO MCC'. DTSBD610 01449 DTSBD610 01450 DISPLAY '*** '. DTSBD610 01451 DTSBD610 01452 DISPLAY '*** '. DTSBD610 01453 DTSBD610 01454 DISPLAY '*** ' DTSBD610 01455 CURR-YEAR-CERT-REC-CNT DTSBD610 01456 ' CURRENT YEAR CERTIFICATION RECORDS WRITTEN'. DTSBD610 01457 DTSBD610 01458 DTSBD610 01459 CLOSE CERT-REQUEST-FILE DTSBD610 01460 CERT-REPLY-FILE DTSBD610 01461 ZERO-CERT-REPLY-FILE DTSBD610 01462 NON-ZERO-CERT-REPLY-FILE DTSBD610 01463 CURRENT-YEAR-CERT-FILE. DTSBD610 01464 DTSBD610 01465 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD610 01466 DTSBD610 01467 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD610 01468 DTSBD610 01469 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD610 01470 DTSBD610 01471 MOVE -1 TO RSK1-LENGTH. DTSBD610 01472 DTSBD610 01473 PERFORM S946-WRITE-RSK1 THRU S946-EXIT. DTSBD610 01474 T0000-EXIT. DTSBD610 01475 EXIT. DTSBD610 01476 EJECT DTSBD610 01477 S007-FROM-YEAR-2. DTSBD610 01478 SET L007-FROM-YR-2 TO TRUE. DTSBD610 01479 GO TO S007-YEAR. DTSBD610 01480 DTSBD610 01481 S007-FROM-YEAR-4. DTSBD610 01482 SET L007-FROM-YR-4 TO TRUE. DTSBD610 01483 GO TO S007-YEAR. DTSBD610 01484 DTSBD610 01485 S007-YEAR. DTSBD610 01486 CALL 'DTSBU007' USING L007-LINK-AREA. DTSBD610 01487 S007-EXIT. DTSBD610 01488 EXIT. DTSBD610 01489 SKIP3 DTSBD610 01490 S516-LIABILITY. DTSBD610 01491 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD610 01492 MPRF-REC. DTSBD610 01493 S516-EXIT. DTSBD610 01494 EXIT. DTSBD610 01495 SKIP3 DTSBD610 01496 S910-OPEN-READ. DTSBD610 01497 SET L910-OPEN-READ-88 TO TRUE. DTSBD610 01498 GO TO S910-MSTR-IO. DTSBD610 01499 DTSBD610 01500 S910-READ. DTSBD610 01501 SET L910-READ-88 TO TRUE. DTSBD610 01502 GO TO S910-MSTR-IO. DTSBD610 01503 DTSBD610 01504 S910-START-BROWSE. DTSBD610 01505 SET L910-START-BROWSE-88 TO TRUE. DTSBD610 01506 GO TO S910-MSTR-IO. DTSBD610 01507 DTSBD610 01508 S910-READ-NEXT. DTSBD610 01509 SET L910-READ-NEXT-88 TO TRUE. DTSBD610 01510 GO TO S910-MSTR-IO. DTSBD610 01511 DTSBD610 01512 *S910-COUNT. DTSBD610 01513 *****SET L910-COUNT-88 TO TRUE. DTSBD610 01514 *****GO TO S910-MSTR-IO. DTSBD610 01515 DTSBD610 01516 S910-CLOSE. DTSBD610 01517 SET L910-CLOSE-88 TO TRUE. DTSBD610 01518 GO TO S910-MSTR-IO. DTSBD610 01519 DTSBD610 01520 S910-MSTR-IO. DTSBD610 01521 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD610 01522 MSKL-REC. DTSBD610 01523 S910-EXIT. DTSBD610 01524 EXIT. DTSBD610 01525 SKIP3 DTSBD610 01526 S921-OPEN-READ. DTSBD610 01527 SET L921-OPEN-READ-88 TO TRUE. DTSBD610 01528 GO TO S921-AIX-IO. DTSBD610 01529 DTSBD610 01530 S921-READ. DTSBD610 01531 SET L921-READ-88 TO TRUE. DTSBD610 01532 GO TO S921-AIX-IO. DTSBD610 01533 DTSBD610 01534 S921-START-BROWSE. DTSBD610 01535 SET L921-START-BROWSE-88 TO TRUE. DTSBD610 01536 GO TO S921-AIX-IO. DTSBD610 01537 DTSBD610 01538 S921-READ-NEXT. DTSBD610 01539 SET L921-READ-NEXT-88 TO TRUE. DTSBD610 01540 GO TO S921-AIX-IO. DTSBD610 01541 DTSBD610 01542 S921-CLOSE. DTSBD610 01543 SET L921-CLOSE-88 TO TRUE. DTSBD610 01544 GO TO S921-AIX-IO. DTSBD610 01545 DTSBD610 01546 S921-AIX-IO. DTSBD610 01547 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD610 01548 ISKL-REC. DTSBD610 01549 S921-EXIT. DTSBD610 01550 EXIT. DTSBD610 01551 SKIP3 DTSBD610 01552 S931-OPEN-READ. DTSBD610 01553 SET L931-OPEN-READ-88 TO TRUE. DTSBD610 01554 GO TO S931-REF-IO. DTSBD610 01555 DTSBD610 01556 S931-CLOSE. DTSBD610 01557 SET L931-CLOSE-88 TO TRUE. DTSBD610 01558 GO TO S931-REF-IO. DTSBD610 01559 DTSBD610 01560 S931-REF-IO. DTSBD610 01561 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD610 01562 FSKL-REC. DTSBD610 01563 S931-EXIT. DTSBD610 01564 EXIT. DTSBD610 01565 SKIP3 DTSBD610 01566 S946-WRITE-RSK1. DTSBD610 01567 CALL 'DTSBU946' USING RSK1-REC. DTSBD610 01568 GO TO S946-EXIT. DTSBD610 01569 DTSBD610 01570 S946-WRITE-R704. DTSBD610 01571 CALL 'DTSBU946' USING R704-REC. DTSBD610 01572 GO TO S946-EXIT. DTSBD610 01573 DTSBD610 01574 S946-WRITE-R705. DTSBD610 01575 CALL 'DTSBU946' USING R705-REC. DTSBD610 01576 GO TO S946-EXIT. DTSBD610 01577 DTSBD610 01578 S946-EXIT. DTSBD610 01579 EXIT. DTSBD610 01580 SKIP3 DTSBD610 01581 S999-ABEND. DTSBD610 01582 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD610 01583 S999-EXIT. DTSBD610 01584 EXIT. DTSBD610