1586 lines
125 KiB
COBOL
1586 lines
125 KiB
COBOL
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
|