00001 IDENTIFICATION DIVISION. 12/13/13 00002 PROGRAM-ID. DTSBD551. DTSBD551 00003 AUTHOR. NGC. LV067 00004 DATE-WRITTEN. JUNE 2004. DTSBD551 00005 DATE-COMPILED. DTSBD551 00006 SKIP3 DTSBD551 00007 ***** DTSBD551 00008 * DTSBD551 00009 * DTSBD551 00010 * NOTE: ARCHIVE JCL SET TO DEVL PARMLIB DTSBD551 00011 * DTSBD551 00012 * FUNCTION: PRELIMINARY EDIT FOR EMPLOYER REPORT AND WAGE DTSBD551 00013 * DATA SUBMITTED ELECTRONICALLY OR ON MAGNETIC DTSBD551 00014 * MEDIA. DTSBD551 00015 * DTSBD551 00016 * ICESA FORMAT DTSBD551 00017 * DTSBD551 00018 * MODIFICATION HISTORY: DTSBD551 00019 * DTSBD551 00020 * 12-01-2004 INITIAL DEVELOPMENT DTSBD551 00021 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - DTSBD551 00022 * DTSBD551 00023 * 02-14-2005 MODIFIED P1512 TO USE TOTAL PAYMENT OR, OPTIONALLYDTSBD551 00024 * TOTAL DUE FROM 'T' RECORD FOR REMITTANCE. DTSBD551 00025 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - DTSBD551 00026 * DTSBD551 00027 * 02-20-2005 MODIFIED TO OUTPUT A RETURN-CODE = 4 IF A FATAL DTSBD551 00028 * ERROR HAS BEEN DETECTED DURING ON THE EDITING DTSBD551 00029 * INPUT DATA PROCESSING. ALL THE FATAL ERRORS WILL DTSBD551 00030 * BE REPORTED ON RPT55R1. DTSBD551 00031 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - RLW DTSBD551 00032 * DTSBD551 00033 * 03-17-2005 MODIFIED P1500 TO BYPASS ZERO-WAGE REPORTS WHEN DTSBD551 00034 * THE EMPLOYER IS NOT LIABLE. DTSBD551 00035 * MODIFIED S2030 TO SET W-LIABLE-NO TO TRUE WHEN DTSBD551 00036 * THERE IS NO SUCCESSOR. DTSBD551 00037 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - GD DTSBD551 00038 * DTSBD551 00039 * 06-22-2005 ADDED TEST IN P1311 TO CHECK WHETHER FEIN FROM DTSBD551 00040 * INPUT DATA MATCHES FEIN ON FILE. THIS TEST IS DTSBD551 00041 * PERFORMED ONLY WHEN THE EMPLOYER WAS FOUND USING DTSBD551 00042 * THE ACCOUNT NUMBER ON THE INPUT FILE. IT IS NOT DTSBD551 00043 * PERFORMED WHEN THE EMPLOYER WAS FOUND USING THE DTSBD551 00044 * FEIN, OR WHEN THE EMPLOYER REFERENCED ON THE DTSBD551 00045 * INPUT FILE HAS BEEN SUCCEEDED. DTSBD551 00046 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - GD DTSBD551 00047 * DTSBD551 00048 * 08-15-2005 ADDED I1300 TO EDIT LOG NUMBER, MODIFIED I3000 DTSBD551 00049 * TO DETERMINE FULL LOG NUMBER (INCLUDING YEAR), DTSBD551 00050 * MODIFIED P1320 TO ADD LOG NUMBER TO T027 RECORD. DTSBD551 00051 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - GD DTSBD551 00052 * DTSBD551 00053 * 09-02-2005 ADDED SUBMITTER AND EMP-RPT FILES. THESE ARE DTSBD551 00054 * DOWNLOADED TO SQL SERVER AND USED TO TRACK DTSBD551 00055 * ACCOUNTING BATCHES AND REMITTANCES. DTSBD551 00056 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00057 * DTSBD551 00058 * 11-03-2005 CHANGED FROM DTSBU600 TO DTSBU601 FOR DTSBD551 00059 * FINDING SUCCESSORS. DTSBU601 INCLUDES DTSBD551 00060 * NON-RATING SUCCESSORS. DTSBD551 00061 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00062 * DTSBD551 00063 * 12-19-2005 MOVE PROCESS THAT INCREMENTS ITEM AND BATCH DTSBD551 00064 * NUMBERS BACK TO P1320 FROM P1540. DTSBD551 00065 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00066 * DTSBD551 00067 * 02-03-2006 MODIFIED X210 SUBMITTER RECORD TO INCLUDE DTSBD551 00068 * STARTING AND ENDING BATCH NUMBERS AND RUN DATE DTSBD551 00069 * AND TIME. DTSBD551 00070 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00071 * DTSBD551 00072 * 04-06-2006 MODIFIED P1512A AND P1512B FOR ADMINISTRATIVE DTSBD551 00073 * ASSESSMENT. DTSBD551 00074 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00075 * DTSBD551 00076 * 06-14-2006 MODIFIED P1310 - CHANGED MISSING ADDRESS FROM DTSBD551 00077 * FATAL TO NON-FATAL ERROR. DTSBD551 00078 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00079 * DTSBD551 00080 * 06-14-2006 CORRECTION FOR PAYCHEX: AMOUNTS IN ASSESSMENT DTSBD551 00081 * FIELD DO NOT NEED TO BE ADDED TO THE TOTAL DTSBD551 00082 * PAYMENT. THE ASSESSMENT IS INCLUDED IN THE DTSBD551 00083 * TOTAL PAYMENT. DTSBD551 00084 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00085 * DTSBD551 00086 * 06-14-2006 TEMPORARY CHANGE FOR PAYCHEX: P1620 - REMOVED DTSBD551 00087 * CHECK FOR WORKER COUNTS. DTSBD551 00088 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00089 * DTSBD551 00090 * 06-16-2006 REMOVED ABOVE CHANGE TO P1620. DTSBD551 00091 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00092 * DTSBD551 00093 * 08-03-2006 MODIFIED ACCOUNT NUMBER EDIT IN P1311, S2200: DTSBD551 00094 * IGNORE NON-NUMERIC CHARACTERS (SUCH AS HYPHENS DTSBD551 00095 * OR SPACES). IF 6 NUMERIC DIGITS SUPPLIED, DTSBD551 00096 * ACCEPT ACCOUNT NUMBER. DTSBD551 00097 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00098 * DTSBD551 00099 * 10-16-2006 ADDED EDIT IN S2020 TO CHECK FOR ANNUAL FILERS. DTSBD551 00100 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00101 * DTSBD551 00102 * 11-02-2006 ADDED CHECK TO ELIMINATE COMMAS FROM DTSIX2* DTSBD551 00103 * EXPORT RECORDS. DTSBD551 00104 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00105 * DTSBD551 00106 * 11-02-2006 MODIFIED DTSIX216, ELIMINATING MESSAGE TYPE DTSBD551 00107 * FIELD. DTSBD551 00108 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00109 * DTSBD551 00110 * 02-05-2007 MODIFIED P1420 - THE PARAGRAPH NO LONGER WRITES DTSBD551 00111 * W001 WAGE TRANSACTIONS IF THE SSN = ZERO. DTSBD551 00112 * WAGE RECORDS WITH ZERO IN THE SSN FIELD WERE DTSBD551 00113 * CAUSING PROBLEMS WITH THE BENEFITS WAGE UPDATE. DTSBD551 00114 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00115 * DTSBD551 00116 * 08-07-2007 ADDED TIMELY AND BYPASS ERROR PARMS. DTSBD551 00117 * TIMELY PARM CONTROLS WHETHER SUBMISSION IS TIMELY DTSBD551 00118 * OR LATE. SEE I1400, I1500, I3000, P1110. DTSBD551 00119 * BYPASS ERROR PARM ALLOWS PROGRAM TO IGNORE A DTSBD551 00120 * FATAL ERROR. DTSBD551 00121 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00122 * DTSBD551 00123 * 09-17-2007 ADDED TEST FOR ANNUAL FILER IN P1540. IF EMPLOYER DTSBD551 00124 * IS AN ANNUAL FILER FOR THE QUARTER, SET DTSBD551 00125 * T027-PASSED-FULL-EDITS TO FALSE. DTSBD551 00126 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00127 * DTSBD551 00128 * 11-05-2007 MODIFY TO PROCESS NEW VERSION OF T002 RECORDS DTSBD551 00129 * REFERENCE RFP: AUTHOR OF CHANGE - ZL1 DTSBD551 00130 * DTSBD551 00131 * 01-25-2008 MODIFIED FOR PARTIAL TRANSFERS OF EXPERIENCE. DTSBD551 00132 * NEW VERSION OF DTSBU601 IS USED. DTSBD551 00133 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00134 * DTSBD551 00135 * 09-09-2008 UPDATED P0000 TO CHECK LAST RECORD TYPE AT DTSBD551 00136 * END-OF-FILE. IF LAST REC IS NOT TYPE F, DTSBD551 00137 * THE SUBMISSION IS INCOMPLETE. DTSBD551 00138 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00139 * DTSBD551 00140 * 04-24-2009 MODIFIED FOR DEPOSIT TRANSMITTAL PROCESS. DTSBD551 00141 * REMITTANCE PARM CHANGED TO INCLUDE CENTS. DTSBD551 00142 * WRITE R202 REPORT RECORD TO EXPORT DEPOSIT DTSBD551 00143 * TRANSMITTAL DATA TO MAINFRAME. DTSBD551 00144 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00145 * DTSBD551 00146 * 05-04-2009 MODIFIED P1311 TO BYPASS TEST THAT CHECKS WHETHER DTSBD551 00147 * THE MPRF-FEIN = THE FEIN IN THE E RECORD IF DTSBD551 00148 * NO EMPLOYER IS FOUND. DTSBD551 00149 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00150 * DTSBD551 00151 * 05-15-2009 MODIFIED T1120: DO NOT WRITE R202 RECORD IF DTSBD551 00152 * REMITTANCE = ZERO. DTSBD551 00153 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00154 * DTSBD551 00155 * 05-18-2009 MODIFIED FUTURE QUARTER EDIT IN S2110, S2120. DTSBD551 00156 * REJECT SUBMISSION IF QUARTER >= TO W-CURR-QTR. DTSBD551 00157 * PREVIOUSLY, THE SUBMISSION WAS ONLY REJECTED IF DTSBD551 00158 * THE IF WAS GREATER THAN THE CURRENT QUARTER. DTSBD551 00159 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00160 * DTSBD551 00161 * 08-19-2009 MODIFIED EDIT COMPARING CHECK AMOUNT TO DTSBD551 00162 * CALCULATED AMOUNT DUE. INSTEAD OF CHECKING DTSBD551 00163 * THAT THE INTEGER PARTS OF EACH AMOUNT ARE EQUAL, DTSBD551 00164 * THE NEW EDIT SUBTRACTS THE ACTUAL NUMBERS DTSBD551 00165 * AND TOLERATES A DIFFERENCE OF 0.99 OR LESS. DTSBD551 00166 * P1620. DTSBD551 00167 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00168 * DTSBD551 00169 * 12-08-2009 ADDED AN EDIT TO PREVENT PROCESSING OF THE DTSBD551 00170 * SAME SUBMISSION MORE THAN ONCE DURING THE SAME DTSBD551 00171 * DAY. I4100 ADDED TO READ CURRENT DAY DTSBD551 00172 * SUBMISSIONS INTO A TABLE. P1110 CHECKS THE DTSBD551 00173 * TABLE TO SEE IF THE FEIN IS ALREADY THERE. DTSBD551 00174 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00175 * DTSBD551 00176 * 02-01-2010 REMOVED ABOVE EDIT IN ORDER TO PROCESS DTSBD551 00177 * MULTIPLE SUBMISSIONS FROM THE SAME EMPLOYER FOR DTSBD551 00178 * DIFFERENT EMPLOYERS. DTSBD551 00179 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00180 * DTSBD551 00181 * 04-19-2011 MODIFIED P1540 TO ADD LOG NUMBER TO T027 RECORD. DTSBD551 00182 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00183 * DTSBD551 00184 * 05-24-2011 MODIFIED P1512B TO USE SUM OF TAX DUE AND ADMIN DTSBD551 00185 * ASSESS DUE IF PAYMENT AMOUNT ON T RECORD IS ZERO. DTSBD551 00186 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00187 * DTSBD551 00188 * 06-02-2011 CORRECTED PROBLEM CAUSED BY ABOVE CHANGE. P1540, DTSBD551 00189 * WHICH BUILDS THE T027 TRANSACTION, USES THE DTSBD551 00190 * W-TYPE-T-TAX-DUE FIELD FOR THE REMITTANCE AMOUNT. DTSBD551 00191 * AS A RESULT OF THE CHANGE ON 5/24, THIS FIELD NOW DTSBD551 00192 * CONTAINS ONLY THE UI TAX DUE, NOT THE TOTAL DTSBD551 00193 * PAYMENT. P1540 HAS BEEN CHANGED TO USE DTSBD551 00194 * W-CALC-EMP-REMITTANCE INSTEAD. DTSBD551 00195 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00196 * DTSBD551 00197 * 07-15-2011 MODIFIED TO READ LOG NUMBER AND REMITTANCE AMOUNT DTSBD551 00198 * FROM THE A RECORD. THESE AMOUNTS ARE STORED IN THEDTSBD551 00199 * FILE BY THE WEB APPLICATION. DTSBD551 00200 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00201 * DTSBD551 00202 * 08-03-2011 INCREASED LENGTH OF FIELDS FOR REMITTANCE. DTSBD551 00203 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00204 * DTSBD551 00205 * 02-07-2012 EDITS ON CONTACT INFORMATION IN TYPE A RECORD DTSBD551 00206 * REMOVED. THE CONTACT DATA IS NOW HANDLED IN DTSBD551 00207 * THE ICESA WEB APPLICATION. DTSBD551 00208 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00209 * DTSBD551 00210 * 04-26-2012 UPDATED TO USE DTSIT028 INSTEAD OF DTSIT027. DTSBD551 00211 * THE NEW COPY BOOK INCLUDES CHANGES TO THE SORT DTSBD551 00212 * FIELDS TO ALLOW ICESA SUBMISSIONS TO FALL INTO DTSBD551 00213 * CONSECUTIVE BATCHES. DTSBD551 00214 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00215 * DTSBD551 00216 * 05-07-2012 MODIFIED P1420 TO REMOVE COMMAS FROM NAME FIELDS. DTSBD551 00217 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00218 * DTSBD551 00219 * 06-05-2012 MODIFIED P1420 TO WRITE W001 WAGE TRANSACTIONS DTSBD551 00220 * WHEN THE SSN IS ZERO. THESE WILL BE SAVED TO DTSBD551 00221 * A SEPARATE FILE. DTSBD551 00222 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00223 * DTSBD551 00224 * 08-10-2012 MODIFIED PROCESS IN P1500 THAT BYPASSES ZERO- DTSBD551 00225 * WAGE REPORTS FOR NOT-LIABLE EMPLOYERS. THE CODE DTSBD551 00226 * NOW CHECKS FOR A REMITTANCE FIRST. DTSBD551 00227 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00228 * DTSBD551 00229 * 07-24-2013 MODIFIED S2210 (EDIT EMP NBR FROM TYPE S). DTSBD551 00230 * IF ACCOUNT NBR IS RIGHT JUSTIFIED, READ LAST DTSBD551 00231 * 6 BYTES INSTEAD OF FIRST 6. DTSBD551 00232 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00233 * DTSBD551 00234 * 07-29-2013 MODIFIED P1410-EXIT-TYPE-S: IF TOTAL WAGES = DTSBD551 00235 * ZERO, BYPASS REMAINING EDITS. THE RECORD WILL DTSBD551 00236 * BE SKIPPED IN P1420. DTSBD551 00237 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 00238 * DTSBD551 00239 * 10-25-2013 MODIFIED TO READ A NEW TYPE 1 HEADER RECORD DTSBD551 00240 * THAT WILL CONTAIN LOG NUMBER, RECEIVED DATE DTSBD551 00241 * AND REMITTANCE AMT. DTSBD551 00242 * REFERENCE RFP: AUTHOR OF CHANGE - ZL1 DTSBD551 00243 * DTSBD551 00244 ***** DTSBD551 00245 SKIP3 DTSBD551 00246 ENVIRONMENT DIVISION. DTSBD551 00247 SKIP2 DTSBD551 00248 INPUT-OUTPUT SECTION. DTSBD551 00249 DTSBD551 00250 FILE-CONTROL. DTSBD551 00251 DTSBD551 00252 SELECT ICESA-FILE ASSIGN TO ICESAFIL DTSBD551 00253 FILE STATUS IS ICESA-STATUS. DTSBD551 00254 DTSBD551 00255 *& SELECT RPT-FILE ASSIGN TO DTSFBTCO DTSBD551 00256 *& FILE STATUS IS RPT-STATUS. DTSBD551 00257 DTSBD551 00258 SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSBD551 00259 FILE STATUS IS BATCH-STATUS. DTSBD551 00260 DTSBD551 00261 SELECT UC30-ARCHIVE-DD ASSIGN TO UC30ARCV DTSBD551 00262 FILE STATUS IS ARCHIVE-STATUS. DTSBD551 00263 DTSBD551 00264 SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP DTSBD551 00265 FILE STATUS IS WAGE-TEMP-STATUS. DTSBD551 00266 DTSBD551 00267 SELECT WAGE-FILE-OUT ASSIGN TO WAGEOUT DTSBD551 00268 FILE STATUS IS WAGE-OUT-STATUS. DTSBD551 00269 DTSBD551 00270 SELECT SUBMITTER-FILE ASSIGN TO DTSBX210 DTSBD551 00271 FILE STATUS IS SUBMITTER-STATUS. DTSBD551 00272 DTSBD551 00273 SELECT EMP-RPT-FILE ASSIGN TO DTSBX212 DTSBD551 00274 FILE STATUS IS EMP-RPT-STATUS. DTSBD551 00275 DTSBD551 00276 SELECT MESSAGE-FILE ASSIGN TO DTSBX216 DTSBD551 00277 FILE STATUS IS MSG-STATUS. DTSBD551 00278 DTSBD551 00279 SELECT SUBMITTER-GDG ASSIGN TO CURBX210 DTSBD551 00280 FILE STATUS IS CURBX210-STATUS. DTSBD551 00281 DTSBD551 00282 DATA DIVISION. DTSBD551 00283 DTSBD551 00284 FILE SECTION. DTSBD551 00285 DTSBD551 00286 FD ICESA-FILE DTSBD551 00287 RECORDING MODE IS F DTSBD551 00288 BLOCK CONTAINS 0 RECORDS DTSBD551 00289 LABEL RECORDS ARE OMITTED. DTSBD551 00290 DTSBD551 00291 01 ICESA-REC. DTSBD551 00292 05 ICESA-REC-TYPE PIC X(01). DTSBD551 00293 88 ICESA-REC-TYPE-1-88 VALUE '1'. DTSBD551 00294 88 ICESA-REC-TYPE-A-88 VALUE 'A'. DTSBD551 00295 88 ICESA-REC-TYPE-B-88 VALUE 'B'. DTSBD551 00296 88 ICESA-REC-TYPE-E-88 VALUE 'E'. DTSBD551 00297 88 ICESA-REC-TYPE-F-88 VALUE 'F'. DTSBD551 00298 88 ICESA-REC-TYPE-S-88 VALUE 'S'. DTSBD551 00299 88 ICESA-REC-TYPE-T-88 VALUE 'T'. DTSBD551 00300 05 ICESA-FILLER PIC X(274). DTSBD551 00301 *** 05 ICESA-FILLER PIC X(275). DTSBD551 00302 DTSBD551 00303 FD CURR-BATCH-NO DTSBD551 00304 RECORDING MODE IS F DTSBD551 00305 BLOCK CONTAINS 0 RECORDS DTSBD551 00306 LABEL RECORDS ARE OMITTED. DTSBD551 00307 DTSBD551 00308 01 CURR-BATCH-NO-REC. DTSBD551 00309 05 CURRENT-BATCH-NO PIC 9(05). DTSBD551 00310 05 CURRENT-ITEM-NO PIC 9(03). DTSBD551 00311 05 FILLER PIC X(01). DTSBD551 00312 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSBD551 00313 05 FILLER PIC X(01). DTSBD551 00314 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSBD551 00315 05 FILLER PIC X(62). DTSBD551 00316 DTSBD551 00317 *FD RPT-FILE DTSBD551 00318 * RECORDING MODE IS V DTSBD551 00319 * BLOCK CONTAINS 0 RECORDS. DTSBD551 00320 * DTSBD551 00321 *01 RPT-REC. DTSBD551 00322 ***INCLUDE DTSIRVAR DTSBD551 00323 DTSBD551 00324 *01 RSK1-REC. DTSBD551 00325 ***INCLUDE DTSIRSK1 DTSBD551 00326 DTSBD551 00327 FD UC30-ARCHIVE-DD DTSBD551 00328 RECORDING MODE IS F DTSBD551 00329 BLOCK CONTAINS 0 RECORDS DTSBD551 00330 LABEL RECORDS ARE OMITTED. DTSBD551 00331 DTSBD551 00332 01 UC30-ARCHIVE-DD-REC PIC X(80). DTSBD551 00333 DTSBD551 00334 FD WAGE-FILE-TEMP DTSBD551 00335 RECORDING MODE IS F DTSBD551 00336 BLOCK CONTAINS 0 RECORDS DTSBD551 00337 LABEL RECORDS ARE OMITTED. DTSBD551 00338 DTSBD551 00339 01 WAGE-TEMP-REC PIC X(128). DTSBD551 00340 DTSBD551 00341 FD WAGE-FILE-OUT DTSBD551 00342 RECORDING MODE IS F DTSBD551 00343 BLOCK CONTAINS 0 RECORDS DTSBD551 00344 LABEL RECORDS ARE OMITTED. DTSBD551 00345 DTSBD551 00346 01 WAGE-OUT-REC PIC X(128). DTSBD551 00347 DTSBD551 00348 FD SUBMITTER-FILE DTSBD551 00349 RECORDING MODE IS F DTSBD551 00350 BLOCK CONTAINS 0 RECORDS DTSBD551 00351 LABEL RECORDS ARE OMITTED. DTSBD551 00352 DTSBD551 00353 01 SUBMITTER-REC PIC X(231). DTSBD551 00354 DTSBD551 00355 FD EMP-RPT-FILE DTSBD551 00356 RECORDING MODE IS F DTSBD551 00357 BLOCK CONTAINS 0 RECORDS DTSBD551 00358 LABEL RECORDS ARE OMITTED. DTSBD551 00359 DTSBD551 00360 01 EMP-RPT-REC PIC X(106). DTSBD551 00361 DTSBD551 00362 FD MESSAGE-FILE DTSBD551 00363 RECORDING MODE IS F DTSBD551 00364 BLOCK CONTAINS 0 RECORDS DTSBD551 00365 LABEL RECORDS ARE OMITTED. DTSBD551 00366 DTSBD551 00367 01 MESSAGE-REC PIC X(318). DTSBD551 00368 DTSBD551 00369 FD SUBMITTER-GDG DTSBD551 00370 RECORDING MODE IS F DTSBD551 00371 BLOCK CONTAINS 0 RECORDS DTSBD551 00372 LABEL RECORDS ARE OMITTED. DTSBD551 00373 DTSBD551 00374 01 SUBMITTER-GDG-REC PIC X(231). DTSBD551 00375 DTSBD551 00376 WORKING-STORAGE SECTION. DTSBD551 003765 77 PAN-VALET PICTURE X(24) VALUE '067DTSBD551 12/13/13'. DTSBD551 00377 77 PAN-VALET PICTURE X(24) VALUE '002DTSBD551 12/13/13'. DTSBD551 00378 77 PAN-VALET PICTURE X(24) VALUE '065DTSBD551 12/11/13'. DTSBD551 00379 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD551 12/11/13'. DTSBD551 00380 77 PAN-VALET PICTURE X(24) VALUE '063DTSBD551 12/06/13'. DTSBD551 00381 77 PAN-VALET PICTURE X(24) VALUE '039DTSBD551 12/05/13'. DTSBD551 00382 01 WRK-AREA. DTSBD551 00383 05 W-ABEND-CD PIC S9(04) COMP VALUE +551.DTSBD551 00384 05 W-MOD-NAME PIC X(08) VALUE 'DTSBD551'.DTSBD551 00385 * 05 W-PARM-LOG-NO-AREA. DTSBD551 00386 * 10 W-LOG-YEAR PIC 9(04). DTSBD551 00387 * 10 W-PARM-LOG-NO PIC 9(06). DTSBD551 00388 * 05 W-LOG-NO REDEFINES W-PARM-LOG-NO-AREA DTSBD551 00389 * PIC 9(10). DTSBD551 00390 DTSBD551 00391 05 W-PARM-TIMELY-IND PIC X(01). DTSBD551 00392 88 W-PARM-TIMELY-YES-88 VALUE 'Y'. DTSBD551 00393 88 W-PARM-TIMELY-NO-88 VALUE 'N'. DTSBD551 00394 DTSBD551 00395 DTSBD551 00396 05 W-PARM-BYPASS-ERR-IND PIC X(01). DTSBD551 00397 88 W-PARM-BYPASS-ERR-YES-88 VALUE 'Y'. DTSBD551 00398 88 W-PARM-BYPASS-ERR-NO-88 VALUE 'N'. DTSBD551 00399 DTSBD551 00400 05 W-PARM-ALLOW-DUP-IND PIC X(01). DTSBD551 00401 88 W-PARM-ALLOW-DUP-YES-88 VALUE 'Y'. DTSBD551 00402 88 W-PARM-ALLOW-DUP-NO-88 VALUE 'N'. DTSBD551 00403 DTSBD551 00404 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBD551 00405 DTSBD551 00406 05 W-PARM-LOG-NO PIC 9(06). DTSBD551 00407 05 W-PARM-RECEIVED-DATE PIC S9(09) COMP-3. DTSBD551 00408 05 W-PARM-REMIT-AREA. DTSBD551 00409 10 W-PARM-REMIT-9 PIC 9(13). DTSBD551 00410 10 W-PARM-REMIT-X REDEFINES W-PARM-REMIT-9. DTSBD551 00411 15 W-PARM-REMIT-DOLLARS PIC 9(11). DTSBD551 00412 15 W-PARM-REMIT-CENTS PIC 9(02). DTSBD551 00413 10 W-PARM-REMIT-DECIMAL REDEFINES W-PARM-REMIT-9 DTSBD551 00414 PIC 9(11)V99. DTSBD551 00415 DTSBD551 00416 05 W-LOG-NO PIC S9(06) COMP-3. DTSBD551 00417 05 W-LOG-NO-9 PIC 9(06). DTSBD551 00418 05 W-LOG-NO-X REDEFINES W-LOG-NO-9 DTSBD551 00419 PIC X(06). DTSBD551 00420 DTSBD551 00421 ** 05 W-PARM-TOT-REMITTANCE PIC S9(09) COMP-3. DTSBD551 00422 05 W-PARM-DEPOSIT-REMIT PIC S9(11)V99 COMP-3. DTSBD551 00423 DTSBD551 00424 05 W-CALC-EMP-REMITTANCE PIC S9(09)V99 COMP-3 DTSBD551 00425 VALUE +0. DTSBD551 00426 05 W-CALC-TOT-REMITTANCE PIC S9(09)V99 COMP-3 DTSBD551 00427 VALUE +0. DTSBD551 00428 ** 05 W-CALC-TOT-REMITTANCE-INT PIC S9(09) COMP-3 DTSBD551 00429 ** VALUE +0. DTSBD551 00430 05 W-DIFF PIC S9(09)V99 COMP-3 DTSBD551 00431 VALUE +0. DTSBD551 00432 05 DISP-CALC-TOT-REMITTANCE PIC $$,$$$,$$$,$$9.99. DTSBD551 00433 DTSBD551 00434 05 W-DEFAULT-RCVD-DT PIC S9(09) COMP-3. DTSBD551 00435 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBD551 00436 DTSBD551 00437 05 W-PREV-REC-TYPE PIC X(01) VALUE SPACE. DTSBD551 00438 88 W-PREV-REC-TYPE-1-88 VALUE '1'. DTSBD551 00439 88 W-PREV-REC-TYPE-A-88 VALUE 'A'. DTSBD551 00440 88 W-PREV-REC-TYPE-B-88 VALUE 'B'. DTSBD551 00441 88 W-PREV-REC-TYPE-E-88 VALUE 'E'. DTSBD551 00442 88 W-PREV-REC-TYPE-S-88 VALUE 'S'. DTSBD551 00443 88 W-PREV-REC-TYPE-T-88 VALUE 'T'. DTSBD551 00444 88 W-PREV-REC-TYPE-F-88 VALUE 'F'. DTSBD551 00445 88 W-PREV-REC-TYPE-NULL-88 VALUE SPACE. DTSBD551 00446 DTSBD551 00447 05 SUB3 PIC S9(04) COMP. DTSBD551 00448 05 SB-MAX PIC S9(04) COMP VALUE +200. DTSBD551 00449 05 SB-LAST PIC S9(04) COMP VALUE +0. DTSBD551 00450 05 W-SB-FEIN OCCURS 200 TIMES DTSBD551 00451 PIC S9(09) COMP-3. DTSBD551 00452 DTSBD551 00453 *& 05 ZW-SUB PIC S9(07) COMP-3. DTSBD551 00454 * 05 ZW-MAX PIC S9(07) COMP-3 DTSBD551 00455 * VALUE +999999. DTSBD551 00456 * 05 ZERO-WAGE-RPTS OCCURS 999999 TIMES. DTSBD551 00457 * 10 ZERO-WAGE-IND PIC X(01). DTSBD551 00458 * 88 ZW-ZERO-WAGE-YES-88 VALUE 'Y'. DTSBD551 00459 *& 88 ZW-ZERO-WAGE-NO-88 VALUE 'N'. DTSBD551 00460 DTSBD551 00461 05 ICESA-STATUS PIC X(02). DTSBD551 00462 88 ICESA-STATUS-OK-88 VALUE '00'. DTSBD551 00463 88 ICESA-STATUS-EOF-88 VALUE '10'. DTSBD551 00464 DTSBD551 00465 05 BATCH-STATUS PIC X(02). DTSBD551 00466 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBD551 00467 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBD551 00468 DTSBD551 00469 05 RPT-STATUS PIC X(02). DTSBD551 00470 88 RPT-STATUS-OK-88 VALUE '00'. DTSBD551 00471 88 RPT-STATUS-EOF-88 VALUE '10'. DTSBD551 00472 DTSBD551 00473 05 ARCHIVE-STATUS PIC X(02). DTSBD551 00474 88 ARCHIVE-STATUS-OK-88 VALUE '00'. DTSBD551 00475 DTSBD551 00476 05 SUBMITTER-STATUS PIC X(02). DTSBD551 00477 88 SUBMITTER-STATUS-OK-88 VALUE '00'. DTSBD551 00478 DTSBD551 00479 05 CURBX210-STATUS PIC X(02). DTSBD551 00480 88 CURBX210-STATUS-OK-88 VALUE '00'. DTSBD551 00481 88 CURBX210-STATUS-EOF-88 VALUE '10'. DTSBD551 00482 DTSBD551 00483 05 EMP-RPT-STATUS PIC X(02). DTSBD551 00484 88 EMP-RPT-STATUS-OK-88 VALUE '00'. DTSBD551 00485 88 EMP-RPT-STATUS-EOF-88 VALUE '10'. DTSBD551 00486 DTSBD551 00487 05 MSG-STATUS PIC X(02). DTSBD551 00488 88 MSG-STATUS-OK-88 VALUE '00'. DTSBD551 00489 DTSBD551 00490 05 WAGE-TEMP-STATUS PIC X(02). DTSBD551 00491 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBD551 00492 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBD551 00493 DTSBD551 00494 05 WAGE-OUT-STATUS PIC X(02). DTSBD551 00495 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBD551 00496 DTSBD551 00497 05 WAGE-TEMP-OPEN-IND PIC X(01) VALUE 'C'. DTSBD551 00498 88 WAGE-TEMP-OPEN-88 VALUE 'O'. DTSBD551 00499 88 WAGE-TEMP-CLOSED-88 VALUE 'C'. DTSBD551 00500 DTSBD551 00501 05 WAGE-TEMP-REQUEST-IND PIC X(02) VALUE SPACE. DTSBD551 00502 88 WAGE-TEMP-REQ-OPEN-INP-88 VALUE 'OI'. DTSBD551 00503 88 WAGE-TEMP-REQ-OPEN-OUT-88 VALUE 'OP'. DTSBD551 00504 88 WAGE-TEMP-REQ-CLOSE-88 VALUE 'CL'. DTSBD551 00505 88 WAGE-TEMP-REQ-WRITE-88 VALUE 'WR'. DTSBD551 00506 88 WAGE-TEMP-REQ-NULL-88 VALUE SPACES. DTSBD551 00507 DTSBD551 00508 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBD551 00509 88 W-ERROR-YES-88 VALUE 'Y'. DTSBD551 00510 88 W-ERROR-NO-88 VALUE 'N'. DTSBD551 00511 DTSBD551 00512 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBD551 00513 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBD551 00514 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBD551 00515 DTSBD551 00516 05 W-LIABLE-IND PIC X(01) VALUE 'N'. DTSBD551 00517 88 W-LIABLE-YES-88 VALUE 'Y'. DTSBD551 00518 88 W-LIABLE-NO-88 VALUE 'N'. DTSBD551 00519 DTSBD551 00520 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBD551 00521 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBD551 00522 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBD551 00523 DTSBD551 00524 05 W-DUP-RPT-IND PIC X(01) VALUE 'N'. DTSBD551 00525 88 W-DUP-RPT-YES-88 VALUE 'Y'. DTSBD551 00526 88 W-DUP-RPT-NO-88 VALUE 'N'. DTSBD551 00527 DTSBD551 00528 05 W-ANNUAL-QTR-IND PIC X(01) VALUE 'N'. DTSBD551 00529 88 W-ANNUAL-QTR-YES-88 VALUE 'Y'. DTSBD551 00530 88 W-ANNUAL-QTR-NO-88 VALUE 'N'. DTSBD551 00531 DTSBD551 00532 05 W-MOPO-FOUND-IND PIC X(01) VALUE 'N'. DTSBD551 00533 88 W-MOPO-FOUND-YES-88 VALUE 'Y'. DTSBD551 00534 88 W-MOPO-FOUND-NO-88 VALUE 'N'. DTSBD551 00535 DTSBD551 00536 ** 05 W-SUCCESSOR-FOUND-IND PIC X(01) VALUE 'N'. DTSBD551 00537 * 88 W-SUCCESSOR-YES-88 VALUE 'Y'. DTSBD551 00538 ** 88 W-SUCCESSOR-NO-88 VALUE 'N'. DTSBD551 00539 DTSBD551 00540 05 W-SUBMITTER-DATA-AREA. DTSBD551 00541 10 W-SUBM-FEIN PIC 9(09). DTSBD551 00542 10 W-SUBM-NAME PIC X(50). DTSBD551 00543 10 W-SUBM-STREET PIC X(40). DTSBD551 00544 10 W-SUBM-CITY PIC X(25). DTSBD551 00545 10 W-SUBM-STATE PIC X(02). DTSBD551 00546 10 W-SUBM-ZIP PIC X(05). DTSBD551 00547 10 W-SUBM-ZIP-EXT PIC X(05). DTSBD551 00548 10 FILLER REDEFINES W-SUBM-ZIP-EXT. DTSBD551 00549 15 FILLER PIC X(01). DTSBD551 00550 15 W-SUBM-ZIP-EXT4 PIC X(04). DTSBD551 00551 10 W-SUBM-CONTACT-NAME PIC X(30). DTSBD551 00552 10 W-SUBM-CONTACT-PHONE-AREA. DTSBD551 00553 15 W-SUBM-CONTACT-PHONE PIC X(10). DTSBD551 00554 15 W-SUBM-CONTACT-PHONE-EXT PIC X(04). DTSBD551 00555 10 W-SUBM-REMIT-AMT-X PIC X(13). DTSBD551 00556 10 W-SUBM-REMIT-AMT-9 REDEFINES DTSBD551 00557 W-SUBM-REMIT-AMT-X PIC 9(10).99. DTSBD551 00558 10 W-SUBM-CREATE-DATE PIC 9(08). DTSBD551 00559 10 FILLER REDEFINES W-SUBM-CREATE-DATE. DTSBD551 00560 15 W-SUBM-CREATE-CCYY PIC 9(04). DTSBD551 00561 15 FILLER PIC X(04). DTSBD551 00562 DTSBD551 00563 05 W-WAGES-EXPECTED-IND PIC 9(01). DTSBD551 00564 88 W-WAGES-EXPECTED-YES-88 VALUE 1. DTSBD551 00565 88 W-WAGES-EXPECTED-NO-88 VALUE 0. DTSBD551 00566 DTSBD551 00567 05 W-ACCT-NBR-ERR-IND PIC X(01) VALUE 'N'. DTSBD551 00568 88 W-ACCT-NBR-ERR-YES-88 VALUE 'Y'. DTSBD551 00569 88 W-ACCT-NBR-ERR-NO-88 VALUE 'N'. DTSBD551 00570 DTSBD551 00571 05 W-SSN-ERR-IND PIC X(01) VALUE '0'. DTSBD551 00572 88 W-SSN-ERR-YES-88 VALUE '1'. DTSBD551 00573 88 W-SSN-ERR-NO-88 VALUE '0'. DTSBD551 00574 88 W-SSN-MISSING-88 VALUE '2'. DTSBD551 00575 DTSBD551 00576 05 W-INTEGER PIC S9(11) COMP-3. DTSBD551 00577 05 W-FRACTION PIC SV9(11) COMP-3. DTSBD551 00578 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSBD551 00579 DTSBD551 00580 05 SUB1 PIC S9(04) COMP. DTSBD551 00581 05 SUB1-INIT PIC S9(04) COMP VALUE +1. DTSBD551 00582 05 SUB2 PIC S9(04) COMP. DTSBD551 00583 05 W-ACCT-NBR-LEN PIC S9(04) COMP VALUE +6. DTSBD551 00584 05 W-ACCT-NBR-IN. DTSBD551 00585 10 W-ACCT-NBR-IN-X OCCURS 15 TIMES DTSBD551 00586 PIC X(01). DTSBD551 00587 05 FILLER REDEFINES W-ACCT-NBR-IN. DTSBD551 00588 10 W-ACCT-NBR-1-6 PIC X(06). DTSBD551 00589 88 FIRST-6-ALL-ZERO-88 VALUE '000000'. DTSBD551 00590 10 FILLER PIC X(09). DTSBD551 00591 DTSBD551 00592 05 W-ACCT-NBR-OUT. DTSBD551 00593 10 W-ACCT-NBR-OUT-X OCCURS 6 TIMES DTSBD551 00594 PIC X(01). DTSBD551 00595 05 W-ACCT-NBR-9 REDEFINES W-ACCT-NBR-OUT DTSBD551 00596 PIC 9(06). DTSBD551 00597 DTSBD551 00598 05 W-EDITED-E-ACCT PIC 9(06). DTSBD551 00599 05 W-EDITED-S-ACCT PIC 9(06). DTSBD551 00600 DTSBD551 00601 05 W-SSN-LEN PIC S9(04) COMP VALUE +9. DTSBD551 00602 05 W-SSN-IN. DTSBD551 00603 10 W-SSN-IN-X OCCURS 9 TIMES DTSBD551 00604 PIC X(01). DTSBD551 00605 05 W-SSN-OUT. DTSBD551 00606 10 W-SSN-OUT-X OCCURS 9 TIMES DTSBD551 00607 PIC X(01). DTSBD551 00608 05 W-SSN-OUT-9 REDEFINES W-SSN-OUT DTSBD551 00609 PIC 9(09). DTSBD551 00610 DTSBD551 00611 05 W-EMP-NO PIC S9(07) COMP-3 DTSBD551 00612 VALUE +0. DTSBD551 00613 05 W-FEIN-EMP-NO PIC S9(07) COMP-3 DTSBD551 00614 VALUE +0. DTSBD551 00615 05 W-FINAL-FEIN PIC S9(09) COMP-3 DTSBD551 00616 VALUE +0. DTSBD551 00617 05 W-PRED-NO PIC S9(07) COMP-3 DTSBD551 00618 VALUE +0. DTSBD551 00619 05 W-EMP-NAME PIC X(40). DTSBD551 00620 DTSBD551 00621 05 W-DIFFERENCE PIC S9(07) COMP-3. DTSBD551 00622 DTSBD551 00623 05 W-REPORT-MM-X PIC X(02). DTSBD551 00624 05 W-REPORT-MM-9 REDEFINES W-REPORT-MM-X DTSBD551 00625 PIC 9(02). DTSBD551 00626 05 W-REPORT-CCYY. DTSBD551 00627 10 W-REPORT-CC PIC X(02). DTSBD551 00628 10 W-REPORT-YY PIC X(02). DTSBD551 00629 05 W-REPORT-CCYY-9 REDEFINES W-REPORT-CCYY DTSBD551 00630 PIC 9(04). DTSBD551 00631 05 W-ZIP-AREA. DTSBD551 00632 10 W-ZIP5 PIC X(05). DTSBD551 00633 10 W-ZIP-DASH PIC X(01) VALUE '-'. DTSBD551 00634 10 W-ZIP-PLUS4 PIC X(04). DTSBD551 00635 05 W-ZIP REDEFINES W-ZIP-AREA DTSBD551 00636 PIC X(10). DTSBD551 00637 DTSBD551 00638 05 W-EARLIEST-QTR PIC 9(05) VALUE ZERO. DTSBD551 00639 05 W-CURR-QTR PIC 9(05) VALUE ZERO. DTSBD551 00640 05 W-RPT-QTR PIC 9(05) VALUE ZERO. DTSBD551 00641 05 W-RPT-DATE PIC 9(08) VALUE ZERO. DTSBD551 00642 05 W-CURR-DATE PIC 9(08) VALUE ZERO. DTSBD551 00643 DTSBD551 00644 05 W-L001-JUL-DATE PIC 9(7) VALUE ZERO. DTSBD551 00645 05 FILLER REDEFINES W-L001-JUL-DATE. DTSBD551 00646 10 W-JULIAN-YR PIC 9(4). DTSBD551 00647 10 W-JULIAN-DAYS PIC 9(3). DTSBD551 00648 DTSBD551 00649 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBD551 00650 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBD551 00651 10 W-PSEUDO-DAYS PIC 9(03). DTSBD551 00652 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBD551 00653 DTSBD551 00654 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBD551 00655 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBD551 00656 DTSBD551 00657 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBD551 00658 DTSBD551 00659 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBD551 00660 DTSBD551 00661 05 W-TYPE-S-TOT-WAGE PIC 9(12)V99. DTSBD551 00662 05 W-TYPE-S-TAX-WAGE PIC 9(12)V99. DTSBD551 00663 05 W-TYPE-T-TOT-WAGE PIC 9(12)V99. DTSBD551 00664 05 W-TYPE-T-TAX-WAGE PIC 9(12)V99. DTSBD551 00665 05 W-TYPE-F-TOT-WAGE PIC S9(13)V99 COMP-3 VALUE +0. DTSBD551 00666 05 W-EMP-TOT-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBD551 00667 05 W-EMP-TAX-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBD551 00668 05 W-TYPE-T-RATE-X PIC X(06). DTSBD551 00669 05 FILLER REDEFINES W-TYPE-T-RATE-X. DTSBD551 00670 10 FILLER PIC X(01). DTSBD551 00671 10 W-TYPE-T-RATE-9 PIC 9(05). DTSBD551 00672 05 W-EMP-TAX-RATE PIC 9V9(05). DTSBD551 00673 05 W-UI-RATE PIC S9(01)V9(04) COMP-3. DTSBD551 00674 05 W-TYPE-T-TAX-DUE PIC 9(11)V99. DTSBD551 00675 05 W-TYPE-T-PMT-DUE PIC 9(11)V99. DTSBD551 00676 05 W-TYPE-T-TOT-WORKER PIC 9(07). DTSBD551 00677 05 W-TYPE-F-TOT-WORKER PIC 9(09). DTSBD551 00678 05 W-TYPE-F-TOT-EMP PIC 9(09). DTSBD551 00679 05 W-TYPE-T-ASSESS-X PIC X(11). DTSBD551 00680 05 W-TYPE-T-ASSESS REDEFINES W-TYPE-T-ASSESS-X DTSBD551 00681 PIC 9(09)V99. DTSBD551 00682 05 W-AMT-DISP1 PIC --,---,---,--9.99. DTSBD551 00683 05 W-AMT-DISP2 PIC --,---,---,--9.99. DTSBD551 00684 05 W-AMT-DISP3 PIC --,---,---,--9.99. DTSBD551 00685 DTSBD551 00686 05 W-MNTE-WORK-AREA. DTSBD551 00687 10 W-MNTE-STARTED-IND PIC X(01). DTSBD551 00688 88 W-MNTE-STARTED-YES-88 VALUE 'Y'. DTSBD551 00689 88 W-MNTE-STARTED-NO-88 VALUE 'N'. DTSBD551 00690 10 W-MNTE-SUBJECT-ACCT PIC X(40) VALUE DTSBD551 00691 'MAG UC30 ACCOUNT NUMBER CHANGE '. DTSBD551 00692 10 W-MNTE-SUBJECT-SSN PIC X(40) VALUE DTSBD551 00693 'MAG UC30 BAD OR MISSING SSN '. DTSBD551 00694 10 W-MNTE-SUBJECT-BOTH PIC X(40) VALUE DTSBD551 00695 'MAG UC30 ACCT NBR CHNG/MISSING SSN '. DTSBD551 00696 10 W-MNTE-TEXT-CNT PIC S9(04) COMP VALUE +0. DTSBD551 00697 10 W-MNTE-TEXT-MAX PIC S9(04) COMP VALUE +16. DTSBD551 00698 10 W-MNTE-TEXT-AREA. DTSBD551 00699 15 W-MNTE-TEXT OCCURS 16 TIMES DTSBD551 00700 PIC X(72). DTSBD551 00701 DTSBD551 00702 05 W-ARCHIVE-CURR-YEAR PIC 9(04). DTSBD551 00703 05 W-ARCHIVE-FIRST-YEAR PIC 9(04). DTSBD551 00704 05 W-ARCHIVE-JOB-STATMENTS. DTSBD551 00705 DTSBD551 00706 10 DD-LINE-1-JOB. DTSBD551 00707 15 FILLER PIC X(40) VALUE DTSBD551 00708 '//BCGB551 JOB (UI,4300,3400,T),UC30ARX,'. DTSBD551 00709 15 FILLER PIC X(40) VALUE SPACES.DTSBD551 00710 10 DD-LINE-2-JOB. DTSBD551 00711 15 FILLER PIC X(30) VALUE DTSBD551 00712 '// CLASS=S,MSGCLASS=X,'. DTSBD551 00713 15 FILLER PIC X(50) VALUE SPACES.DTSBD551 00714 10 DD-LINE-3-JOB. DTSBD551 00715 15 FILLER PIC X(34) VALUE DTSBD551 00716 '// NOTIFY=DCGGAB,REGION=0M'. DTSBD551 00717 15 FILLER PIC X(45) VALUE SPACES.DTSBD551 00718 10 DD-LINE-3A-JOB. DTSBD551 00719 15 FILLER PIC X(03) VALUE DTSBD551 00720 '//*'. DTSBD551 00721 15 FILLER PIC X(77) VALUE SPACES.DTSBD551 00722 10 DD-LINE-3B-JOB. DTSBD551 00723 15 FILLER PIC X(03) VALUE DTSBD551 00724 '//*'. DTSBD551 00725 15 FILLER PIC X(77) VALUE SPACES.DTSBD551 00726 10 DD-LINE-3C-JOB. DTSBD551 00727 15 FILLER PIC X(50) VALUE DTSBD551 00728 '//* THIS JOB ARCHIVES ICESA CONTRIB/WAGE FILES '.DTSBD551 00729 15 FILLER PIC X(28) VALUE SPACES.DTSBD551 00730 10 DD-LINE-3D-JOB. DTSBD551 00731 15 FILLER PIC X(47) VALUE DTSBD551 00732 '//* THE INTERNAL FILE CREATION DATE DETERMINES'. DTSBD551 00733 15 FILLER PIC X(33) VALUE SPACES.DTSBD551 00734 10 DD-LINE-3E-JOB. DTSBD551 00735 15 FILLER PIC X(47) VALUE DTSBD551 00736 '//* THE OUTPUT FILE CREATION YEAR (MOD OR NEW)'. DTSBD551 00737 15 FILLER PIC X(33) VALUE SPACES.DTSBD551 00738 10 DD-LINE-3F-JOB. DTSBD551 00739 15 FILLER PIC X(03) VALUE DTSBD551 00740 '//*'. DTSBD551 00741 15 FILLER PIC X(77) VALUE SPACES.DTSBD551 00742 10 DD-LINE-3G-JOB. DTSBD551 00743 15 FILLER PIC X(03) VALUE DTSBD551 00744 '//*'. DTSBD551 00745 15 FILLER PIC X(77) VALUE SPACES.DTSBD551 00746 10 DD-LINE-4-JOB. DTSBD551 00747 15 FILLER PIC X(39) VALUE DTSBD551 00748 '//STEP100 EXEC PGM=IDCAMS,COND=(0,LT)'. DTSBD551 00749 15 FILLER PIC X(41) VALUE SPACES.DTSBD551 00750 10 DD-LINE-5-JOB. DTSBD551 00751 15 FILLER PIC X(29) VALUE DTSBD551 00752 '//SYSPRINT DD SYSOUT=*'. DTSBD551 00753 15 FILLER PIC X(51) VALUE SPACES.DTSBD551 00754 10 DD-LINE-6-JOB. DTSBD551 00755 15 FILLER PIC X(45) VALUE DTSBD551 00756 '//INDD01 DD DSN=DOESTAX.CONV.ICESA.UPLOAD,'. DTSBD551 00757 15 FILLER PIC X(35) VALUE SPACES.DTSBD551 00758 10 DD-LINE-7-JOB. DTSBD551 00759 15 FILLER PIC X(23) VALUE DTSBD551 00760 '// DISP=SHR'. DTSBD551 00761 15 FILLER PIC X(57) VALUE SPACES.DTSBD551 00762 10 DD-LINE-8-JOB. DTSBD551 00763 15 FILLER PIC X(49) VALUE DTSBD551 00764 '//SYSIN DD DSN=DOESTAX.DEVL.PARMLIB(DTSRONE),'. DTSBD551 00765 15 FILLER PIC X(31) VALUE SPACES.DTSBD551 00766 10 DD-LINE-9-JOB. DTSBD551 00767 15 FILLER PIC X(23) VALUE DTSBD551 00768 '// DISP=SHR'. DTSBD551 00769 15 FILLER PIC X(57) VALUE SPACES.DTSBD551 00770 10 DD-LINE-10-JOB. DTSBD551 00771 15 FILLER PIC X(05) VALUE DTSBD551 00772 '/*EOF'. DTSBD551 00773 15 FILLER PIC X(75) VALUE SPACES.DTSBD551 00774 10 DD-LINE-11-JOB. DTSBD551 00775 15 FILLER PIC X(02) VALUE DTSBD551 00776 '/*'. DTSBD551 00777 15 FILLER PIC X(78) VALUE SPACES.DTSBD551 00778 10 DD-LINE-12-JOB. DTSBD551 00779 15 FILLER PIC X(02) VALUE DTSBD551 00780 '//'. DTSBD551 00781 15 FILLER PIC X(78) VALUE SPACES.DTSBD551 00782 05 W-ARCHIVE-OLD-DD-STATEMENT. DTSBD551 00783 DTSBD551 00784 10 DD-LINE-1-OLD. DTSBD551 00785 15 FILLER PIC X(48) VALUE DTSBD551 00786 '//OUTDD01 DD DSN=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 00787 15 W-ARCHIVE-OLD-YEAR PIC X(04). DTSBD551 00788 15 FILLER PIC X(01) VALUE ','. DTSBD551 00789 15 FILLER PIC X(27) VALUE SPACES.DTSBD551 00790 10 DD-LINE-2-OLD. DTSBD551 00791 15 FILLER PIC X(24) VALUE DTSBD551 00792 '// UNIT=CART'. DTSBD551 00793 15 FILLER PIC X(01) VALUE ','. DTSBD551 00794 15 FILLER PIC X(54) VALUE SPACES.DTSBD551 00795 10 DD-LINE-3-OLD. DTSBD551 00796 15 FILLER PIC X(33) VALUE DTSBD551 00797 '// SPACE=(CYL,(5,5)),'. DTSBD551 00798 15 FILLER PIC X(47) VALUE SPACES.DTSBD551 00799 10 DD-LINE-4-OLD. DTSBD551 00800 15 FILLER PIC X(35) VALUE DTSBD551 00801 '// DISP=(MOD,KEEP,KEEP)'. DTSBD551 00802 15 FILLER PIC X(45) VALUE SPACES.DTSBD551 00803 DTSBD551 00804 05 W-ARCHIVE-UNCATLG-DD-STATEMENT. DTSBD551 00805 DTSBD551 00806 10 DD-LINE-1-UNCATLG. DTSBD551 00807 15 FILLER PIC X(27) VALUE DTSBD551 00808 '//UNCATLG EXEC PGM=IEHPROGM'. DTSBD551 00809 15 FILLER PIC X(53) VALUE SPACES.DTSBD551 00810 10 DD-LINE-2-UNCATLG. DTSBD551 00811 15 FILLER PIC X(22) VALUE DTSBD551 00812 '//SYSPRINT DD SYSOUT=*'. DTSBD551 00813 15 FILLER PIC X(56) VALUE SPACES.DTSBD551 00814 10 DD-LINE-3-UNCATLG. DTSBD551 00815 15 FILLER PIC X(12) VALUE DTSBD551 00816 '//SYSIN DD *'. DTSBD551 00817 15 FILLER PIC X(68) VALUE SPACES.DTSBD551 00818 DTSBD551 00819 10 DD-LINE-4-UNCATLG. DTSBD551 00820 15 FILLER PIC X(46) VALUE DTSBD551 00821 ' UNCATLG DSNAME=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 00822 15 W-ARCHIVE-UNCATLG-YEAR PIC X(04). DTSBD551 00823 15 FILLER PIC X(07) VALUE DTSBD551 00824 '.BACKUP'. DTSBD551 00825 15 FILLER PIC X(23) VALUE SPACES.DTSBD551 00826 DTSBD551 00827 10 DD-LINE-5-UNCATLG. DTSBD551 00828 15 FILLER PIC X(02) VALUE DTSBD551 00829 '/*'. DTSBD551 00830 15 FILLER PIC X(78) VALUE SPACES.DTSBD551 00831 DTSBD551 00832 05 W-ARCHIVE-BACKUP-DD-STATEMENT. DTSBD551 00833 DTSBD551 00834 10 DD-LINE-1-BACKUP. DTSBD551 00835 15 FILLER PIC X(23) VALUE DTSBD551 00836 '//STEP2 EXEC PGM=IDCAMS'. DTSBD551 00837 15 FILLER PIC X(57) VALUE SPACES.DTSBD551 00838 DTSBD551 00839 10 DD-LINE-2-BACKUP. DTSBD551 00840 15 FILLER PIC X(44) VALUE DTSBD551 00841 '//IFILE DD DSN=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 00842 15 W-ARCHIVE-BACKUP-YEAR-I PIC X(04). DTSBD551 00843 15 FILLER PIC X(01) VALUE ','. DTSBD551 00844 15 FILLER PIC X(27) VALUE SPACES.DTSBD551 00845 DTSBD551 00846 10 DD-LINE-3-BACKUP. DTSBD551 00847 15 FILLER PIC X(35) VALUE DTSBD551 00848 '// DISP=(OLD,KEEP,KEEP)'. DTSBD551 00849 15 FILLER PIC X(45) VALUE SPACES.DTSBD551 00850 DTSBD551 00851 10 DD-LINE-4-BACKUP. DTSBD551 00852 15 FILLER PIC X(44) VALUE DTSBD551 00853 '//OFILE DD DSN=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 00854 15 W-ARCHIVE-BACKUP-YEAR-O PIC X(04). DTSBD551 00855 15 FILLER PIC X(07) VALUE DTSBD551 00856 '.BACKUP'. DTSBD551 00857 15 FILLER PIC X(01) VALUE ','. DTSBD551 00858 15 FILLER PIC X(24) VALUE SPACES.DTSBD551 00859 DTSBD551 00860 10 DD-LINE-5-BACKUP. DTSBD551 00861 15 FILLER PIC X(43) VALUE DTSBD551 00862 '// DCB=(RECFM=FB,LRECL=275,BLKSIZE=27500)'. DTSBD551 00863 15 FILLER PIC X(01) VALUE ','. DTSBD551 00864 15 FILLER PIC X(35) VALUE SPACES.DTSBD551 00865 DTSBD551 00866 10 DD-LINE-6-BACKUP. DTSBD551 00867 15 FILLER PIC X(34) VALUE DTSBD551 00868 '// UNIT=CART,LABEL=(,SL,RETPD=1)'. DTSBD551 00869 15 FILLER PIC X(01) VALUE ','. DTSBD551 00870 15 FILLER PIC X(45) VALUE SPACES.DTSBD551 00871 DTSBD551 00872 10 DD-LINE-7-BACKUP. DTSBD551 00873 15 FILLER PIC X(28) VALUE DTSBD551 00874 '// DISP=(NEW,CATLG,DELETE)'. DTSBD551 00875 15 FILLER PIC X(51) VALUE SPACES.DTSBD551 00876 DTSBD551 00877 10 DD-LINE-8-BACKUP. DTSBD551 00878 15 FILLER PIC X(24) VALUE DTSBD551 00879 '//SYSPRINT DD SYSOUT=(X)'. DTSBD551 00880 15 FILLER PIC X(56) VALUE SPACES.DTSBD551 00881 DTSBD551 00882 10 DD-LINE-9-BACKUP. DTSBD551 00883 15 FILLER PIC X(49) VALUE DTSBD551 00884 '//SYSIN DD DSN=DOESTAX.DEVL.PARMLIB(DTSRONE),'. DTSBD551 00885 15 FILLER PIC X(31) VALUE SPACES.DTSBD551 00886 DTSBD551 00887 10 DD-LINE-10-BACKUP. DTSBD551 00888 15 FILLER PIC X(23) VALUE DTSBD551 00889 '// DISP=SHR'. DTSBD551 00890 15 FILLER PIC X(57) VALUE SPACES.DTSBD551 00891 DTSBD551 00892 05 W-ARCHIVE-NEW-DD-STATEMENT. DTSBD551 00893 10 DD-LINE-1-NEW. DTSBD551 00894 15 FILLER PIC X(49) VALUE DTSBD551 00895 '//OUTDD01 DD DSN=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 00896 15 W-ARCHIVE-NEW-YEAR PIC X(04). DTSBD551 00897 15 FILLER PIC X(01) VALUE ','. DTSBD551 00898 15 FILLER PIC X(26) VALUE SPACES.DTSBD551 00899 10 DD-LINE-2-NEW. DTSBD551 00900 15 FILLER PIC X(37) VALUE DTSBD551 00901 '// DISP=(NEW,CATLG,KEEP),'. DTSBD551 00902 15 FILLER PIC X(43) VALUE SPACES.DTSBD551 00903 DTSBD551 00904 10 DD-LINE-3-NEW. DTSBD551 00905 15 FILLER PIC X(14) VALUE DTSBD551 00906 '// UNIT=CART'. DTSBD551 00907 15 FILLER PIC X(01) VALUE ','. DTSBD551 00908 15 FILLER PIC X(64) VALUE SPACES.DTSBD551 00909 DTSBD551 00910 10 DD-LINE-4-NEW. DTSBD551 00911 15 FILLER PIC X(43) VALUE DTSBD551 00912 '// SPACE=(CYL,(5,5)),'. DTSBD551 00913 15 FILLER PIC X(37) VALUE SPACES.DTSBD551 00914 DTSBD551 00915 10 DD-LINE-5-NEW. DTSBD551 00916 15 FILLER PIC X(53) VALUE DTSBD551 00917 '// DCB=(RECFM=FB,LRECL=275,BLKSIZE=27500)'. DTSBD551 00918 15 FILLER PIC X(27) VALUE SPACES.DTSBD551 00919 DTSBD551 00920 05 W-INPUT-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00921 05 W-ALL-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00922 05 W-EMP-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00923 05 W-FAILED-FULL-EDITS-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00924 05 W-BYPASS-0-WAGE-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00925 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00926 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00927 05 W-ACCT-NOT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00928 05 W-ACCT-FROM-FEIN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00929 05 W-ACCT-FROM-SUCC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00930 05 W-ALL-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00931 05 W-WAGE-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00932 05 W-ZERO-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00933 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00934 05 W-T002-CONTACT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00935 05 W-T003-MNTE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00936 05 W-VALID-NEW-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00937 05 W-SI-WITH-REMIT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00938 05 W-INVALID-NEW-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00939 05 W-MISSING-SSN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 00940 05 W-ALL-TOT-WAGE PIC S9(13)V99 COMP-3 VALUE +0. DTSBD551 00941 DTSBD551 00942 05 W-MONTH-1-CNT-X PIC X(07). DTSBD551 00943 05 W-MONTH-1-CNT-9 REDEFINES W-MONTH-1-CNT-X PIC 9(07). DTSBD551 00944 05 W-MONTH-2-CNT-X PIC X(07). DTSBD551 00945 05 W-MONTH-2-CNT-9 REDEFINES W-MONTH-2-CNT-X PIC 9(07). DTSBD551 00946 05 W-MONTH-3-CNT-X PIC X(07). DTSBD551 00947 05 W-MONTH-3-CNT-9 REDEFINES W-MONTH-3-CNT-X PIC 9(07). DTSBD551 00948 DTSBD551 00949 01 MESSAGE-AREA. DTSBD551 00950 *** FATAL ERRORS MSG-A DTSBD551 00951 05 MSG-A1. DTSBD551 00952 10 FILLER PIC X(32) DTSBD551 00953 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBD551 00954 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBD551 00955 05 MSG-A2. DTSBD551 00956 10 FILLER PIC X(20) DTSBD551 00957 VALUE 'A-NON-NUMERIC FEIN: '. DTSBD551 00958 10 MSG-A2-FEIN PIC X(09). DTSBD551 00959 05 MSG-A3. DTSBD551 00960 10 FILLER PIC X(37) DTSBD551 00961 VALUE 'A-SUBMITTER NAME MISSING '. DTSBD551 00962 05 MSG-A4. DTSBD551 00963 10 FILLER PIC X(37) DTSBD551 00964 VALUE 'A-SUBMITTER ADDRESS MISSING '. DTSBD551 00965 05 MSG-A5. DTSBD551 00966 10 FILLER PIC X(37) DTSBD551 00967 VALUE 'A-SUBMITTER ZIP CODE MISSING '. DTSBD551 00968 05 MSG-A6. DTSBD551 00969 10 FILLER PIC X(37) DTSBD551 00970 VALUE 'A-CONTACT NAME MISSING '. DTSBD551 00971 05 MSG-A7. DTSBD551 00972 10 FILLER PIC X(37) DTSBD551 00973 VALUE 'A-CONTACT PHONE MISSING '. DTSBD551 00974 05 MSG-A8. DTSBD551 00975 10 FILLER PIC X(33) DTSBD551 00976 VALUE 'A-NON-NUMERIC MEDIA CREATE DATE: '. DTSBD551 00977 10 MSG-A8-MEDIA-DATE PIC X(08). DTSBD551 00978 05 MSG-A9. DTSBD551 00979 10 FILLER PIC X(29) DTSBD551 00980 VALUE 'A-INVALID MEDIA CREATE DATE: '. DTSBD551 00981 10 MSG-A9-MEDIA-DATE PIC X(08). DTSBD551 00982 05 MSG-A10. DTSBD551 00983 10 FILLER PIC X(29) DTSBD551 00984 VALUE 'DUPLICATE SUBMISSION '. DTSBD551 00985 10 MSG-A10-FEIN PIC 9(09). DTSBD551 00986 05 MSG-A11. DTSBD551 00987 10 FILLER PIC X(20) DTSBD551 00988 VALUE 'INVALID LOG NUMBER: '. DTSBD551 00989 10 MSG-A11-LOG-REMIT PIC X(25). DTSBD551 00990 05 MSG-A12. DTSBD551 00991 10 FILLER PIC X(20) DTSBD551 00992 VALUE 'INVALID REMITTANCE: '. DTSBD551 00993 10 MSG-A12-LOG-REMIT PIC X(25). DTSBD551 00994 DTSBD551 00995 *** NON-FATAL ERRORS MSG-E DTSBD551 00996 05 MSG-E1. DTSBD551 00997 10 FILLER PIC X(38) DTSBD551 00998 VALUE 'ACCOUNT NUMBER NOT FOUND FROM FEIN: '. DTSBD551 00999 10 MSG-E1-FEIN PIC X(09). DTSBD551 01000 DTSBD551 01001 05 MSG-E2. DTSBD551 01002 10 FILLER PIC X(34) DTSBD551 01003 VALUE 'ACCOUNT NUMBER NOT ON TAX FILE: '. DTSBD551 01004 10 MSG-E2-BATCH PIC 9(05). DTSBD551 01005 10 FILLER PIC X(01) DTSBD551 01006 VALUE '/'. DTSBD551 01007 10 MSG-E2-ITEM PIC 9(03). DTSBD551 01008 05 MSG-E3. DTSBD551 01009 10 FILLER PIC X(35) DTSBD551 01010 VALUE 'NO UI RATE FOR QUARTER '. DTSBD551 01011 DTSBD551 01012 05 MSG-E4. DTSBD551 01013 10 FILLER PIC X(23) DTSBD551 01014 VALUE 'NOT LIABLE FOR QUARTER '. DTSBD551 01015 10 MSG-E4-REPORT-CCYY PIC X(04). DTSBD551 01016 10 FILLER PIC X(01) DTSBD551 01017 VALUE '/'. DTSBD551 01018 10 MSG-E4-REPORT-MM-X PIC X(02). DTSBD551 01019 DTSBD551 01020 05 MSG-E4A. DTSBD551 01021 10 FILLER PIC X(29) DTSBD551 01022 VALUE 'NOT LIABLE - PARTIAL TRANSFER'. DTSBD551 01023 10 MSG-E4A-REPORT-CCYY PIC X(04). DTSBD551 01024 10 FILLER PIC X(01) DTSBD551 01025 VALUE '/'. DTSBD551 01026 10 MSG-E4A-REPORT-MM-X PIC X(02). DTSBD551 01027 DTSBD551 01028 05 MSG-E5. DTSBD551 01029 10 FILLER PIC X(32) DTSBD551 01030 VALUE 'RPT ALREADY ON FILE FOR THE QTR '. DTSBD551 01031 10 MSG-E5-ACCT-NO PIC 9(06). DTSBD551 01032 10 FILLER PIC X(03) DTSBD551 01033 VALUE ' - '. DTSBD551 01034 10 MSG-E5-REPORT-CCYY PIC X(04). DTSBD551 01035 10 FILLER PIC X(01) DTSBD551 01036 VALUE '/'. DTSBD551 01037 10 MSG-E5-REPORT-MM-X PIC X(02). DTSBD551 01038 DTSBD551 01039 05 MSG-E6. DTSBD551 01040 10 FILLER PIC X(23) DTSBD551 01041 VALUE 'INVALID ACCOUNT NUMBER '. DTSBD551 01042 10 MSG-E6-ACCT-NO PIC X(15). DTSBD551 01043 DTSBD551 01044 05 MSG-E7. DTSBD551 01045 10 FILLER PIC X(16) DTSBD551 01046 VALUE 'FOUND ACCT NBR: '. DTSBD551 01047 10 MSG-E7-ACCT-NO PIC X(06). DTSBD551 01048 10 FILLER PIC X(12) DTSBD551 01049 VALUE ' FROM FEIN: '. DTSBD551 01050 10 MSG-E7-FEIN PIC X(09). DTSBD551 01051 DTSBD551 01052 05 MSG-E8. DTSBD551 01053 10 FILLER PIC X(09) DTSBD551 01054 VALUE 'ACCT NBR '. DTSBD551 01055 10 MSG-E8-ACCT-NO PIC 9(06). DTSBD551 01056 10 FILLER PIC X(29) DTSBD551 01057 VALUE ' SUCCEEDED. USING SUCCESSOR: '. DTSBD551 01058 10 MSG-E8-SUCCESSOR PIC 9(06). DTSBD551 01059 DTSBD551 01060 05 MSG-E9A. DTSBD551 01061 10 FILLER PIC X(17) DTSBD551 01062 VALUE 'NEW ADDRESS FOR: '. DTSBD551 01063 10 MSG-E9A-ACCT-NO PIC 9(06). DTSBD551 01064 10 FILLER PIC X(11) DTSBD551 01065 VALUE ' IS INVALID'. DTSBD551 01066 DTSBD551 01067 05 MSG-E9B. DTSBD551 01068 10 FILLER PIC X(17) DTSBD551 01069 VALUE 'NEW ADDRESS FOR: '. DTSBD551 01070 10 MSG-E9B-ACCT-NO PIC 9(06). DTSBD551 01071 10 FILLER PIC X(09) DTSBD551 01072 VALUE ' IS VALID'. DTSBD551 01073 DTSBD551 01074 05 MSG-E9C. DTSBD551 01075 10 FILLER PIC X(27) DTSBD551 01076 VALUE 'ZERO-WAGE REPORT IGNORED: '. DTSBD551 01077 10 MSG-E9C-REASON PIC X(11). DTSBD551 01078 10 MSG-E9C-ACCT-NO PIC 9(06). DTSBD551 01079 DTSBD551 01080 05 MSG-E9D. DTSBD551 01081 10 FILLER PIC X(29) DTSBD551 01082 VALUE 'TAX FEIN/REPORT FEIN DIFFER: '. DTSBD551 01083 10 MSG-E9D-TAX-FEIN PIC 9(09). DTSBD551 01084 10 FILLER PIC X(01) DTSBD551 01085 VALUE '/'. DTSBD551 01086 10 MSG-E9D-RPT-FEIN PIC 9(09). DTSBD551 01087 DTSBD551 01088 05 MSG-E9E. DTSBD551 01089 10 FILLER PIC X(29) DTSBD551 01090 VALUE 'QUARTER IS FILED ANNUALLY. '. DTSBD551 01091 DTSBD551 01092 *** FATAL ERRORS MSG-E DTSBD551 01093 05 MSG-E10. DTSBD551 01094 10 FILLER PIC X(32) DTSBD551 01095 VALUE 'E-PREVIOUS REC TYPE NOT A OR T: '. DTSBD551 01096 10 MSG-E10-REC-TYPE PIC X(01). DTSBD551 01097 05 MSG-E11. DTSBD551 01098 10 FILLER PIC X(20) DTSBD551 01099 VALUE 'E-INVALID FEIN: '. DTSBD551 01100 10 MSG-E11-FEIN PIC X(09). DTSBD551 01101 05 MSG-E12. DTSBD551 01102 10 FILLER PIC X(35) DTSBD551 01103 VALUE 'E-EMPLOYER NAME MISSING '. DTSBD551 01104 05 MSG-E13. DTSBD551 01105 10 FILLER PIC X(35) DTSBD551 01106 VALUE 'E-EMPLOYER ADDRESS MISSING '. DTSBD551 01107 05 MSG-E14. DTSBD551 01108 10 FILLER PIC X(35) DTSBD551 01109 VALUE 'E-EMPLOYER ZIP CODE MISSING '. DTSBD551 01110 05 MSG-E15. DTSBD551 01111 10 FILLER PIC X(21) DTSBD551 01112 VALUE 'E-STATE CODE NOT DC: '. DTSBD551 01113 10 MSG-E15-STATE-CODE PIC X(02). DTSBD551 01114 05 MSG-E16. DTSBD551 01115 10 FILLER PIC X(26) DTSBD551 01116 VALUE 'INVALID WORKER/WAGE CODE: '. DTSBD551 01117 10 MSG-E16-WORKER-WAGE PIC X(01). DTSBD551 01118 ** 05 MSG-E17. DTSBD551 01119 * 10 FILLER PIC X(27) DTSBD551 01120 * VALUE 'ACCT NBR EXCEEDS 6 DIGITS: '. DTSBD551 01121 * 10 MSG-E17-ACCT-NO PIC X(15). DTSBD551 01122 * 05 MSG-E18. DTSBD551 01123 * 10 FILLER PIC X(35) DTSBD551 01124 * VALUE 'ACCOUNT NUMBER MISSING '. DTSBD551 01125 * 05 MSG-E19. DTSBD551 01126 * 10 FILLER PIC X(22) DTSBD551 01127 * VALUE 'ACCT NBR NOT NUMERIC: '. DTSBD551 01128 ** 10 MSG-E19-ACCT-NO PIC X(15). DTSBD551 01129 05 MSG-E20. DTSBD551 01130 10 FILLER PIC X(24) DTSBD551 01131 VALUE 'REPORT QTR NOT NUMERIC: '. DTSBD551 01132 10 MSG-E20-REPORT-CCYY PIC X(04). DTSBD551 01133 10 FILLER PIC X(01) DTSBD551 01134 VALUE '/'. DTSBD551 01135 10 MSG-E20-REPORT-MM-X PIC X(02). DTSBD551 01136 05 MSG-E21. DTSBD551 01137 10 FILLER PIC X(23) DTSBD551 01138 * VALUE 'INVALID REPORT QTR: '. DTSBD551 01139 VALUE 'INVALID REPORT PERIOD: '. DTSBD551 01140 10 MSG-E21-REPORT-MM-9 PIC X(02). DTSBD551 01141 05 MSG-E22. DTSBD551 01142 10 FILLER PIC X(25) DTSBD551 01143 VALUE 'INVALID REPORT YEAR-QTR: '. DTSBD551 01144 10 MSG-E22-REPORT-CCYY PIC X(04). DTSBD551 01145 10 FILLER PIC X(01). DTSBD551 01146 10 MSG-E22-REPORT-MM-X PIC X(02). DTSBD551 01147 05 MSG-E23. DTSBD551 01148 10 FILLER PIC X(35) DTSBD551 01149 VALUE 'REPORT QTR >= CURR QTR - REJECTED: '. DTSBD551 01150 10 MSG-E23-RPT-QTR PIC X(05). DTSBD551 01151 10 FILLER PIC X(01). DTSBD551 01152 10 MSG-E23-CURR-QTR PIC X(05). DTSBD551 01153 DTSBD551 01154 *** FATAL ERRORS MSG-S DTSBD551 01155 05 MSG-S1. DTSBD551 01156 10 FILLER PIC X(20) DTSBD551 01157 VALUE 'WAGES NOT EXPECTED: '. DTSBD551 01158 10 MSG-S1-WAGES-EXP-IND PIC X(01). DTSBD551 01159 05 MSG-S2. DTSBD551 01160 10 FILLER PIC X(30) DTSBD551 01161 VALUE 'PREVIOUS REC TYPE NOT E OR S: '. DTSBD551 01162 10 MSG-S2-REC-TYPE PIC X(01). DTSBD551 01163 05 MSG-S3. DTSBD551 01164 10 FILLER PIC X(17) DTSBD551 01165 VALUE 'NON-NUMERIC SSN: '. DTSBD551 01166 10 MSG-S3-SSN PIC X(09). DTSBD551 01167 05 MSG-S4. DTSBD551 01168 10 FILLER PIC X(35) DTSBD551 01169 VALUE 'EMPLOYEE NAME MISSING '. DTSBD551 01170 05 MSG-S5. DTSBD551 01171 10 FILLER PIC X(19) DTSBD551 01172 VALUE 'STATE CODE NOT DC: '. DTSBD551 01173 10 MSG-S5-STATE-CODE PIC X(02). DTSBD551 01174 05 MSG-S6. DTSBD551 01175 10 FILLER PIC X(32) DTSBD551 01176 VALUE 'NON-NUM TOT WAGE, SSN & EMP-NO: '. DTSBD551 01177 10 MSG-S6-SSN PIC X(09). DTSBD551 01178 10 FILLER PIC X(01). DTSBD551 01179 10 MSG-S6-EMP-NO PIC 9(06). DTSBD551 01180 05 MSG-S7. DTSBD551 01181 10 FILLER PIC X(32) DTSBD551 01182 VALUE 'NON-NUM TAX WAGE, SSN & EMP-NO: '. DTSBD551 01183 10 MSG-S7-SSN PIC X(09). DTSBD551 01184 10 FILLER PIC X(01). DTSBD551 01185 10 MSG-S7-EMP-NO PIC 9(06). DTSBD551 01186 DTSBD551 01187 *** NON-FATAL ERRORS MSG-S DTSBD551 01188 05 MSG-S8. DTSBD551 01189 10 FILLER PIC X(34) DTSBD551 01190 VALUE 'SKIP ZERO WAGE REC, SSN & EMP-NO: '. DTSBD551 01191 10 MSG-S8-SSN PIC X(09). DTSBD551 01192 10 FILLER PIC X(01). DTSBD551 01193 10 MSG-S8-EMP-NO PIC 9(06). DTSBD551 01194 05 MSG-S9. DTSBD551 01195 10 FILLER PIC X(37) DTSBD551 01196 VALUE 'TYPE S INVALID, USING TYPE E EMP-NO: '. DTSBD551 01197 10 MSG-S9-S-EMP-NO PIC 9(06). DTSBD551 01198 10 FILLER PIC X(01). DTSBD551 01199 10 MSG-S9-E-EMP-NO PIC 9(06). DTSBD551 01200 05 MSG-S10. DTSBD551 01201 10 FILLER PIC X(35) DTSBD551 01202 VALUE 'TYPE S EMP-NO NOT = TYPE E EMP-NO: '. DTSBD551 01203 10 MSG-S10-S-EMP-NO PIC 9(06). DTSBD551 01204 10 FILLER PIC X(01). DTSBD551 01205 10 MSG-S10-E-EMP-NO PIC 9(06). DTSBD551 01206 05 MSG-S11. DTSBD551 01207 10 FILLER PIC X(18) DTSBD551 01208 VALUE 'MISSING SSN. EMP: '. DTSBD551 01209 10 MSG-S11-EMP-NO PIC 9(06). DTSBD551 01210 10 FILLER PIC X(06) DTSBD551 01211 VALUE ' SSN: '. DTSBD551 01212 10 MSG-S11-SSN PIC X(09). DTSBD551 01213 05 MSG-S12. DTSBD551 01214 10 FILLER PIC X(22) DTSBD551 01215 VALUE 'NON-NUMERIC SSN. EMP: '. DTSBD551 01216 10 MSG-S12-EMP-NO PIC 9(06). DTSBD551 01217 10 FILLER PIC X(06) DTSBD551 01218 VALUE ' SSN: '. DTSBD551 01219 10 MSG-S12-SSN PIC X(09). DTSBD551 01220 DTSBD551 01221 *** FATAL ERRORS MSG-T DTSBD551 01222 05 MSG-T1. DTSBD551 01223 10 FILLER PIC X(25) DTSBD551 01224 VALUE 'PREVIOUS REC NOT E OR S: '. DTSBD551 01225 10 MSG-T1-REC-TYPE PIC X(01). DTSBD551 01226 05 MSG-T2. DTSBD551 01227 10 FILLER PIC X(27) DTSBD551 01228 VALUE 'NON-NUMERIC TOTAL WORKERS: '. DTSBD551 01229 10 MSG-T2-TOT-EMPLOYEE PIC X(09). DTSBD551 01230 05 MSG-T3. DTSBD551 01231 10 FILLER PIC X(31) DTSBD551 01232 VALUE 'NON-NUMERIC TOT WAGES, EMP-NO: '. DTSBD551 01233 10 MSG-T3-EMP-NO PIC 9(06). DTSBD551 01234 05 MSG-T4. DTSBD551 01235 10 FILLER PIC X(31) DTSBD551 01236 VALUE 'NON-NUMERIC TAX WAGES, EMP-NO: '. DTSBD551 01237 10 MSG-T4-EMP-NO PIC 9(06). DTSBD551 01238 05 MSG-T5. DTSBD551 01239 10 FILLER PIC X(35) DTSBD551 01240 VALUE 'NON-NUMERIC TAX RATE - IGNORED '. DTSBD551 01241 05 MSG-T6. DTSBD551 01242 10 FILLER PIC X(35) DTSBD551 01243 VALUE 'TAX RATE IGNORED - SELF-INSRED '. DTSBD551 01244 05 MSG-T7. DTSBD551 01245 10 FILLER PIC X(35) DTSBD551 01246 VALUE 'INVALID RATE IGNORED '. DTSBD551 01247 05 MSG-T8. DTSBD551 01248 10 FILLER PIC X(35) DTSBD551 01249 VALUE 'NON-NUMERIC TAX DUE '. DTSBD551 01250 05 MSG-T9. DTSBD551 01251 10 FILLER PIC X(21) DTSBD551 01252 VALUE 'NON-NUMERIC MONTH 1: '. DTSBD551 01253 10 MSG-T9-NON-NUM-MONTH1 PIC X(07). DTSBD551 01254 05 MSG-T10. DTSBD551 01255 10 FILLER PIC X(21) DTSBD551 01256 VALUE 'NON-NUMERIC MONTH 2: '. DTSBD551 01257 10 MSG-T10-NON-NUM-MONTH2 PIC X(07). DTSBD551 01258 05 MSG-T11. DTSBD551 01259 10 FILLER PIC X(21) DTSBD551 01260 VALUE 'NON-NUMERIC MONTH 3: '. DTSBD551 01261 10 MSG-T11-NON-NUM-MONTH3 PIC X(07). DTSBD551 01262 05 MSG-T12. DTSBD551 01263 10 FILLER PIC X(27) DTSBD551 01264 VALUE 'TOT WAGE NOT = TYPE S SUM: '. DTSBD551 01265 10 MSG-T12-TOT-WAGES PIC Z(07)9.99. DTSBD551 01266 10 FILLER PIC X(01). DTSBD551 01267 10 MSG-T12-S-SUM PIC Z(07)9.99. DTSBD551 01268 05 MSG-T13. DTSBD551 01269 10 FILLER PIC X(27) DTSBD551 01270 VALUE 'TAX WAGE NOT = TYPE S SUM: '. DTSBD551 01271 10 MSG-T13-TAX-WAGES PIC Z(07)9.99. DTSBD551 01272 10 FILLER PIC X(01). DTSBD551 01273 10 MSG-T13-S-SUM PIC Z(07)9.99. DTSBD551 01274 05 MSG-T14. DTSBD551 01275 10 FILLER PIC X(25) DTSBD551 01276 VALUE 'TAX WAGES > TOTAL WAGES: '. DTSBD551 01277 10 MSG-T14-TAX-WAGES PIC Z(07)9.99. DTSBD551 01278 10 FILLER PIC X(02). DTSBD551 01279 10 MSG-T14-TOT-WAGES PIC Z(07)9.99. DTSBD551 01280 05 MSG-T15. DTSBD551 01281 10 FILLER PIC X(34) DTSBD551 01282 VALUE 'WORKERS T CNT & S SUM CNT NOT = : '. DTSBD551 01283 10 MSG-T15-T-COUNT PIC Z(06)9. DTSBD551 01284 10 FILLER PIC X(01). DTSBD551 01285 10 MSG-T15-S-COUNT PIC Z(06)9. DTSBD551 01286 05 MSG-T16. DTSBD551 01287 10 FILLER PIC X(24) DTSBD551 01288 VALUE 'CHECK FOR SELF-INS EMP: '. DTSBD551 01289 10 MSG-T16-EMP-NO PIC 9(06). DTSBD551 01290 10 FILLER PIC X(07) DTSBD551 01291 VALUE ' AMT = '. DTSBD551 01292 10 MSG-T16-REMIT PIC Z(09).99. DTSBD551 01293 05 MSG-T17. DTSBD551 01294 10 FILLER PIC X(33) DTSBD551 01295 VALUE 'DUPLICATE ZERO WAGE RPT DELETED: '. DTSBD551 01296 10 MSG-T17-EMP-NO PIC 9(06). DTSBD551 01297 DTSBD551 01298 *** FATAL ERRORS MSG-F DTSBD551 01299 05 MSG-F1. DTSBD551 01300 10 FILLER PIC X(20) DTSBD551 01301 VALUE 'PREVIOUS REC NOT T: '. DTSBD551 01302 10 MSG-F1-REC-TYPE PIC X(01). DTSBD551 01303 05 MSG-F2. DTSBD551 01304 10 FILLER PIC X(29) DTSBD551 01305 VALUE 'NON-NUMERIC TOTAL WORKERS: '. DTSBD551 01306 10 MSG-F2-TOT-EMPLOYEE PIC X(10). DTSBD551 01307 05 MSG-F3. DTSBD551 01308 10 FILLER PIC X(29) DTSBD551 01309 VALUE 'NON-NUMERIC TOTAL EMPLOYERS: '. DTSBD551 01310 10 MSG-F3-TOT-EMPLOYER PIC X(10). DTSBD551 01311 05 MSG-F4. DTSBD551 01312 10 FILLER PIC X(25) DTSBD551 01313 VALUE 'NON-NUMERIC TOTAL WAGES '. DTSBD551 01314 05 MSG-F5. DTSBD551 01315 10 FILLER PIC X(32) DTSBD551 01316 VALUE 'TYPE F NOT = ACTUAL WORKER CNT: '. DTSBD551 01317 10 MSG-F5-TOT-WORKERS PIC Z(07)9. DTSBD551 01318 10 FILLER PIC X(02). DTSBD551 01319 10 MSG-F5-ALL-WAGE-CNT PIC Z(07)9. DTSBD551 01320 05 MSG-F6. DTSBD551 01321 10 FILLER PIC X(32) DTSBD551 01322 VALUE 'TYPE F NOT = ACTUAL EMPL CNT: '. DTSBD551 01323 10 MSG-F6-TOT-EMPLOYER PIC Z(07)9. DTSBD551 01324 10 FILLER PIC X(02). DTSBD551 01325 10 MSG-F6-ALL-EMPL-CNT PIC Z(07)9. DTSBD551 01326 05 MSG-F7. DTSBD551 01327 10 FILLER PIC X(21) DTSBD551 01328 VALUE 'INVALID TOTAL WAGES: '. DTSBD551 01329 10 MSG-F7-TOT-WAGE PIC Z(10)9.99. DTSBD551 01330 10 FILLER PIC X(01). DTSBD551 01331 10 MSG-F7-ALL-TOT-WAGE PIC Z(10)9.99. DTSBD551 01332 05 MSG-F8. DTSBD551 01333 10 FILLER PIC X(28) DTSBD551 01334 VALUE 'CALC REMIT NOT = PARM REMIT '. DTSBD551 01335 10 MSG-F8-CALC-REMIT PIC Z(09).99. DTSBD551 01336 10 FILLER PIC X(01) DTSBD551 01337 VALUE '/'. DTSBD551 01338 10 MSG-F8-PARM-REMIT PIC Z(09).99. DTSBD551 01339 05 MSG-F9. DTSBD551 01340 10 FILLER PIC X(32) DTSBD551 01341 VALUE 'INCOMPLETE FILE: LAST REC NOT F '. DTSBD551 01342 DTSBD551 01343 ++INCLUDE EWGREC1 DTSBD551 01344 DTSBD551 01345 ++INCLUDE EWGRECA DTSBD551 01346 DTSBD551 01347 ++INCLUDE EWGRECB DTSBD551 01348 DTSBD551 01349 ++INCLUDE EWGRECE DTSBD551 01350 DTSBD551 01351 ++INCLUDE EWGRECF DTSBD551 01352 DTSBD551 01353 ++INCLUDE EWGRECS DTSBD551 01354 DTSBD551 01355 ++INCLUDE EWGRECT DTSBD551 01356 DTSBD551 01357 01 T028-REC. DTSBD551 01358 ++INCLUDE DTSIT028 DTSBD551 01359 DTSBD551 01360 01 T002-REC. DTSBD551 01361 ++INCLUDE DTSIT002 DTSBD551 01362 DTSBD551 01363 01 T003-REC. DTSBD551 01364 ++INCLUDE DTSIT003 DTSBD551 01365 DTSBD551 01366 01 W001-REC. DTSBD551 01367 ++INCLUDE DTSIW001 DTSBD551 01368 DTSBD551 01369 01 W-SUBMITTER-REC. DTSBD551 01370 ++INCLUDE DTSIX210 DTSBD551 01371 DTSBD551 01372 01 W-EMP-RPT-REC. DTSBD551 01373 ++INCLUDE DTSIX212 DTSBD551 01374 DTSBD551 01375 01 W-MESSAGE-REC. DTSBD551 01376 ++INCLUDE DTSIX216 DTSBD551 01377 DTSBD551 01378 01 L001-LINK-AREA. DTSBD551 01379 ++INCLUDE DTSIL001 DTSBD551 01380 DTSBD551 01381 01 L003-LINK-AREA. DTSBD551 01382 ++INCLUDE DTSIL003 DTSBD551 01383 DTSBD551 01384 01 L004-LINK-AREA. DTSBD551 01385 ++INCLUDE DTSIL004 DTSBD551 01386 DTSBD551 01387 01 L072-LINK-AREA. DTSBD551 01388 ++INCLUDE DTSIL072 DTSBD551 01389 DTSBD551 01390 01 L205-LINK-AREA. DTSBD551 01391 ++INCLUDE DTSIL205 DTSBD551 01392 DTSBD551 01393 01 L005-LINK-AREA. DTSBD551 01394 ++INCLUDE DTSIL005 DTSBD551 01395 DTSBD551 01396 01 L516-LINK-AREA. DTSBD551 01397 ++INCLUDE DTSIL516 DTSBD551 01398 DTSBD551 01399 01 L601-LINK-AREA. DTSBD551 01400 ++INCLUDE DTSIL601 DTSBD551 01401 DTSBD551 01402 01 L910-LINK-AREA. DTSBD551 01403 ++INCLUDE DTSIL910 DTSBD551 01404 01 MSKL-REC. DTSBD551 01405 ++INCLUDE DTSIMSKL DTSBD551 01406 DTSBD551 01407 01 MHDR-REC. DTSBD551 01408 ++INCLUDE DTSIMHDR DTSBD551 01409 DTSBD551 01410 01 MPRF-REC. DTSBD551 01411 ++INCLUDE DTSIMPRF DTSBD551 01412 DTSBD551 01413 01 MSOL-REC. DTSBD551 01414 ++INCLUDE DTSIMSOL DTSBD551 01415 DTSBD551 01416 01 MQTR-REC. DTSBD551 01417 ++INCLUDE DTSIMQTR DTSBD551 01418 DTSBD551 01419 01 MOPO-REC. DTSBD551 01420 ++INCLUDE DTSIMOPO DTSBD551 01421 DTSBD551 01422 01 MTAD-REC. DTSBD551 01423 ++INCLUDE DTSIMTAD DTSBD551 01424 DTSBD551 01425 01 MNTE-REC. DTSBD551 01426 ++INCLUDE DTSIMNTE DTSBD551 01427 DTSBD551 01428 01 L921-LINK-AREA. DTSBD551 01429 ++INCLUDE DTSIL921 DTSBD551 01430 SKIP3 DTSBD551 01431 01 ISKL-REC. DTSBD551 01432 ++INCLUDE DTSIISKL DTSBD551 01433 SKIP3 DTSBD551 01434 01 IEIN-REC. DTSBD551 01435 ++INCLUDE DTSIIEIN DTSBD551 01436 DTSBD551 01437 01 L927-LINK-AREA. DTSBD551 01438 ++INCLUDE DTSIL927 DTSBD551 01439 DTSBD551 01440 01 L931-LINK-AREA. DTSBD551 01441 ++INCLUDE DTSIL931 DTSBD551 01442 DTSBD551 01443 01 FSKL-REC. DTSBD551 01444 ++INCLUDE DTSIFSKL DTSBD551 01445 DTSBD551 01446 01 TSKL-REC. DTSBD551 01447 ++INCLUDE DTSITSKL DTSBD551 01448 DTSBD551 01449 01 RSKL-REC. DTSBD551 01450 ++INCLUDE DTSIRSK1 DTSBD551 01451 EJECT DTSBD551 01452 01 R551-REC. DTSBD551 01453 ++INCLUDE DTSIR551 DTSBD551 01454 DTSBD551 01455 01 R202-REC. DTSBD551 01456 ++INCLUDE DTSIR202 DTSBD551 01457 DTSBD551 01458 01 IY120-REC. DTSBD551 01459 ++INCLUDE DTSIY120 DTSBD551 01460 DTSBD551 01461 *01 C202-MSG-TABLE. DTSBD551 01462 ***INCLUDE DTSIC202 DTSBD551 01463 DTSBD551 01464 01 WORK-PARM-AREA. DTSBD551 01465 DTSBD551 01466 05 WORK-PARM-DATA. DTSBD551 01467 10 WORK-PARM-TOT-REMITTANCE PIC 9(11)V99. DTSBD551 01468 10 FILLER PIC X(01). DTSBD551 01469 10 WORK-PARM-LOG-NO PIC 9(06). DTSBD551 01470 10 FILLER PIC X(01). DTSBD551 01471 10 WORK-PARM-RUN-TYPE PIC X(01). DTSBD551 01472 88 WORK-PARM-RUN-TYPE-RECENT-88 VALUE '0'. DTSBD551 01473 88 WORK-PARM-RUN-TYPE-ANY-88 VALUE '1'. DTSBD551 01474 10 FILLER PIC X(01). DTSBD551 01475 10 WORK-PARM-TIMELY-IND PIC X(01). DTSBD551 01476 88 WORK-PARM-TIMELY-YES-88 VALUE 'Y'. DTSBD551 01477 88 WORK-PARM-TIMELY-NO-88 VALUE 'N'. DTSBD551 01478 10 FILLER PIC X(01). DTSBD551 01479 10 WORK-PARM-RECEIVED-DATE PIC X(08). DTSBD551 01480 10 FILLER PIC X(01). DTSBD551 01481 10 WORK-PARM-BYPASS-ERR-IND PIC X(01). DTSBD551 01482 88 WORK-PARM-BYPASS-ERR-YES-88 VALUE 'Y'. DTSBD551 01483 88 WORK-PARM-BYPASS-ERR-NO-88 VALUE 'N'. DTSBD551 01484 10 FILLER PIC X(01). DTSBD551 01485 LINKAGE SECTION. DTSBD551 01486 SKIP3 DTSBD551 01487 01 PARM-AREA. DTSBD551 01488 05 PARM-LENGTH PIC S9(04) COMP. DTSBD551 01489 DTSBD551 01490 05 PARM-DATA. DTSBD551 01491 10 PARM-ALLOW-DUP-IND PIC X(01). DTSBD551 01492 88 PARM-ALLOW-DUP-YES-88 VALUE 'Y'. DTSBD551 01493 88 PARM-ALLOW-DUP-NO-88 VALUE 'N'. DTSBD551 01494 DTSBD551 01495 PROCEDURE DIVISION USING PARM-AREA. DTSBD551 01496 DTSBD551 01497 DTSBD551-MAIN. DTSBD551 01498 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD551 01499 IF W-ERROR-YES-88 DTSBD551 01500 MOVE +4 TO RETURN-CODE DTSBD551 01501 GO TO DTSBD551-MAIN-EXIT. DTSBD551 01502 DTSBD551 01503 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD551 01504 DTSBD551 01505 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD551 01506 DTSBD551 01507 IF W-FATAL-ERROR-YES-88 DTSBD551 01508 MOVE 4 TO RETURN-CODE DTSBD551 01509 DISPLAY '!! FATAL ERROR ON END OF SUBMISSION !!' DTSBD551 01510 DISPLAY ' SUBMISSION REJECTED' DTSBD551 01511 DISPLAY ' RETURN-CODE = ' RETURN-CODE DTSBD551 01512 DISPLAY SPACE. DTSBD551 01513 DTSBD551 01514 DTSBD551-MAIN-EXIT. DTSBD551 01515 GOBACK. DTSBD551 01516 EJECT DTSBD551 01517 I0000-INITIATE. DTSBD551 01518 SET W-ERROR-NO-88 TO TRUE. DTSBD551 01519 DTSBD551 01520 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBD551 01521 IF W-ERROR-YES-88 DTSBD551 01522 GO TO I0000-EXIT. DTSBD551 01523 DTSBD551 01524 PERFORM I3000-READ-HDR THRU I3000-EXIT DTSBD551 01525 IF W-ERROR-YES-88 DTSBD551 01526 GO TO I0000-EXIT DTSBD551 01527 END-IF. DTSBD551 01528 DTSBD551 01529 PERFORM I0999-READ-WEB-HDR THRU I0999-EXIT DTSBD551 01530 IF W-ERROR-YES-88 DTSBD551 01531 GO TO I0000-EXIT DTSBD551 01532 END-IF. DTSBD551 01533 DTSBD551 01534 PERFORM I1000-EDIT-PARM THRU I1000-EXIT. DTSBD551 01535 IF W-ERROR-YES-88 DTSBD551 01536 GO TO I0000-EXIT DTSBD551 01537 ELSE DTSBD551 01538 PERFORM I3100-SYS-DATE THRU I3100-EXIT DTSBD551 01539 PERFORM I4000-READ-FIRST THRU I4000-EXIT DTSBD551 01540 IF W-ERROR-YES-88 DTSBD551 01541 GO TO I0000-EXIT DTSBD551 01542 ELSE DTSBD551 01543 PERFORM I4100-SUBMITTERS THRU I4100-EXIT DTSBD551 01544 END-IF DTSBD551 01545 END-IF. DTSBD551 01546 DTSBD551 01547 *& PERFORM DTSBD551 01548 * VARYING ZW-SUB FROM +1 BY +1 DTSBD551 01549 * UNTIL ZW-SUB > ZW-MAX DTSBD551 01550 * SET ZW-ZERO-WAGE-YES-88 (ZW-SUB) TO TRUE DTSBD551 01551 *& END-PERFORM. DTSBD551 01552 DTSBD551 01553 IF W-ERROR-YES-88 DTSBD551 01554 DISPLAY SPACE DTSBD551 01555 DISPLAY '*** DTSBD551 FAILED WITH FATAL ERROR ***' DTSBD551 01556 END-IF. DTSBD551 01557 DTSBD551 01558 I0000-EXIT. DTSBD551 01559 EXIT. DTSBD551 01560 DTSBD551 01561 I0999-READ-WEB-HDR. DTSBD551 01562 OPEN INPUT ICESA-FILE. DTSBD551 01563 IF ICESA-STATUS-OK-88 DTSBD551 01564 NEXT SENTENCE DTSBD551 01565 ELSE DTSBD551 01566 SET W-ERROR-YES-88 TO TRUE DTSBD551 01567 DISPLAY 'ICESA FILE EMPTY: ' ICESA-STATUS DTSBD551 01568 GO TO I4000-EXIT DTSBD551 01569 END-IF. DTSBD551 01570 DTSBD551 01571 READ ICESA-FILE. DTSBD551 01572 IF ICESA-STATUS-OK-88 DTSBD551 01573 NEXT SENTENCE DTSBD551 01574 ELSE DTSBD551 01575 DISPLAY 'BAD FIRST READ ' ICESA-STATUS DTSBD551 01576 SET W-ERROR-YES-88 TO TRUE DTSBD551 01577 GO TO I4000-EXIT DTSBD551 01578 END-IF. DTSBD551 01579 DTSBD551 01580 IF ICESA-REC-TYPE-1-88 DTSBD551 01581 MOVE ICESA-REC TO WAGE-RECORD-1 DTSBD551 01582 ELSE DTSBD551 01583 DISPLAY 'ZIRST RECORD NOT TYPE 1: ' ICESA-REC-TYPE DTSBD551 01584 SET W-ERROR-YES-88 TO TRUE DTSBD551 01585 GO TO I4000-EXIT DTSBD551 01586 END-IF. DTSBD551 01587 DTSBD551 01588 PERFORM P1111-LOG-RCV-REMIT THRU P1111-EXIT. DTSBD551 01589 SET WORK-PARM-RUN-TYPE-ANY-88 TO TRUE DTSBD551 01590 SET WORK-PARM-BYPASS-ERR-NO-88 TO TRUE DTSBD551 01591 SET WORK-PARM-TIMELY-YES-88 TO TRUE. DTSBD551 01592 DTSBD551 01593 I0999-EXIT. DTSBD551 01594 EXIT. DTSBD551 01595 DTSBD551 01596 I1000-EDIT-PARM. DTSBD551 01597 PERFORM I1100-RUN-TYPE THRU I1100-EXIT. DTSBD551 01598 PERFORM I1200-REMITTANCE THRU I1200-EXIT. DTSBD551 01599 PERFORM I1300-LOG-NO THRU I1300-EXIT. DTSBD551 01600 PERFORM I1400-TIMELY-IND THRU I1400-EXIT. DTSBD551 01601 * PERFORM I1500-RCVD-DATE THRU I1500-EXIT. DTSBD551 01602 PERFORM I1600-BYPASS-ERR THRU I1600-EXIT. DTSBD551 01603 PERFORM I1700-ALLOW-DUP THRU I1700-EXIT. DTSBD551 01604 DTSBD551 01605 I1000-EXIT. DTSBD551 01606 EXIT. DTSBD551 01607 DTSBD551 01608 I1100-RUN-TYPE. DTSBD551 01609 IF WORK-PARM-RUN-TYPE-ANY-88 DTSBD551 01610 OR WORK-PARM-RUN-TYPE-RECENT-88 DTSBD551 01611 NEXT SENTENCE DTSBD551 01612 ELSE DTSBD551 01613 DISPLAY 'INVALID PARM ' WORK-PARM-RUN-TYPE DTSBD551 01614 SET W-ERROR-YES-88 TO TRUE DTSBD551 01615 END-IF. DTSBD551 01616 I1100-EXIT. DTSBD551 01617 EXIT. DTSBD551 01618 DTSBD551 01619 I1200-REMITTANCE. DTSBD551 01620 DISPLAY 'I12 PARM REMIT ' WORK-PARM-TOT-REMITTANCE. DTSBD551 01621 * IF WORK-PARM-TOT-REMITTANCE = ZEROS DTSBD551 01622 * DISPLAY 'REMITTANCE AMOUNT REQUIRED ' DTSBD551 01623 * SET W-ERROR-YES-88 TO TRUE DTSBD551 01624 * ELSE DTSBD551 01625 IF WORK-PARM-TOT-REMITTANCE NOT NUMERIC DTSBD551 01626 DISPLAY 'REMITTANCE AMOUNT IS NOT NUMERIC ' DTSBD551 01627 SET W-ERROR-YES-88 TO TRUE DTSBD551 01628 * ELSE DTSBD551 01629 * MOVE WORK-PARM-TOT-REMITTANCE TO W-PARM-REMIT-9 DTSBD551 01630 * MOVE W-PARM-REMIT-DECIMAL TO W-PARM-DEPOSIT-REMIT DTSBD551 01631 * DISPLAY ' I121 REMIT ' W-PARM-DEPOSIT-REMIT DTSBD551 01632 END-IF. DTSBD551 01633 DTSBD551 01634 I1200-EXIT. DTSBD551 01635 EXIT. DTSBD551 01636 DTSBD551 01637 I1300-LOG-NO. DTSBD551 01638 IF WORK-PARM-LOG-NO NOT NUMERIC DTSBD551 01639 DISPLAY 'LOG NUMBER REQUIRED ' DTSBD551 01640 SET W-ERROR-YES-88 TO TRUE DTSBD551 01641 ELSE DTSBD551 01642 MOVE WORK-PARM-LOG-NO TO W-PARM-LOG-NO DTSBD551 01643 END-IF. DTSBD551 01644 DTSBD551 01645 I1300-EXIT. DTSBD551 01646 EXIT. DTSBD551 01647 DTSBD551 01648 I1400-TIMELY-IND. DTSBD551 01649 IF WORK-PARM-TIMELY-YES-88 DTSBD551 01650 OR WORK-PARM-TIMELY-NO-88 DTSBD551 01651 MOVE WORK-PARM-TIMELY-IND TO W-PARM-TIMELY-IND DTSBD551 01652 ELSE DTSBD551 01653 DISPLAY 'INVALID TIMELY IND: ' WORK-PARM-TIMELY-IND DTSBD551 01654 SET W-ERROR-YES-88 TO TRUE DTSBD551 01655 END-IF. DTSBD551 01656 DTSBD551 01657 I1400-EXIT. DTSBD551 01658 EXIT. DTSBD551 01659 DTSBD551 01660 I1500-RCVD-DATE. DTSBD551 01661 IF WORK-PARM-TIMELY-NO-88 DTSBD551 01662 MOVE WORK-PARM-RECEIVED-DATE TO L001-CAL-6-DATE-X DTSBD551 01663 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBD551 01664 IF L001-VALID-DATE DTSBD551 01665 MOVE L001-FED-8-DATE-9 TO W-PARM-RECEIVED-DATE DTSBD551 01666 ELSE DTSBD551 01667 DISPLAY 'INVALID PARM RECEIVED DATE ' DTSBD551 01668 WORK-PARM-RECEIVED-DATE DTSBD551 01669 SET W-ERROR-YES-88 TO TRUE DTSBD551 01670 END-IF DTSBD551 01671 ELSE DTSBD551 01672 MOVE ZEROS TO W-PARM-RECEIVED-DATE DTSBD551 01673 END-IF. DTSBD551 01674 DTSBD551 01675 I1500-EXIT. DTSBD551 01676 EXIT. DTSBD551 01677 DTSBD551 01678 I1600-BYPASS-ERR. DTSBD551 01679 IF WORK-PARM-BYPASS-ERR-YES-88 DTSBD551 01680 OR WORK-PARM-BYPASS-ERR-NO-88 DTSBD551 01681 MOVE WORK-PARM-BYPASS-ERR-IND TO W-PARM-BYPASS-ERR-IND DTSBD551 01682 ELSE DTSBD551 01683 DISPLAY 'INVALID BYPASS ERROR IND: ' DTSBD551 01684 WORK-PARM-BYPASS-ERR-IND DTSBD551 01685 SET W-ERROR-YES-88 TO TRUE DTSBD551 01686 END-IF. DTSBD551 01687 DTSBD551 01688 DISPLAY 'I1600 ' W-PARM-BYPASS-ERR-IND. DTSBD551 01689 I1600-EXIT. DTSBD551 01690 EXIT. DTSBD551 01691 DTSBD551 01692 I1700-ALLOW-DUP. DTSBD551 01693 IF PARM-ALLOW-DUP-YES-88 DTSBD551 01694 OR PARM-ALLOW-DUP-NO-88 DTSBD551 01695 MOVE PARM-ALLOW-DUP-IND TO W-PARM-ALLOW-DUP-IND DTSBD551 01696 ELSE DTSBD551 01697 DISPLAY 'INVALID ALLOW DUP IND: ' DTSBD551 01698 PARM-ALLOW-DUP-IND DTSBD551 01699 SET W-ERROR-YES-88 TO TRUE DTSBD551 01700 END-IF. DTSBD551 01701 DTSBD551 01702 DISPLAY 'I1700 ' W-PARM-ALLOW-DUP-IND. DTSBD551 01703 I1700-EXIT. DTSBD551 01704 EXIT. DTSBD551 01705 DTSBD551 01706 I2000-OPEN-FILES. DTSBD551 01707 OPEN I-O CURR-BATCH-NO. DTSBD551 01708 IF BATCH-STATUS-OK-88 DTSBD551 01709 READ CURR-BATCH-NO DTSBD551 01710 IF BATCH-STATUS-OK-88 DTSBD551 01711 MOVE CURRENT-ARCHIVE-YEAR TO W-ARCHIVE-CURR-YEAR DTSBD551 01712 MOVE FIRST-ARCHIVE-YEAR TO W-ARCHIVE-FIRST-YEAR DTSBD551 01713 COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1) DTSBD551 01714 MOVE W-PSEUDO-BATCH-NO TO W-START-BATCH DTSBD551 01715 MOVE ZERO TO W-PSEUDO-ITEM-NO DTSBD551 01716 DISPLAY 'CURRENT BATCH ' W-PSEUDO-BATCH-NO DTSBD551 01717 DISPLAY 'CURRENT ITEM ' W-PSEUDO-ITEM-NO DTSBD551 01718 DISPLAY 'CURRENT YEAR ' W-ARCHIVE-CURR-YEAR DTSBD551 01719 DISPLAY 'FIRST YEAR ' W-ARCHIVE-FIRST-YEAR DTSBD551 01720 ELSE DTSBD551 01721 SET W-ERROR-YES-88 TO TRUE DTSBD551 01722 DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBD551 01723 BATCH-STATUS DTSBD551 01724 GO TO I2000-EXIT DTSBD551 01725 END-IF DTSBD551 01726 ELSE DTSBD551 01727 SET W-ERROR-YES-88 TO TRUE DTSBD551 01728 DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBD551 01729 BATCH-STATUS DTSBD551 01730 GO TO I2000-EXIT DTSBD551 01731 END-IF. DTSBD551 01732 DTSBD551 01733 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD551 01734 DTSBD551 01735 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD551 01736 DTSBD551 01737 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD551 01738 DTSBD551 01739 PERFORM S1500-OPEN-WAGE-OUT THRU S1500-EXIT. DTSBD551 01740 IF W-ERROR-YES-88 DTSBD551 01741 GO TO I2000-EXIT DTSBD551 01742 END-IF. DTSBD551 01743 DTSBD551 01744 OPEN OUTPUT SUBMITTER-FILE. DTSBD551 01745 IF SUBMITTER-STATUS-OK-88 DTSBD551 01746 NEXT SENTENCE DTSBD551 01747 ELSE DTSBD551 01748 SET W-ERROR-YES-88 TO TRUE DTSBD551 01749 DISPLAY 'CANNOT OPEN SUBMITTER FILE ' SUBMITTER-STATUS DTSBD551 01750 GO TO I2000-EXIT DTSBD551 01751 END-IF. DTSBD551 01752 DTSBD551 01753 OPEN OUTPUT EMP-RPT-FILE. DTSBD551 01754 IF EMP-RPT-STATUS-OK-88 DTSBD551 01755 NEXT SENTENCE DTSBD551 01756 ELSE DTSBD551 01757 SET W-ERROR-YES-88 TO TRUE DTSBD551 01758 DISPLAY 'CANNOT OPEN EMP-RPT FILE ' EMP-RPT-STATUS DTSBD551 01759 GO TO I2000-EXIT DTSBD551 01760 END-IF. DTSBD551 01761 DTSBD551 01762 OPEN OUTPUT MESSAGE-FILE. DTSBD551 01763 IF MSG-STATUS-OK-88 DTSBD551 01764 NEXT SENTENCE DTSBD551 01765 ELSE DTSBD551 01766 SET W-ERROR-YES-88 TO TRUE DTSBD551 01767 DISPLAY 'CANNOT OPEN MESSAGE FILE ' MSG-STATUS DTSBD551 01768 GO TO I2000-EXIT DTSBD551 01769 END-IF. DTSBD551 01770 DTSBD551 01771 MOVE 'N' TO L927-TRACE-IND. DTSBD551 01772 MOVE W-MOD-NAME TO L927-MOD-NAME. DTSBD551 01773 PERFORM S927A-OPEN THRU S927A-EXIT. DTSBD551 01774 DTSBD551 01775 *** INITALIZE REPORT RECORD DTSBD551 01776 MOVE LENGTH OF R551-REC TO R551-LENGTH. DTSBD551 01777 MOVE '551' TO R551-REC-TYPE. DTSBD551 01778 DTSBD551 01779 MOVE LENGTH OF R202-REC TO R202-LENGTH. DTSBD551 01780 MOVE '202' TO R202-REC-TYPE. DTSBD551 01781 *** DTSBD551 01782 I2000-EXIT. DTSBD551 01783 EXIT. DTSBD551 01784 DTSBD551 01785 *I2500-INIT-LOG. DTSBD551 01786 * DISPLAY 'PARM LOG NO ' PARM-LOG-NO. DTSBD551 01787 * IF PARM-LOG-NO NOT NUMERIC DTSBD551 01788 * DISPLAY 'LOG NUMBER REQUIRED ' DTSBD551 01789 * SET W-ERROR-YES-88 TO TRUE DTSBD551 01790 * ELSE DTSBD551 01791 * MOVE PARM-LOG-NO TO W-PARM-LOG-NO DTSBD551 01792 * SET L200-CMD-INIT-88 TO TRUE DTSBD551 01793 * MOVE W-PARM-LOG-NO TO L200-LOG-NO-SFX DTSBD551 01794 * MOVE W-MOD-NAME TO L200-PROG-NAME DTSBD551 01795 * PERFORM S200-INIT-LOG THRU S200-EXIT DTSBD551 01796 * MOVE L200-LOG-NO TO W-LOG-NO DTSBD551 01797 * DISPLAY 'PARM-LOG-NO = ' W-LOG-NO DTSBD551 01798 * END-IF. DTSBD551 01799 * DTSBD551 01800 *I2500-EXIT. DTSBD551 01801 * EXIT. DTSBD551 01802 DTSBD551 01803 I3000-READ-HDR. DTSBD551 01804 MOVE LOW-VALUES TO MSKL-REC. DTSBD551 01805 MOVE +0 TO MSKL-EMP-NO. DTSBD551 01806 SET MSKL-HDR-88 TO TRUE. DTSBD551 01807 DTSBD551 01808 PERFORM S910-READ THRU S910-EXIT. DTSBD551 01809 IF L910-NO-REC-88 DTSBD551 01810 DISPLAY 'DTSBD551: MHDR RECORD IS MISSING' DTSBD551 01811 SET W-ERROR-YES-88 TO TRUE DTSBD551 01812 GO TO I3000-EXIT DTSBD551 01813 ELSE DTSBD551 01814 MOVE MSKL-REC TO MHDR-REC DTSBD551 01815 END-IF. DTSBD551 01816 DTSBD551 01817 ** MOVE MHDR-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBD551 01818 ** MOVE L001-FED-8-YR TO W-LOG-YEAR. DTSBD551 01819 ** DISPLAY 'LOG NUMBER: ' W-LOG-NO. DTSBD551 01820 DTSBD551 01821 MOVE MHDR-CURR-RUN-DATE TO L004-DATE DTSBD551 01822 W-CURR-DATE. DTSBD551 01823 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBD551 01824 MOVE L004-QTR-5-9 TO W-CURR-QTR. DTSBD551 01825 MOVE L004-QTR-DEFAULT-DUE-DATE TO W-DEFAULT-RCVD-DT. DTSBD551 01826 SUBTRACT +12 FROM L004-ABS-QTR. DTSBD551 01827 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD551 01828 IF WORK-PARM-RUN-TYPE-ANY-88 DTSBD551 01829 MOVE ZERO TO W-EARLIEST-QTR DTSBD551 01830 ELSE DTSBD551 01831 MOVE L004-ABS-QTR TO W-EARLIEST-QTR DTSBD551 01832 END-IF. DTSBD551 01833 DTSBD551 01834 DISPLAY 'CURR QTR ' W-CURR-QTR ' EARLIEST ' W-EARLIEST-QTR. DTSBD551 01835 DISPLAY 'DEFAULT RECEIVED DATE ' W-DEFAULT-RCVD-DT. DTSBD551 01836 DTSBD551 01837 I3000-EXIT. DTSBD551 01838 EXIT. DTSBD551 01839 DTSBD551 01840 I3100-SYS-DATE. DTSBD551 01841 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD551 01842 DTSBD551 01843 I3100-EXIT. DTSBD551 01844 EXIT. DTSBD551 01845 DTSBD551 01846 I4000-READ-FIRST. DTSBD551 01847 READ ICESA-FILE. DTSBD551 01848 IF ICESA-STATUS-OK-88 DTSBD551 01849 ADD +1 TO W-INPUT-READ-CNT DTSBD551 01850 ELSE DTSBD551 01851 DISPLAY 'BAD FIRST READ ' ICESA-STATUS DTSBD551 01852 SET W-ERROR-YES-88 TO TRUE DTSBD551 01853 GO TO I4000-EXIT DTSBD551 01854 END-IF. DTSBD551 01855 DTSBD551 01856 IF ICESA-REC-TYPE-A-88 DTSBD551 01857 NEXT SENTENCE DTSBD551 01858 ELSE DTSBD551 01859 DISPLAY 'FIRST RECORD NOT TYPE A: ' ICESA-REC-TYPE DTSBD551 01860 SET W-ERROR-YES-88 TO TRUE DTSBD551 01861 GO TO I4000-EXIT DTSBD551 01862 END-IF. DTSBD551 01863 DTSBD551 01864 DTSBD551 01865 I4000-EXIT. DTSBD551 01866 EXIT. DTSBD551 01867 DTSBD551 01868 I4100-SUBMITTERS. DTSBD551 01869 OPEN INPUT SUBMITTER-GDG. DTSBD551 01870 IF CURBX210-STATUS-OK-88 DTSBD551 01871 NEXT SENTENCE DTSBD551 01872 ELSE DTSBD551 01873 SET W-ERROR-YES-88 TO TRUE DTSBD551 01874 DISPLAY 'CANNOT OPEN SUBMITTER GDG ' CURBX210-STATUS DTSBD551 01875 GO TO I4100-EXIT DTSBD551 01876 END-IF. DTSBD551 01877 DTSBD551 01878 PERFORM DTSBD551 01879 VARYING SUB3 FROM +1 BY +1 DTSBD551 01880 UNTIL SUB3 > SB-MAX DTSBD551 01881 MOVE +0 TO W-SB-FEIN (SUB3) DTSBD551 01882 END-PERFORM. DTSBD551 01883 DTSBD551 01884 READ SUBMITTER-GDG INTO W-SUBMITTER-REC. DTSBD551 01885 IF CURBX210-STATUS-OK-88 DTSBD551 01886 PERFORM UNTIL CURBX210-STATUS-EOF-88 DTSBD551 01887 IF SB-LAST < SB-MAX DTSBD551 01888 ADD +1 TO SB-LAST DTSBD551 01889 MOVE X210-FEIN TO W-SB-FEIN (SB-LAST) DTSBD551 01890 READ SUBMITTER-GDG INTO W-SUBMITTER-REC DTSBD551 01891 ELSE DTSBD551 01892 DISPLAY 'SUBMITTER TABLE LENGTH EXCEEDED' DTSBD551 01893 SET CURBX210-STATUS-EOF-88 TO TRUE DTSBD551 01894 END-IF DTSBD551 01895 END-PERFORM DTSBD551 01896 END-IF. DTSBD551 01897 DTSBD551 01898 CLOSE SUBMITTER-GDG. DTSBD551 01899 DTSBD551 01900 DTSBD551 01901 I4100-EXIT. DTSBD551 01902 EXIT. DTSBD551 01903 DTSBD551 01904 EJECT DTSBD551 01905 P0000-PROCESS. DTSBD551 01906 DISPLAY 'ICESA CONTRIBUTION AND WAGE REPORTS '. DTSBD551 01907 DISPLAY SPACE. DTSBD551 01908 DTSBD551 01909 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBD551 01910 DTSBD551 01911 PERFORM P1000-READ-INPUT THRU P1000-EXIT DTSBD551 01912 UNTIL ICESA-STATUS-EOF-88 DTSBD551 01913 OR W-ERROR-YES-88. DTSBD551 01914 DTSBD551 01915 ********************************************************** DTSBD551 01916 * IF LAST RECORD TYPE IS NOT F AT END OF FILE, THE DTSBD551 01917 * SUBMISSION IS INCOMPLETE. DTSBD551 01918 ********************************************************** DTSBD551 01919 IF ICESA-STATUS-EOF-88 DTSBD551 01920 IF NOT W-PREV-REC-TYPE-F-88 DTSBD551 01921 DISPLAY 'INCOMPLETE SUBMISSION. LAST REC TYPE IS: ' DTSBD551 01922 W-PREV-REC-TYPE DTSBD551 01923 MOVE MSG-F9 TO R551-MSG-TEXT DTSBD551 01924 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD551 01925 MOVE A-NAME TO R551-SUBMITTER-NAME DTSBD551 01926 MOVE A-CONTACT TO R551-CONTACT-NAME DTSBD551 01927 MOVE A-CONTACT-PHONE TO R551-CONTACT-PHONE DTSBD551 01928 MOVE A-PHONE-BOX TO R551-CONTACT-PHONE-EXT DTSBD551 01929 MOVE W-INPUT-READ-CNT TO R551-REC-NO DTSBD551 01930 SET R551-RPT-TYPE-FATAL-88 TO TRUE DTSBD551 01931 MOVE ICESA-REC-TYPE TO R551-ICESA-REC-TYPE DTSBD551 01932 MOVE R551-REC TO RSKL-REC DTSBD551 01933 PERFORM S946-RPT-1 THRU S946-EXIT DTSBD551 01934 END-IF DTSBD551 01935 END-IF. DTSBD551 01936 DTSBD551 01937 P0000-EXIT. DTSBD551 01938 EXIT. DTSBD551 01939 EJECT DTSBD551 01940 DTSBD551 01941 P1000-READ-INPUT. DTSBD551 01942 EVALUATE TRUE DTSBD551 01943 WHEN ICESA-REC-TYPE-A-88 DTSBD551 01944 PERFORM P1100-TYPE-A THRU P1100-EXIT DTSBD551 01945 DTSBD551 01946 WHEN ICESA-REC-TYPE-B-88 DTSBD551 01947 PERFORM P1200-TYPE-B THRU P1200-EXIT DTSBD551 01948 DTSBD551 01949 WHEN ICESA-REC-TYPE-E-88 DTSBD551 01950 PERFORM P1300-TYPE-E THRU P1300-EXIT DTSBD551 01951 DTSBD551 01952 WHEN ICESA-REC-TYPE-S-88 DTSBD551 01953 PERFORM P1400-TYPE-S THRU P1400-EXIT DTSBD551 01954 DTSBD551 01955 WHEN ICESA-REC-TYPE-T-88 DTSBD551 01956 PERFORM P1500-TYPE-T THRU P1500-EXIT DTSBD551 01957 DTSBD551 01958 WHEN ICESA-REC-TYPE-F-88 DTSBD551 01959 PERFORM P1600-TYPE-F THRU P1600-EXIT DTSBD551 01960 DTSBD551 01961 END-EVALUATE. DTSBD551 01962 DTSBD551 01963 IF W-ERROR-YES-88 DTSBD551 01964 GO TO P1000-EXIT DTSBD551 01965 ELSE DTSBD551 01966 READ ICESA-FILE DTSBD551 01967 IF ICESA-STATUS-OK-88 DTSBD551 01968 OR ICESA-STATUS-EOF-88 DTSBD551 01969 ADD +1 TO W-INPUT-READ-CNT DTSBD551 01970 ELSE DTSBD551 01971 DISPLAY 'BAD READ ON INPUT FILE ' ICESA-STATUS DTSBD551 01972 SET W-ERROR-YES-88 TO TRUE DTSBD551 01973 END-IF DTSBD551 01974 END-IF. DTSBD551 01975 DTSBD551 01976 P1000-EXIT. DTSBD551 01977 EXIT. DTSBD551 01978 DTSBD551 01979 P1100-TYPE-A. DTSBD551 01980 * DISPLAY 'P1100-TYEP A ' DTSBD551 01981 MOVE ICESA-REC TO WAGE-RECORD-A. DTSBD551 01982 *& DTSBD551 01983 DISPLAY 'TYPE A ' WAGE-RECORD-A (1:60). DTSBD551 01984 *& DTSBD551 01985 DTSBD551 01986 PERFORM P1110-EDIT-TYPE-A THRU P1110-EXIT DTSBD551 01987 IF W-ERROR-NO-88 DTSBD551 01988 SET W-PREV-REC-TYPE-A-88 TO TRUE DTSBD551 01989 PERFORM P1120-SAVE-TYPE-A THRU P1120-EXIT DTSBD551 01990 ELSE DTSBD551 01991 DISPLAY 'TYPE A REC NOT FIRST IN FILE ' DTSBD551 01992 W-PREV-REC-TYPE DTSBD551 01993 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 01994 MOVE W-PREV-REC-TYPE TO MSG-A1-PREV-REC-TYPE DTSBD551 01995 MOVE MSG-A1 TO R551-MSG-TEXT DTSBD551 01996 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 01997 END-IF. DTSBD551 01998 DTSBD551 01999 P1100-EXIT. DTSBD551 02000 EXIT. DTSBD551 02001 DTSBD551 02002 P1110-EDIT-TYPE-A. DTSBD551 02003 * DISPLAY 'P1110-TYEP A ' DTSBD551 02004 IF A-FEDERAL-EIN NOT NUMERIC DTSBD551 02005 * DISPLAY 'TYPE A: NON-NUMERIC FEIN ' A-FEDERAL-EIN DTSBD551 02006 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02007 MOVE A-FEDERAL-EIN TO MSG-A2-FEIN DTSBD551 02008 MOVE MSG-A2 TO R551-MSG-TEXT DTSBD551 02009 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02010 END-IF. DTSBD551 02011 DTSBD551 02012 IF A-NAME = SPACES DTSBD551 02013 * DISPLAY 'TYPE A: SUBMITTER NAME MISSING' DTSBD551 02014 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02015 MOVE MSG-A3 TO R551-MSG-TEXT DTSBD551 02016 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02017 END-IF. DTSBD551 02018 DTSBD551 02019 ************************************************************* DTSBD551 02020 * 02/07/2012: EDITS ON CONTACT INFORMATION REMOVED. DTSBD551 02021 * THE ICESA WEB APPLICATION HANDLES THIS INFORMATION. DTSBD551 02022 ************************************************************* DTSBD551 02023 * IF A-STREET = SPACES DTSBD551 02024 * OR A-CITY = SPACES DTSBD551 02025 * OR A-STATE = SPACES DTSBD551 02026 * DISPLAY 'TYPE A: SUBMITTER ADDRESS MISSING' DTSBD551 02027 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02028 * MOVE MSG-A4 TO R551-MSG-TEXT DTSBD551 02029 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02030 * END-IF. DTSBD551 02031 * DTSBD551 02032 * IF A-ZIP-CODE = SPACES DTSBD551 02033 * DISPLAY 'TYPE A: SUBMITTER ZIP CODE MISSING' DTSBD551 02034 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02035 * MOVE MSG-A5 TO R551-MSG-TEXT DTSBD551 02036 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02037 * END-IF. DTSBD551 02038 * DTSBD551 02039 * IF A-CONTACT = SPACES DTSBD551 02040 * DISPLAY 'TYPE A: CONTACT NAME MISSING' DTSBD551 02041 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02042 * MOVE MSG-A6 TO R551-MSG-TEXT DTSBD551 02043 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02044 * END-IF. DTSBD551 02045 * DTSBD551 02046 * IF A-CONTACT-PHONE = SPACES DTSBD551 02047 * DISPLAY 'TYPE A: CONTACT PHONE MISSING' DTSBD551 02048 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02049 * MOVE MSG-A7 TO R551-MSG-TEXT DTSBD551 02050 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02051 * END-IF. DTSBD551 02052 * DTSBD551 02053 IF A-MEDIA-DATE NOT NUMERIC DTSBD551 02054 DISPLAY 'TYPE A: NON-NUMERIC MEDIA CREATE DATE ' DTSBD551 02055 A-MEDIA-DATE DTSBD551 02056 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02057 MOVE A-MEDIA-DATE TO MSG-A8-MEDIA-DATE DTSBD551 02058 MOVE MSG-A8 TO R551-MSG-TEXT DTSBD551 02059 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02060 ELSE DTSBD551 02061 MOVE A-MEDIA-DATE TO L001-CAL-8-DATE-X DTSBD551 02062 PERFORM S001-FROM-CAL-8 THRU S001-EXIT DTSBD551 02063 IF L001-VALID-DATE DTSBD551 02064 MOVE L001-FED-8-DATE-9 TO W-SUBM-CREATE-DATE DTSBD551 02065 ELSE DTSBD551 02066 * DISPLAY 'TYPE A: INVALID MEDIA CREATE DATE ' DTSBD551 02067 * A-MEDIA-DATE DTSBD551 02068 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02069 MOVE A-MEDIA-DATE TO MSG-A9-MEDIA-DATE DTSBD551 02070 MOVE MSG-A9 TO R551-MSG-TEXT DTSBD551 02071 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02072 END-IF DTSBD551 02073 END-IF. DTSBD551 02074 DTSBD551 02075 DTSBD551 02076 IF W-PARM-ALLOW-DUP-YES-88 DTSBD551 02077 NEXT SENTENCE DTSBD551 02078 ELSE DTSBD551 02079 PERFORM DTSBD551 02080 VARYING SUB3 FROM +1 BY +1 DTSBD551 02081 UNTIL SUB3 > SB-LAST DTSBD551 02082 IF W-SB-FEIN (SUB3) = A-FEDERAL-EIN DTSBD551 02083 DISPLAY 'P1110: DUPLICATE SUBMISSION ' DTSBD551 02084 A-FEDERAL-EIN DTSBD551 02085 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02086 MOVE A-FEDERAL-EIN TO MSG-A10-FEIN DTSBD551 02087 MOVE MSG-A10 TO R551-MSG-TEXT DTSBD551 02088 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02089 SET W-ERROR-YES-88 TO TRUE DTSBD551 02090 END-IF DTSBD551 02091 END-PERFORM DTSBD551 02092 END-IF. DTSBD551 02093 DTSBD551 02094 * IF A-REMITT-AMOUNT NOT NUMERIC DTSBD551 02095 * DISPLAY 'TYPE A: NON-NUMERIC REMIT AMT ' DTSBD551 02096 * A-REMITT-AMOUNT DTSBD551 02097 * SET W-ERROR-YES-88 TO TRUE DTSBD551 02098 * END-IF. DTSBD551 02099 DTSBD551 02100 P1110-EXIT. DTSBD551 02101 EXIT. DTSBD551 02102 DTSBD551 02103 P1111-LOG-RCV-REMIT. DTSBD551 02104 * DISPLAY 'P1111-TYEP A ' DTSBD551 02105 PERFORM DTSBD551 02106 VARYING SUB1 FROM +1 BY +1 DTSBD551 02107 UNTIL SUB1 > +100 DTSBD551 02108 MOVE +0 TO L205-FIELD-LENGTH (SUB1) DTSBD551 02109 L205-INTEGER (SUB1) DTSBD551 02110 L205-FRACTION (SUB1) DTSBD551 02111 MOVE SPACES TO L205-TEXT (SUB1) DTSBD551 02112 L205-DATE (SUB1) DTSBD551 02113 SET L205-TYPE-TEXT-88 (SUB1) TO TRUE DTSBD551 02114 END-PERFORM. DTSBD551 02115 DTSBD551 02116 MOVE +4 TO L205-LAST-FIELD DTSBD551 02117 MOVE +10 TO L205-LAST-FIELD-LEN DTSBD551 02118 DTSBD551 02119 MOVE +1 TO L205-FIELD-LENGTH (1). DTSBD551 02120 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBD551 02121 DTSBD551 02122 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBD551 02123 SET L205-TYPE-NUMBER-88 (2) TO TRUE. DTSBD551 02124 DTSBD551 02125 MOVE +13 TO L205-FIELD-LENGTH (3). DTSBD551 02126 SET L205-TYPE-NUMBER-88 (3) TO TRUE. DTSBD551 02127 DTSBD551 02128 SET L205-TYPE-DATE-88 (4) TO TRUE. DTSBD551 02129 DTSBD551 02130 MOVE ICESA-REC (1:30) TO L205-INPUT-DATA. DTSBD551 02131 DISPLAY ' WEB HDR REC=' L205-INPUT-DATA (1:30). DTSBD551 02132 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBD551 02133 DTSBD551 02134 IF L205-TEXT (1) (1:1) NOT = '1' DTSBD551 02135 DISPLAY 'INVALID TYPE 1 RECORD ' L205-TEXT (1) (1:10) DTSBD551 02136 SET W-ERROR-YES-88 TO TRUE DTSBD551 02137 GO TO P1111-EXIT DTSBD551 02138 END-IF. DTSBD551 02139 DTSBD551 02140 IF L205-VALID-NO-88 (2) DTSBD551 02141 DISPLAY ' LOG NO ' L205-INTEGER (2) DTSBD551 02142 * MOVE A-LOG-REMIT TO MSG-A11-LOG-REMIT DTSBD551 02143 MOVE MSG-A11 TO R551-MSG-TEXT DTSBD551 02144 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02145 ELSE DTSBD551 02146 MOVE L205-INTEGER (2) TO WORK-PARM-LOG-NO DTSBD551 02147 W-LOG-NO DTSBD551 02148 DISPLAY '**** LOG-NO ' WORK-PARM-LOG-NO DTSBD551 02149 END-IF. DTSBD551 02150 DTSBD551 02151 DTSBD551 02152 DTSBD551 02153 DTSBD551 02154 IF L205-VALID-NO-88 (3) DTSBD551 02155 DISPLAY ' REMIT DOLLS ' L205-INTEGER (3) DTSBD551 02156 DISPLAY ' REMIT CENTS ' L205-FRACTION (3) DTSBD551 02157 * MOVE A-LOG-REMIT TO MSG-A12-LOG-REMIT DTSBD551 02158 MOVE MSG-A12 TO R551-MSG-TEXT DTSBD551 02159 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02160 ELSE DTSBD551 02161 MOVE L205-INTEGER (3) TO W-INTEGER DTSBD551 02162 MOVE L205-FRACTION (3) TO W-FRACTION DTSBD551 02163 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION DTSBD551 02164 MOVE W-NUMBER TO W-PARM-DEPOSIT-REMIT DTSBD551 02165 MOVE W-NUMBER TO WORK-PARM-TOT-REMITTANCE DTSBD551 02166 END-IF. DTSBD551 02167 DTSBD551 02168 IF L205-VALID-YES-88 (4) DTSBD551 02169 MOVE L205-DATE (4) TO L001-SLASH-8-DATE DTSBD551 02170 MOVE L001-SLASH-8-MO TO L001-FED-8-MO DTSBD551 02171 MOVE L001-SLASH-8-DA TO L001-FED-8-DA DTSBD551 02172 MOVE L001-SLASH-8-YR TO L001-FED-8-YR DTSBD551 02173 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBD551 02174 IF L001-VALID-DATE DTSBD551 02175 MOVE L001-FED-8-DATE-9 TO WORK-PARM-RECEIVED-DATE DTSBD551 02176 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBD551 02177 ELSE DTSBD551 02178 DISPLAY 'USING DEFAULT RCVD DT ' W-DEFAULT-RCVD-DT DTSBD551 02179 MOVE W-DEFAULT-RCVD-DT TO WORK-PARM-RECEIVED-DATE DTSBD551 02180 MOVE W-DEFAULT-RCVD-DT TO W-RECEIVED-DATE DTSBD551 02181 END-IF DTSBD551 02182 END-IF. DTSBD551 02183 DTSBD551 02184 MOVE W-PARM-DEPOSIT-REMIT TO W-AMT-DISP1. DTSBD551 02185 DISPLAY 'P1111 - LOG: ' WORK-PARM-LOG-NO DTSBD551 02186 ' REMIT: ' W-AMT-DISP1 DTSBD551 02187 ' RCV DTE: ' WORK-PARM-RECEIVED-DATE. DTSBD551 02188 P1111-EXIT. DTSBD551 02189 EXIT. DTSBD551 02190 DTSBD551 02191 P1120-SAVE-TYPE-A. DTSBD551 02192 * DISPLAY 'P1120-TYEP A ' DTSBD551 02193 *& DTSBD551 02194 DISPLAY 'TYPE A OK ' A-FEDERAL-EIN ' ' A-NAME. DTSBD551 02195 *& DTSBD551 02196 MOVE A-FEDERAL-EIN TO W-SUBM-FEIN DTSBD551 02197 X210-FEIN. DTSBD551 02198 MOVE A-NAME TO W-SUBM-NAME DTSBD551 02199 X210-NAME. DTSBD551 02200 MOVE A-STREET TO W-SUBM-STREET DTSBD551 02201 X210-STREET. DTSBD551 02202 MOVE A-CITY TO W-SUBM-CITY DTSBD551 02203 X210-CITY. DTSBD551 02204 MOVE A-STATE TO W-SUBM-STATE DTSBD551 02205 X210-STATE. DTSBD551 02206 MOVE A-ZIP-CODE TO W-SUBM-ZIP DTSBD551 02207 W-ZIP5. DTSBD551 02208 MOVE A-ZIP-CODE-EXT TO W-SUBM-ZIP-EXT DTSBD551 02209 W-ZIP-PLUS4. DTSBD551 02210 MOVE W-ZIP TO X210-ZIP. DTSBD551 02211 MOVE A-CONTACT TO W-SUBM-CONTACT-NAME DTSBD551 02212 X210-CONTACT-NAME. DTSBD551 02213 MOVE A-CONTACT-PHONE TO W-SUBM-CONTACT-PHONE DTSBD551 02214 X210-CONTACT-PHONE. DTSBD551 02215 MOVE A-PHONE-BOX TO W-SUBM-CONTACT-PHONE-EXT DTSBD551 02216 X210-CONTACT-PHONE-EXT. DTSBD551 02217 *** MOVE A-REMITT-AMOUNT TO W-SUBM-REMIT-AMT-X DTSBD551 02218 MOVE A-MEDIA-DATE TO L001-CAL-8-DATE-X. DTSBD551 02219 PERFORM S001-FROM-CAL-8 THRU S001-EXIT DTSBD551 02220 MOVE L001-SLASH-8-DATE TO X210-ESTB-DATE. DTSBD551 02221 DTSBD551 02222 MOVE L005-SLASH-8-DATE TO X210-RUN-DATE. DTSBD551 02223 MOVE L005-DISPLAY-TIME TO X210-RUN-TIME. DTSBD551 02224 DTSBD551 02225 INSPECT X210-NAME REPLACING ALL ',' BY SPACE. DTSBD551 02226 INSPECT X210-STREET REPLACING ALL ',' BY SPACE. DTSBD551 02227 INSPECT X210-CITY REPLACING ALL ',' BY SPACE. DTSBD551 02228 INSPECT X210-STATE REPLACING ALL ',' BY SPACE. DTSBD551 02229 INSPECT X210-CONTACT-NAME DTSBD551 02230 REPLACING ALL ',' BY SPACE. DTSBD551 02231 DTSBD551 02232 *** WRITE MOVED TO T1110 DTSBD551 02233 *** WRITE SUBMITTER-REC FROM W-SUBMITTER-REC. DTSBD551 02234 * IF SUBMITTER-STATUS-OK-88 DTSBD551 02235 * NEXT SENTENCE DTSBD551 02236 * ELSE DTSBD551 02237 * SET W-ERROR-YES-88 TO TRUE DTSBD551 02238 * DISPLAY 'CANNOT WRITE SUBMITTER FILE: ' DTSBD551 02239 * SUBMITTER-STATUS DTSBD551 02240 *** END-IF. DTSBD551 02241 DTSBD551 02242 P1120-EXIT. DTSBD551 02243 EXIT. DTSBD551 02244 DTSBD551 02245 P1199-FATAL-ERROR. DTSBD551 02246 DTSBD551 02247 IF A-FEDERAL-EIN NUMERIC DTSBD551 02248 MOVE A-FEDERAL-EIN TO R551-SUBMITTER-FEIN DTSBD551 02249 ELSE DTSBD551 02250 MOVE ZERO TO R551-SUBMITTER-FEIN DTSBD551 02251 END-IF. DTSBD551 02252 DTSBD551 02253 IF W-PARM-BYPASS-ERR-YES-88 DTSBD551 02254 NEXT SENTENCE DTSBD551 02255 ELSE DTSBD551 02256 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD551 02257 MOVE A-NAME TO R551-SUBMITTER-NAME DTSBD551 02258 MOVE A-CONTACT TO R551-CONTACT-NAME DTSBD551 02259 MOVE A-CONTACT-PHONE TO R551-CONTACT-PHONE DTSBD551 02260 MOVE A-PHONE-BOX TO R551-CONTACT-PHONE-EXT DTSBD551 02261 MOVE W-INPUT-READ-CNT TO R551-REC-NO DTSBD551 02262 SET R551-RPT-TYPE-FATAL-88 TO TRUE DTSBD551 02263 MOVE ICESA-REC-TYPE TO R551-ICESA-REC-TYPE DTSBD551 02264 MOVE R551-REC TO RSKL-REC DTSBD551 02265 PERFORM S946-RPT-1 THRU S946-EXIT DTSBD551 02266 END-IF. DTSBD551 02267 DTSBD551 02268 DISPLAY 'P1199 ' W-FATAL-ERROR-IND ' ' DTSBD551 02269 W-PARM-BYPASS-ERR-IND. DTSBD551 02270 P1199-EXIT. DTSBD551 02271 EXIT. DTSBD551 02272 DTSBD551 02273 P1200-TYPE-B. DTSBD551 02274 * DISPLAY 'P1200-TYEP B ' DTSBD551 02275 MOVE ICESA-REC TO WAGE-RECORD-B. DTSBD551 02276 *& DTSBD551 02277 * DISPLAY 'TYPE B '. DTSBD551 02278 *& DTSBD551 02279 P1200-EXIT. DTSBD551 02280 EXIT. DTSBD551 02281 DTSBD551 02282 P1300-TYPE-E. DTSBD551 02283 * DISPLAY 'P1300-TYEP E ' DTSBD551 02284 * DISPLAY ' ERROR IND ' W-ERROR-IND. DTSBD551 02285 * DISPLAY ' FATAL IND ' W-FATAL-ERROR-IND DTSBD551 02286 MOVE ICESA-REC TO WAGE-RECORD-E. DTSBD551 02287 *& DTSBD551 02288 DISPLAY 'TYPE E ' WAGE-RECORD-E (1:60). DTSBD551 02289 *& DTSBD551 02290 DTSBD551 02291 * DISPLAY SPACE. DTSBD551 02292 * IF E-ACCOUNT-NO = '121131' DTSBD551 02293 * DISPLAY 'EMPLOYER ACCT ' E-ACCOUNT-NO DTSBD551 02294 * ' FEIN ' E-FEDERAL-EIN. DTSBD551 02295 DTSBD551 02296 SET W-WAGES-EXPECTED-NO-88 TO TRUE. DTSBD551 02297 MOVE SPACES TO L601-RETURN-CODE. DTSBD551 02298 SET W-EMP-FOUND-YES-88 TO TRUE. DTSBD551 02299 SET W-LIABLE-YES-88 TO TRUE. DTSBD551 02300 SET W-DUP-RPT-NO-88 TO TRUE. DTSBD551 02301 SET W-ANNUAL-QTR-NO-88 TO TRUE. DTSBD551 02302 ** SET W-SUCCESSOR-NO-88 TO TRUE. DTSBD551 02303 MOVE ZERO TO W-EMP-NO DTSBD551 02304 W-FEIN-EMP-NO DTSBD551 02305 W-FINAL-FEIN DTSBD551 02306 W-PRED-NO DTSBD551 02307 W-EMP-TOT-WAGE DTSBD551 02308 W-EMP-TAX-WAGE DTSBD551 02309 W-EMP-WAGE-CNT DTSBD551 02310 W-UI-RATE DTSBD551 02311 W-EDITED-E-ACCT DTSBD551 02312 W-EDITED-S-ACCT. DTSBD551 02313 MOVE E-NAME TO W-EMP-NAME. DTSBD551 02314 DTSBD551 02315 IF W-PSEUDO-ITEM-NO < 999 DTSBD551 02316 ADD 1 TO W-PSEUDO-ITEM-NO DTSBD551 02317 ELSE DTSBD551 02318 ADD 1 TO W-PSEUDO-BATCH-NO DTSBD551 02319 MOVE 1 TO W-PSEUDO-ITEM-NO DTSBD551 02320 END-IF. DTSBD551 02321 DTSBD551 02322 SET W-MNTE-STARTED-NO-88 TO TRUE. DTSBD551 02323 PERFORM DTSBD551 02324 VARYING W-MNTE-TEXT-CNT FROM +1 BY +1 DTSBD551 02325 UNTIL W-MNTE-TEXT-CNT > W-MNTE-TEXT-MAX DTSBD551 02326 MOVE SPACES TO W-MNTE-TEXT (W-MNTE-TEXT-CNT) DTSBD551 02327 END-PERFORM. DTSBD551 02328 MOVE +0 TO W-MNTE-TEXT-CNT. DTSBD551 02329 DTSBD551 02330 INITIALIZE T028-REC. DTSBD551 02331 DTSBD551 02332 IF W-PREV-REC-TYPE-A-88 DTSBD551 02333 OR W-PREV-REC-TYPE-T-88 DTSBD551 02334 SET W-PREV-REC-TYPE-E-88 TO TRUE DTSBD551 02335 ELSE DTSBD551 02336 DISPLAY 'TYPE E: PREVIOUS REC TYPE NOT A OR T: ' DTSBD551 02337 W-PREV-REC-TYPE DTSBD551 02338 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02339 MOVE W-PREV-REC-TYPE TO MSG-E10-REC-TYPE DTSBD551 02340 MOVE MSG-E10 TO R551-MSG-TEXT DTSBD551 02341 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02342 GO TO P1300-EXIT DTSBD551 02343 END-IF. DTSBD551 02344 DTSBD551 02345 SET WAGE-TEMP-REQ-OPEN-OUT-88 TO TRUE. DTSBD551 02346 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT DTSBD551 02347 IF W-ERROR-YES-88 DTSBD551 02348 NEXT SENTENCE DTSBD551 02349 ELSE DTSBD551 02350 PERFORM P1310-EDIT-TYPE-E THRU P1310-EXIT DTSBD551 02351 DISPLAY ' P1310 ERROR IND ' W-ERROR-IND DTSBD551 02352 IF W-ERROR-NO-88 DTSBD551 02353 SET W-PREV-REC-TYPE-E-88 TO TRUE DTSBD551 02354 PERFORM P1320-FORMAT-T028 THRU P1320-EXIT DTSBD551 02355 IF W-EMP-FOUND-NO-88 DTSBD551 02356 MOVE W-PSEUDO-BATCH-NO TO MSG-E2-BATCH DTSBD551 02357 MOVE W-PSEUDO-ITEM-NO TO MSG-E2-ITEM DTSBD551 02358 MOVE MSG-E2 TO R551-MSG-TEXT DTSBD551 02359 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 02360 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02361 END-IF DTSBD551 02362 END-IF DTSBD551 02363 END-IF. DTSBD551 02364 DTSBD551 02365 DTSBD551 02366 P1300-EXIT. DTSBD551 02367 EXIT. DTSBD551 02368 DTSBD551 02369 P1310-EDIT-TYPE-E. DTSBD551 02370 * DISPLAY 'P1310-TYEP E ' DTSBD551 02371 * DISPLAY ' ERROR IND ' W-ERROR-IND. DTSBD551 02372 * DISPLAY ' FATAL IND ' W-FATAL-ERROR-IND DTSBD551 02373 IF E-FEDERAL-EIN NOT NUMERIC DTSBD551 02374 DISPLAY 'TYPE E: NON-NUMERIC FEIN ' E-FEDERAL-EIN DTSBD551 02375 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02376 MOVE E-FEDERAL-EIN TO MSG-E11-FEIN DTSBD551 02377 MOVE MSG-E11 TO R551-MSG-TEXT DTSBD551 02378 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02379 ELSE DTSBD551 02380 MOVE E-FEDERAL-EIN TO W-FINAL-FEIN DTSBD551 02381 END-IF. DTSBD551 02382 DTSBD551 02383 IF E-NAME = SPACES DTSBD551 02384 DISPLAY 'TYPE E: EMPLOYER NAME MISSING' DTSBD551 02385 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02386 MOVE MSG-E12 TO R551-MSG-TEXT DTSBD551 02387 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02388 END-IF. DTSBD551 02389 DTSBD551 02390 IF E-STREET = SPACES DTSBD551 02391 OR E-CITY = SPACES DTSBD551 02392 OR E-STATE = SPACES DTSBD551 02393 DISPLAY 'TYPE E: EMPLOYER ADDRESS MISSING' DTSBD551 02394 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02395 MOVE MSG-E13 TO R551-MSG-TEXT DTSBD551 02396 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02397 *** PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02398 END-IF. DTSBD551 02399 DTSBD551 02400 IF E-ZIP-CODE = SPACES DTSBD551 02401 * DISPLAY 'TYPE E: EMPLOYER ZIP CODE MISSING' DTSBD551 02402 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02403 MOVE MSG-E14 TO R551-MSG-TEXT DTSBD551 02404 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02405 *** PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02406 END-IF. DTSBD551 02407 DTSBD551 02408 * DISPLAY ' P1310 FATAL IND ' W-FATAL-ERROR-IND DTSBD551 02409 MOVE E-YEAR TO W-REPORT-CCYY. DTSBD551 02410 MOVE E-REPORT-PERIOD TO W-REPORT-MM-X. DTSBD551 02411 PERFORM S2100-REPORT-QTR THRU S2100-EXIT. DTSBD551 02412 * DISPLAY ' P13101 FATAL IND ' W-FATAL-ERROR-IND DTSBD551 02413 * PERFORM S2130-RECEIVED-DATE THRU S2130-EXIT. DTSBD551 02414 * DISPLAY ' P13102 FATAL IND ' W-FATAL-ERROR-IND DTSBD551 02415 DTSBD551 02416 IF E-STATE-CODE NOT = '11' DTSBD551 02417 DISPLAY 'TYPE E: STATE CODE NOT DC ' E-STATE-CODE DTSBD551 02418 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02419 MOVE E-STATE-CODE TO MSG-E15-STATE-CODE DTSBD551 02420 MOVE MSG-E15 TO R551-MSG-TEXT DTSBD551 02421 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02422 END-IF. DTSBD551 02423 DTSBD551 02424 IF E-WORKER-WAGE = 0 OR 1 DTSBD551 02425 MOVE E-WORKER-WAGE TO W-WAGES-EXPECTED-IND DTSBD551 02426 ELSE DTSBD551 02427 DISPLAY 'TYPE E: INVALID WORKER/WAGE CODE ' DTSBD551 02428 E-WORKER-WAGE DTSBD551 02429 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02430 MOVE E-WORKER-WAGE TO MSG-E16-WORKER-WAGE DTSBD551 02431 MOVE MSG-E16 TO R551-MSG-TEXT DTSBD551 02432 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02433 END-IF. DTSBD551 02434 DTSBD551 02435 * DISPLAY ' P1310E ERROR IND ' W-ERROR-IND DTSBD551 02436 IF W-ERROR-NO-88 DTSBD551 02437 MOVE E-ACCOUNT-NO TO W-ACCT-NBR-IN DTSBD551 02438 PERFORM P1311-TYPE-E-ACCT-NBR THRU P1311-EXIT DTSBD551 02439 PERFORM P1312-CHK-FOR-MNTE THRU P1312-EXIT DTSBD551 02440 END-IF. DTSBD551 02441 DTSBD551 02442 *& IF W-EMP-NO NOT = ZERO DTSBD551 02443 * PERFORM P1313-CHECK-ADDR-CHANGE THRU P1313-EXIT DTSBD551 02444 *& END-IF. DTSBD551 02445 DTSBD551 02446 P1310-EXIT. DTSBD551 02447 EXIT. DTSBD551 02448 DTSBD551 02449 ******================***************************************** DTSBD551 02450 * EDIT ACCOUNT NUMBER DTSBD551 02451 * INPUT: W-ACCT-NBR-IN, SET IN P1311 DTSBD551 02452 * OUTPUT: W-EMP-NO DTSBD551 02453 * DTSBD551 02454 * IF ACCOUNT NUMBER IS INVALID, SEARCH FOR A VALID EMPLOYER DTSBD551 02455 * USING THE FEIN. DTSBD551 02456 * IF THE EMPLOYER IS INACTIVE, SEARCH FOR AN ACTIVE DTSBD551 02457 * SUCCESSOR. DTSBD551 02458 * ONCE THE ACCOUNT NUMBER IS VALIDATED, CHECK WHETHER THE DTSBD551 02459 * EMPLOYER IS LIABLE FOR THE QUARTER AND HAS A UI RATE. DTSBD551 02460 * DTSBD551 02461 * IF THE EMPLOYER IS NOT LIABLE FOR THE QUARTER, BUILD DTSBD551 02462 * REPORT AND WAGE TRANSACTIONS, BUT SET 'PASSED EDITS' TO NO. DTSBD551 02463 * IF THERE IS NO RECORD OF THE EMPLOYER, BUILD DTSBD551 02464 * REPORT AND WAGE TRANSACTIONS, BUT SET 'PASSED EDITS' TO NO DTSBD551 02465 * AND SET UP A POTENTIAL EMPLOYER. DTSBD551 02466 * DTSBD551 02467 * W-EDITED-E-ACCT SAVES THE E-RECORD ACCOUNT NUMBER AFTER DTSBD551 02468 * SPACES, HYPHENS, ETC. ARE REMOVED. IT IS USED IN S2200 DTSBD551 02469 * TO ENSURE THAT THE SAME ACCOUNT NUMBER IS USED ON THE DTSBD551 02470 * BOTH THE S-RECORDS AND E-RECORDS. DTSBD551 02471 *************************************************************** DTSBD551 02472 P1311-TYPE-E-ACCT-NBR. DTSBD551 02473 * DISPLAY 'P1311-TYEP E ' DTSBD551 02474 * DISPLAY ' ERROR IND ' W-ERROR-IND. DTSBD551 02475 * DISPLAY ' FATAL IND ' W-FATAL-ERROR-IND DTSBD551 02476 MOVE ZERO TO SUB2. DTSBD551 02477 MOVE SPACES TO W-ACCT-NBR-OUT. DTSBD551 02478 SET W-ACCT-NBR-ERR-NO-88 TO TRUE. DTSBD551 02479 DTSBD551 02480 PERFORM DTSBD551 02481 VARYING SUB1 FROM +1 BY +1 DTSBD551 02482 UNTIL SUB1 > +15 DTSBD551 02483 IF W-ACCT-NBR-IN-X (SUB1) >= '0' DTSBD551 02484 AND W-ACCT-NBR-IN-X (SUB1) <= '9' DTSBD551 02485 IF SUB2 < W-ACCT-NBR-LEN DTSBD551 02486 ADD +1 TO SUB2 DTSBD551 02487 MOVE W-ACCT-NBR-IN-X (SUB1) DTSBD551 02488 TO W-ACCT-NBR-OUT-X (SUB2) DTSBD551 02489 ** ELSE DTSBD551 02490 ** SET W-ACCT-NBR-ERR-YES-88 TO TRUE DTSBD551 02491 END-IF DTSBD551 02492 END-IF DTSBD551 02493 END-PERFORM. DTSBD551 02494 DTSBD551 02495 IF W-ACCT-NBR-OUT = SPACES DTSBD551 02496 SET W-ACCT-NBR-ERR-YES-88 TO TRUE DTSBD551 02497 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02498 MOVE W-ACCT-NBR-IN TO MSG-E6-ACCT-NO DTSBD551 02499 MOVE MSG-E6 TO R551-MSG-TEXT DTSBD551 02500 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 02501 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02502 ELSE DTSBD551 02503 IF W-ACCT-NBR-9 NOT NUMERIC DTSBD551 02504 SET W-ACCT-NBR-ERR-YES-88 TO TRUE DTSBD551 02505 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02506 MOVE W-ACCT-NBR-IN TO MSG-E6-ACCT-NO DTSBD551 02507 MOVE MSG-E6 TO R551-MSG-TEXT DTSBD551 02508 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 02509 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02510 ELSE DTSBD551 02511 ** IF W-ACCT-NBR-ERR-YES-88 DTSBD551 02512 IF SUB2 < 6 DTSBD551 02513 DISPLAY 'TYPE E: ACCT NUMBER NOT 6 DIGITS ' DTSBD551 02514 W-ACCT-NBR-IN DTSBD551 02515 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02516 MOVE W-ACCT-NBR-IN TO MSG-E6-ACCT-NO DTSBD551 02517 MOVE MSG-E6 TO R551-MSG-TEXT DTSBD551 02518 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 02519 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02520 END-IF DTSBD551 02521 END-IF DTSBD551 02522 END-IF. DTSBD551 02523 DTSBD551 02524 MOVE W-ACCT-NBR-9 TO W-EDITED-E-ACCT. DTSBD551 02525 DTSBD551 02526 IF W-ACCT-NBR-ERR-YES-88 DTSBD551 02527 PERFORM S2050-ACCT-FROM-FEIN THRU S2050-EXIT DTSBD551 02528 IF W-FEIN-EMP-NO > ZERO DTSBD551 02529 ADD +1 TO W-ACCT-FROM-FEIN-CNT DTSBD551 02530 MOVE W-FEIN-EMP-NO TO W-EMP-NO DTSBD551 02531 PERFORM S2000-EMP-LIABILITY THRU S2000-EXIT DTSBD551 02532 PERFORM S2300-DUP-REPORT THRU S2300-EXIT DTSBD551 02533 ELSE DTSBD551 02534 SET W-EMP-FOUND-NO-88 TO TRUE DTSBD551 02535 ADD +1 TO W-ACCT-NOT-FOUND-CNT DTSBD551 02536 END-IF DTSBD551 02537 ELSE DTSBD551 02538 MOVE W-ACCT-NBR-9 TO W-EMP-NO DTSBD551 02539 PERFORM S2000-EMP-LIABILITY THRU S2000-EXIT DTSBD551 02540 PERFORM S2300-DUP-REPORT THRU S2300-EXIT DTSBD551 02541 END-IF. DTSBD551 02542 DTSBD551 02543 IF W-FEIN-EMP-NO > ZERO DTSBD551 02544 OR L601-SUCCESSOR-FOUND-88 DTSBD551 02545 OR W-EMP-FOUND-NO-88 DTSBD551 02546 NEXT SENTENCE DTSBD551 02547 ELSE DTSBD551 02548 IF E-FEDERAL-EIN NOT = MPRF-FEIN DTSBD551 02549 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02550 MSG-E9D-RPT-FEIN DTSBD551 02551 MOVE MPRF-FEIN TO MSG-E9D-TAX-FEIN DTSBD551 02552 MOVE MSG-E9D TO R551-MSG-TEXT DTSBD551 02553 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 02554 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02555 END-IF DTSBD551 02556 END-IF. DTSBD551 02557 DTSBD551 02558 P1311-EXIT. DTSBD551 02559 EXIT. DTSBD551 02560 DTSBD551 02561 P1312-CHK-FOR-MNTE. DTSBD551 02562 IF W-FEIN-EMP-NO > ZERO DTSBD551 02563 MOVE W-EMP-NO TO MSG-E7-ACCT-NO DTSBD551 02564 MOVE E-FEDERAL-EIN TO MSG-E7-FEIN DTSBD551 02565 MOVE MSG-E7 TO R551-MSG-TEXT DTSBD551 02566 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 02567 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02568 PERFORM P1397-ADD-MNTE THRU P1397-EXIT DTSBD551 02569 IF L601-SUCCESSOR-FOUND-88 DTSBD551 02570 MOVE W-PRED-NO TO MSG-E8-ACCT-NO DTSBD551 02571 MOVE W-EMP-NO TO MSG-E8-SUCCESSOR DTSBD551 02572 MOVE MSG-E8 TO R551-MSG-TEXT DTSBD551 02573 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 02574 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02575 PERFORM P1397-ADD-MNTE THRU P1397-EXIT DTSBD551 02576 END-IF DTSBD551 02577 ELSE DTSBD551 02578 IF L601-SUCCESSOR-FOUND-88 DTSBD551 02579 MOVE W-PRED-NO TO MSG-E8-ACCT-NO DTSBD551 02580 MOVE W-EMP-NO TO MSG-E8-SUCCESSOR DTSBD551 02581 MOVE MSG-E8 TO R551-MSG-TEXT DTSBD551 02582 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 02583 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02584 PERFORM P1397-ADD-MNTE THRU P1397-EXIT DTSBD551 02585 END-IF DTSBD551 02586 END-IF. DTSBD551 02587 DTSBD551 02588 P1312-EXIT. DTSBD551 02589 EXIT. DTSBD551 02590 DTSBD551 02591 P1313-CHECK-ADDR-CHANGE. DTSBD551 02592 * PERFORM P1313A-VERIFY-ADDR THRU P1313A-EXIT. DTSBD551 02593 * IF L072-ADDRESS-NOT-VALID-88 DTSBD551 02594 * GO TO P1313-EXIT DTSBD551 02595 * END-IF. DTSBD551 02596 DTSBD551 02597 MOVE LOW-VALUE TO MTAD-KEY-AREA. DTSBD551 02598 MOVE W-EMP-NO TO MTAD-EMP-NO. DTSBD551 02599 SET MTAD-TAD-88 TO TRUE. DTSBD551 02600 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBD551 02601 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD551 02602 DTSBD551 02603 PERFORM S910-READ THRU S910-EXIT. DTSBD551 02604 IF L910-NO-REC-88 DTSBD551 02605 GO TO P1313-EXIT DTSBD551 02606 ELSE DTSBD551 02607 MOVE MSKL-REC TO MTAD-REC DTSBD551 02608 END-IF. DTSBD551 02609 DTSBD551 02610 MOVE MTAD-ZIP TO W-ZIP. DTSBD551 02611 IF W-ZIP5 NOT = E-ZIP-CODE DTSBD551 02612 *** DISPLAY 'ZIP1 ' W-EMP-NO ' ' MTAD-ZIP ' ' E-ZIP-CODE DTSBD551 02613 * IF MTAD-ST = E-STATE DTSBD551 02614 **** IF MTAD-ZIP NOT = L072-ZIP DTSBD551 02615 PERFORM P1313B-LOCAL-ADDR THRU P1313B-EXIT DTSBD551 02616 END-IF. DTSBD551 02617 * IF MTAD-ST = L072-ST DTSBD551 02618 * IF MTAD-CITY = L072-CITY DTSBD551 02619 * IF MTAD-DELIV-LINE-2 = L072-DELIV-LINE-2 DTSBD551 02620 * NEXT SENTENCE DTSBD551 02621 * ELSE DTSBD551 02622 * PERFORM P1313B-LOCAL-ADDR THRU P1313B-EXIT DTSBD551 02623 * END-IF DTSBD551 02624 * ELSE DTSBD551 02625 * PERFORM P1313B-LOCAL-ADDR THRU P1313B-EXIT DTSBD551 02626 * END-IF DTSBD551 02627 * ELSE DTSBD551 02628 * PERFORM P1313B-LOCAL-ADDR THRU P1313B-EXIT DTSBD551 02629 * END-IF. DTSBD551 02630 P1313-EXIT. DTSBD551 02631 EXIT. DTSBD551 02632 DTSBD551 02633 P1313A-VERIFY-ADDR. DTSBD551 02634 * SET L072-CASS-EDITS-88 TO TRUE. DTSBD551 02635 * SET L072-MTAD-88 TO TRUE. DTSBD551 02636 * MOVE MPRF-PRIMARY-NAME TO L072-NAME. DTSBD551 02637 * DTSBD551 02638 * MOVE SPACES TO L072-ADDRESS. DTSBD551 02639 * MOVE E-STREET TO L072-DELIV-LINE-2. DTSBD551 02640 * MOVE E-CITY TO L072-CITY. DTSBD551 02641 * MOVE E-STATE TO L072-ST. DTSBD551 02642 * MOVE E-ZIP-CODE TO L072-ZIP. DTSBD551 02643 DTSBD551 02644 * PERFORM S072-ADDRESS THRU S072-EXIT. DTSBD551 02645 DTSBD551 02646 * IF L072-ADDRESS-NOT-VALID-88 DTSBD551 02647 * MOVE W-EMP-NO TO MSG-E9A-ACCT-NO DTSBD551 02648 * MOVE MSG-E9A TO R551-MSG-TEXT DTSBD551 02649 * PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 02650 * ADD +1 TO W-INVALID-NEW-ADDR-CNT DTSBD551 02651 *** DISPLAY 'NEW ADDR FOR ' W-EMP-NO ' CANNOT VERIFY' DTSBD551 02652 * END-IF. DTSBD551 02653 DTSBD551 02654 P1313A-EXIT. DTSBD551 02655 EXIT. DTSBD551 02656 DTSBD551 02657 P1313B-LOCAL-ADDR. DTSBD551 02658 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSBD551 02659 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD551 02660 PERFORM S910-READ THRU S910-EXIT. DTSBD551 02661 IF L910-NO-REC-88 DTSBD551 02662 PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 02663 GO TO P1313B-EXIT DTSBD551 02664 ELSE DTSBD551 02665 MOVE MSKL-REC TO MTAD-REC DTSBD551 02666 END-IF. DTSBD551 02667 DTSBD551 02668 MOVE MTAD-ZIP TO W-ZIP. DTSBD551 02669 IF W-ZIP5 NOT = E-ZIP-CODE DTSBD551 02670 *** DISPLAY 'ZIP2 ' W-EMP-NO ' ' MTAD-ZIP ' ' E-ZIP-CODE DTSBD551 02671 * IF MTAD-ST = E-STATE DTSBD551 02672 **** IF MTAD-ZIP NOT = L072-ZIP DTSBD551 02673 PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 02674 END-IF. DTSBD551 02675 * IF MTAD-ST = L072-ST DTSBD551 02676 * IF MTAD-CITY = L072-CITY DTSBD551 02677 * IF MTAD-DELIV-LINE-2 = L072-DELIV-LINE-2 DTSBD551 02678 * NEXT SENTENCE DTSBD551 02679 * ELSE DTSBD551 02680 * PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 02681 * END-IF DTSBD551 02682 * ELSE DTSBD551 02683 * PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 02684 * END-IF DTSBD551 02685 * ELSE DTSBD551 02686 * PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 02687 * END-IF. DTSBD551 02688 P1313B-EXIT. DTSBD551 02689 EXIT. DTSBD551 02690 DTSBD551 02691 P1313C-ADDR-ERROR. DTSBD551 02692 MOVE W-EMP-NO TO MSG-E9B-ACCT-NO. DTSBD551 02693 MOVE MSG-E9B TO R551-MSG-TEXT. DTSBD551 02694 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE. DTSBD551 02695 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT. DTSBD551 02696 ADD +1 TO W-VALID-NEW-ADDR-CNT. DTSBD551 02697 *** DISPLAY 'ADDR ERROR FOR ' W-EMP-NO. DTSBD551 02698 DTSBD551 02699 P1313C-EXIT. DTSBD551 02700 EXIT. DTSBD551 02701 DTSBD551 02702 DTSBD551 02703 P1320-FORMAT-T028. DTSBD551 02704 MOVE W-EMP-NO TO T028-EMP-NO. DTSBD551 02705 MOVE 'MAG UC30' TO T028-ORIGIN. DTSBD551 02706 MOVE L005-DATE TO T028-SYS-DATE. DTSBD551 02707 MOVE L005-TIME TO T028-SYS-TIME. DTSBD551 02708 SET T028-ICESA-88 TO TRUE. DTSBD551 02709 DTSBD551 02710 *** IF W-PSEUDO-ITEM-NO < 999 DTSBD551 02711 * ADD 1 TO W-PSEUDO-ITEM-NO DTSBD551 02712 * ELSE DTSBD551 02713 * ADD 1 TO W-PSEUDO-BATCH-NO DTSBD551 02714 * MOVE 1 TO W-PSEUDO-ITEM-NO DTSBD551 02715 *** END-IF. DTSBD551 02716 DTSBD551 02717 ** MOVE W-PSEUDO-BATCH-NO TO T028-PSEUDO-BATCH-NO. DTSBD551 02718 ** MOVE W-PSEUDO-ITEM-NO TO T028-PSEUDO-ITEM-NO. DTSBD551 02719 DTSBD551 02720 MOVE W-EMP-NAME (1:4) TO T028-NAME-CHECK. DTSBD551 02721 *** MOVE MPRF-PRIMARY-NAME (1:4) TO T028-NAME-CHECK. DTSBD551 02722 SET T028-ORIG-88 TO TRUE. DTSBD551 02723 MOVE W-RPT-QTR TO T028-YRQ. DTSBD551 02724 MOVE ZERO TO T028-TOT-WAGE DTSBD551 02725 T028-EXCESS-WAGE DTSBD551 02726 T028-TAX-WAGE DTSBD551 02727 T028-REMIT-AMT. DTSBD551 02728 DTSBD551 02729 SET T028-WAIVE-BOTH-NO-88 TO TRUE. DTSBD551 02730 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSBD551 02731 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBD551 02732 MOVE ZERO TO T028-1ST-MTH-EMPL-CNT DTSBD551 02733 T028-2ND-MTH-EMPL-CNT DTSBD551 02734 T028-3RD-MTH-EMPL-CNT DTSBD551 02735 T028-TOTAL-EMPL-CNT. DTSBD551 02736 MOVE W-RECEIVED-DATE TO T028-RECEIVED-DATE. DTSBD551 02737 *& DTSBD551 02738 * IF W-EMP-NO = 153766 DTSBD551 02739 * OR W-SUBM-CREATE-DATE NOT = W-RECEIVED-DATE DTSBD551 02740 * DISPLAY 'EMP ' W-EMP-NO ' ' W-RECEIVED-DATE DTSBD551 02741 * ' ' W-SUBM-CREATE-DATE DTSBD551 02742 * END-IF. DTSBD551 02743 *& DTSBD551 02744 DTSBD551 02745 MOVE W-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBD551 02746 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD551 02747 DTSBD551 02748 SET L003-NOT-WORK-DAY TO TRUE. DTSBD551 02749 PERFORM P1321-WORK-DAY-LOOP THRU P1321-EXIT DTSBD551 02750 UNTIL L003-IS-WORK-DAY. DTSBD551 02751 MOVE L001-FED-8-DATE-9 TO T028-DEPOSIT-DATE. DTSBD551 02752 DTSBD551 02753 MOVE ZERO TO T028-TRACE-NO. DTSBD551 02754 DTSBD551 02755 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSBD551 02756 MOVE 'MAG UC30' TO T028-RESPONSIBLE-OP-ID. DTSBD551 02757 DTSBD551 02758 P1320-EXIT. DTSBD551 02759 EXIT. DTSBD551 02760 DTSBD551 02761 P1321-WORK-DAY-LOOP. DTSBD551 02762 ADD +1 TO L001-JUL-ABS-DAY. DTSBD551 02763 DTSBD551 02764 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBD551 02765 DTSBD551 02766 MOVE L001-FED-8-DATE-9 TO L003-DATE. DTSBD551 02767 DTSBD551 02768 PERFORM S003-AGENCY-DAY THRU S003-EXIT. DTSBD551 02769 DTSBD551 02770 P1321-EXIT. DTSBD551 02771 EXIT. DTSBD551 02772 DTSBD551 02773 DTSBD551 02774 P1397-ADD-MNTE. DTSBD551 02775 IF W-MNTE-STARTED-YES-88 DTSBD551 02776 PERFORM P1397B-ADD-MSG THRU P1397B-EXIT DTSBD551 02777 ELSE DTSBD551 02778 PERFORM P1397A-INIT-MNTE THRU P1397A-EXIT DTSBD551 02779 PERFORM P1397B-ADD-MSG THRU P1397B-EXIT DTSBD551 02780 END-IF. DTSBD551 02781 P1397-EXIT. DTSBD551 02782 EXIT. DTSBD551 02783 DTSBD551 02784 P1397A-INIT-MNTE. DTSBD551 02785 *& DTSBD551 02786 * DISPLAY 'P1397 INIT MNTE ' W-EMP-NO. DTSBD551 02787 *& DTSBD551 02788 SET W-MNTE-STARTED-YES-88 TO TRUE. DTSBD551 02789 DTSBD551 02790 MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBD551 02791 MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBD551 02792 SET MNTE-NTE-88 TO TRUE. DTSBD551 02793 MOVE +0 TO MNTE-PURGE-DATE. DTSBD551 02794 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBD551 02795 DTSBD551 02796 MOVE W-CURR-DATE TO MNTE-ESTB-DATE DTSBD551 02797 MNTE-CHNG-DATE. DTSBD551 02798 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBD551 02799 MNTE-DATA-ESTB-ABSTIME DTSBD551 02800 MNTE-CHNG-ABSTIME. DTSBD551 02801 MOVE 'MAG UC30' TO MNTE-ESTB-OP-ID DTSBD551 02802 MNTE-CHNG-OP-ID. DTSBD551 02803 DTSBD551 02804 MOVE W-MNTE-SUBJECT-ACCT TO MNTE-SUBJECT. DTSBD551 02805 DTSBD551 02806 P1397A-EXIT. DTSBD551 02807 EXIT. DTSBD551 02808 DTSBD551 02809 P1397B-ADD-MSG. DTSBD551 02810 ADD +1 TO W-MNTE-TEXT-CNT. DTSBD551 02811 MOVE R551-MSG-TEXT TO W-MNTE-TEXT (W-MNTE-TEXT-CNT). DTSBD551 02812 IF MNTE-SUBJECT = W-MNTE-SUBJECT-SSN DTSBD551 02813 MOVE W-MNTE-SUBJECT-BOTH TO MNTE-SUBJECT DTSBD551 02814 END-IF. DTSBD551 02815 *& DTSBD551 02816 * DISPLAY 'P1397B ADD ' W-EMP-NO DTSBD551 02817 * ' ' W-MNTE-TEXT (W-MNTE-TEXT-CNT). DTSBD551 02818 *& DTSBD551 02819 DTSBD551 02820 P1397B-EXIT. DTSBD551 02821 EXIT. DTSBD551 02822 DTSBD551 02823 P1398-NON-FATAL-ERROR. DTSBD551 02824 IF A-FEDERAL-EIN NUMERIC DTSBD551 02825 MOVE A-FEDERAL-EIN TO R551-SUBMITTER-FEIN DTSBD551 02826 ELSE DTSBD551 02827 MOVE ZERO TO R551-SUBMITTER-FEIN DTSBD551 02828 END-IF. DTSBD551 02829 DTSBD551 02830 MOVE A-NAME TO R551-SUBMITTER-NAME. DTSBD551 02831 MOVE A-CONTACT TO R551-CONTACT-NAME. DTSBD551 02832 MOVE A-CONTACT-PHONE TO R551-CONTACT-PHONE. DTSBD551 02833 MOVE A-PHONE-BOX TO R551-CONTACT-PHONE-EXT. DTSBD551 02834 DTSBD551 02835 ** SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE. DTSBD551 02836 MOVE ICESA-REC-TYPE TO R551-ICESA-REC-TYPE. DTSBD551 02837 MOVE W-INPUT-READ-CNT TO R551-REC-NO. DTSBD551 02838 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN. DTSBD551 02839 MOVE E-NAME TO R551-EMP-NAME. DTSBD551 02840 MOVE E-STREET TO R551-EMP-STREET. DTSBD551 02841 MOVE E-CITY TO R551-EMP-CITY. DTSBD551 02842 MOVE E-STATE TO R551-EMP-STATE. DTSBD551 02843 MOVE E-ZIP-CODE TO R551-EMP-ZIP. DTSBD551 02844 MOVE E-ZIP-CODE-EXT TO R551-EMP-ZIP-EXT. DTSBD551 02845 DTSBD551 02846 *** WRITE REPORT RECORD DTSBD551 02847 MOVE R551-REC TO RSKL-REC. DTSBD551 02848 PERFORM S946-RPT-1 THRU S946-EXIT. DTSBD551 02849 DTSBD551 02850 MOVE W-PSEUDO-BATCH-NO TO X216-PSEUDO-BATCH. DTSBD551 02851 MOVE W-PSEUDO-ITEM-NO TO X216-PSEUDO-ITEM. DTSBD551 02852 MOVE R551-SUBMITTER-NAME TO X216-SUBMITTER-NAME. DTSBD551 02853 MOVE R551-SUBMITTER-FEIN TO X216-SUBMITTER-FEIN. DTSBD551 02854 MOVE R551-CONTACT-NAME TO X216-CONTACT-NAME. DTSBD551 02855 MOVE R551-CONTACT-PHONE TO X216-CONTACT-PHONE. DTSBD551 02856 MOVE R551-CONTACT-PHONE-EXT TO X216-CONTACT-PHONE-EXT. DTSBD551 02857 MOVE R551-ICESA-REC-TYPE TO X216-ICESA-REC-TYPE. DTSBD551 02858 MOVE R551-MSG-TEXT TO X216-MSG-TEXT. DTSBD551 02859 MOVE R551-EMP-FEIN TO X216-EMP-FEIN. DTSBD551 02860 MOVE R551-EMP-NAME TO X216-EMP-NAME. DTSBD551 02861 MOVE R551-EMP-STREET TO X216-EMP-STREET. DTSBD551 02862 MOVE R551-EMP-CITY TO X216-EMP-CITY. DTSBD551 02863 MOVE R551-EMP-STATE TO X216-EMP-STATE. DTSBD551 02864 MOVE R551-EMP-ZIP TO X216-EMP-ZIP. DTSBD551 02865 MOVE R551-EMP-ZIP-EXT TO X216-EMP-ZIP-EXT. DTSBD551 02866 DTSBD551 02867 INSPECT X216-SUBMITTER-NAME REPLACING ALL ',' BY ' '. DTSBD551 02868 INSPECT X216-CONTACT-NAME REPLACING ALL ',' BY ' '. DTSBD551 02869 INSPECT X216-MSG-TEXT REPLACING ALL ',' BY ' '. DTSBD551 02870 INSPECT X216-EMP-NAME REPLACING ALL ',' BY ' '. DTSBD551 02871 INSPECT X216-EMP-STREET REPLACING ALL ',' BY ' '. DTSBD551 02872 INSPECT X216-EMP-CITY REPLACING ALL ',' BY ' '. DTSBD551 02873 INSPECT X216-EMP-STATE REPLACING ALL ',' BY ' '. DTSBD551 02874 DTSBD551 02875 WRITE MESSAGE-REC FROM W-MESSAGE-REC. DTSBD551 02876 IF MSG-STATUS-OK-88 DTSBD551 02877 NEXT SENTENCE DTSBD551 02878 ELSE DTSBD551 02879 SET W-ERROR-YES-88 TO TRUE DTSBD551 02880 DISPLAY 'CANNOT WRITE MESSAGE FILE: ' DTSBD551 02881 MSG-STATUS DTSBD551 02882 END-IF. DTSBD551 02883 DTSBD551 02884 P1398-EXIT. DTSBD551 02885 EXIT. DTSBD551 02886 DTSBD551 02887 P1400-TYPE-S. DTSBD551 02888 MOVE ICESA-REC TO WAGE-RECORD-S. DTSBD551 02889 ADD +1 TO W-EMP-WAGE-CNT DTSBD551 02890 W-ALL-WAGE-CNT. DTSBD551 02891 *& DTSBD551 02892 * DISPLAY 'TYPE S ' WAGE-RECORD-S (1:60). DTSBD551 02893 *& DTSBD551 02894 DTSBD551 02895 IF W-PREV-REC-TYPE-E-88 DTSBD551 02896 IF W-WAGES-EXPECTED-NO-88 DTSBD551 02897 * DISPLAY 'TYPE S: WAGES NOT EXPECTED: ' DTSBD551 02898 * W-WAGES-EXPECTED-IND DTSBD551 02899 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02900 MOVE W-WAGES-EXPECTED-IND TO MSG-S1-WAGES-EXP-IND DTSBD551 02901 MOVE MSG-S1 TO R551-MSG-TEXT DTSBD551 02902 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02903 GO TO P1400-EXIT DTSBD551 02904 END-IF DTSBD551 02905 ELSE DTSBD551 02906 IF W-PREV-REC-TYPE-S-88 DTSBD551 02907 NEXT SENTENCE DTSBD551 02908 ELSE DTSBD551 02909 * DISPLAY 'TYPE S: PREVIOUS REC TYPE NOT E OR S: ' DTSBD551 02910 * W-PREV-REC-TYPE DTSBD551 02911 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02912 MOVE W-PREV-REC-TYPE TO MSG-S2-REC-TYPE DTSBD551 02913 MOVE MSG-S2 TO R551-MSG-TEXT DTSBD551 02914 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02915 GO TO P1400-EXIT DTSBD551 02916 END-IF DTSBD551 02917 END-IF. DTSBD551 02918 SET W-PREV-REC-TYPE-S-88 TO TRUE. DTSBD551 02919 DTSBD551 02920 IF W-ERROR-NO-88 DTSBD551 02921 PERFORM P1410-EDIT-TYPE-S THRU P1410-EXIT DTSBD551 02922 IF W-ERROR-NO-88 DTSBD551 02923 PERFORM P1420-FORMAT-W001 THRU P1420-EXIT DTSBD551 02924 ELSE DTSBD551 02925 ADD +1 TO W-WAGE-ERROR-CNT DTSBD551 02926 END-IF DTSBD551 02927 END-IF. DTSBD551 02928 DTSBD551 02929 P1400-EXIT. DTSBD551 02930 EXIT. DTSBD551 02931 DTSBD551 02932 P1410-EDIT-TYPE-S. DTSBD551 02933 * DISPLAY 'P1410-TYEP S ' DTSBD551 02934 MOVE S-SSN TO W-SSN-IN. DTSBD551 02935 PERFORM P1411-TYPE-S-SSN THRU P1411-EXIT. DTSBD551 02936 DTSBD551 02937 *** IF S-SSN NOT NUMERIC DTSBD551 02938 * DISPLAY 'TYPE S: NON-NUMERIC SSN ' S-SSN DTSBD551 02939 * MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02940 * MOVE S-SSN TO MSG-S3-SSN DTSBD551 02941 * MOVE MSG-S3 TO R551-MSG-TEXT DTSBD551 02942 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02943 *** END-IF. DTSBD551 02944 DTSBD551 02945 IF S-STATE-CODE NOT = '11' DTSBD551 02946 * DISPLAY 'TYPE S: STATE CODE NOT DC ' DTSBD551 02947 * S-STATE-CODE DTSBD551 02948 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02949 MOVE S-STATE-CODE TO MSG-S5-STATE-CODE DTSBD551 02950 MOVE MSG-S5 TO R551-MSG-TEXT DTSBD551 02951 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02952 END-IF. DTSBD551 02953 DTSBD551 02954 IF S-UNEMP-WAGE NOT NUMERIC DTSBD551 02955 * DISPLAY 'TYPE S: NON-NUMERIC TOT WAGE ' S-UNEMP-WAGE DTSBD551 02956 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02957 * MOVE S-UNEMP-WAGE TO MSG-S6-UNEMP-WAGE DTSBD551 02958 MOVE S-SSN TO MSG-S6-SSN DTSBD551 02959 MOVE W-EMP-NO TO MSG-S6-EMP-NO DTSBD551 02960 MOVE MSG-S6 TO R551-MSG-TEXT DTSBD551 02961 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02962 ELSE DTSBD551 02963 MOVE S-UNEMP-WAGE TO W-TYPE-S-TOT-WAGE DTSBD551 02964 ADD W-TYPE-S-TOT-WAGE TO W-EMP-TOT-WAGE DTSBD551 02965 W-ALL-TOT-WAGE DTSBD551 02966 IF W-TYPE-S-TOT-WAGE = ZERO DTSBD551 02967 DISPLAY W-EMP-NO ' ' S-SSN ' TOT WAGE = 0' DTSBD551 02968 GO TO P1410-EXIT DTSBD551 02969 END-IF DTSBD551 02970 END-IF. DTSBD551 02971 DTSBD551 02972 IF S-TAXABLE-WAGE NOT NUMERIC DTSBD551 02973 * DISPLAY 'TYPE S: NON-NUMERIC TAX WAGE ' S-TAXABLE-WAGE DTSBD551 02974 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02975 * MOVE S-TAXABLE-WAGE TO MSG-S7-TAXABLE-WAGE DTSBD551 02976 MOVE S-SSN TO MSG-S7-SSN DTSBD551 02977 MOVE W-EMP-NO TO MSG-S7-EMP-NO DTSBD551 02978 MOVE MSG-S7 TO R551-MSG-TEXT DTSBD551 02979 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02980 ELSE DTSBD551 02981 MOVE S-TAXABLE-WAGE TO W-TYPE-S-TAX-WAGE DTSBD551 02982 ADD W-TYPE-S-TAX-WAGE TO W-EMP-TAX-WAGE DTSBD551 02983 END-IF. DTSBD551 02984 DTSBD551 02985 MOVE S-ACCOUNT-NO TO W-ACCT-NBR-IN. DTSBD551 02986 PERFORM S2200-TYPE-S-ACCT-NBR THRU S2200-EXIT. DTSBD551 02987 DTSBD551 02988 MOVE S-REPT-CNTRY TO W-REPORT-CC. DTSBD551 02989 MOVE S-REPT-YR TO W-REPORT-YY. DTSBD551 02990 MOVE S-REPT-MTH TO W-REPORT-MM-X. DTSBD551 02991 PERFORM S2100-REPORT-QTR THRU S2100-EXIT. DTSBD551 02992 DTSBD551 02993 IF S-EMPLOYEE-INFO = LOW-VALUES OR SPACES DTSBD551 02994 * DISPLAY 'TYPE S: WORKER NAME MISSING' DTSBD551 02995 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 02996 MOVE MSG-S4 TO R551-MSG-TEXT DTSBD551 02997 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 02998 END-IF. DTSBD551 02999 DTSBD551 03000 P1410-EXIT. DTSBD551 03001 EXIT. DTSBD551 03002 DTSBD551 03003 P1411-TYPE-S-SSN. DTSBD551 03004 MOVE ZERO TO SUB2. DTSBD551 03005 MOVE SPACES TO W-SSN-OUT. DTSBD551 03006 SET W-SSN-ERR-NO-88 TO TRUE. DTSBD551 03007 DTSBD551 03008 PERFORM DTSBD551 03009 VARYING SUB1 FROM +1 BY +1 DTSBD551 03010 UNTIL SUB1 > W-SSN-LEN DTSBD551 03011 IF W-SSN-IN-X (SUB1) >= '0' DTSBD551 03012 AND W-SSN-IN-X (SUB1) <= '9' DTSBD551 03013 IF SUB2 < W-SSN-LEN DTSBD551 03014 ADD +1 TO SUB2 DTSBD551 03015 MOVE W-SSN-IN-X (SUB1) TO W-SSN-OUT-X (SUB2) DTSBD551 03016 END-IF DTSBD551 03017 ELSE DTSBD551 03018 DISPLAY 'BAD SSN ' W-INPUT-READ-CNT DTSBD551 03019 ' ' S-SSN DTSBD551 03020 END-IF DTSBD551 03021 END-PERFORM. DTSBD551 03022 DTSBD551 03023 IF SUB2 = ZERO DTSBD551 03024 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03025 MOVE S-SSN TO MSG-S11-SSN DTSBD551 03026 MOVE W-EMP-NO TO MSG-S11-EMP-NO DTSBD551 03027 MOVE MSG-S11 TO R551-MSG-TEXT DTSBD551 03028 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 03029 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 03030 PERFORM P1497-ADD-MNTE THRU P1497-EXIT DTSBD551 03031 MOVE ZERO TO S-SSN DTSBD551 03032 ELSE DTSBD551 03033 IF SUB2 < W-SSN-LEN DTSBD551 03034 SET W-SSN-ERR-YES-88 TO TRUE DTSBD551 03035 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03036 MOVE S-SSN TO MSG-S12-SSN DTSBD551 03037 MOVE W-EMP-NO TO MSG-S12-EMP-NO DTSBD551 03038 MOVE MSG-S12 TO R551-MSG-TEXT DTSBD551 03039 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 03040 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 03041 PERFORM P1497-ADD-MNTE THRU P1497-EXIT DTSBD551 03042 MOVE ZERO TO S-SSN DTSBD551 03043 END-IF DTSBD551 03044 END-IF. DTSBD551 03045 DTSBD551 03046 P1411-EXIT. DTSBD551 03047 EXIT. DTSBD551 03048 DTSBD551 03049 P1420-FORMAT-W001. DTSBD551 03050 IF W-TYPE-S-TOT-WAGE = ZERO DTSBD551 03051 ADD +1 TO W-ZERO-WAGE-CNT DTSBD551 03052 * DISPLAY 'TYPE S: BYPASSING ZERO WAGE RECORD ' DTSBD551 03053 * ' SSN: ' S-SSN ' EMP: ' W-EMP-NO DTSBD551 03054 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03055 MOVE S-SSN TO MSG-S8-SSN DTSBD551 03056 MOVE W-EMP-NO TO MSG-S8-EMP-NO DTSBD551 03057 MOVE MSG-S8 TO R551-MSG-TEXT DTSBD551 03058 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 03059 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 03060 GO TO P1420-EXIT DTSBD551 03061 END-IF. DTSBD551 03062 DTSBD551 03063 ************************************************************ DTSBD551 03064 * MODIFIED TO WRITE TRANSACTIONS WHEN THE SSN = ZERO. DTSBD551 03065 * DTSBD551 03066 ************************************************************ DTSBD551 03067 IF S-SSN = ZERO DTSBD551 03068 ADD +1 TO W-MISSING-SSN-CNT DTSBD551 03069 *** GO TO P1420-EXIT DTSBD551 03070 END-IF. DTSBD551 03071 DTSBD551 03072 MOVE W-PSEUDO-BATCH-NO TO W001-BATCH-NO. DTSBD551 03073 MOVE W-PSEUDO-ITEM-NO TO W001-ITEM-NO. DTSBD551 03074 ADD 1 TO W-SEQ-NO. DTSBD551 03075 MOVE W-SEQ-NO TO W001-SEQ-NO. DTSBD551 03076 MOVE W-EMP-NO TO W001-EMP-NO. DTSBD551 03077 MOVE S-SSN TO W001-SSN. DTSBD551 03078 SET W001-SSN-VALID-88 TO TRUE. DTSBD551 03079 MOVE S-FIRST-NAME TO W001-FIRST-NAME. DTSBD551 03080 MOVE S-MIDDLE-INIT TO W001-MID-INIT. DTSBD551 03081 MOVE S-LAST-NAME TO W001-LAST-NAME. DTSBD551 03082 INSPECT W001-LAST-NAME REPLACING ALL ',' BY ' '. DTSBD551 03083 INSPECT W001-FIRST-NAME REPLACING ALL ',' BY ' '. DTSBD551 03084 INSPECT W001-MID-INIT REPLACING ALL ',' BY ' '. DTSBD551 03085 SET W001-NAME-VALID-88 TO TRUE. DTSBD551 03086 MOVE W-RPT-QTR TO W001-YRQ. DTSBD551 03087 MOVE W-TYPE-S-TOT-WAGE TO W001-WAGE-CHNG. DTSBD551 03088 MOVE W-TYPE-S-TAX-WAGE TO W001-TAX-WAGE. DTSBD551 03089 SET W001-WAGE-VALID-88 TO TRUE. DTSBD551 03090 MOVE ZERO TO W001-CURR-WAGE DTSBD551 03091 W001-PRIOR-WAGE. DTSBD551 03092 MOVE T028-RECEIVED-DATE TO W001-RECEIVED-DATE. DTSBD551 03093 MOVE L005-TIME TO W001-RECEIVED-TIME. DTSBD551 03094 MOVE 'MAG UC30' TO W001-RESPONSIBLE-OP-ID. DTSBD551 03095 SET W001-ICESA-88 TO TRUE. DTSBD551 03096 DTSBD551 03097 SET WAGE-TEMP-REQ-WRITE-88 TO TRUE. DTSBD551 03098 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT. DTSBD551 03099 DTSBD551 03100 P1420-EXIT. DTSBD551 03101 EXIT. DTSBD551 03102 DTSBD551 03103 P1497-ADD-MNTE. DTSBD551 03104 IF W-MNTE-STARTED-YES-88 DTSBD551 03105 PERFORM P1497B-ADD-MSG THRU P1497B-EXIT DTSBD551 03106 ELSE DTSBD551 03107 PERFORM P1497A-INIT-MNTE THRU P1497A-EXIT DTSBD551 03108 PERFORM P1497B-ADD-MSG THRU P1497B-EXIT DTSBD551 03109 END-IF. DTSBD551 03110 P1497-EXIT. DTSBD551 03111 EXIT. DTSBD551 03112 DTSBD551 03113 P1497A-INIT-MNTE. DTSBD551 03114 *& DTSBD551 03115 * DISPLAY 'P1497 INIT MNTE ' W-EMP-NO. DTSBD551 03116 *& DTSBD551 03117 SET W-MNTE-STARTED-YES-88 TO TRUE. DTSBD551 03118 DTSBD551 03119 MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBD551 03120 MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBD551 03121 SET MNTE-NTE-88 TO TRUE. DTSBD551 03122 MOVE +0 TO MNTE-PURGE-DATE. DTSBD551 03123 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBD551 03124 DTSBD551 03125 MOVE W-CURR-DATE TO MNTE-ESTB-DATE DTSBD551 03126 MNTE-CHNG-DATE. DTSBD551 03127 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBD551 03128 MNTE-DATA-ESTB-ABSTIME DTSBD551 03129 MNTE-CHNG-ABSTIME. DTSBD551 03130 MOVE 'MAG UC30' TO MNTE-ESTB-OP-ID DTSBD551 03131 MNTE-CHNG-OP-ID. DTSBD551 03132 DTSBD551 03133 MOVE W-MNTE-SUBJECT-SSN TO MNTE-SUBJECT. DTSBD551 03134 DTSBD551 03135 P1497A-EXIT. DTSBD551 03136 EXIT. DTSBD551 03137 DTSBD551 03138 P1497B-ADD-MSG. DTSBD551 03139 ADD +1 TO W-MNTE-TEXT-CNT. DTSBD551 03140 MOVE R551-MSG-TEXT TO W-MNTE-TEXT (W-MNTE-TEXT-CNT). DTSBD551 03141 IF MNTE-SUBJECT = W-MNTE-SUBJECT-ACCT DTSBD551 03142 MOVE W-MNTE-SUBJECT-BOTH TO MNTE-SUBJECT DTSBD551 03143 END-IF. DTSBD551 03144 *& DTSBD551 03145 * DISPLAY 'P1497B ADD ' W-EMP-NO DTSBD551 03146 * ' ' W-MNTE-TEXT (W-MNTE-TEXT-CNT). DTSBD551 03147 *& DTSBD551 03148 DTSBD551 03149 P1497B-EXIT. DTSBD551 03150 EXIT. DTSBD551 03151 DTSBD551 03152 P1500-TYPE-T. DTSBD551 03153 *& DTSBD551 03154 * DISPLAY 'P1500-TYEP T ' DTSBD551 03155 IF E-FEDERAL-EIN = 232720862 OR 383271169 DTSBD551 03156 DISPLAY 'P1500 ' E-FEDERAL-EIN DTSBD551 03157 ' ' T-TOT-PMT-DUE ' ' T-TAX-DUE DTSBD551 03158 ' ' T-EMPLOYER-ASSESS-AMT DTSBD551 03159 END-IF. DTSBD551 03160 *& DTSBD551 03161 MOVE ICESA-REC TO WAGE-RECORD-T. DTSBD551 03162 ADD +1 TO W-ALL-EMP-CNT. DTSBD551 03163 MOVE ZERO TO W-TYPE-T-TAX-DUE. DTSBD551 03164 *& DTSBD551 03165 * IF E-ACCOUNT-NO = '025391' DTSBD551 03166 * DISPLAY 'TYPE T ' WAGE-RECORD-T (1:60). DTSBD551 03167 *& DTSBD551 03168 DTSBD551 03169 IF W-PREV-REC-TYPE-E-88 DTSBD551 03170 OR W-PREV-REC-TYPE-S-88 DTSBD551 03171 SET W-PREV-REC-TYPE-T-88 TO TRUE DTSBD551 03172 ELSE DTSBD551 03173 DISPLAY 'TYPE T: PREVIOUS REC TYPE NOT E OR S: ' DTSBD551 03174 W-PREV-REC-TYPE DTSBD551 03175 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03176 MOVE W-PREV-REC-TYPE TO MSG-T1-REC-TYPE DTSBD551 03177 MOVE MSG-T1 TO R551-MSG-TEXT DTSBD551 03178 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03179 GO TO P1500-EXIT DTSBD551 03180 END-IF. DTSBD551 03181 DTSBD551 03182 IF W-ERROR-YES-88 DTSBD551 03183 GO TO P1500-EXIT DTSBD551 03184 END-IF. DTSBD551 03185 DTSBD551 03186 *& DTSBD551 03187 * IF E-ACCOUNT-NO = '025391' DTSBD551 03188 * DISPLAY ' TYPE T ' W-EMP-TOT-WAGE DTSBD551 03189 * ' LIAB ' W-LIABLE-IND DTSBD551 03190 * ' FND ' W-EMP-FOUND-IND DTSBD551 03191 * ' DUP ' W-DUP-RPT-IND. DTSBD551 03192 *& DTSBD551 03193 IF T-TOT-PMT-DUE NOT = ZERO DTSBD551 03194 OR T-TAX-DUE NOT = ZERO DTSBD551 03195 OR T-EMPLOYER-ASSESS-AMT NOT = ZERO DTSBD551 03196 NEXT SENTENCE DTSBD551 03197 ELSE DTSBD551 03198 IF W-EMP-TOT-WAGE = ZERO DTSBD551 03199 IF W-LIABLE-NO-88 DTSBD551 03200 OR W-EMP-FOUND-NO-88 DTSBD551 03201 OR W-DUP-RPT-YES-88 DTSBD551 03202 ** OR W-SUCCESSOR-YES-88 DTSBD551 03203 PERFORM P1580-ZERO-WAGE THRU P1580-EXIT DTSBD551 03204 GO TO P1500-EXIT DTSBD551 03205 END-IF DTSBD551 03206 END-IF DTSBD551 03207 END-IF. DTSBD551 03208 DTSBD551 03209 PERFORM P1510-EDIT-TYPE-T THRU P1510-EXIT DTSBD551 03210 IF W-ERROR-NO-88 DTSBD551 03211 PERFORM P1520-SET-WAGE-FILES THRU P1520-EXIT DTSBD551 03212 IF W-ERROR-NO-88 DTSBD551 03213 PERFORM P1530-COPY-WAGES THRU P1530-EXIT DTSBD551 03214 IF W-ERROR-NO-88 DTSBD551 03215 PERFORM P1540-WRITE-T028 THRU P1540-EXIT DTSBD551 03216 PERFORM P1550-CONTACT THRU P1550-EXIT DTSBD551 03217 PERFORM P1560-MNTE THRU P1560-EXIT DTSBD551 03218 *** PERFORM P1570-UPD-LOG THRU P1570-EXIT DTSBD551 03219 PERFORM P1590-EMP-RPT-REC THRU P1590-EXIT DTSBD551 03220 END-IF DTSBD551 03221 END-IF DTSBD551 03222 ELSE DTSBD551 03223 ADD +1 TO W-EMP-ERROR-CNT DTSBD551 03224 END-IF. DTSBD551 03225 DTSBD551 03226 P1500-EXIT. DTSBD551 03227 EXIT. DTSBD551 03228 DTSBD551 03229 P1510-EDIT-TYPE-T. DTSBD551 03230 IF T-TOT-EMPLOYEE NOT NUMERIC DTSBD551 03231 DISPLAY 'TYPE T: NON-NUMERIC TOT WORKERS ' DTSBD551 03232 T-TOT-EMPLOYEE DTSBD551 03233 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03234 MOVE T-TOT-EMPLOYEE TO MSG-T2-TOT-EMPLOYEE DTSBD551 03235 MOVE MSG-T2 TO R551-MSG-TEXT DTSBD551 03236 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03237 ELSE DTSBD551 03238 MOVE T-TOT-EMPLOYEE TO W-TYPE-T-TOT-WORKER DTSBD551 03239 END-IF. DTSBD551 03240 DTSBD551 03241 IF T-TOTAL-WAGE NOT NUMERIC DTSBD551 03242 * DISPLAY 'TYPE T: NON-NUMERIC TOT WAGE ' T-TOTAL-WAGE DTSBD551 03243 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03244 MOVE E-ACCOUNT-NO TO MSG-T3-EMP-NO DTSBD551 03245 MOVE MSG-T3 TO R551-MSG-TEXT DTSBD551 03246 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03247 ELSE DTSBD551 03248 MOVE T-TOTAL-WAGE TO W-TYPE-T-TOT-WAGE DTSBD551 03249 END-IF. DTSBD551 03250 DTSBD551 03251 IF T-TAXABLE-WAGE NOT NUMERIC DTSBD551 03252 * DISPLAY 'TYPE T: NON-NUMERIC TAX WAGE ' T-TAXABLE-WAGE DTSBD551 03253 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03254 MOVE E-ACCOUNT-NO TO MSG-T4-EMP-NO DTSBD551 03255 MOVE MSG-T4 TO R551-MSG-TEXT DTSBD551 03256 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03257 ELSE DTSBD551 03258 MOVE T-TAXABLE-WAGE TO W-TYPE-T-TAX-WAGE DTSBD551 03259 END-IF. DTSBD551 03260 DTSBD551 03261 MOVE T-TAX-RATE TO W-TYPE-T-RATE-X. DTSBD551 03262 IF W-TYPE-T-RATE-9 NOT NUMERIC DTSBD551 03263 IF MPRF-CLASS-SELF-INS-88 DTSBD551 03264 NEXT SENTENCE DTSBD551 03265 ELSE DTSBD551 03266 * DISPLAY 'TYPE T: NON-NUMERIC TAX RATE IGNORED ' DTSBD551 03267 * T-TAX-RATE DTSBD551 03268 MOVE SPACES TO W-TYPE-T-RATE-X DTSBD551 03269 END-IF DTSBD551 03270 ELSE DTSBD551 03271 COMPUTE W-EMP-TAX-RATE = (W-TYPE-T-RATE-9 / 100000) DTSBD551 03272 END-IF. DTSBD551 03273 DTSBD551 03274 INSPECT T-MONTH-1 REPLACING ALL SPACE BY ZERO. DTSBD551 03275 IF T-MONTH-1 NOT NUMERIC DTSBD551 03276 * DISPLAY 'TYPE T: NON-NUMERIC MONTH 1 ' T-MONTH-1 DTSBD551 03277 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03278 MOVE T-MONTH-1 TO MSG-T9-NON-NUM-MONTH1 DTSBD551 03279 MOVE MSG-T9 TO R551-MSG-TEXT DTSBD551 03280 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03281 ELSE DTSBD551 03282 MOVE T-MONTH-1 TO W-MONTH-1-CNT-X DTSBD551 03283 END-IF. DTSBD551 03284 DTSBD551 03285 INSPECT T-MONTH-2 REPLACING ALL SPACE BY ZERO. DTSBD551 03286 IF T-MONTH-2 NOT NUMERIC DTSBD551 03287 * DISPLAY 'TYPE T: NON-NUMERIC MONTH 2 ' T-MONTH-2 DTSBD551 03288 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03289 MOVE T-MONTH-2 TO MSG-T10-NON-NUM-MONTH2 DTSBD551 03290 MOVE MSG-T10 TO R551-MSG-TEXT DTSBD551 03291 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03292 ELSE DTSBD551 03293 MOVE T-MONTH-2 TO W-MONTH-2-CNT-X DTSBD551 03294 END-IF. DTSBD551 03295 DTSBD551 03296 INSPECT T-MONTH-3 REPLACING ALL SPACE BY ZERO. DTSBD551 03297 IF T-MONTH-3 NOT NUMERIC DTSBD551 03298 * DISPLAY 'TYPE T: NON-NUMERIC MONTH 3 ' T-MONTH-3 DTSBD551 03299 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03300 MOVE T-MONTH-3 TO MSG-T11-NON-NUM-MONTH3 DTSBD551 03301 MOVE MSG-T11 TO R551-MSG-TEXT DTSBD551 03302 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03303 ELSE DTSBD551 03304 MOVE T-MONTH-3 TO W-MONTH-3-CNT-X DTSBD551 03305 END-IF. DTSBD551 03306 DTSBD551 03307 IF W-ERROR-NO-88 DTSBD551 03308 PERFORM P1511-CROSS-EDITS THRU P1511-EXIT DTSBD551 03309 END-IF. DTSBD551 03310 DTSBD551 03311 PERFORM P1512-PAYMENT THRU P1512-EXIT. DTSBD551 03312 DTSBD551 03313 P1510-EXIT. DTSBD551 03314 EXIT. DTSBD551 03315 DTSBD551 03316 P1511-CROSS-EDITS. DTSBD551 03317 * DISPLAY 'P1511-TYEP T ' DTSBD551 03318 IF W-TYPE-T-TOT-WAGE NOT = W-EMP-TOT-WAGE DTSBD551 03319 COMPUTE W-DIFFERENCE = DTSBD551 03320 (W-TYPE-T-TOT-WAGE - W-EMP-TOT-WAGE) DTSBD551 03321 IF W-DIFFERENCE > +0.99 DTSBD551 03322 OR W-DIFFERENCE < -0.99 DTSBD551 03323 * DISPLAY 'TYPE T: TOT WAGE NOT = TYPE S SUM ' DTSBD551 03324 * DISPLAY ' TYPE T: ' W-TYPE-T-TOT-WAGE DTSBD551 03325 * ' TYPE S: ' W-EMP-TOT-WAGE DTSBD551 03326 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03327 MOVE W-TYPE-T-TOT-WAGE TO MSG-T12-TOT-WAGES DTSBD551 03328 MOVE W-EMP-TOT-WAGE TO MSG-T12-S-SUM DTSBD551 03329 MOVE MSG-T12 TO R551-MSG-TEXT DTSBD551 03330 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03331 END-IF DTSBD551 03332 END-IF. DTSBD551 03333 DTSBD551 03334 IF W-TYPE-T-TAX-WAGE NOT = W-EMP-TAX-WAGE DTSBD551 03335 COMPUTE W-DIFFERENCE = DTSBD551 03336 (W-TYPE-T-TAX-WAGE - W-EMP-TAX-WAGE) DTSBD551 03337 IF W-DIFFERENCE > +0.99 DTSBD551 03338 OR W-DIFFERENCE < -0.99 DTSBD551 03339 * DISPLAY 'TYPE T: TAX WAGE NOT = TYPE S SUM ' DTSBD551 03340 * DISPLAY ' TYPE T: ' W-TYPE-T-TAX-WAGE DTSBD551 03341 * ' TYPE S: ' W-EMP-TAX-WAGE DTSBD551 03342 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03343 MOVE W-TYPE-T-TAX-WAGE TO MSG-T13-TAX-WAGES DTSBD551 03344 MOVE W-EMP-TAX-WAGE TO MSG-T13-S-SUM DTSBD551 03345 MOVE MSG-T13 TO R551-MSG-TEXT DTSBD551 03346 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03347 END-IF DTSBD551 03348 END-IF. DTSBD551 03349 DTSBD551 03350 IF W-EMP-TAX-WAGE > W-EMP-TOT-WAGE DTSBD551 03351 * DISPLAY 'TYPE T: TAX WAGE > TOT WAGE ' DTSBD551 03352 * DISPLAY ' TOT: ' W-EMP-TOT-WAGE DTSBD551 03353 * ' TAX: ' W-EMP-TAX-WAGE DTSBD551 03354 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03355 MOVE W-EMP-TAX-WAGE TO MSG-T14-TAX-WAGES DTSBD551 03356 MOVE W-EMP-TOT-WAGE TO MSG-T14-TOT-WAGES DTSBD551 03357 MOVE MSG-T14 TO R551-MSG-TEXT DTSBD551 03358 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03359 END-IF. DTSBD551 03360 DTSBD551 03361 IF W-TYPE-T-TOT-WORKER NOT = W-EMP-WAGE-CNT DTSBD551 03362 *** IF W-TYPE-T-TOT-WORKER NOT = W-ALL-WAGE-CNT DTSBD551 03363 * DISPLAY 'TYPE T: WORKER COUNTS INCONSISTENT ' DTSBD551 03364 * DISPLAY ' TYPE T TOTAL: ' W-TYPE-T-TOT-WORKER DTSBD551 03365 * ' SUM OF TYPE S: ' W-EMP-WAGE-CNT DTSBD551 03366 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03367 MOVE W-TYPE-T-TOT-WORKER TO MSG-T15-T-COUNT DTSBD551 03368 MOVE W-EMP-WAGE-CNT TO MSG-T15-S-COUNT DTSBD551 03369 MOVE MSG-T15 TO R551-MSG-TEXT DTSBD551 03370 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03371 END-IF. DTSBD551 03372 DTSBD551 03373 P1511-EXIT. DTSBD551 03374 EXIT. DTSBD551 03375 DTSBD551 03376 P1512-PAYMENT. DTSBD551 03377 IF MPRF-CLASS-SELF-INS-88 DTSBD551 03378 PERFORM P1512A-SELF-INS THRU P1512A-EXIT DTSBD551 03379 ELSE DTSBD551 03380 PERFORM P1512B-RATED THRU P1512B-EXIT DTSBD551 03381 END-IF. DTSBD551 03382 DTSBD551 03383 P1512-EXIT. DTSBD551 03384 EXIT. DTSBD551 03385 DTSBD551 03386 P1512A-SELF-INS. DTSBD551 03387 MOVE ZERO TO W-TYPE-T-PMT-DUE DTSBD551 03388 W-TYPE-T-TAX-DUE DTSBD551 03389 W-TYPE-T-ASSESS DTSBD551 03390 W-CALC-EMP-REMITTANCE. DTSBD551 03391 DTSBD551 03392 IF T-TOT-PMT-DUE NUMERIC DTSBD551 03393 MOVE T-TOT-PMT-DUE TO W-TYPE-T-PMT-DUE DTSBD551 03394 END-IF. DTSBD551 03395 DTSBD551 03396 IF T-TAX-DUE NUMERIC DTSBD551 03397 MOVE T-TAX-DUE TO W-TYPE-T-TAX-DUE DTSBD551 03398 END-IF. DTSBD551 03399 DTSBD551 03400 IF W-TYPE-T-PMT-DUE > ZERO DTSBD551 03401 MOVE W-TYPE-T-PMT-DUE TO W-CALC-EMP-REMITTANCE DTSBD551 03402 ADD W-TYPE-T-PMT-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 03403 ELSE DTSBD551 03404 MOVE W-TYPE-T-TAX-DUE TO W-CALC-EMP-REMITTANCE DTSBD551 03405 ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 03406 MOVE T-EMPLOYER-ASSESS-AMT TO W-TYPE-T-ASSESS-X DTSBD551 03407 IF W-TYPE-T-ASSESS NUMERIC DTSBD551 03408 ADD W-TYPE-T-ASSESS TO W-CALC-TOT-REMITTANCE DTSBD551 03409 W-CALC-EMP-REMITTANCE DTSBD551 03410 END-IF DTSBD551 03411 END-IF. DTSBD551 03412 DTSBD551 03413 IF W-CALC-EMP-REMITTANCE > ZERO DTSBD551 03414 MOVE T-TOT-PMT-DUE TO W-TYPE-T-TAX-DUE DTSBD551 03415 MOVE W-EMP-NO TO MSG-T16-EMP-NO DTSBD551 03416 MOVE T-TAX-DUE TO MSG-T16-REMIT DTSBD551 03417 MOVE MSG-T16 TO R551-MSG-TEXT DTSBD551 03418 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 03419 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 03420 ADD +1 TO W-SI-WITH-REMIT-CNT DTSBD551 03421 END-IF. DTSBD551 03422 DTSBD551 03423 * MOVE W-CALC-EMP-REMITTANCE TO W-AMT-DISP1. DTSBD551 03424 * DISPLAY 'P1512A SI: ' T028-EMP-NO ' ' W-AMT-DISP1. DTSBD551 03425 * IF T-TOT-PMT-DUE NUMERIC DTSBD551 03426 * IF T-TOT-PMT-DUE > ZERO DTSBD551 03427 * MOVE T-TOT-PMT-DUE TO W-TYPE-T-TAX-DUE DTSBD551 03428 * ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 03429 * MOVE W-EMP-NO TO MSG-T16-EMP-NO DTSBD551 03430 * MOVE T-TAX-DUE TO MSG-T16-REMIT DTSBD551 03431 * MOVE MSG-T16 TO R551-MSG-TEXT DTSBD551 03432 * SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 03433 * PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 03434 * ADD +1 TO W-SI-WITH-REMIT-CNT DTSBD551 03435 * END-IF DTSBD551 03436 * ELSE DTSBD551 03437 * IF T-TAX-DUE NUMERIC DTSBD551 03438 * IF T-TAX-DUE > ZERO DTSBD551 03439 * MOVE T-TAX-DUE TO W-TYPE-T-TAX-DUE DTSBD551 03440 * ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 03441 * MOVE W-EMP-NO TO MSG-T16-EMP-NO DTSBD551 03442 * MOVE T-TAX-DUE TO MSG-T16-REMIT DTSBD551 03443 * MOVE MSG-T16 TO R551-MSG-TEXT DTSBD551 03444 * SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 03445 * PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 03446 * ADD +1 TO W-SI-WITH-REMIT-CNT DTSBD551 03447 * END-IF DTSBD551 03448 * END-IF DTSBD551 03449 * END-IF. DTSBD551 03450 * DTSBD551 03451 * MOVE T-EMPLOYER-ASSESS-AMT TO W-TYPE-T-ASSESS-X. DTSBD551 03452 ** IF W-TYPE-T-ASSESS NUMERIC DTSBD551 03453 * IF W-TYPE-T-ASSESS > ZERO DTSBD551 03454 *& ADD W-TYPE-T-ASSESS TO W-TYPE-T-TAX-DUE DTSBD551 03455 *& ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 03456 * MOVE W-TYPE-T-ASSESS TO W-AMT-DISP1 DTSBD551 03457 * DISPLAY 'P1512A SI ASSESSMENT ' W-EMP-NO DTSBD551 03458 * ' ' W-AMT-DISP1 DTSBD551 03459 * END-IF DTSBD551 03460 ** END-IF. DTSBD551 03461 DTSBD551 03462 P1512A-EXIT. DTSBD551 03463 EXIT. DTSBD551 03464 DTSBD551 03465 P1512B-RATED. DTSBD551 03466 * DISPLAY 'P1512B-TYEP T ' DTSBD551 03467 MOVE ZERO TO W-TYPE-T-PMT-DUE DTSBD551 03468 W-TYPE-T-TAX-DUE DTSBD551 03469 W-TYPE-T-ASSESS DTSBD551 03470 W-CALC-EMP-REMITTANCE. DTSBD551 03471 DTSBD551 03472 IF T-TOT-PMT-DUE NUMERIC DTSBD551 03473 MOVE T-TOT-PMT-DUE TO W-TYPE-T-PMT-DUE DTSBD551 03474 ELSE DTSBD551 03475 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03476 MOVE MSG-T8 TO R551-MSG-TEXT DTSBD551 03477 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03478 GO TO P1512B-EXIT DTSBD551 03479 END-IF. DTSBD551 03480 DTSBD551 03481 IF T-TAX-DUE NUMERIC DTSBD551 03482 MOVE T-TAX-DUE TO W-TYPE-T-TAX-DUE DTSBD551 03483 ELSE DTSBD551 03484 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03485 MOVE MSG-T8 TO R551-MSG-TEXT DTSBD551 03486 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03487 GO TO P1512B-EXIT DTSBD551 03488 END-IF. DTSBD551 03489 DTSBD551 03490 IF W-TYPE-T-PMT-DUE > ZERO DTSBD551 03491 MOVE W-TYPE-T-PMT-DUE TO W-CALC-EMP-REMITTANCE DTSBD551 03492 ADD W-TYPE-T-PMT-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 03493 ELSE DTSBD551 03494 MOVE W-TYPE-T-TAX-DUE TO W-CALC-EMP-REMITTANCE DTSBD551 03495 ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 03496 MOVE T-EMPLOYER-ASSESS-AMT TO W-TYPE-T-ASSESS-X DTSBD551 03497 IF W-TYPE-T-ASSESS NUMERIC DTSBD551 03498 ADD W-TYPE-T-ASSESS TO W-CALC-TOT-REMITTANCE DTSBD551 03499 W-CALC-EMP-REMITTANCE DTSBD551 03500 END-IF DTSBD551 03501 END-IF. DTSBD551 03502 DTSBD551 03503 ** MOVE W-TYPE-T-PMT-DUE TO W-AMT-DISP1. DTSBD551 03504 * MOVE W-TYPE-T-TAX-DUE TO W-AMT-DISP2. DTSBD551 03505 * MOVE W-CALC-EMP-REMITTANCE TO W-AMT-DISP3. DTSBD551 03506 * DISPLAY ' PMT-DUE: ' W-AMT-DISP1. DTSBD551 03507 * DISPLAY ' TAX-DUE: ' W-AMT-DISP2. DTSBD551 03508 * DISPLAY ' ADMIN : ' W-TYPE-T-ASSESS-X. DTSBD551 03509 * DISPLAY ' REMIT : ' W-AMT-DISP3. DTSBD551 03510 * MOVE W-CALC-TOT-REMITTANCE TO W-AMT-DISP3. DTSBD551 03511 ** DISPLAY ' TOTAL : ' W-AMT-DISP3. DTSBD551 03512 DTSBD551 03513 ** MOVE T-EMPLOYER-ASSESS-AMT TO W-TYPE-T-ASSESS-X. DTSBD551 03514 * IF W-TYPE-T-ASSESS NUMERIC DTSBD551 03515 * IF W-TYPE-T-ASSESS > ZERO DTSBD551 03516 *& ADD W-TYPE-T-ASSESS TO W-TYPE-T-TAX-DUE DTSBD551 03517 *& ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 03518 * MOVE W-TYPE-T-ASSESS TO W-AMT-DISP1 DTSBD551 03519 * DISPLAY 'P1512B ASSESSMENT ' W-EMP-NO DTSBD551 03520 * ' ' W-AMT-DISP1 DTSBD551 03521 * END-IF DTSBD551 03522 ** END-IF. DTSBD551 03523 DTSBD551 03524 P1512B-EXIT. DTSBD551 03525 EXIT. DTSBD551 03526 DTSBD551 03527 P1520-SET-WAGE-FILES. DTSBD551 03528 IF W-ERROR-YES-88 DTSBD551 03529 SET WAGE-TEMP-REQ-CLOSE-88 TO TRUE DTSBD551 03530 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT DTSBD551 03531 ELSE DTSBD551 03532 SET WAGE-TEMP-REQ-CLOSE-88 TO TRUE DTSBD551 03533 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT DTSBD551 03534 IF W-ERROR-NO-88 DTSBD551 03535 SET WAGE-TEMP-REQ-OPEN-INP-88 TO TRUE DTSBD551 03536 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT DTSBD551 03537 END-IF DTSBD551 03538 END-IF. DTSBD551 03539 DTSBD551 03540 P1520-EXIT. DTSBD551 03541 EXIT. DTSBD551 03542 DTSBD551 03543 P1530-COPY-WAGES. DTSBD551 03544 PERFORM DTSBD551 03545 UNTIL WAGE-TEMP-STATUS-EOF-88 DTSBD551 03546 READ WAGE-FILE-TEMP INTO W001-REC DTSBD551 03547 IF WAGE-TEMP-STATUS-EOF-88 DTSBD551 03548 NEXT SENTENCE DTSBD551 03549 ELSE DTSBD551 03550 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 03551 WRITE WAGE-OUT-REC FROM W001-REC DTSBD551 03552 IF NOT WAGE-OUT-STATUS-OK-88 DTSBD551 03553 PERFORM P1531-ERROR THRU P1531-EXIT DTSBD551 03554 ELSE DTSBD551 03555 ADD +1 TO W-W001-WRITE-CNT DTSBD551 03556 END-IF DTSBD551 03557 ELSE DTSBD551 03558 PERFORM P1532-ERROR THRU P1532-EXIT DTSBD551 03559 END-IF DTSBD551 03560 END-IF DTSBD551 03561 END-PERFORM. DTSBD551 03562 DTSBD551 03563 SET WAGE-TEMP-REQ-CLOSE-88 TO TRUE. DTSBD551 03564 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT. DTSBD551 03565 DTSBD551 03566 P1530-EXIT. DTSBD551 03567 EXIT. DTSBD551 03568 DTSBD551 03569 P1531-ERROR. DTSBD551 03570 DISPLAY 'P1500: CANNOT WRITE WAGE-OUT ' DTSBD551 03571 WAGE-OUT-STATUS ' ' E-FEDERAL-EIN ' ' W001-SSN DTSBD551 03572 SET WAGE-TEMP-STATUS-EOF-88 TO TRUE DTSBD551 03573 SET W-ERROR-YES-88 TO TRUE. DTSBD551 03574 DTSBD551 03575 P1531-EXIT. DTSBD551 03576 EXIT. DTSBD551 03577 DTSBD551 03578 P1532-ERROR. DTSBD551 03579 DISPLAY 'P1500: ERROR READING WAGE TEMP ' DTSBD551 03580 WAGE-TEMP-STATUS ' ' E-FEDERAL-EIN ' ' W001-SSN DTSBD551 03581 SET WAGE-TEMP-STATUS-EOF-88 TO TRUE DTSBD551 03582 SET W-ERROR-YES-88 TO TRUE. DTSBD551 03583 DTSBD551 03584 P1532-EXIT. DTSBD551 03585 EXIT. DTSBD551 03586 DTSBD551 03587 P1540-WRITE-T028. DTSBD551 03588 *& IF W-EMP-TOT-WAGE > ZERO DTSBD551 03589 * MOVE W-EMP-NO TO ZW-SUB DTSBD551 03590 * SET ZW-ZERO-WAGE-NO-88 (ZW-SUB) TO TRUE DTSBD551 03591 *& END-IF. DTSBD551 03592 DTSBD551 03593 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSBD551 03594 MOVE '028' TO T028-REC-TYPE. DTSBD551 03595 DTSBD551 03596 MOVE W-PSEUDO-BATCH-NO TO T028-PSEUDO-BATCH-NO. DTSBD551 03597 MOVE W-PSEUDO-ITEM-NO TO T028-PSEUDO-ITEM-NO. DTSBD551 03598 DTSBD551 03599 MOVE W-EMP-TOT-WAGE TO T028-TOT-WAGE. DTSBD551 03600 DTSBD551 03601 IF MPRF-CLASS-SELF-INS-88 DTSBD551 03602 MOVE ZERO TO T028-TAX-WAGE DTSBD551 03603 T028-EXCESS-WAGE DTSBD551 03604 ELSE DTSBD551 03605 MOVE W-EMP-TAX-WAGE TO T028-TAX-WAGE DTSBD551 03606 COMPUTE T028-EXCESS-WAGE = DTSBD551 03607 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBD551 03608 END-IF. DTSBD551 03609 DTSBD551 03610 MOVE W-EMP-WAGE-CNT TO T028-TOTAL-EMPL-CNT. DTSBD551 03611 MOVE W-MONTH-1-CNT-9 TO T028-1ST-MTH-EMPL-CNT. DTSBD551 03612 MOVE W-MONTH-2-CNT-9 TO T028-2ND-MTH-EMPL-CNT. DTSBD551 03613 MOVE W-MONTH-3-CNT-9 TO T028-3RD-MTH-EMPL-CNT. DTSBD551 03614 DTSBD551 03615 MOVE W-CALC-EMP-REMITTANCE TO T028-REMIT-AMT. DTSBD551 03616 *** MOVE W-TYPE-T-TAX-DUE TO T028-REMIT-AMT. DTSBD551 03617 DTSBD551 03618 IF W-LIABLE-NO-88 DTSBD551 03619 OR W-EMP-FOUND-NO-88 DTSBD551 03620 OR W-DUP-RPT-YES-88 DTSBD551 03621 OR W-ANNUAL-QTR-YES-88 DTSBD551 03622 SET T028-PASSED-FULL-EDITS-NO-88 TO TRUE DTSBD551 03623 ADD +1 TO W-FAILED-FULL-EDITS-CNT DTSBD551 03624 ELSE DTSBD551 03625 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSBD551 03626 END-IF. DTSBD551 03627 DTSBD551 03628 MOVE W-LOG-NO TO W-LOG-NO-9. DTSBD551 03629 MOVE W-LOG-NO-X TO T028-LOG-NBR. DTSBD551 03630 DTSBD551 03631 MOVE T028-REC TO TSKL-REC. DTSBD551 03632 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD551 03633 ADD +1 TO W-T028-WRITE-CNT. DTSBD551 03634 DTSBD551 03635 *& DTSBD551 03636 * IF E-ACCOUNT-NO = '025391' DTSBD551 03637 * DISPLAY SPACE DTSBD551 03638 * DISPLAY 'EMP COMPLETE: ' T028-EMP-NO DTSBD551 03639 * DISPLAY ' WAGE ITEMS ' W-EMP-WAGE-CNT DTSBD551 03640 * ' TOT WAGES ' T028-TOT-WAGE DTSBD551 03641 * END-IF. DTSBD551 03642 *& DTSBD551 03643 DTSBD551 03644 P1540-EXIT. DTSBD551 03645 EXIT. DTSBD551 03646 DTSBD551 03647 P1550-CONTACT. DTSBD551 03648 IF W-EMP-FOUND-NO-88 DTSBD551 03649 GO TO P1550-EXIT DTSBD551 03650 END-IF. DTSBD551 03651 DTSBD551 03652 *** PERFORM P1551-FIND-MOPO THRU P1551-EXIT. DTSBD551 03653 PERFORM P1552-BUILD-T002 THRU P1552-EXIT. DTSBD551 03654 DTSBD551 03655 P1550-EXIT. DTSBD551 03656 EXIT. DTSBD551 03657 DTSBD551 03658 P1551-FIND-MOPO. DTSBD551 03659 SET W-MOPO-FOUND-NO-88 TO TRUE. DTSBD551 03660 DTSBD551 03661 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBD551 03662 MOVE W-EMP-NO TO MOPO-EMP-NO. DTSBD551 03663 SET MOPO-OPO-88 TO TRUE. DTSBD551 03664 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBD551 03665 DTSBD551 03666 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD551 03667 IF L910-NO-REC-88 DTSBD551 03668 NEXT SENTENCE DTSBD551 03669 ELSE DTSBD551 03670 PERFORM DTSBD551 03671 UNTIL L910-NO-REC-88 DTSBD551 03672 OR W-MOPO-FOUND-YES-88 DTSBD551 03673 MOVE MSKL-REC TO MOPO-REC DTSBD551 03674 IF MOPO-TYPE-RPT-BSNS-88 DTSBD551 03675 SET W-MOPO-FOUND-YES-88 TO TRUE DTSBD551 03676 ELSE DTSBD551 03677 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD551 03678 END-IF DTSBD551 03679 END-PERFORM DTSBD551 03680 END-IF. DTSBD551 03681 DTSBD551 03682 P1551-EXIT. DTSBD551 03683 EXIT. DTSBD551 03684 DTSBD551 03685 P1552-BUILD-T002. DTSBD551 03686 SET T002-LENGTH-CONTACT-88 TO TRUE. DTSBD551 03687 MOVE '002' TO T002-REC-TYPE. DTSBD551 03688 MOVE MPRF-EMP-NO TO T002-EMP-NO. DTSBD551 03689 MOVE 'MAG UC30 ' TO T002-ORIGIN. DTSBD551 03690 MOVE L005-DATE TO T002-SYS-DATE. DTSBD551 03691 MOVE L005-TIME TO T002-SYS-TIME. DTSBD551 03692 DTSBD551 03693 SET Y120-CONTACT-RPT-BSNS-88 TO TRUE. DTSBD551 03694 DTSBD551 03695 MOVE W-SUBM-NAME TO Y120-CONTACT-NAME. DTSBD551 03696 MOVE W-SUBM-CONTACT-PHONE-AREA DTSBD551 03697 TO Y120-CONTACT-VOICE. DTSBD551 03698 MOVE ZEROS TO Y120-CONTACT-SSN DTSBD551 03699 MOVE SPACES TO Y120-CONTACT-ADDR DTSBD551 03700 MOVE SPACES TO Y120-CONTACT-TITLE DTSBD551 03701 MOVE SPACES TO Y120-CONTACT-FAX DTSBD551 03702 MOVE SPACES TO Y120-CONTACT-EMAIL DTSBD551 03703 DTSBD551 03704 MOVE Y120-DATA-AREA TO T002-DATA-AREA DTSBD551 03705 SET T002-CONTACT-88 TO TRUE. DTSBD551 03706 DTSBD551 03707 MOVE T002-REC TO TSKL-REC. DTSBD551 03708 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD551 03709 ADD +1 TO W-T002-CONTACT-CNT. DTSBD551 03710 DTSBD551 03711 P1552-EXIT. DTSBD551 03712 EXIT. DTSBD551 03713 DTSBD551 03714 P1560-MNTE. DTSBD551 03715 IF W-MNTE-STARTED-NO-88 DTSBD551 03716 GO TO P1560-EXIT DTSBD551 03717 END-IF. DTSBD551 03718 DTSBD551 03719 SET W-MNTE-STARTED-NO-88 TO TRUE. DTSBD551 03720 MOVE LENGTH OF T003-REC TO T003-LENGTH DTSBD551 03721 MOVE '003' TO T003-REC-TYPE. DTSBD551 03722 MOVE MPRF-EMP-NO TO T003-EMP-NO. DTSBD551 03723 MOVE 'MAG UC30 ' TO T003-ORIGIN. DTSBD551 03724 MOVE L005-DATE TO T003-SYS-DATE. DTSBD551 03725 MOVE L005-TIME TO T003-SYS-TIME. DTSBD551 03726 SET T003-ADD-MNTE-88 TO TRUE. DTSBD551 03727 MOVE W-MNTE-TEXT-CNT TO MNTE-TEXT-CNT. DTSBD551 03728 MOVE W-MNTE-TEXT-AREA TO MNTE-TEXT-AREA. DTSBD551 03729 MOVE MNTE-REC TO T003-MNTE-REC. DTSBD551 03730 DTSBD551 03731 MOVE T003-REC TO TSKL-REC. DTSBD551 03732 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD551 03733 ADD +1 TO W-T003-MNTE-CNT. DTSBD551 03734 DTSBD551 03735 *& DTSBD551 03736 * DISPLAY 'P1560B WRITE ' W-EMP-NO. DTSBD551 03737 *& DTSBD551 03738 P1560-EXIT. DTSBD551 03739 EXIT. DTSBD551 03740 DTSBD551 03741 *P1570-UPD-LOG. DTSBD551 03742 * SET L200-CMD-EMP-COMPLETE-88 TO TRUE. DTSBD551 03743 * MOVE W-EMP-NO TO L200-EMP-NO. DTSBD551 03744 * MOVE W-RPT-DATE TO L200-REPORTING-DATE. DTSBD551 03745 * MOVE W-EMP-WAGE-CNT TO L200-TOT-CNT DTSBD551 03746 * L200-SUCCESS-CNT. DTSBD551 03747 * PERFORM S201-UPD-LOG THRU S201-EXIT. DTSBD551 03748 * DTSBD551 03749 *P1570-EXIT. DTSBD551 03750 * EXIT. DTSBD551 03751 DTSBD551 03752 P1580-ZERO-WAGE. DTSBD551 03753 *& DTSBD551 03754 * IF W-SUCCESSOR-YES-88 DTSBD551 03755 * DISPLAY ' P1580 ' E-ACCOUNT-NO ' ' W-EMP-TOT-WAGE DTSBD551 03756 * ' ' W-EMP-NO. DTSBD551 03757 *& DTSBD551 03758 ADD +1 TO W-EMP-ERROR-CNT. DTSBD551 03759 ADD +1 TO W-BYPASS-0-WAGE-RPT-CNT. DTSBD551 03760 MOVE W-EMP-NO TO MSG-E9C-ACCT-NO. DTSBD551 03761 IF W-LIABLE-NO-88 DTSBD551 03762 MOVE 'NOT LIABLE ' TO MSG-E9C-REASON DTSBD551 03763 ELSE DTSBD551 03764 IF W-EMP-FOUND-NO-88 DTSBD551 03765 MOVE 'NOT FOUND ' TO MSG-E9C-REASON DTSBD551 03766 ELSE DTSBD551 03767 IF W-DUP-RPT-YES-88 DTSBD551 03768 MOVE 'DUP REPORT ' TO MSG-E9C-REASON DTSBD551 03769 END-IF DTSBD551 03770 END-IF DTSBD551 03771 END-IF. DTSBD551 03772 MOVE MSG-E9C TO R551-MSG-TEXT. DTSBD551 03773 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE. DTSBD551 03774 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT. DTSBD551 03775 DTSBD551 03776 DISPLAY '*** ZERO WAGE ' MSG-E9C-REASON DTSBD551 03777 ' ' W-EMP-NO ' ' E-NAME. DTSBD551 03778 P1580-EXIT. DTSBD551 03779 EXIT. DTSBD551 03780 DTSBD551 03781 P1590-EMP-RPT-REC. DTSBD551 03782 MOVE W-EMP-NO TO X212-EMP-NBR. DTSBD551 03783 MOVE W-ACCT-NBR-9 TO X212-ORIG-EMP-NBR. DTSBD551 03784 IF E-FEDERAL-EIN NUMERIC DTSBD551 03785 MOVE E-FEDERAL-EIN TO X212-ORIG-FEIN DTSBD551 03786 ELSE DTSBD551 03787 MOVE ZEROS TO X212-ORIG-FEIN DTSBD551 03788 END-IF. DTSBD551 03789 MOVE W-FINAL-FEIN TO X212-FEIN. DTSBD551 03790 MOVE W-SUBM-FEIN TO X212-SUBMITTER-FEIN. DTSBD551 03791 MOVE W-RPT-QTR TO L004-QTR-5-9. DTSBD551 03792 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD551 03793 MOVE L004-SLASH-5-QTR TO X212-QTR. DTSBD551 03794 MOVE W-PSEUDO-BATCH-NO TO X212-BATCH. DTSBD551 03795 MOVE W-PSEUDO-ITEM-NO TO X212-ITEM. DTSBD551 03796 MOVE W-CALC-EMP-REMITTANCE TO X212-REMITTANCE. DTSBD551 03797 *** MOVE W-TYPE-T-TAX-DUE TO X212-REMITTANCE. DTSBD551 03798 MOVE W-CURR-DATE TO L001-FED-8-DATE-9. DTSBD551 03799 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD551 03800 MOVE L001-SLASH-8-DATE TO X212-PROCESS-DT. DTSBD551 03801 MOVE T028-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBD551 03802 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD551 03803 MOVE L001-SLASH-8-DATE TO X212-RECEIVED-DT. DTSBD551 03804 MOVE T028-DEPOSIT-DATE TO L001-FED-8-DATE-9. DTSBD551 03805 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD551 03806 MOVE L001-SLASH-8-DATE TO X212-DEPOSIT-DT. DTSBD551 03807 DTSBD551 03808 WRITE EMP-RPT-REC FROM W-EMP-RPT-REC. DTSBD551 03809 IF EMP-RPT-STATUS-OK-88 DTSBD551 03810 NEXT SENTENCE DTSBD551 03811 ELSE DTSBD551 03812 SET W-ERROR-YES-88 TO TRUE DTSBD551 03813 DISPLAY 'CANNOT WRITE EMP RPT FILE: ' DTSBD551 03814 EMP-RPT-STATUS DTSBD551 03815 END-IF. DTSBD551 03816 DTSBD551 03817 P1590-EXIT. DTSBD551 03818 EXIT. DTSBD551 03819 DTSBD551 03820 P1600-TYPE-F. DTSBD551 03821 MOVE ICESA-REC TO WAGE-RECORD-F. DTSBD551 03822 DTSBD551 03823 *& DTSBD551 03824 DISPLAY 'TYPE F ' WAGE-RECORD-F (1:60). DTSBD551 03825 *& DTSBD551 03826 DTSBD551 03827 IF W-PREV-REC-TYPE-T-88 DTSBD551 03828 SET W-PREV-REC-TYPE-F-88 TO TRUE DTSBD551 03829 ELSE DTSBD551 03830 * DISPLAY 'TYPE F: PREVIOUS REC TYPE NOT T: ' DTSBD551 03831 * W-PREV-REC-TYPE DTSBD551 03832 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03833 MOVE W-PREV-REC-TYPE TO MSG-F1-REC-TYPE DTSBD551 03834 MOVE MSG-F1 TO R551-MSG-TEXT DTSBD551 03835 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03836 GO TO P1600-EXIT DTSBD551 03837 END-IF. DTSBD551 03838 DTSBD551 03839 IF W-ERROR-NO-88 DTSBD551 03840 PERFORM P1610-EDIT-TYPE-F THRU P1610-EXIT DTSBD551 03841 IF W-ERROR-NO-88 DTSBD551 03842 PERFORM P1620-VALIDATE-TOTALS THRU P1620-EXIT DTSBD551 03843 END-IF DTSBD551 03844 END-IF. DTSBD551 03845 DTSBD551 03846 P1600-EXIT. DTSBD551 03847 EXIT. DTSBD551 03848 DTSBD551 03849 P1610-EDIT-TYPE-F. DTSBD551 03850 IF F-TOT-EMPLOYEE NOT NUMERIC DTSBD551 03851 DISPLAY 'TYPE F: NON-NUMERIC TOT WORKERS ' DTSBD551 03852 F-TOT-EMPLOYEE DTSBD551 03853 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03854 MOVE F-TOT-EMPLOYEE TO MSG-F2-TOT-EMPLOYEE DTSBD551 03855 MOVE MSG-F2 TO R551-MSG-TEXT DTSBD551 03856 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03857 ELSE DTSBD551 03858 MOVE F-TOT-EMPLOYEE TO W-TYPE-F-TOT-WORKER DTSBD551 03859 END-IF. DTSBD551 03860 DTSBD551 03861 IF F-TOT-EMPLOYER NOT NUMERIC DTSBD551 03862 DISPLAY 'TYPE F: NON-NUMERIC TOT EMPLOYERS ' DTSBD551 03863 F-TOT-EMPLOYER DTSBD551 03864 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03865 MOVE F-TOT-EMPLOYER TO MSG-F3-TOT-EMPLOYER DTSBD551 03866 MOVE MSG-F3 TO R551-MSG-TEXT DTSBD551 03867 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03868 ELSE DTSBD551 03869 MOVE F-TOT-EMPLOYER TO W-TYPE-F-TOT-EMP DTSBD551 03870 END-IF. DTSBD551 03871 DTSBD551 03872 IF F-TOTAL-WAGE NOT NUMERIC DTSBD551 03873 DISPLAY 'TYPE F: NON-NUMERIC TOT WAGE ' F-TOTAL-WAGE DTSBD551 03874 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03875 * MOVE F-TOTAL-WAGE TO MSG-F4-TOT-WAGES DTSBD551 03876 MOVE MSG-F4 TO R551-MSG-TEXT DTSBD551 03877 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03878 ELSE DTSBD551 03879 MOVE F-TOTAL-WAGE TO W-TYPE-F-TOT-WAGE DTSBD551 03880 END-IF. DTSBD551 03881 DTSBD551 03882 P1610-EXIT. DTSBD551 03883 EXIT. DTSBD551 03884 DTSBD551 03885 P1620-VALIDATE-TOTALS. DTSBD551 03886 IF W-TYPE-F-TOT-WORKER NOT = W-ALL-WAGE-CNT DTSBD551 03887 DISPLAY 'TYPE F: INVALID TOT WORKERS ' DTSBD551 03888 W-TYPE-F-TOT-WORKER DTSBD551 03889 ' ACTUAL ' W-ALL-WAGE-CNT DTSBD551 03890 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03891 MOVE W-TYPE-F-TOT-WORKER TO MSG-F5-TOT-WORKERS DTSBD551 03892 MOVE W-ALL-WAGE-CNT TO MSG-F5-ALL-WAGE-CNT DTSBD551 03893 MOVE MSG-F5 TO R551-MSG-TEXT DTSBD551 03894 *& PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 03895 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03896 END-IF. DTSBD551 03897 DTSBD551 03898 IF W-TYPE-F-TOT-EMP NOT = W-ALL-EMP-CNT DTSBD551 03899 DISPLAY 'TYPE F: INVALID TOT EMPLOYERS ' DTSBD551 03900 W-TYPE-F-TOT-EMP DTSBD551 03901 ' ACTUAL ' W-ALL-EMP-CNT DTSBD551 03902 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03903 MOVE W-TYPE-F-TOT-EMP TO MSG-F6-TOT-EMPLOYER DTSBD551 03904 MOVE W-ALL-EMP-CNT TO MSG-F6-ALL-EMPL-CNT DTSBD551 03905 MOVE MSG-F6 TO R551-MSG-TEXT DTSBD551 03906 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03907 END-IF. DTSBD551 03908 DTSBD551 03909 IF W-TYPE-F-TOT-WAGE NOT = W-ALL-TOT-WAGE DTSBD551 03910 DISPLAY 'TYPE F: INVALID TOT WAGE ' DTSBD551 03911 W-TYPE-F-TOT-WAGE DTSBD551 03912 ' ACTUAL ' W-ALL-TOT-WAGE DTSBD551 03913 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03914 MOVE W-TYPE-F-TOT-WAGE TO MSG-F7-TOT-WAGE DTSBD551 03915 MOVE W-ALL-TOT-WAGE TO MSG-F7-ALL-TOT-WAGE DTSBD551 03916 MOVE MSG-F7 TO R551-MSG-TEXT DTSBD551 03917 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03918 END-IF. DTSBD551 03919 DTSBD551 03920 COMPUTE W-DIFF = DTSBD551 03921 (W-CALC-TOT-REMITTANCE - W-PARM-DEPOSIT-REMIT). DTSBD551 03922 IF W-DIFF > 0.99 OR < -0.99 DTSBD551 03923 MOVE W-PARM-DEPOSIT-REMIT TO W-AMT-DISP1 DTSBD551 03924 MOVE W-CALC-TOT-REMITTANCE TO W-AMT-DISP2 DTSBD551 03925 MOVE W-DIFF TO W-AMT-DISP3 DTSBD551 03926 DISPLAY 'TYPE F: CALC REMIT NOT = PARM REMIT ' DTSBD551 03927 DISPLAY ' CALC: ' W-AMT-DISP2 DTSBD551 03928 ' CHECK ' W-AMT-DISP1 DTSBD551 03929 ' DIFFERENCE ' W-AMT-DISP3 DTSBD551 03930 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03931 MOVE W-AMT-DISP2 TO MSG-F8-CALC-REMIT DTSBD551 03932 MOVE W-AMT-DISP1 TO MSG-F8-PARM-REMIT DTSBD551 03933 MOVE MSG-F8 TO R551-MSG-TEXT DTSBD551 03934 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03935 END-IF. DTSBD551 03936 DTSBD551 03937 *** MOVE W-CALC-TOT-REMITTANCE TO W-CALC-TOT-REMITTANCE-INT. DTSBD551 03938 * IF W-CALC-TOT-REMITTANCE-INT NOT = W-PARM-TOT-REMITTANCE DTSBD551 03939 * DISPLAY 'TYPE F: CALC REMIT NOT = PARM REMIT ' DTSBD551 03940 * W-PARM-TOT-REMITTANCE DTSBD551 03941 * ' ACTUAL ' W-CALC-TOT-REMITTANCE-INT DTSBD551 03942 *& DTSBD551 03943 * MOVE W-CALC-TOT-REMITTANCE TO W-AMT-DISP1 DTSBD551 03944 * MOVE W-PARM-REMIT-DECIMAL TO W-AMT-DISP2 DTSBD551 03945 * DISPLAY ' CALC ' W-AMT-DISP1 ' ACT ' W-AMT-DISP2 DTSBD551 03946 *& DTSBD551 03947 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 03948 * MOVE W-CALC-TOT-REMITTANCE-INT TO MSG-F8-CALC-REMIT DTSBD551 03949 * MOVE W-PARM-TOT-REMITTANCE TO MSG-F8-PARM-REMIT DTSBD551 03950 * MOVE MSG-F8 TO R551-MSG-TEXT DTSBD551 03951 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 03952 *** END-IF. DTSBD551 03953 P1620-EXIT. DTSBD551 03954 EXIT. DTSBD551 03955 DTSBD551 03956 DTSBD551 03957 T0000-TERMINATE. DTSBD551 03958 DISPLAY ' '. DTSBD551 03959 DTSBD551 03960 DISPLAY '*** DTSBD551 TERMINATION STATISTICS ***'. DTSBD551 03961 DTSBD551 03962 DISPLAY ' '. DTSBD551 03963 DTSBD551 03964 IF W-ERROR-YES-88 DTSBD551 03965 OR W-FATAL-ERROR-YES-88 DTSBD551 03966 NEXT SENTENCE DTSBD551 03967 ELSE DTSBD551 03968 PERFORM T0100-DELETE-0-WAGE-DUPS THRU T0100-EXIT DTSBD551 03969 PERFORM T1000-UPDATE-ARCHIVE-DD THRU T1000-EXIT DTSBD551 03970 PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT DTSBD551 03971 PERFORM T1110-WRITE-X210-REC THRU T1110-EXIT DTSBD551 03972 PERFORM T1120-WRITE-R202-REC THRU T1120-EXIT DTSBD551 03973 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT DTSBD551 03974 *** PERFORM T0200-UPD-LOG-SUCCESS THRU T0200-EXIT DTSBD551 03975 END-IF. DTSBD551 03976 DTSBD551 03977 CLOSE ICESA-FILE DTSBD551 03978 WAGE-FILE-TEMP DTSBD551 03979 WAGE-FILE-OUT DTSBD551 03980 CURR-BATCH-NO DTSBD551 03981 SUBMITTER-FILE DTSBD551 03982 EMP-RPT-FILE DTSBD551 03983 MESSAGE-FILE. DTSBD551 03984 DTSBD551 03985 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD551 03986 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD551 03987 *** PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBD551 03988 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD551 03989 DTSBD551 03990 DTSBD551 03991 T0000-EXIT. DTSBD551 03992 EXIT. DTSBD551 03993 DTSBD551 03994 T0100-DELETE-0-WAGE-DUPS. DTSBD551 03995 PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBD551 03996 DTSBD551 03997 *& OPEN I-O RPT-FILE. DTSBD551 03998 * IF RPT-STATUS-OK-88 DTSBD551 03999 * NEXT SENTENCE DTSBD551 04000 * ELSE DTSBD551 04001 * DISPLAY 'T0100: CANNOT OPEN RPT-FILE: ' DTSBD551 04002 * RPT-STATUS DTSBD551 04003 * GO TO T0100-EXIT DTSBD551 04004 * END-IF. DTSBD551 04005 * DTSBD551 04006 * READ RPT-FILE. DTSBD551 04007 * PERFORM UNTIL EMP-RPT-STATUS-EOF-88 DTSBD551 04008 * MOVE RSK1-REC TO T028-REC DTSBD551 04009 * IF T028-TOT-WAGE = ZERO DTSBD551 04010 * IF ZW-ZERO-WAGE-NO-88 (ZW-SUB) DTSBD551 04011 * DELETE RPT-FILE DTSBD551 04012 * DISPLAY 'T0100 ' T028-EMP-NO ' ' T028-TOT-WAGE DTSBD551 04013 * MOVE T028-EMP-NO TO MSG-T17-EMP-NO DTSBD551 04014 * MOVE MSG-T17 TO R551-MSG-TEXT DTSBD551 04015 * SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 04016 * PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 04017 * END-IF DTSBD551 04018 * END-IF DTSBD551 04019 * READ RPT-FILE DTSBD551 04020 *& END-PERFORM. DTSBD551 04021 DTSBD551 04022 T0100-EXIT. DTSBD551 04023 EXIT. DTSBD551 04024 DTSBD551 04025 *T0300-UPD-LOG-FAILED. DTSBD551 04026 * SET L200-CMD-TERMINATE-88 TO TRUE. DTSBD551 04027 * MOVE ZERO TO L200-EMP-NO DTSBD551 04028 * L200-REPORTING-DATE DTSBD551 04029 * L200-TOT-CNT DTSBD551 04030 * L200-SUCCESS-CNT. DTSBD551 04031 * PERFORM S201-UPD-LOG THRU S201-EXIT. DTSBD551 04032 * DTSBD551 04033 *T0300-EXIT. DTSBD551 04034 * EXIT. DTSBD551 04035 DTSBD551 04036 *T0400-UPD-LOG-SUCCESS. DTSBD551 04037 * SET L200-CMD-TERMINATE-88 TO TRUE. DTSBD551 04038 * MOVE W-EMP-NO TO L200-EMP-NO. DTSBD551 04039 * MOVE W-RPT-DATE TO L200-REPORTING-DATE. DTSBD551 04040 * MOVE W-ALL-EMP-CNT TO L200-TOT-CNT DTSBD551 04041 * L200-SUCCESS-CNT. DTSBD551 04042 * PERFORM S201-UPD-LOG THRU S201-EXIT. DTSBD551 04043 * DTSBD551 04044 *T0400-EXIT. DTSBD551 04045 * EXIT. DTSBD551 04046 DTSBD551 04047 T1000-UPDATE-ARCHIVE-DD. DTSBD551 04048 OPEN OUTPUT UC30-ARCHIVE-DD. DTSBD551 04049 IF ARCHIVE-STATUS-OK-88 DTSBD551 04050 NEXT SENTENCE DTSBD551 04051 ELSE DTSBD551 04052 SET W-ERROR-YES-88 TO TRUE DTSBD551 04053 DISPLAY 'CANNOT OPEN ARCHIVE FILE ' ARCHIVE-STATUS DTSBD551 04054 GO TO T1000-EXIT DTSBD551 04055 END-IF. DTSBD551 04056 DTSBD551 04057 DISPLAY 'T1000 ' W-SUBM-CREATE-DATE. DTSBD551 04058 DISPLAY ' ' W-SUBM-CREATE-CCYY. DTSBD551 04059 DTSBD551 04060 PERFORM T1010-START-JOB THRU T1010-EXIT. DTSBD551 04061 DTSBD551 04062 IF W-SUBM-CREATE-CCYY > W-ARCHIVE-CURR-YEAR DTSBD551 04063 OR W-SUBM-CREATE-CCYY < W-ARCHIVE-FIRST-YEAR DTSBD551 04064 PERFORM T1020-WRITE-NEW-DD THRU T1020-EXIT DTSBD551 04065 PERFORM T1035-WRITE-BACKUP-DD THRU T1035-EXIT DTSBD551 04066 ELSE DTSBD551 04067 PERFORM T1030-WRITE-OLD-DD THRU T1030-EXIT DTSBD551 04068 PERFORM T1031-WRITE-UNCATLG-DD THRU T1031-EXIT DTSBD551 04069 PERFORM T1035-WRITE-BACKUP-DD THRU T1035-EXIT DTSBD551 04070 END-IF. DTSBD551 04071 DTSBD551 04072 PERFORM T1040-END-JOB THRU T1040-EXIT. DTSBD551 04073 DTSBD551 04074 CLOSE UC30-ARCHIVE-DD. DTSBD551 04075 DTSBD551 04076 T1000-EXIT. DTSBD551 04077 EXIT. DTSBD551 04078 DTSBD551 04079 T1010-START-JOB. DTSBD551 04080 MOVE DD-LINE-1-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04081 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04082 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04083 GO TO T1010-EXIT DTSBD551 04084 END-IF. DTSBD551 04085 DTSBD551 04086 MOVE DD-LINE-2-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04087 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04088 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04089 GO TO T1010-EXIT DTSBD551 04090 END-IF. DTSBD551 04091 DTSBD551 04092 MOVE DD-LINE-3-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04093 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04094 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04095 GO TO T1010-EXIT DTSBD551 04096 END-IF. DTSBD551 04097 DTSBD551 04098 MOVE DD-LINE-3A-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04099 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04100 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04101 GO TO T1010-EXIT DTSBD551 04102 END-IF. DTSBD551 04103 DTSBD551 04104 MOVE DD-LINE-3B-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04105 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04106 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04107 GO TO T1010-EXIT DTSBD551 04108 END-IF. DTSBD551 04109 DTSBD551 04110 MOVE DD-LINE-3C-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04111 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04112 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04113 GO TO T1010-EXIT DTSBD551 04114 END-IF. DTSBD551 04115 DTSBD551 04116 MOVE DD-LINE-3D-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04117 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04118 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04119 GO TO T1010-EXIT DTSBD551 04120 END-IF. DTSBD551 04121 DTSBD551 04122 MOVE DD-LINE-3E-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04123 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04124 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04125 GO TO T1010-EXIT DTSBD551 04126 END-IF. DTSBD551 04127 DTSBD551 04128 MOVE DD-LINE-3F-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04129 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04130 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04131 GO TO T1010-EXIT DTSBD551 04132 END-IF. DTSBD551 04133 DTSBD551 04134 MOVE DD-LINE-3G-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04135 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04136 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04137 GO TO T1010-EXIT DTSBD551 04138 END-IF. DTSBD551 04139 DTSBD551 04140 MOVE DD-LINE-4-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04141 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04142 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04143 GO TO T1010-EXIT DTSBD551 04144 END-IF. DTSBD551 04145 DTSBD551 04146 MOVE DD-LINE-5-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04147 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04148 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04149 GO TO T1010-EXIT DTSBD551 04150 END-IF. DTSBD551 04151 DTSBD551 04152 MOVE DD-LINE-6-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04153 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04154 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04155 GO TO T1010-EXIT DTSBD551 04156 END-IF. DTSBD551 04157 DTSBD551 04158 MOVE DD-LINE-7-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04159 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04160 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04161 GO TO T1010-EXIT DTSBD551 04162 END-IF. DTSBD551 04163 DTSBD551 04164 T1010-EXIT. DTSBD551 04165 EXIT. DTSBD551 04166 DTSBD551 04167 T1020-WRITE-NEW-DD. DTSBD551 04168 DTSBD551 04169 MOVE W-SUBM-CREATE-CCYY TO W-ARCHIVE-NEW-YEAR. DTSBD551 04170 DTSBD551 04171 MOVE DD-LINE-1-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 04172 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04173 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04174 GO TO T1020-EXIT DTSBD551 04175 END-IF. DTSBD551 04176 DTSBD551 04177 MOVE DD-LINE-2-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 04178 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04179 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04180 GO TO T1020-EXIT DTSBD551 04181 END-IF. DTSBD551 04182 DTSBD551 04183 MOVE DD-LINE-3-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 04184 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04185 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04186 GO TO T1020-EXIT DTSBD551 04187 END-IF. DTSBD551 04188 DTSBD551 04189 DTSBD551 04190 MOVE DD-LINE-4-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 04191 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04192 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04193 GO TO T1020-EXIT DTSBD551 04194 END-IF. DTSBD551 04195 DTSBD551 04196 DTSBD551 04197 MOVE DD-LINE-5-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 04198 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04199 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04200 GO TO T1020-EXIT DTSBD551 04201 END-IF. DTSBD551 04202 DTSBD551 04203 T1020-EXIT. DTSBD551 04204 EXIT. DTSBD551 04205 DTSBD551 04206 T1030-WRITE-OLD-DD. DTSBD551 04207 MOVE W-SUBM-CREATE-CCYY TO W-ARCHIVE-OLD-YEAR. DTSBD551 04208 DTSBD551 04209 MOVE DD-LINE-1-OLD TO UC30-ARCHIVE-DD-REC. DTSBD551 04210 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04211 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04212 GO TO T1030-EXIT DTSBD551 04213 END-IF. DTSBD551 04214 DTSBD551 04215 MOVE DD-LINE-2-OLD TO UC30-ARCHIVE-DD-REC. DTSBD551 04216 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04217 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04218 GO TO T1030-EXIT DTSBD551 04219 END-IF. DTSBD551 04220 DTSBD551 04221 MOVE DD-LINE-3-OLD TO UC30-ARCHIVE-DD-REC. DTSBD551 04222 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04223 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04224 GO TO T1030-EXIT DTSBD551 04225 END-IF. DTSBD551 04226 DTSBD551 04227 MOVE DD-LINE-4-OLD TO UC30-ARCHIVE-DD-REC. DTSBD551 04228 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04229 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04230 GO TO T1030-EXIT DTSBD551 04231 END-IF. DTSBD551 04232 DTSBD551 04233 DTSBD551 04234 MOVE DD-LINE-8-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04235 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04236 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04237 GO TO T1010-EXIT DTSBD551 04238 END-IF. DTSBD551 04239 DTSBD551 04240 MOVE DD-LINE-9-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04241 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04242 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04243 GO TO T1010-EXIT DTSBD551 04244 END-IF. DTSBD551 04245 DTSBD551 04246 MOVE DD-LINE-11-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04247 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04248 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04249 GO TO T1010-EXIT DTSBD551 04250 END-IF. DTSBD551 04251 DTSBD551 04252 T1030-EXIT. DTSBD551 04253 EXIT. DTSBD551 04254 DTSBD551 04255 T1031-WRITE-UNCATLG-DD. DTSBD551 04256 DTSBD551 04257 MOVE W-SUBM-CREATE-CCYY TO W-ARCHIVE-UNCATLG-YEAR. DTSBD551 04258 DTSBD551 04259 MOVE DD-LINE-1-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 04260 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04261 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04262 GO TO T1031-EXIT DTSBD551 04263 END-IF. DTSBD551 04264 DTSBD551 04265 MOVE DD-LINE-2-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 04266 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04267 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04268 GO TO T1031-EXIT DTSBD551 04269 END-IF. DTSBD551 04270 DTSBD551 04271 MOVE DD-LINE-3-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 04272 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04273 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04274 GO TO T1031-EXIT DTSBD551 04275 END-IF. DTSBD551 04276 DTSBD551 04277 MOVE DD-LINE-4-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 04278 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04279 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04280 GO TO T1031-EXIT DTSBD551 04281 END-IF. DTSBD551 04282 DTSBD551 04283 MOVE DD-LINE-5-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 04284 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04285 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04286 GO TO T1031-EXIT DTSBD551 04287 END-IF. DTSBD551 04288 DTSBD551 04289 T1031-EXIT. DTSBD551 04290 EXIT. DTSBD551 04291 DTSBD551 04292 T1035-WRITE-BACKUP-DD. DTSBD551 04293 DTSBD551 04294 MOVE W-SUBM-CREATE-CCYY TO W-ARCHIVE-BACKUP-YEAR-I DTSBD551 04295 W-ARCHIVE-BACKUP-YEAR-O. DTSBD551 04296 DTSBD551 04297 MOVE DD-LINE-1-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04298 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04299 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04300 GO TO T1035-EXIT DTSBD551 04301 END-IF. DTSBD551 04302 DTSBD551 04303 MOVE DD-LINE-2-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04304 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04305 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04306 GO TO T1035-EXIT DTSBD551 04307 END-IF. DTSBD551 04308 DTSBD551 04309 MOVE DD-LINE-3-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04310 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04311 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04312 GO TO T1035-EXIT DTSBD551 04313 END-IF. DTSBD551 04314 DTSBD551 04315 MOVE DD-LINE-4-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04316 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04317 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04318 GO TO T1035-EXIT DTSBD551 04319 END-IF. DTSBD551 04320 DTSBD551 04321 MOVE DD-LINE-5-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04322 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04323 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04324 GO TO T1035-EXIT DTSBD551 04325 END-IF. DTSBD551 04326 DTSBD551 04327 MOVE DD-LINE-6-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04328 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04329 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04330 GO TO T1035-EXIT DTSBD551 04331 END-IF. DTSBD551 04332 DTSBD551 04333 MOVE DD-LINE-7-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04334 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04335 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04336 GO TO T1035-EXIT DTSBD551 04337 END-IF. DTSBD551 04338 DTSBD551 04339 MOVE DD-LINE-8-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04340 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04341 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04342 GO TO T1035-EXIT DTSBD551 04343 END-IF. DTSBD551 04344 DTSBD551 04345 MOVE DD-LINE-9-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04346 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04347 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04348 GO TO T1035-EXIT DTSBD551 04349 END-IF. DTSBD551 04350 DTSBD551 04351 MOVE DD-LINE-10-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 04352 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04353 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04354 GO TO T1035-EXIT DTSBD551 04355 END-IF. DTSBD551 04356 DTSBD551 04357 T1035-EXIT. DTSBD551 04358 EXIT. DTSBD551 04359 DTSBD551 04360 T1040-END-JOB. DTSBD551 04361 DTSBD551 04362 MOVE DD-LINE-10-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04363 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04364 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04365 GO TO T1040-EXIT DTSBD551 04366 END-IF. DTSBD551 04367 DTSBD551 04368 MOVE DD-LINE-12-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 04369 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 04370 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 04371 GO TO T1040-EXIT DTSBD551 04372 END-IF. DTSBD551 04373 DTSBD551 04374 T1040-EXIT. DTSBD551 04375 EXIT. DTSBD551 04376 DTSBD551 04377 T1100-UPDATE-CURR-BATCH. DTSBD551 04378 MOVE W-PSEUDO-BATCH-NO TO CURRENT-BATCH-NO DTSBD551 04379 W-END-BATCH. DTSBD551 04380 MOVE W-PSEUDO-ITEM-NO TO CURRENT-ITEM-NO. DTSBD551 04381 MOVE W-SUBM-CREATE-CCYY TO CURRENT-ARCHIVE-YEAR. DTSBD551 04382 DISPLAY 'REWRITING CURRENT BATCH ' DTSBD551 04383 W-PSEUDO-BATCH-NO '/' W-PSEUDO-ITEM-NO DTSBD551 04384 ' ' CURRENT-ARCHIVE-YEAR. DTSBD551 04385 REWRITE CURR-BATCH-NO-REC. DTSBD551 04386 IF BATCH-STATUS-OK-88 DTSBD551 04387 NEXT SENTENCE DTSBD551 04388 ELSE DTSBD551 04389 DISPLAY 'T1000 - CANNOT REWRITE BATCH NUMBER FILE ' DTSBD551 04390 BATCH-STATUS DTSBD551 04391 END-IF. DTSBD551 04392 DTSBD551 04393 T1100-EXIT. DTSBD551 04394 EXIT. DTSBD551 04395 DTSBD551 04396 T1110-WRITE-X210-REC. DTSBD551 04397 MOVE W-START-BATCH TO X210-START-BATCH. DTSBD551 04398 MOVE W-END-BATCH TO X210-END-BATCH. DTSBD551 04399 DTSBD551 04400 WRITE SUBMITTER-REC FROM W-SUBMITTER-REC. DTSBD551 04401 IF SUBMITTER-STATUS-OK-88 DTSBD551 04402 NEXT SENTENCE DTSBD551 04403 ELSE DTSBD551 04404 SET W-ERROR-YES-88 TO TRUE DTSBD551 04405 DISPLAY 'CANNOT WRITE SUBMITTER FILE: ' DTSBD551 04406 SUBMITTER-STATUS DTSBD551 04407 END-IF. DTSBD551 04408 DTSBD551 04409 T1110-EXIT. DTSBD551 04410 EXIT. DTSBD551 04411 DTSBD551 04412 T1120-WRITE-R202-REC. DTSBD551 04413 IF W-PARM-DEPOSIT-REMIT NOT > ZERO DTSBD551 04414 DISPLAY 'REMITTANCE = 0 NO R202 WRITTEN ' DTSBD551 04415 GO TO T1120-EXIT DTSBD551 04416 END-IF. DTSBD551 04417 DTSBD551 04418 MOVE W-START-BATCH TO R202-BATCH-NO. DTSBD551 04419 SET R202-BATCH-ICESA-88 TO TRUE. DTSBD551 04420 MOVE W-PARM-DEPOSIT-REMIT TO R202-CONTROL-REMIT-AMT. DTSBD551 04421 MOVE W-T028-WRITE-CNT TO R202-CONTROL-TRAN-CNT. DTSBD551 04422 MOVE L005-DATE TO R202-BATCH-ESTB-DATE DTSBD551 04423 R202-APPROVED-DATE. DTSBD551 04424 MOVE 'MAG UC30' TO R202-APPROVED-OPID. DTSBD551 04425 DTSBD551 04426 MOVE R202-REC TO RSKL-REC. DTSBD551 04427 PERFORM S947-RPT-2 THRU S947-EXIT. DTSBD551 04428 DTSBD551 04429 T1120-EXIT. DTSBD551 04430 EXIT. DTSBD551 04431 DTSBD551 04432 T2000-DISPLAY-TOTALS. DTSBD551 04433 DISPLAY 'TOTAL EMPLOYERS ' DTSBD551 04434 W-ALL-EMP-CNT. DTSBD551 04435 DTSBD551 04436 DISPLAY 'TOTAL EMPLOYER ERRORS ' DTSBD551 04437 W-EMP-ERROR-CNT. DTSBD551 04438 DTSBD551 04439 DISPLAY 'FULL EDITS FAILED ' DTSBD551 04440 W-FAILED-FULL-EDITS-CNT. DTSBD551 04441 DTSBD551 04442 DISPLAY 'ZERO WAGE RPTS BYPASSED ' DTSBD551 04443 W-BYPASS-0-WAGE-RPT-CNT. DTSBD551 04444 DTSBD551 04445 DISPLAY 'EMPLOYER NOT FOUND ' DTSBD551 04446 W-ACCT-NOT-FOUND-CNT. DTSBD551 04447 DTSBD551 04448 DISPLAY 'EMPLOYER ACCOUNT NUMBERS FOUND FROM FEIN ' DTSBD551 04449 W-ACCT-FROM-FEIN-CNT. DTSBD551 04450 DTSBD551 04451 DISPLAY 'EMPLOYER ACCOUNT NUMBERS FOUND FROM SUCCESSOR ' DTSBD551 04452 W-ACCT-FROM-SUCC-CNT. DTSBD551 04453 DTSBD551 04454 DISPLAY 'TOTAL T028 RECORDS WRITTEN ' DTSBD551 04455 W-T028-WRITE-CNT. DTSBD551 04456 DTSBD551 04457 DISPLAY 'TOTAL T002 RECORDS WRITTEN ' DTSBD551 04458 W-T002-CONTACT-CNT. DTSBD551 04459 DTSBD551 04460 DISPLAY 'TOTAL T003 RECORDS WRITTEN ' DTSBD551 04461 W-T003-MNTE-CNT. DTSBD551 04462 DTSBD551 04463 DISPLAY 'SELF-INS EMPLOYERS WITH CHECKS ' DTSBD551 04464 W-SI-WITH-REMIT-CNT. DTSBD551 04465 DTSBD551 04466 *** DISPLAY 'NEW ADDRESS VERIFIED ' DTSBD551 04467 * W-VALID-NEW-ADDR-CNT. DTSBD551 04468 * DTSBD551 04469 * DISPLAY 'NEW ADDRESS NOT VERIFIED ' DTSBD551 04470 *** W-INVALID-NEW-ADDR-CNT. DTSBD551 04471 DTSBD551 04472 DISPLAY SPACE. DTSBD551 04473 DTSBD551 04474 MOVE W-CALC-TOT-REMITTANCE TO DISP-CALC-TOT-REMITTANCE. DTSBD551 04475 DISPLAY 'TOTAL REMITTANCE ' DTSBD551 04476 DISP-CALC-TOT-REMITTANCE. DTSBD551 04477 DTSBD551 04478 DISPLAY SPACE. DTSBD551 04479 DTSBD551 04480 DISPLAY 'TOTAL WAGE RECORDS ' DTSBD551 04481 W-ALL-WAGE-CNT. DTSBD551 04482 DTSBD551 04483 DISPLAY 'TOTAL WAGE ERRORS ' DTSBD551 04484 W-WAGE-ERROR-CNT. DTSBD551 04485 DTSBD551 04486 DISPLAY 'TOTAL ZERO WAGE RECORDS EXCLUDED ' DTSBD551 04487 W-ZERO-WAGE-CNT. DTSBD551 04488 DTSBD551 04489 DISPLAY 'WAGE RECORDS WITH MISSING SSNS EXCLUDED ' DTSBD551 04490 W-MISSING-SSN-CNT. DTSBD551 04491 DTSBD551 04492 DISPLAY 'TOTAL W001 RECORDS WRITTEN ' DTSBD551 04493 W-W001-WRITE-CNT. DTSBD551 04494 DTSBD551 04495 T2000-EXIT. DTSBD551 04496 EXIT. DTSBD551 04497 DTSBD551 04498 S001-FROM-FED-8. DTSBD551 04499 SET L001-FROM-FED-8 TO TRUE. DTSBD551 04500 GO TO S001-DATE. DTSBD551 04501 DTSBD551 04502 S001-FROM-CAL-8. DTSBD551 04503 SET L001-FROM-CAL-8 TO TRUE. DTSBD551 04504 GO TO S001-DATE. DTSBD551 04505 DTSBD551 04506 S001-FROM-CAL-6. DTSBD551 04507 SET L001-FROM-CAL-6 TO TRUE. DTSBD551 04508 GO TO S001-DATE. DTSBD551 04509 DTSBD551 04510 S001-FROM-ABS-DAY. DTSBD551 04511 SET L001-FROM-ABS-DAY TO TRUE. DTSBD551 04512 GO TO S001-DATE. DTSBD551 04513 DTSBD551 04514 S001-DATE. DTSBD551 04515 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD551 04516 S001-EXIT. DTSBD551 04517 EXIT. DTSBD551 04518 DTSBD551 04519 S003-AGENCY-DAY. DTSBD551 04520 SET L003-AGENCY-DAY TO TRUE. DTSBD551 04521 GO TO S003-WORK-DAY. DTSBD551 04522 DTSBD551 04523 S003-WORK-DAY. DTSBD551 04524 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBD551 04525 S003-EXIT. DTSBD551 04526 EXIT. DTSBD551 04527 DTSBD551 04528 S004-FROM-5. DTSBD551 04529 SET L004-FROM-5 TO TRUE. DTSBD551 04530 GO TO S004-YRQ. DTSBD551 04531 DTSBD551 04532 S004-FROM-DATE. DTSBD551 04533 SET L004-FROM-DATE TO TRUE. DTSBD551 04534 GO TO S004-YRQ. DTSBD551 04535 DTSBD551 04536 S004-FROM-ABS. DTSBD551 04537 SET L004-FROM-ABS TO TRUE. DTSBD551 04538 GO TO S004-YRQ. DTSBD551 04539 DTSBD551 04540 S004-YRQ. DTSBD551 04541 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD551 04542 DTSBD551 04543 S004-EXIT. DTSBD551 04544 EXIT. DTSBD551 04545 DTSBD551 04546 S005-FROM-SYS. DTSBD551 04547 SET L005-FROM-SYS TO TRUE. DTSBD551 04548 GO TO S005-ABSTIME. DTSBD551 04549 DTSBD551 04550 S005-ABSTIME. DTSBD551 04551 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD551 04552 S005-EXIT. DTSBD551 04553 EXIT. DTSBD551 04554 DTSBD551 04555 S072-ADDRESS. DTSBD551 04556 CALL 'DTSBU072' USING L072-LINK-AREA. DTSBD551 04557 DTSBD551 04558 S072-EXIT. DTSBD551 04559 EXIT. DTSBD551 04560 DTSBD551 04561 S516-LIABILITY-INFO. DTSBD551 04562 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD551 04563 MPRF-REC. DTSBD551 04564 S516-EXIT. DTSBD551 04565 EXIT. DTSBD551 04566 DTSBD551 04567 *S200-INIT-LOG. DTSBD551 04568 * CALL 'DESBD201' USING L200-LINK-AREA C202-MSG-TABLE. DTSBD551 04569 *S200-EXIT. DTSBD551 04570 * EXIT. DTSBD551 04571 * DTSBD551 04572 *S201-UPD-LOG. DTSBD551 04573 * MOVE W-LOG-NO TO L200-LOG-NO. DTSBD551 04574 * MOVE W-MOD-NAME TO L200-PROG-NAME. DTSBD551 04575 * CALL 'DESBD201' USING L200-LINK-AREA C202-MSG-TABLE. DTSBD551 04576 *S201-EXIT. DTSBD551 04577 * EXIT. DTSBD551 04578 DTSBD551 04579 S601-CALL-BU601. DTSBD551 04580 CALL 'DTSBU601' USING L601-LINK-AREA. DTSBD551 04581 S601-EXIT. DTSBD551 04582 EXIT. DTSBD551 04583 DTSBD551 04584 S910-OPEN-READ. DTSBD551 04585 SET L910-OPEN-READ-88 TO TRUE. DTSBD551 04586 GO TO S910-MSTR-IO. DTSBD551 04587 DTSBD551 04588 S910-READ. DTSBD551 04589 SET L910-READ-88 TO TRUE. DTSBD551 04590 GO TO S910-MSTR-IO. DTSBD551 04591 DTSBD551 04592 S910-START-BROWSE. DTSBD551 04593 SET L910-START-BROWSE-88 TO TRUE. DTSBD551 04594 GO TO S910-MSTR-IO. DTSBD551 04595 DTSBD551 04596 S910-READ-NEXT. DTSBD551 04597 SET L910-READ-NEXT-88 TO TRUE. DTSBD551 04598 GO TO S910-MSTR-IO. DTSBD551 04599 DTSBD551 04600 S910-CLOSE. DTSBD551 04601 SET L910-CLOSE-88 TO TRUE. DTSBD551 04602 GO TO S910-MSTR-IO. DTSBD551 04603 DTSBD551 04604 S910-MSTR-IO. DTSBD551 04605 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD551 04606 MSKL-REC. DTSBD551 04607 S910-EXIT. DTSBD551 04608 EXIT. DTSBD551 04609 DTSBD551 04610 S921-OPEN-READ. DTSBD551 04611 SET L921-OPEN-READ-88 TO TRUE. DTSBD551 04612 GO TO S921-AIX-IO. DTSBD551 04613 DTSBD551 04614 S921-READ. DTSBD551 04615 SET L921-READ-88 TO TRUE. DTSBD551 04616 GO TO S921-AIX-IO. DTSBD551 04617 DTSBD551 04618 S921-START-BROWSE. DTSBD551 04619 SET L921-START-BROWSE-88 TO TRUE. DTSBD551 04620 GO TO S921-AIX-IO. DTSBD551 04621 DTSBD551 04622 S921-READ-NEXT. DTSBD551 04623 SET L921-READ-NEXT-88 TO TRUE. DTSBD551 04624 GO TO S921-AIX-IO. DTSBD551 04625 DTSBD551 04626 S921-CLOSE. DTSBD551 04627 SET L921-CLOSE-88 TO TRUE. DTSBD551 04628 GO TO S921-AIX-IO. DTSBD551 04629 DTSBD551 04630 S921-AIX-IO. DTSBD551 04631 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD551 04632 ISKL-REC. DTSBD551 04633 S921-EXIT. DTSBD551 04634 EXIT. DTSBD551 04635 DTSBD551 04636 S927A-OPEN. DTSBD551 04637 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBD551 04638 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD551 04639 DTSBD551 04640 S927A-EXIT. DTSBD551 04641 EXIT. DTSBD551 04642 DTSBD551 04643 S927B-WRITE. DTSBD551 04644 SET L927-WRITE-88 TO TRUE. DTSBD551 04645 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD551 04646 DTSBD551 04647 S927B-EXIT. DTSBD551 04648 EXIT. DTSBD551 04649 DTSBD551 04650 S927C-CLOSE. DTSBD551 04651 SET L927-CLOSE-88 TO TRUE. DTSBD551 04652 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD551 04653 DTSBD551 04654 S927C-EXIT. DTSBD551 04655 EXIT. DTSBD551 04656 DTSBD551 04657 S927Z-IO. DTSBD551 04658 CALL 'DTSBU927' USING L927-LINK-AREA DTSBD551 04659 TSKL-REC. DTSBD551 04660 S927Z-EXIT. DTSBD551 04661 EXIT. DTSBD551 04662 DTSBD551 04663 S931-OPEN-READ. DTSBD551 04664 SET L931-OPEN-READ-88 TO TRUE. DTSBD551 04665 GO TO S931-REF-IO. DTSBD551 04666 DTSBD551 04667 S931-CLOSE. DTSBD551 04668 SET L931-CLOSE-88 TO TRUE. DTSBD551 04669 GO TO S931-REF-IO. DTSBD551 04670 DTSBD551 04671 S931-REF-IO. DTSBD551 04672 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD551 04673 FSKL-REC. DTSBD551 04674 S931-EXIT. DTSBD551 04675 EXIT. DTSBD551 04676 DTSBD551 04677 S946-RPT-1. DTSBD551 04678 CALL 'DTSBU946' USING RSKL-REC. DTSBD551 04679 DTSBD551 04680 S946-EXIT. DTSBD551 04681 EXIT. DTSBD551 04682 DTSBD551 04683 S947-RPT-2. DTSBD551 04684 CALL 'DTSBU947' USING RSKL-REC. DTSBD551 04685 DTSBD551 04686 S947-EXIT. DTSBD551 04687 EXIT. DTSBD551 04688 DTSBD551 04689 S1000-WAGE-TEMP-IO. DTSBD551 04690 EVALUATE TRUE DTSBD551 04691 WHEN WAGE-TEMP-REQ-OPEN-OUT-88 DTSBD551 04692 IF WAGE-TEMP-CLOSED-88 DTSBD551 04693 PERFORM S1010-OPEN-WAGE-TEMP-OUT THRU S1010-EXIT DTSBD551 04694 ELSE DTSBD551 04695 *** DISPLAY 'WAGE TEMP ALREADY OPEN ' E-FEDERAL-EIN DTSBD551 04696 PERFORM S1020-CLOSE-WAGE-TEMP THRU S1020-EXIT DTSBD551 04697 IF W-ERROR-NO-88 DTSBD551 04698 PERFORM S1010-OPEN-WAGE-TEMP-OUT THRU S1010-EXIT DTSBD551 04699 END-IF DTSBD551 04700 END-IF DTSBD551 04701 DTSBD551 04702 WHEN WAGE-TEMP-REQ-CLOSE-88 DTSBD551 04703 IF WAGE-TEMP-OPEN-88 DTSBD551 04704 PERFORM S1020-CLOSE-WAGE-TEMP THRU S1020-EXIT DTSBD551 04705 ELSE DTSBD551 04706 DISPLAY 'WAGE TEMP ALREADY CLOSED ' E-FEDERAL-EIN DTSBD551 04707 END-IF DTSBD551 04708 DTSBD551 04709 WHEN WAGE-TEMP-REQ-WRITE-88 DTSBD551 04710 IF WAGE-TEMP-OPEN-88 DTSBD551 04711 PERFORM S1030-WRITE-WAGE-TEMP THRU S1030-EXIT DTSBD551 04712 ELSE DTSBD551 04713 DISPLAY 'WAGE TEMP NOT OPEN, CANONOT WRITE ' DTSBD551 04714 E-FEDERAL-EIN DTSBD551 04715 END-IF DTSBD551 04716 DTSBD551 04717 WHEN WAGE-TEMP-REQ-OPEN-INP-88 DTSBD551 04718 IF WAGE-TEMP-CLOSED-88 DTSBD551 04719 PERFORM S1040-OPEN-WAGE-TEMP-INP THRU S1040-EXIT DTSBD551 04720 ELSE DTSBD551 04721 DISPLAY 'WAGE TEMP STILL OPEN ' E-FEDERAL-EIN DTSBD551 04722 PERFORM S1020-CLOSE-WAGE-TEMP THRU S1020-EXIT DTSBD551 04723 IF W-ERROR-NO-88 DTSBD551 04724 PERFORM S1040-OPEN-WAGE-TEMP-INP THRU S1040-EXIT DTSBD551 04725 END-IF DTSBD551 04726 END-IF DTSBD551 04727 DTSBD551 04728 END-EVALUATE. DTSBD551 04729 DTSBD551 04730 SET WAGE-TEMP-REQ-NULL-88 TO TRUE. DTSBD551 04731 DTSBD551 04732 S1000-EXIT. DTSBD551 04733 EXIT. DTSBD551 04734 DTSBD551 04735 S1010-OPEN-WAGE-TEMP-OUT. DTSBD551 04736 OPEN OUTPUT WAGE-FILE-TEMP. DTSBD551 04737 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 04738 SET WAGE-TEMP-OPEN-88 TO TRUE DTSBD551 04739 *& DISPLAY 'TEMP WAGE FILE OPENED ' E-FEDERAL-EIN DTSBD551 04740 ELSE DTSBD551 04741 SET W-ERROR-YES-88 TO TRUE DTSBD551 04742 DISPLAY 'CANNOT OPEN WAGE TEMP FILE: ' DTSBD551 04743 WAGE-TEMP-STATUS DTSBD551 04744 END-IF. DTSBD551 04745 DTSBD551 04746 S1010-EXIT. DTSBD551 04747 EXIT. DTSBD551 04748 DTSBD551 04749 S1020-CLOSE-WAGE-TEMP. DTSBD551 04750 CLOSE WAGE-FILE-TEMP. DTSBD551 04751 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 04752 SET WAGE-TEMP-CLOSED-88 TO TRUE DTSBD551 04753 *& DISPLAY 'TEMP WAGE FILE CLOSED ' E-FEDERAL-EIN DTSBD551 04754 ELSE DTSBD551 04755 SET W-ERROR-YES-88 TO TRUE DTSBD551 04756 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSBD551 04757 WAGE-TEMP-STATUS DTSBD551 04758 END-IF. DTSBD551 04759 DTSBD551 04760 S1020-EXIT. DTSBD551 04761 EXIT. DTSBD551 04762 DTSBD551 04763 S1030-WRITE-WAGE-TEMP. DTSBD551 04764 WRITE WAGE-TEMP-REC FROM W001-REC. DTSBD551 04765 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 04766 NEXT SENTENCE DTSBD551 04767 ELSE DTSBD551 04768 SET W-ERROR-YES-88 TO TRUE DTSBD551 04769 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSBD551 04770 WAGE-TEMP-STATUS DTSBD551 04771 END-IF. DTSBD551 04772 DTSBD551 04773 S1030-EXIT. DTSBD551 04774 EXIT. DTSBD551 04775 DTSBD551 04776 S1040-OPEN-WAGE-TEMP-INP. DTSBD551 04777 OPEN INPUT WAGE-FILE-TEMP. DTSBD551 04778 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 04779 SET WAGE-TEMP-OPEN-88 TO TRUE DTSBD551 04780 *& DISPLAY 'WAGE FILE OPENED INP ' E-FEDERAL-EIN DTSBD551 04781 ELSE DTSBD551 04782 SET W-ERROR-YES-88 TO TRUE DTSBD551 04783 DISPLAY 'CANNOT OPEN WAGE TEMP FILE: ' DTSBD551 04784 WAGE-TEMP-STATUS DTSBD551 04785 END-IF. DTSBD551 04786 DTSBD551 04787 S1040-EXIT. DTSBD551 04788 EXIT. DTSBD551 04789 DTSBD551 04790 S1500-OPEN-WAGE-OUT. DTSBD551 04791 OPEN OUTPUT WAGE-FILE-OUT. DTSBD551 04792 IF WAGE-OUT-STATUS-OK-88 DTSBD551 04793 NEXT SENTENCE DTSBD551 04794 *& DISPLAY 'WAGE FILE OPENED ' E-FEDERAL-EIN DTSBD551 04795 ELSE DTSBD551 04796 SET W-ERROR-YES-88 TO TRUE DTSBD551 04797 DISPLAY 'CANNOT OPEN WAGE OUT FILE: ' DTSBD551 04798 WAGE-OUT-STATUS DTSBD551 04799 END-IF. DTSBD551 04800 DTSBD551 04801 S1500-EXIT. DTSBD551 04802 EXIT. DTSBD551 04803 DTSBD551 04804 S1600-CLOSE-WAGE-OUT. DTSBD551 04805 CLOSE WAGE-FILE-OUT. DTSBD551 04806 IF WAGE-OUT-STATUS-OK-88 DTSBD551 04807 NEXT SENTENCE DTSBD551 04808 *& DISPLAY 'OUT WAGE FILE CLOSED ' E-FEDERAL-EIN DTSBD551 04809 ELSE DTSBD551 04810 SET W-ERROR-YES-88 TO TRUE DTSBD551 04811 DISPLAY 'CANNOT CLOSE WAGE OUT FILE: ' DTSBD551 04812 WAGE-OUT-STATUS DTSBD551 04813 END-IF. DTSBD551 04814 DTSBD551 04815 S1600-EXIT. DTSBD551 04816 EXIT. DTSBD551 04817 DTSBD551 04818 S2000-EMP-LIABILITY. DTSBD551 04819 *& DTSBD551 04820 * IF E-FEDERAL-EIN = 941245885 DTSBD551 04821 * DISPLAY 'S2000 ' E-FEDERAL-EIN ' ' W-EMP-NO DTSBD551 04822 * END-IF. DTSBD551 04823 *& DTSBD551 04824 PERFORM S2010-FIND-MPRF THRU S2010-EXIT. DTSBD551 04825 IF W-EMP-FOUND-NO-88 DTSBD551 04826 NEXT SENTENCE DTSBD551 04827 ELSE DTSBD551 04828 IF W-ERROR-NO-88 DTSBD551 04829 PERFORM S2020-QTR-LIABILITY THRU S2020-EXIT DTSBD551 04830 IF L516-NOT-LIABLE-88 DTSBD551 04831 PERFORM S2030-FIND-SUCCESSOR THRU S2030-EXIT DTSBD551 04832 END-IF DTSBD551 04833 END-IF DTSBD551 04834 END-IF. DTSBD551 04835 DTSBD551 04836 DTSBD551 04837 S2000-EXIT. DTSBD551 04838 EXIT. DTSBD551 04839 DTSBD551 04840 S2010-FIND-MPRF. DTSBD551 04841 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD551 04842 MOVE W-EMP-NO TO MSKL-EMP-NO. DTSBD551 04843 SET MSKL-PRF-88 TO TRUE. DTSBD551 04844 DTSBD551 04845 PERFORM S910-READ THRU S910-EXIT. DTSBD551 04846 IF L910-NO-REC-88 DTSBD551 04847 MOVE ZERO TO W-EMP-NO DTSBD551 04848 PERFORM S2050-ACCT-FROM-FEIN THRU S2050-EXIT DTSBD551 04849 IF W-FEIN-EMP-NO > ZERO DTSBD551 04850 ADD +1 TO W-ACCT-FROM-FEIN-CNT DTSBD551 04851 MOVE W-FEIN-EMP-NO TO W-EMP-NO DTSBD551 04852 ELSE DTSBD551 04853 SET W-EMP-FOUND-NO-88 TO TRUE DTSBD551 04854 ADD +1 TO W-ACCT-NOT-FOUND-CNT DTSBD551 04855 END-IF DTSBD551 04856 ELSE DTSBD551 04857 MOVE MSKL-REC TO MPRF-REC DTSBD551 04858 MOVE MPRF-PRIMARY-NAME TO W-EMP-NAME DTSBD551 04859 END-IF. DTSBD551 04860 DTSBD551 04861 S2010-EXIT. DTSBD551 04862 EXIT. DTSBD551 04863 DTSBD551 04864 S2020-QTR-LIABILITY. DTSBD551 04865 *& DTSBD551 04866 * IF E-FEDERAL-EIN = 941245885 DTSBD551 04867 * DISPLAY 'S2020 ' E-FEDERAL-EIN ' ' W-EMP-NO DTSBD551 04868 * END-IF. DTSBD551 04869 *& DTSBD551 04870 MOVE W-RPT-QTR TO L516-YRQ DTSBD551 04871 PERFORM S516-LIABILITY-INFO THRU S516-EXIT DTSBD551 04872 IF L516-NOT-LIABLE-88 DTSBD551 04873 NEXT SENTENCE DTSBD551 04874 ELSE DTSBD551 04875 IF MPRF-CLASS-SELF-INS-88 DTSBD551 04876 MOVE ZERO TO W-UI-RATE DTSBD551 04877 ELSE DTSBD551 04878 IF L516-NO-RATE-88 DTSBD551 04879 SET W-LIABLE-NO-88 TO TRUE DTSBD551 04880 MOVE MSG-E3 TO R551-MSG-TEXT DTSBD551 04881 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 04882 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 04883 * DISPLAY 'TYPE E: NO UI RATE FOR QUARTER ' W-EMP-NO DTSBD551 04884 * DISPLAY ' TRANSACTION WILL FAIL EDITS' DTSBD551 04885 ELSE DTSBD551 04886 MOVE L516-UI-RATE TO W-UI-RATE DTSBD551 04887 END-IF DTSBD551 04888 IF L516-ANN-SCHED-88 DTSBD551 04889 SET W-ANNUAL-QTR-YES-88 TO TRUE DTSBD551 04890 MOVE MSG-E9E TO R551-MSG-TEXT DTSBD551 04891 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 04892 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 04893 DISPLAY 'TYPE E: ANNUAL QUARTER ' W-EMP-NO DTSBD551 04894 DISPLAY ' TRANSACTION WILL FAIL EDITS' DTSBD551 04895 END-IF DTSBD551 04896 END-IF DTSBD551 04897 END-IF. DTSBD551 04898 DTSBD551 04899 S2020-EXIT. DTSBD551 04900 EXIT. DTSBD551 04901 DTSBD551 04902 S2030-FIND-SUCCESSOR. DTSBD551 04903 *& DTSBD551 04904 * IF E-FEDERAL-EIN = 941245885 DTSBD551 04905 * DISPLAY 'S2030 ' E-FEDERAL-EIN ' ' MPRF-EMP-NO DTSBD551 04906 * END-IF. DTSBD551 04907 *& DTSBD551 04908 MOVE MPRF-EMP-NO TO L601-EMP-NO. DTSBD551 04909 MOVE 99999999 TO L601-EXP-TRN-EFF-DATE. DTSBD551 04910 PERFORM S601-CALL-BU601 THRU S601-EXIT. DTSBD551 04911 IF L601-SUCCESSOR-FOUND-88 DTSBD551 04912 PERFORM S2031-SUCCESSOR-FOUND THRU S2031-EXIT DTSBD551 04913 ELSE DTSBD551 04914 SET W-LIABLE-NO-88 TO TRUE DTSBD551 04915 IF L601-PARTIAL-TRANSFER-88 DTSBD551 04916 MOVE W-REPORT-CCYY TO MSG-E4A-REPORT-CCYY DTSBD551 04917 MOVE W-REPORT-MM-X TO MSG-E4A-REPORT-MM-X DTSBD551 04918 MOVE MSG-E4A TO R551-MSG-TEXT DTSBD551 04919 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 04920 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 04921 ELSE DTSBD551 04922 MOVE W-REPORT-CCYY TO MSG-E4-REPORT-CCYY DTSBD551 04923 MOVE W-REPORT-MM-X TO MSG-E4-REPORT-MM-X DTSBD551 04924 MOVE MSG-E4 TO R551-MSG-TEXT DTSBD551 04925 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 04926 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 04927 END-IF DTSBD551 04928 END-IF. DTSBD551 04929 DTSBD551 04930 S2030-EXIT. DTSBD551 04931 EXIT. DTSBD551 04932 DTSBD551 04933 S2031-SUCCESSOR-FOUND. DTSBD551 04934 ** SET W-SUCCESSOR-YES-88 TO TRUE. DTSBD551 04935 MOVE L601-ULTIMATE-SUCCESSOR TO W-EMP-NO DTSBD551 04936 *& DTSBD551 04937 * IF E-FEDERAL-EIN = 941245885 DTSBD551 04938 * DISPLAY 'S2031 ' E-FEDERAL-EIN ' ' W-EMP-NO DTSBD551 04939 * END-IF. DTSBD551 04940 *& DTSBD551 04941 MOVE MPRF-EMP-NO TO W-PRED-NO DTSBD551 04942 *** DISPLAY 'TYPE E: USING SUCCESSOR ACCOUNT ' W-EMP-NO DTSBD551 04943 PERFORM S2010-FIND-MPRF THRU S2010-EXIT DTSBD551 04944 IF W-ERROR-NO-88 DTSBD551 04945 ADD +1 TO W-ACCT-FROM-SUCC-CNT DTSBD551 04946 MOVE MPRF-FEIN TO W-FINAL-FEIN DTSBD551 04947 PERFORM S2020-QTR-LIABILITY THRU S2020-EXIT DTSBD551 04948 IF L516-NOT-LIABLE-88 DTSBD551 04949 SET W-LIABLE-NO-88 TO TRUE DTSBD551 04950 MOVE W-REPORT-CCYY TO MSG-E4-REPORT-CCYY DTSBD551 04951 MOVE W-REPORT-MM-X TO MSG-E4-REPORT-MM-X DTSBD551 04952 MOVE MSG-E4 TO R551-MSG-TEXT DTSBD551 04953 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 04954 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 04955 END-IF DTSBD551 04956 END-IF. DTSBD551 04957 DTSBD551 04958 S2031-EXIT. DTSBD551 04959 EXIT. DTSBD551 04960 DTSBD551 04961 S2050-ACCT-FROM-FEIN. DTSBD551 04962 *& DTSBD551 04963 *** DISPLAY 'FIND ACCT FROM FEIN ' E-FEDERAL-EIN ' ' W-EMP-NO DTSBD551 04964 *& DTSBD551 04965 MOVE ZERO TO W-FEIN-EMP-NO. DTSBD551 04966 DTSBD551 04967 MOVE LOW-VALUE TO IEIN-KEY-AREA DTSBD551 04968 SET IEIN-EIN-88 TO TRUE DTSBD551 04969 MOVE E-FEDERAL-EIN TO IEIN-FEIN DTSBD551 04970 MOVE +0 TO IEIN-EMP-NO DTSBD551 04971 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DTSBD551 04972 PERFORM S921-START-BROWSE THRU S921-EXIT DTSBD551 04973 MOVE ISKL-REC TO IEIN-REC DTSBD551 04974 PERFORM DTSBD551 04975 UNTIL L921-NO-REC-88 DTSBD551 04976 OR W-FEIN-EMP-NO > ZERO DTSBD551 04977 IF IEIN-FEIN = E-FEDERAL-EIN DTSBD551 04978 PERFORM S2051-FIND-MPRF THRU S2051-EXIT DTSBD551 04979 IF W-FEIN-EMP-NO = ZERO DTSBD551 04980 PERFORM S921-READ-NEXT THRU S921-EXIT DTSBD551 04981 MOVE ISKL-REC TO IEIN-REC DTSBD551 04982 END-IF DTSBD551 04983 ELSE DTSBD551 04984 SET L921-NO-REC-88 TO TRUE DTSBD551 04985 END-IF DTSBD551 04986 END-PERFORM. DTSBD551 04987 DTSBD551 04988 S2050-EXIT. DTSBD551 04989 EXIT. DTSBD551 04990 DTSBD551 04991 S2051-FIND-MPRF. DTSBD551 04992 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD551 04993 MOVE IEIN-EMP-NO TO MSKL-EMP-NO. DTSBD551 04994 SET MSKL-PRF-88 TO TRUE. DTSBD551 04995 DTSBD551 04996 PERFORM S910-READ THRU S910-EXIT. DTSBD551 04997 IF L910-NO-REC-88 DTSBD551 04998 NEXT SENTENCE DTSBD551 04999 ELSE DTSBD551 05000 MOVE MSKL-REC TO MPRF-REC DTSBD551 05001 MOVE MPRF-EMP-NO TO W-FEIN-EMP-NO DTSBD551 05002 MOVE MPRF-PRIMARY-NAME TO W-EMP-NAME DTSBD551 05003 END-IF. DTSBD551 05004 DTSBD551 05005 S2051-EXIT. DTSBD551 05006 EXIT. DTSBD551 05007 DTSBD551 05008 S2100-REPORT-QTR. DTSBD551 05009 * DISPLAY ' S2100 FATAL IND ' W-FATAL-ERROR-IND DTSBD551 05010 IF W-REPORT-CC NOT NUMERIC DTSBD551 05011 OR W-REPORT-YY NOT NUMERIC DTSBD551 05012 OR W-REPORT-MM-X NOT NUMERIC DTSBD551 05013 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 05014 ': REPORT QUARTER NOT NUMERIC ' DTSBD551 05015 W-REPORT-CCYY ' ' W-REPORT-MM-X DTSBD551 05016 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 05017 MOVE W-REPORT-CCYY TO MSG-E20-REPORT-CCYY DTSBD551 05018 MOVE W-REPORT-MM-X TO MSG-E20-REPORT-MM-X DTSBD551 05019 MOVE MSG-E20 TO R551-MSG-TEXT DTSBD551 05020 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 05021 GO TO S2100-EXIT DTSBD551 05022 END-IF. DTSBD551 05023 DTSBD551 05024 MOVE W-REPORT-CCYY-9 TO L004-QTR-5-YR. DTSBD551 05025 EVALUATE TRUE DTSBD551 05026 WHEN W-REPORT-MM-9 = 3 DTSBD551 05027 MOVE 1 TO L004-QTR-5-Q DTSBD551 05028 DTSBD551 05029 WHEN W-REPORT-MM-9 = 6 DTSBD551 05030 MOVE 2 TO L004-QTR-5-Q DTSBD551 05031 DTSBD551 05032 WHEN W-REPORT-MM-9 = 9 DTSBD551 05033 MOVE 3 TO L004-QTR-5-Q DTSBD551 05034 DTSBD551 05035 WHEN W-REPORT-MM-9 = 12 DTSBD551 05036 MOVE 4 TO L004-QTR-5-Q DTSBD551 05037 DTSBD551 05038 WHEN OTHER DTSBD551 05039 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 05040 ': INVALID REPORT QTR ' W-REPORT-MM-9 DTSBD551 05041 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 05042 MOVE W-REPORT-MM-9 TO MSG-E21-REPORT-MM-9 DTSBD551 05043 MOVE MSG-E21 TO R551-MSG-TEXT DTSBD551 05044 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 05045 GO TO S2100-EXIT DTSBD551 05046 DTSBD551 05047 END-EVALUATE. DTSBD551 05048 DTSBD551 05049 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD551 05050 IF L004-INVALID-QTR DTSBD551 05051 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 05052 ': INVALID REPORT QUARTER ' DTSBD551 05053 W-REPORT-CCYY ' ' W-REPORT-MM-9 DTSBD551 05054 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 05055 MOVE W-REPORT-CCYY TO MSG-E22-REPORT-CCYY DTSBD551 05056 MOVE W-REPORT-MM-X TO MSG-E22-REPORT-MM-X DTSBD551 05057 MOVE MSG-E22 TO R551-MSG-TEXT DTSBD551 05058 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 05059 ELSE DTSBD551 05060 MOVE L004-QTR-5-9 TO W-RPT-QTR DTSBD551 05061 MOVE L004-QTR-END-DATE TO W-RPT-DATE DTSBD551 05062 IF WORK-PARM-RUN-TYPE-ANY-88 DTSBD551 05063 PERFORM S2110-ANY-QTR THRU S2110-EXIT DTSBD551 05064 ELSE DTSBD551 05065 PERFORM S2120-LAST-3-YRS THRU S2120-EXIT DTSBD551 05066 END-IF DTSBD551 05067 END-IF. DTSBD551 05068 DTSBD551 05069 S2100-EXIT. DTSBD551 05070 EXIT. DTSBD551 05071 DTSBD551 05072 S2110-ANY-QTR. DTSBD551 05073 IF W-RPT-QTR < W-EARLIEST-QTR DTSBD551 05074 * DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 05075 * ': REPORT MORE THAN 3 YEARS OLD ACCEPTED: ' DTSBD551 05076 * W-RPT-QTR DTSBD551 05077 NEXT SENTENCE DTSBD551 05078 ELSE DTSBD551 05079 IF W-RPT-QTR >= W-CURR-QTR DTSBD551 05080 * DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 05081 * ': REPORT REJECTED - QTR > CURRENT QTR: ' DTSBD551 05082 * W-RPT-QTR DTSBD551 05083 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 05084 MOVE W-RPT-QTR TO MSG-E23-RPT-QTR DTSBD551 05085 MOVE W-CURR-QTR TO MSG-E23-CURR-QTR DTSBD551 05086 MOVE MSG-E23 TO R551-MSG-TEXT DTSBD551 05087 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 05088 END-IF DTSBD551 05089 END-IF. DTSBD551 05090 DTSBD551 05091 S2110-EXIT. DTSBD551 05092 EXIT. DTSBD551 05093 DTSBD551 05094 S2120-LAST-3-YRS. DTSBD551 05095 IF W-RPT-QTR < W-EARLIEST-QTR DTSBD551 05096 ** SET W-ERROR-YES-88 TO TRUE DTSBD551 05097 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 05098 ': REPORT QTR MORE THAN 3 YEARS OLD-ACCEPTED: ' W-RPT-QTR DTSBD551 05099 ELSE DTSBD551 05100 IF W-RPT-QTR >= W-CURR-QTR DTSBD551 05101 * DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 05102 * ': REPORT REJECTED - QTR > CURRENT QTR: ' DTSBD551 05103 * W-RPT-QTR DTSBD551 05104 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 05105 MOVE W-RPT-QTR TO MSG-E23-RPT-QTR DTSBD551 05106 MOVE W-CURR-QTR TO MSG-E23-CURR-QTR DTSBD551 05107 MOVE MSG-E23 TO R551-MSG-TEXT DTSBD551 05108 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 05109 END-IF DTSBD551 05110 END-IF. DTSBD551 05111 DTSBD551 05112 S2120-EXIT. DTSBD551 05113 EXIT. DTSBD551 05114 DTSBD551 05115 S2130-RECEIVED-DATE. DTSBD551 05116 MOVE W-RPT-QTR TO L004-QTR-5-9. DTSBD551 05117 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD551 05118 MOVE L004-QTR-DEFAULT-DUE-DATE TO W-DEFAULT-RCVD-DT. DTSBD551 05119 DTSBD551 05120 IF W-PARM-TIMELY-YES-88 DTSBD551 05121 IF W-SUBM-CREATE-DATE > W-DEFAULT-RCVD-DT DTSBD551 05122 MOVE W-DEFAULT-RCVD-DT TO W-RECEIVED-DATE DTSBD551 05123 ELSE DTSBD551 05124 MOVE W-SUBM-CREATE-DATE TO W-RECEIVED-DATE DTSBD551 05125 END-IF DTSBD551 05126 ELSE DTSBD551 05127 MOVE W-PARM-RECEIVED-DATE TO W-RECEIVED-DATE DTSBD551 05128 END-IF. DTSBD551 05129 DTSBD551 05130 S2130-EXIT. DTSBD551 05131 EXIT. DTSBD551 05132 DTSBD551 05133 ************************************************************** DTSBD551 05134 * W-EDITED-E-ACCT SAVES THE E-RECORD ACCOUNT NUMBER AFTER DTSBD551 05135 * SPACES, HYPHENS, ETC. ARE REMOVED. IT IS USED HERE DTSBD551 05136 * TO ENSURE THAT THE SAME ACCOUNT NUMBER IS USED ON THE DTSBD551 05137 * BOTH THE S-RECORDS AND E-RECORDS. DTSBD551 05138 ************************************************************** DTSBD551 05139 S2200-TYPE-S-ACCT-NBR. DTSBD551 05140 ** EDIT ACCOUNT NUMBER FROM TYPE S RECORD. DTSBD551 05141 ** DTSBD551 05142 DTSBD551 05143 IF W-FEIN-EMP-NO NOT = ZERO DTSBD551 05144 * DISPLAY 'TYPE S: USING ACCOUNT NUMBER FROM FEIN ' DTSBD551 05145 * W-FEIN-EMP-NO DTSBD551 05146 NEXT SENTENCE DTSBD551 05147 ELSE DTSBD551 05148 PERFORM S2210-FORMAT-ACCT-NO THRU S2210-EXIT DTSBD551 05149 *** IF W-ACCT-NBR-ERR-YES-88 DTSBD551 05150 IF W-ACCT-NBR-OUT = SPACES DTSBD551 05151 OR W-ACCT-NBR-9 NOT NUMERIC DTSBD551 05152 OR SUB2 < 6 DTSBD551 05153 * DISPLAY 'TYPE S: ACCOUNT NUMBER INVALID, USING TYPE E 'DTSBD551 05154 * DISPLAY ' TYPE S: ' S-ACCOUNT-NO DTSBD551 05155 * ' TYPE E: ' W-EMP-NO DTSBD551 05156 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 05157 MOVE S-ACCOUNT-NO TO MSG-S9-S-EMP-NO DTSBD551 05158 MOVE W-EMP-NO TO MSG-S9-E-EMP-NO DTSBD551 05159 MOVE MSG-S9 TO R551-MSG-TEXT DTSBD551 05160 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 05161 ELSE DTSBD551 05162 MOVE W-ACCT-NBR-9 TO W-EDITED-S-ACCT DTSBD551 05163 IF W-EDITED-E-ACCT NOT = W-EDITED-S-ACCT DTSBD551 05164 *** IF W-ACCT-NBR-9 NOT = W-EMP-NO DTSBD551 05165 * DISPLAY 'TYPE S: ACCT NBR DIFFERENT FROM TYPE E ' DTSBD551 05166 * DISPLAY ' USING TYPE E ACCT NBR ' DTSBD551 05167 * DISPLAY ' TYPE S: ' W-ACCT-NBR-9 DTSBD551 05168 * ' TYPE E: ' W-EMP-NO DTSBD551 05169 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 05170 MOVE W-ACCT-NBR-9 TO MSG-S10-S-EMP-NO DTSBD551 05171 MOVE W-EMP-NO TO MSG-S10-E-EMP-NO DTSBD551 05172 MOVE MSG-S10 TO R551-MSG-TEXT DTSBD551 05173 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 05174 END-IF DTSBD551 05175 END-IF. DTSBD551 05176 DTSBD551 05177 S2200-EXIT. DTSBD551 05178 EXIT. DTSBD551 05179 DTSBD551 05180 S2210-FORMAT-ACCT-NO. DTSBD551 05181 IF FIRST-6-ALL-ZERO-88 DTSBD551 05182 ** DISPLAY 'S2210 RIGHT JUST ' W-ACCT-NBR-IN DTSBD551 05183 MOVE +10 TO SUB1-INIT DTSBD551 05184 ELSE DTSBD551 05185 MOVE +1 TO SUB1-INIT DTSBD551 05186 END-IF. DTSBD551 05187 DTSBD551 05188 MOVE ZERO TO SUB2. DTSBD551 05189 MOVE SPACES TO W-ACCT-NBR-OUT. DTSBD551 05190 SET W-ACCT-NBR-ERR-NO-88 TO TRUE. DTSBD551 05191 DTSBD551 05192 PERFORM DTSBD551 05193 VARYING SUB1 FROM SUB1-INIT BY +1 DTSBD551 05194 UNTIL SUB1 > +15 DTSBD551 05195 *** IF SUB1 > +6 DTSBD551 05196 * IF W-ACCT-NBR-IN-X (SUB1) >= '0' DTSBD551 05197 * NEXT SENTENCE DTSBD551 05198 * END-IF DTSBD551 05199 *** END-IF DTSBD551 05200 IF W-ACCT-NBR-IN-X (SUB1) >= '0' DTSBD551 05201 AND W-ACCT-NBR-IN-X (SUB1) <= '9' DTSBD551 05202 IF SUB2 < W-ACCT-NBR-LEN DTSBD551 05203 ADD +1 TO SUB2 DTSBD551 05204 MOVE W-ACCT-NBR-IN-X (SUB1) DTSBD551 05205 TO W-ACCT-NBR-OUT-X (SUB2) DTSBD551 05206 *** ELSE DTSBD551 05207 *** SET W-ACCT-NBR-ERR-YES-88 TO TRUE DTSBD551 05208 END-IF DTSBD551 05209 END-IF DTSBD551 05210 END-PERFORM. DTSBD551 05211 DTSBD551 05212 S2210-EXIT. DTSBD551 05213 EXIT. DTSBD551 05214 DTSBD551 05215 S2300-DUP-REPORT. DTSBD551 05216 IF W-LIABLE-NO-88 DTSBD551 05217 GO TO S2300-EXIT DTSBD551 05218 END-IF. DTSBD551 05219 DTSBD551 05220 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD551 05221 MOVE W-EMP-NO TO MQTR-EMP-NO. DTSBD551 05222 MOVE W-RPT-QTR TO MQTR-YRQ. DTSBD551 05223 SET MQTR-QTR-88 TO TRUE. DTSBD551 05224 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD551 05225 DTSBD551 05226 PERFORM S910-READ THRU S910-EXIT. DTSBD551 05227 IF L910-NO-REC-88 DTSBD551 05228 NEXT SENTENCE DTSBD551 05229 ELSE DTSBD551 05230 MOVE MSKL-REC TO MQTR-REC DTSBD551 05231 IF MQTR-CURR-RCVD-88 DTSBD551 05232 SET W-DUP-RPT-YES-88 TO TRUE DTSBD551 05233 MOVE W-EMP-NO TO MSG-E5-ACCT-NO DTSBD551 05234 MOVE W-REPORT-CCYY TO MSG-E5-REPORT-CCYY DTSBD551 05235 MOVE W-REPORT-MM-X TO MSG-E5-REPORT-MM-X DTSBD551 05236 MOVE MSG-E5 TO R551-MSG-TEXT DTSBD551 05237 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 05238 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 05239 *RW1 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 05240 * ': REPORT ALREADY ON FILE FOR THIS EMP/QTR: ' DTSBD551 05241 *RW2 W-EMP-NO ' / ' W-RPT-QTR DTSBD551 05242 END-IF DTSBD551 05243 END-IF. DTSBD551 05244 DTSBD551 05245 S2300-EXIT. DTSBD551 05246 EXIT. DTSBD551 05247 DTSBD551 05248 S3000-WRITE-ARCHIVE. DTSBD551 05249 WRITE UC30-ARCHIVE-DD-REC. DTSBD551 05250 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 05251 DISPLAY 'CANNOT WRITE ARCHIVE DD ' ARCHIVE-STATUS DTSBD551 05252 END-IF. DTSBD551 05253 DTSBD551 05254 S3000-EXIT. DTSBD551 05255 EXIT. DTSBD551 05256 DTSBD551 05257 DTSBD551 05258 S999-ABEND. DTSBD551 05259 CALL 'DTSBU999' USING W-ABEND-CD. DTSBD551 05260 S999-EXIT. DTSBD551 05261 EXIT. DTSBD551 05262 DTSBD551