giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
c99f490664479f7d28c575be3d5068507007c38d
DUTAS/Batch/DTSBD551.cob

5264 lines
416 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink