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
