00001 IDENTIFICATION DIVISION. 07/28/14 00002 PROGRAM-ID. DESBD422. DESBD422 00003 AUTHOR. NGC. LV023 00004 DATE-WRITTEN. NOVEMBER 2011. DESBD422 00005 DATE-COMPILED. DESBD422 00006 DESBD422 00007 ***** DESBD422 00008 * DESBD422 00009 * FUNCTION: PROCESS WAGE DATA FROM TDEC. FIND THE REPORT DESBD422 00010 * THE WAGES ARE ASSOCIATED WITH. DESBD422 00011 * DESBD422 00012 * IF THE REPORT IS ON FILE, WRITE W4 RECORDS DESBD422 00013 * IS ON FILE, WRITE W4 RECORDS TO UPDATE THE DESBD422 00014 * DOES WAGE FILE. DESBD422 00015 * DESBD422 00016 * IF THE REPORT IS IN THE ATC FILE, ADD THE DESBD422 00017 * WAGES TO THE WTC FILE: THEY WILL BE RELEASED DESBD422 00018 * WHEN THE REPORT IS POSTED. DESBD422 00019 * DESBD422 00020 * IF THE REPORT OR EMPLOYER CANNOT BE FOUND, DESBD422 00021 * WRITE THE WAGES TO A PENDING FILE. THE SYSTEM DESBD422 00022 * WILL CHECK THE PENDING FILE EACH DAY UNTIL DESBD422 00023 * EITHER THE REPORT IS FOUND OR A SET PERIOD OF DESBD422 00024 * TIME HAS BEEN PASSED. AFTER THE SET TIME, A DESBD422 00025 * MESSAGE WILL BE SENT TO TAX STAFF. DESBD422 00026 * DESBD422 00027 * MODIFICATION HISTORY: DESBD422 00028 * DESBD422 00029 * 11/22/2011 INITIAL DEVELOPMENT DESBD422 00030 * REFERENCE: PROGRAMMER: GD DESBD422 00031 * DESBD422 00032 * 02/04/2013 MODIFIED HANDLING OF WAGES FOR ANNUAL FILERS. DESBD422 00033 * ADDED PROCESSING FOR WORKER NAMES. DESBD422 00034 * REFERENCE: PROGRAMMER: GD DESBD422 00035 * DESBD422 00036 * 07/29/2013 A NUMBER OF CHANGES TO IMPROVE THE DESBD422 00037 * EFFECTIVENESS OF THE PROGRAM, BASED ON DESBD422 00038 * TYPICAL ERRORS FOUND IN THE DATA FROM TDEC: DESBD422 00039 * - INCLUSION OF THE NAME CHECK AND FEIN IN THE DESBD422 00040 * SORT TO KEEP REPORTS TOGETHER WHEN THE DESBD422 00041 * EMPLOYER NUMBER IS MISSING. DESBD422 00042 * - IMPROVED HANDLING OF MISSING EMPLOYER DESBD422 00043 * NUMBERS - SEARCH BY FEIN DESBD422 00044 * - SUCCESSOR EMPLOYERS WILL BE IDENTIFIED WHEN DESBD422 00045 * POSSIBLE. DESBD422 00046 * - USE OF THE NEW ITM FILE (BATCH/ITEM CROSS DESBD422 00047 * - WORKER NAMES WILL BE ADDED TO THE NAME FILE DESBD422 00048 * - IMPROVEMENTS TO THE REPORTS. DESBD422 00049 * REFERENCE: PROGRAMMER: GD DESBD422 00050 * DESBD422 00051 * DESBD422 00052 * 01/13/2014 ALLOW PROGRAM TO UPDATE THE VSAM WAGE NAME FILE. DESBD422 00053 * VERIFY VSAM FILE IS CLOSED IF PROGRAM ABENDS. DESBD422 00054 * REFERENCE: PROGRAMMER: ZL1 DESBD422 00055 * DESBD422 00056 * 07/24/2014 PARAGRAPH 3000 - CHANGED THE COMPARE FOR QTR DESBD422 00057 * FROM W-YRQ TO WRK-YRQ. W-YRQ WAS BEING CHANGED DESBD422 00058 * IN SEVERAL PLACES PRIOR TO P3000 AND CAUSING DESBD422 00059 * ISSUES WITH POSSIBLE DUPLICATE ENTRIES WHEN DESBD422 00060 * THE QUARTERS BEING PROCESSING ARE NOT DUPS DESBD422 00061 * THIS SEEMS TO HAPPEN WHEN DOES RECEIVESSAVEILE DESBD422 00062 * FOR THE SAME PERSON SAME EMPLOYER SAME WAGES DESBD422 00063 * BUT FOR DIFFERENT QUARTERS. DESBD422 00064 * REFERENCE: PROGRAMMER: NH1 DESBD422 00065 DESBD422 00066 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD422 00067 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD422 00068 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD422 00069 * DESBD422 00070 * DESCRIPTION: DESBD422 00071 * DESBD422 00072 * DESBD422 00073 * RECORDS READ: DESBD422 00074 * EDITED TDEC W4 TRANSACTIONS FROM DESBD420 DESBD422 00075 * DESBD422 00076 * PRINTED OUTPUTS: DESBD422 00077 * NONE DESBD422 00078 * DESBD422 00079 * RECORDS WRITTEN: DESBD422 00080 * W001 WAGE RECORD DESBD422 00081 * WXXX MISSING SSN RECORD DESBD422 00082 * DESBD422 00083 * MODULES CALLED: DESBD422 00084 * NONE DESBD422 00085 * DESBD422 00086 ***** DESBD422 00087 DESBD422 00088 ENVIRONMENT DIVISION. DESBD422 00089 SKIP2 DESBD422 00090 INPUT-OUTPUT SECTION. DESBD422 00091 SKIP3 DESBD422 00092 FILE-CONTROL. DESBD422 00093 SELECT TDEC-TRAN-IN ASSIGN TO DTSFTDIN DESBD422 00094 FILE STATUS IS TDEC-IN-STATUS. DESBD422 00095 DESBD422 00096 SELECT WAGE-W001-FILE ASSIGN TO DTSFW001 DESBD422 00097 FILE STATUS IS WAGE-W001-STATUS. DESBD422 00098 DESBD422 00099 SELECT WAGE-X148-W4FILE ASSIGN TO DTSFW004 DESBD422 00100 FILE STATUS IS WAGE-X148-STATUS. DESBD422 00101 DESBD422 00102 SELECT WAGE-X153-FILE ASSIGN TO DTSFW153 DESBD422 00103 FILE STATUS IS WAGE-X153-STATUS. DESBD422 00104 DESBD422 00105 SELECT PENDING-FILE ASSIGN TO DTSFPEND DESBD422 00106 FILE STATUS IS PENDING-STATUS. DESBD422 00107 DESBD422 00108 SELECT MISSING-REPORT ASSIGN TO DTSFMISS DESBD422 00109 FILE STATUS IS MISSING-RPT-STATUS. DESBD422 00110 DESBD422 00111 SELECT WAGE-ERRORS ASSIGN TO DTSFERR DESBD422 00112 FILE STATUS IS WAGE-ERROR-STATUS. DESBD422 00113 DESBD422 00114 SELECT RECORD-COUNTS ASSIGN TO DTSFCNT DESBD422 00115 FILE STATUS IS RECORD-COUNT-STATUS. DESBD422 00116 DESBD422 00117 SELECT WWG2-FILE ASSIGN TO DTSFWG2 DESBD422 00118 ORGANIZATION IS INDEXED DESBD422 00119 ACCESS MODE IS DYNAMIC DESBD422 00120 RECORD KEY IS WWG2-KEY-AREA DESBD422 00121 FILE STATUS IS WWG2-STATUS. DESBD422 00122 DESBD422 00123 SELECT WITM-FILE ASSIGN TO DTSFITM DESBD422 00124 ORGANIZATION IS INDEXED DESBD422 00125 ACCESS MODE IS DYNAMIC DESBD422 00126 RECORD KEY IS WITM-KEY-AREA DESBD422 00127 FILE STATUS IS WITM-STATUS. DESBD422 00128 DESBD422 00129 DATA DIVISION. DESBD422 00130 DESBD422 00131 FILE SECTION. DESBD422 00132 DESBD422 00133 FD TDEC-TRAN-IN DESBD422 00134 RECORDING MODE IS F DESBD422 00135 LABEL RECORDS ARE STANDARD DESBD422 00136 BLOCK CONTAINS 0 CHARACTERS. DESBD422 00137 SKIP1 DESBD422 00138 01 TDEC-TRAN-IN-REC. DESBD422 00139 ++INCLUDE DTSIX154 DESBD422 00140 DESBD422 00141 FD WAGE-X153-FILE DESBD422 00142 RECORDING MODE IS F DESBD422 00143 BLOCK CONTAINS 0 RECORDS. DESBD422 00144 DESBD422 00145 01 WAGE-X153-REC PIC X(93). DESBD422 00146 DESBD422 00147 FD WAGE-W001-FILE DESBD422 00148 RECORDING MODE IS F DESBD422 00149 BLOCK CONTAINS 0 RECORDS. DESBD422 00150 DESBD422 00151 01 WAGE-W001-REC PIC X(128). DESBD422 00152 DESBD422 00153 FD WAGE-X148-W4FILE DESBD422 00154 RECORDING MODE IS F DESBD422 00155 BLOCK CONTAINS 0 RECORDS. DESBD422 00156 DESBD422 00157 01 WAGE-X148-W4REC PIC X(80). DESBD422 00158 DESBD422 00159 FD PENDING-FILE DESBD422 00160 RECORDING MODE IS F DESBD422 00161 LABEL RECORDS ARE STANDARD DESBD422 00162 BLOCK CONTAINS 0 CHARACTERS. DESBD422 00163 SKIP1 DESBD422 00164 01 PENDING-REC PIC X(106). DESBD422 00165 DESBD422 00166 FD MISSING-REPORT DESBD422 00167 RECORDING MODE IS F DESBD422 00168 LABEL RECORDS ARE STANDARD DESBD422 00169 BLOCK CONTAINS 0 CHARACTERS. DESBD422 00170 SKIP1 DESBD422 00171 01 MISSING-REPORT-REC PIC X(109). DESBD422 00172 DESBD422 00173 FD WAGE-ERRORS DESBD422 00174 RECORDING MODE IS F DESBD422 00175 BLOCK CONTAINS 0 RECORDS. DESBD422 00176 DESBD422 00177 01 WAGE-ERROR-REC PIC X(126). DESBD422 00178 DESBD422 00179 FD RECORD-COUNTS DESBD422 00180 RECORDING MODE IS F DESBD422 00181 BLOCK CONTAINS 0 RECORDS. DESBD422 00182 DESBD422 00183 01 RECORD-COUNT-REC PIC X(37). DESBD422 00184 DESBD422 00185 FD WWG2-FILE DESBD422 00186 RECORD CONTAINS 37 CHARACTERS DESBD422 00187 DATA RECORD IS WWG2-REC. DESBD422 00188 DESBD422 00189 01 WWG2-REC. DESBD422 00190 ++INCLUDE DTSIWWG2 DESBD422 00191 DESBD422 00192 FD WITM-FILE DESBD422 00193 RECORD CONTAINS 17 CHARACTERS DESBD422 00194 DATA RECORD IS WITM-REC. DESBD422 00195 DESBD422 00196 01 WITM-REC. DESBD422 00197 ++INCLUDE DTSIWITM DESBD422 00198 DESBD422 00199 WORKING-STORAGE SECTION. DESBD422 001995 77 PAN-VALET PICTURE X(24) VALUE '023DESBD422 07/28/14'. DESBD422 00200 77 PAN-VALET PICTURE X(24) VALUE '010DESBD422 07/28/14'. DESBD422 00201 77 PAN-VALET PICTURE X(24) VALUE '021DESBD422 07/18/14'. DESBD422 00202 77 PAN-VALET PICTURE X(24) VALUE '002DESBD422 07/18/14'. DESBD422 00203 77 PAN-VALET PICTURE X(24) VALUE '019DESBD422 01/14/14'. DESBD422 00204 77 PAN-VALET PICTURE X(24) VALUE '002DESBD422 01/13/14'. DESBD422 00205 77 PAN-VALET PICTURE X(24) VALUE '017DESBD422 12/11/13'. DESBD422 00206 77 PAN-VALET PICTURE X(24) VALUE '012DESBD422 11/22/13'. DESBD422 00207 77 PAN-VALET PICTURE X(24) VALUE '015DESBD422 11/07/13'. DESBD422 00208 77 PAN-VALET PICTURE X(24) VALUE '003DESBD422 11/07/13'. DESBD422 00209 77 PAN-VALET PICTURE X(24) VALUE '013DESBD422 11/01/13'. DESBD422 00210 77 PAN-VALET PICTURE X(24) VALUE '083DESBD422 11/01/13'. DESBD422 00211 77 PAN-VALET PICTURE X(24) VALUE '011DESBD422 05/22/13'. DESBD422 00212 77 PAN-VALET PICTURE X(24) VALUE '010DESBD422 05/22/13'. DESBD422 00213 77 PAN-VALET PICTURE X(24) VALUE '009DESBD422 02/11/13'. DESBD422 00214 77 PAN-VALET PICTURE X(24) VALUE '002DESBD422 02/11/13'. DESBD422 00215 77 PAN-VALET PICTURE X(24) VALUE '007DESBD422 02/11/13'. DESBD422 00216 77 PAN-VALET PICTURE X(24) VALUE '002DESBD422 02/11/13'. DESBD422 00217 77 PAN-VALET PICTURE X(24) VALUE '005DESBD422 02/08/13'. DESBD422 00218 77 PAN-VALET PICTURE X(24) VALUE '021DESBD422 02/07/13'. DESBD422 00219 77 PAN-VALET PICTURE X(24) VALUE '003DESBD422 01/17/13'. DESBD422 00220 77 PAN-VALET PICTURE X(24) VALUE '012DESBD422 01/17/13'. DESBD422 00221 77 PAN-VALET PICTURE X(24) VALUE '001DESBD422 01/08/13'. DESBD422 00222 77 PAN-VALET PICTURE X(24) VALUE '188DESBD422 01/08/13'. DESBD422 00223 SKIP3 DESBD422 00224 01 W-AREA. DESBD422 00225 05 W-MOD-NAME PIC X(08) VALUE 'DESBD422'. DESBD422 00226 05 W-TRACE-IND PIC X(01) VALUE 'N'. DESBD422 00227 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +422. DESBD422 00228 DESBD422 00229 05 W-START-BATCH PIC S9(05) COMP-3 DESBD422 00230 VALUE +71937. DESBD422 00231 DESBD422 00232 05 W-ERROR-IND PIC X(01) VALUE 'N'. DESBD422 00233 88 W-ERROR-YES-88 VALUE 'Y'. DESBD422 00234 88 W-ERROR-NO-88 VALUE 'N'. DESBD422 00235 DESBD422 00236 05 TDEC-IN-STATUS PIC X(02) VALUE SPACES. DESBD422 00237 88 TDEC-IN-OK-88 VALUE '00'. DESBD422 00238 88 TDEC-IN-EOF-88 VALUE '10'. DESBD422 00239 DESBD422 00240 05 PENDING-STATUS PIC X(02) VALUE SPACES. DESBD422 00241 88 PENDING-OK-88 VALUE '00'. DESBD422 00242 DESBD422 00243 05 MISSING-RPT-STATUS PIC X(02) VALUE SPACES. DESBD422 00244 88 MISSING-RPT-OK-88 VALUE '00'. DESBD422 00245 DESBD422 00246 05 WAGE-ERROR-STATUS PIC X(02) VALUE SPACES. DESBD422 00247 88 WAGE-ERROR-OK-88 VALUE '00'. DESBD422 00248 DESBD422 00249 05 RECORD-COUNT-STATUS PIC X(02) VALUE SPACES. DESBD422 00250 88 RECORD-COUNT-OK-88 VALUE '00'. DESBD422 00251 DESBD422 00252 05 WAGE-X148-STATUS PIC X(02) VALUE SPACES. DESBD422 00253 88 WAGE-X148-OK-88 VALUE '00'. DESBD422 00254 DESBD422 00255 DESBD422 00256 05 WAGE-X153-STATUS PIC X(02). DESBD422 00257 88 WAGE-X153-FILE-OK-88 VALUE '00'. DESBD422 00258 88 WAGE-X153-FILE-VERIFY-88 VALUE '97'. DESBD422 00259 DESBD422 00260 05 WAGE-W001-STATUS PIC X(02) VALUE SPACES. DESBD422 00261 88 WAGE-W001-OK-88 VALUE '00'. DESBD422 00262 DESBD422 00263 05 WWG2-STATUS PIC X(02) VALUE SPACES. DESBD422 00264 88 WWG2-OK-88 VALUE '00'. DESBD422 00265 88 WWG2-EOF-88 VALUE '10'. DESBD422 00266 DESBD422 00267 05 WITM-STATUS PIC X(02) VALUE SPACES. DESBD422 00268 88 WITM-OK-88 VALUE '00'. DESBD422 00269 88 WITM-EOF-88 VALUE '10'. DESBD422 00270 DESBD422 00271 05 W-WAGE-REC-IND PIC X(01) VALUE 'N'. DESBD422 00272 88 W-WAGE-REC-ERR-YES-88 VALUE 'Y'. DESBD422 00273 88 W-WAGE-REC-ERR-NO-88 VALUE 'N'. DESBD422 00274 DESBD422 00275 05 W-BATCH-ERR-IND PIC X(01) VALUE 'N'. DESBD422 00276 88 W-BATCH-ERR-YES-88 VALUE 'Y'. DESBD422 00277 88 W-BATCH-ERR-NO-88 VALUE 'N'. DESBD422 00278 DESBD422 00279 05 W-EMP-NBR-CHNG-IND PIC X(01) VALUE 'N'. DESBD422 00280 88 W-EMP-NBR-CHNG-YES-88 VALUE 'Y'. DESBD422 00281 88 W-EMP-NBR-CHNG-NO-88 VALUE 'N'. DESBD422 00282 DESBD422 00283 05 W-WAGE-ERR-IND PIC X(01) VALUE 'N'. DESBD422 00284 88 W-WAGE-ERR-YES-88 VALUE 'Y'. DESBD422 00285 88 W-WAGE-ERR-NO-88 VALUE 'N'. DESBD422 00286 DESBD422 00287 05 W-WAGE-ON-FILE-IND PIC X(01) VALUE 'N'. DESBD422 00288 88 W-WAGE-ON-FILE-YES-88 VALUE 'Y'. DESBD422 00289 88 W-WAGE-ON-FILE-NO-88 VALUE 'N'. DESBD422 00290 DESBD422 00291 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DESBD422 00292 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DESBD422 00293 88 W-EMP-FOUND-NO-88 VALUE 'N'. DESBD422 00294 DESBD422 00295 05 W-EMP-LIABLE-IND PIC X(01) VALUE 'N'. DESBD422 00296 88 W-EMP-LIABLE-YES-88 VALUE 'Y'. DESBD422 00297 88 W-EMP-LIABLE-NO-88 VALUE 'N'. DESBD422 00298 DESBD422 00299 05 W-PARTIAL-XFER-IND PIC X(01) VALUE 'N'. DESBD422 00300 88 W-PARTIAL-XFER-YES-88 VALUE 'Y'. DESBD422 00301 88 W-PARTIAL-XFER-NO-88 VALUE 'N'. DESBD422 00302 DESBD422 00303 05 W-VALID-QTR-IND PIC X(01) VALUE 'N'. DESBD422 00304 88 W-VALID-QTR-YES-88 VALUE 'Y'. DESBD422 00305 88 W-VALID-QTR-NO-88 VALUE 'N'. DESBD422 00306 DESBD422 00307 05 W-RPT-FOUND-IND PIC X(01) VALUE '0'. DESBD422 00308 88 W-RPT-FOUND-NO-88 VALUE '0'. DESBD422 00309 88 W-RPT-FOUND-MRPT-88 VALUE '1'. DESBD422 00310 88 W-RPT-FOUND-ATC-88 VALUE '2'. DESBD422 00311 88 W-RPT-FOUND-YES-88 VALUE '1' '2'. DESBD422 00312 DESBD422 00313 05 W-RPT-FOUND-TEXT PIC X(20). DESBD422 00314 05 W-SSN-ERR-IND PIC X(01) VALUE 'N'. DESBD422 00315 88 W-SSN-ERR-YES-88 VALUE 'Y'. DESBD422 00316 88 W-SSN-ERR-NO-88 VALUE 'N'. DESBD422 00317 DESBD422 00318 05 W-MISS-FOUND-IND PIC X(01) VALUE 'N'. DESBD422 00319 88 W-MISS-FOUND-YES-88 VALUE 'Y'. DESBD422 00320 88 W-MISS-FOUND-NO-88 VALUE 'N'. DESBD422 00321 DESBD422 00322 05 WRK-SLASH-DATE. DESBD422 00323 10 WRK-SLASH-MM PIC 9(02). DESBD422 00324 10 FILLER PIC X(01). DESBD422 00325 10 WRK-SLASH-DD PIC 9(02). DESBD422 00326 10 FILLER PIC X(01). DESBD422 00327 10 WRK-SLASH-YR PIC 9(02). DESBD422 00328 DESBD422 00329 05 WRK-PEND-DATE. DESBD422 00330 10 WRK-PEND-MM PIC 9(02). DESBD422 00331 10 WRK-PEND-DD PIC 9(02). DESBD422 00332 10 WRK-PEND-YR PIC 9(02). DESBD422 00333 DESBD422 00334 05 W-EMP-NO PIC 9(06) VALUE 0. DESBD422 00335 05 WRK-WNAM-CNT PIC 9(05) VALUE 0. DESBD422 00336 05 WRK-YRQ PIC 9(05) VALUE 0. DESBD422 00337 05 W-YRQ PIC 9(05) VALUE 0. DESBD422 00338 05 W-ANNUAL-YRQ PIC 9(05) VALUE 0. DESBD422 00339 05 W-DEFAULT-YRQ PIC 9(05) VALUE 0. DESBD422 00340 05 W-DEFAULT-QTR-DISP PIC X(06) VALUE SPACES. DESBD422 00341 05 W-CURR-EMP PIC 9(06) VALUE 0. DESBD422 00342 05 W-CURR-QTR PIC 9(05) VALUE 0. DESBD422 00343 05 W-CURR-SSN PIC 9(09) VALUE 0. DESBD422 00344 05 W-CURR-WAGES PIC 9(08)V99 VALUE 0. DESBD422 00345 05 W-SEQ-NO PIC S9(07) COMP-3 VALUE +0. DESBD422 00346 05 W-RPT-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD422 00347 05 W-EMP-NAME PIC X(04) VALUE SPACES. DESBD422 00348 05 W-FEIN PIC 9(09) VALUE ZERO. DESBD422 00349 05 W-RPT-BATCH PIC S9(05) COMP-3 VALUE +0. DESBD422 00350 05 W-RPT-ITEM PIC S9(03) COMP-3 VALUE +0. DESBD422 00351 05 W-FEIN-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD422 00352 ** 05 W-FEIN-FOR-EMP PIC S9(07) COMP-3 VALUE +0. DESBD422 00353 05 W-HOLD-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD422 00354 05 W-W4-TOT-WAGE PIC S9(09)V99 COMP-3 VALUE +0. DESBD422 00355 05 W-MRPT-TOT-WAGE PIC S9(09)V99 COMP-3 VALUE +0. DESBD422 00356 05 W-WGH-TOT-WAGE PIC S9(09)V99 COMP-3 VALUE +0. DESBD422 00357 05 W-SSN PIC 9(09) VALUE 0. DESBD422 00358 05 W-MRPT-RESP-OPID PIC X(08). DESBD422 00359 05 W-MRPT-ESTB-DATE PIC S9(09). DESBD422 00360 05 W-DIFF PIC S9(09)V99 COMP-3 VALUE +0. DESBD422 00361 05 W-ESTB-DATE PIC X(10) VALUE SPACES. DESBD422 00362 05 W-SLASH-QTR PIC X(06) VALUE SPACES. DESBD422 00363 DESBD422 00364 01 WAGE-TRANS-AREA. DESBD422 00365 05 ESP-TRANSACTION-AREA PIC X(80). DESBD422 00366 ++INCLUDE EWGTRNW4 DESBD422 00367 EJECT DESBD422 00368 DESBD422 00369 05 W-W001-REC. DESBD422 00370 ++INCLUDE DTSIW001 DESBD422 00371 DESBD422 00372 01 WRK-X153-REC. DESBD422 00373 ++INCLUDE DTSIX153 DESBD422 00374 DESBD422 00375 05 W-RPT1-FIRST-TIME PIC X(01) VALUE 'Y'. DESBD422 00376 88 W-RPT1-FIRST-TIME-YES-88 DESBD422 00377 VALUE 'Y'. DESBD422 00378 88 W-RPT1-FIRST-TIME-NO-88 DESBD422 00379 VALUE 'N'. DESBD422 00380 05 W-MISSING-RPT-HDR. DESBD422 00381 10 FILLER PIC X(07) VALUE DESBD422 00382 'EMP ;'. DESBD422 00383 10 FILLER PIC X(05) VALUE DESBD422 00384 'NAME;'. DESBD422 00385 10 FILLER PIC X(10) VALUE DESBD422 00386 'FEIN ;'. DESBD422 00387 10 FILLER PIC X(10) VALUE DESBD422 00388 'BATCH/ITM;'. DESBD422 00389 10 FILLER PIC X(07) VALUE DESBD422 00390 'QTR ;'. DESBD422 00391 10 FILLER PIC X(06) VALUE DESBD422 00392 'ANN? ;'. DESBD422 00393 10 FILLER PIC X(13) VALUE DESBD422 00394 'TOT WAGES ;'. DESBD422 00395 10 FILLER PIC X(11) VALUE DESBD422 00396 'WAGE DATE ;'. DESBD422 00397 10 FILLER PIC X(07) VALUE DESBD422 00398 'MESSAGE'. DESBD422 00399 DESBD422 00400 05 W-MISSING-RPT-REC. DESBD422 00401 10 MSRP-EMP PIC 9(06). DESBD422 00402 10 FILLER PIC X(01) VALUE ';'. DESBD422 00403 10 MSRP-EMP-NAME PIC X(04). DESBD422 00404 10 FILLER PIC X(01) VALUE ';'. DESBD422 00405 10 MSRP-FEIN PIC X(09). DESBD422 00406 10 FILLER PIC X(01) VALUE ';'. DESBD422 00407 10 MSRP-BATCH PIC 9(05). DESBD422 00408 10 FILLER PIC X(01) VALUE '/'. DESBD422 00409 10 MSRP-ITEM PIC X(03). DESBD422 00410 10 FILLER PIC X(01) VALUE ';'. DESBD422 00411 10 MSRP-QTR PIC X(06). DESBD422 00412 10 FILLER PIC X(01) VALUE ';'. DESBD422 00413 10 MSRP-FILING-SCHED PIC X(05). DESBD422 00414 10 FILLER PIC X(01) VALUE ';'. DESBD422 00415 10 MSRP-TOT-WAGE PIC --------9.99. DESBD422 00416 10 FILLER PIC X(01) VALUE ';'. DESBD422 00417 10 MSRP-DATE PIC X(10). DESBD422 00418 10 FILLER PIC X(01) VALUE ';'. DESBD422 00419 10 MSRP-REASON PIC X(40). DESBD422 00420 88 MSRP-RSN-NOT-FOUND-88 VALUE DESBD422 00421 'ACCOUNT NUMBER DOES NOT EXIST '. DESBD422 00422 88 MSRP-RSN-NOT-LIABLE-88 VALUE DESBD422 00423 'EMPLOYER NOT LIABLE '. DESBD422 00424 88 MSRP-RSN-INVALID-QTR-88 VALUE DESBD422 00425 'INVALID QUARTER '. DESBD422 00426 88 MSRP-RSN-RPT-NOT-FOUND-88 VALUE DESBD422 00427 'REPORT NOT FOUND '. DESBD422 00428 88 MSRP-RSN-RPT-DELETED-88 VALUE DESBD422 00429 'REPORT PROBABLY DELETED '. DESBD422 00430 88 MSRP-RSN-PART-XFER-88 VALUE DESBD422 00431 'PARTIAL TRANSFER OF EXPERIENCE '. DESBD422 00432 DESBD422 00433 05 W-RPT2-FIRST-TIME PIC X(01) VALUE 'Y'. DESBD422 00434 88 W-RPT2-FIRST-TIME-YES-88 DESBD422 00435 VALUE 'Y'. DESBD422 00436 88 W-RPT2-FIRST-TIME-NO-88 DESBD422 00437 VALUE 'N'. DESBD422 00438 05 W-WAGE-ERROR-HDR. DESBD422 00439 10 FILLER PIC X(09) VALUE DESBD422 00440 'EMPLOYER;'. DESBD422 00441 10 FILLER PIC X(09) VALUE DESBD422 00442 'BATCH#: '. DESBD422 00443 10 FILLER PIC X(08) VALUE DESBD422 00444 'QUARTER;'. DESBD422 00445 10 FILLER PIC X(09) VALUE DESBD422 00446 'W4 WAGES;'. DESBD422 00447 10 FILLER PIC X(12) VALUE DESBD422 00448 'UC-30 WAGES;'. DESBD422 00449 10 FILLER PIC X(11) VALUE DESBD422 00450 'DIFFERENCE;'. DESBD422 00451 10 FILLER PIC X(13) VALUE DESBD422 00452 'WORKER COUNT;'. DESBD422 00453 10 FILLER PIC X(14) VALUE DESBD422 00454 'WAGES ON FILE;'. DESBD422 00455 10 FILLER PIC X(18) VALUE DESBD422 00456 'REPORT ENTERED DT;'. DESBD422 00457 10 FILLER PIC X(17) VALUE DESBD422 00458 'WAGES ENTERED DT;'. DESBD422 00459 10 FILLER PIC X(10) VALUE DESBD422 00460 'RESP OPID;'. DESBD422 00461 05 W-WAGE-ERROR-REC. DESBD422 00462 10 WERR-EMP PIC 9(06). DESBD422 00463 10 FILLER PIC X(01) VALUE ';'. DESBD422 00464 10 WERR-BATCH PIC 9(05). DESBD422 00465 10 FILLER PIC X(01) VALUE ';'. DESBD422 00466 10 WERR-QTR PIC X(06). DESBD422 00467 10 FILLER PIC X(01) VALUE ';'. DESBD422 00468 10 WERR-W4-WAGE PIC --------9.99. DESBD422 00469 10 FILLER PIC X(01) VALUE ';'. DESBD422 00470 10 WERR-MRPT-WAGE PIC --------9.99. DESBD422 00471 10 FILLER PIC X(01) VALUE ';'. DESBD422 00472 10 WERR-DIFFERENCE PIC --------9.99. DESBD422 00473 10 FILLER PIC X(01) VALUE ';'. DESBD422 00474 10 WERR-WORKER-CNT PIC 9(07). DESBD422 00475 10 FILLER PIC X(01) VALUE ';'. DESBD422 00476 10 WERR-WGH-WAGE PIC --------9.99. DESBD422 00477 10 FILLER PIC X(01) VALUE ';'. DESBD422 00478 10 WERR-RPT-DATE PIC X(10). DESBD422 00479 10 FILLER PIC X(01) VALUE ';'. DESBD422 00480 10 WERR-WAGE-DATE PIC X(10). DESBD422 00481 10 FILLER PIC X(01) VALUE ';'. DESBD422 00482 10 WERR-RESP-OPID PIC X(08). DESBD422 00483 DESBD422 00484 05 W-RECORD-COUNT-REC. DESBD422 00485 10 WC-REC-IN. DESBD422 00486 15 FILLER PIC X(30) VALUE DESBD422 00487 'INPUT RECORDS: '. DESBD422 00488 15 WC-REC-IN-CNT PIC 9(07). DESBD422 00489 10 WC-TOT-RPTS. DESBD422 00490 15 FILLER PIC X(30) VALUE DESBD422 00491 'TOTAL REPORTS: '. DESBD422 00492 15 WC-TOT-RPTS-CNT PIC 9(07). DESBD422 00493 10 WC-RPTS-FOUND. DESBD422 00494 15 FILLER PIC X(30) VALUE DESBD422 00495 'REPORTS FOUND: '. DESBD422 00496 15 WC-RPTS-FOUND-CNT PIC 9(07). DESBD422 00497 10 WC-MRPT-FOUND. DESBD422 00498 15 FILLER PIC X(30) VALUE DESBD422 00499 'REPORTS POSTED: '. DESBD422 00500 15 WC-MRPT-FOUND-CNT PIC 9(07). DESBD422 00501 10 WC-ATC-FOUND. DESBD422 00502 15 FILLER PIC X(30) VALUE DESBD422 00503 'REPORTS FOUND IN ATC '. DESBD422 00504 15 WC-ATC-FOUND-CNT PIC 9(07). DESBD422 00505 10 WC-RPT-DELETED. DESBD422 00506 15 FILLER PIC X(30) VALUE DESBD422 00507 'REPORTS PROBABLY DELETED '. DESBD422 00508 15 WC-RPT-DELETED-CNT PIC 9(07). DESBD422 00509 10 WC-RPT-MISSING. DESBD422 00510 15 FILLER PIC X(30) VALUE DESBD422 00511 'TOTAL REPORTS MISSING '. DESBD422 00512 15 WC-RPT-MISSING-CNT PIC 9(07). DESBD422 00513 10 WC-EMP-CHANGED. DESBD422 00514 15 FILLER PIC X(30) VALUE DESBD422 00515 'EMPLOYER NBR CHANGED '. DESBD422 00516 15 WC-EMP-CHANGED-CNT PIC 9(07). DESBD422 00517 10 WC-NOT-LIABLE. DESBD422 00518 15 FILLER PIC X(30) VALUE DESBD422 00519 'EMPLOYER NOT LIABLE '. DESBD422 00520 15 WC-NOT-LIABLE-CNT PIC 9(07). DESBD422 00521 10 WC-NO-EMP. DESBD422 00522 15 FILLER PIC X(30) VALUE DESBD422 00523 'EMPLOYER NBR NOT FOUND '. DESBD422 00524 15 WC-NO-EMP-CNT PIC 9(07). DESBD422 00525 10 WC-INVALID-QTR. DESBD422 00526 15 FILLER PIC X(30) VALUE DESBD422 00527 'INVALID QUARTER '. DESBD422 00528 15 WC-INVALID-QTR-CNT PIC 9(07). DESBD422 00529 10 WC-WAGE-DIFF. DESBD422 00530 15 FILLER PIC X(30) VALUE DESBD422 00531 'WAGE DISCREPANCIES '. DESBD422 00532 15 WC-WAGE-DIFF-CNT PIC 9(07). DESBD422 00533 10 WC-DUP-SSN. DESBD422 00534 15 FILLER PIC X(30) VALUE DESBD422 00535 'DUPLICATE SSNS '. DESBD422 00536 15 WC-DUP-SSN-CNT PIC 9(07). DESBD422 00537 10 WC-X148. DESBD422 00538 15 FILLER PIC X(30) VALUE DESBD422 00539 'WAGE RECORDS WRITTEN '. DESBD422 00540 15 WC-X148-CNT PIC 9(07). DESBD422 00541 10 WC-WAGES-HELD. DESBD422 00542 15 FILLER PIC X(30) VALUE DESBD422 00543 'WAGES HELD '. DESBD422 00544 15 WC-HELD-CNT PIC 9(07). DESBD422 00545 DESBD422 00546 05 WRK-ABSTIME PIC S9(15) COMP-3. DESBD422 00547 05 W-TDEC-IN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00548 05 W-X148-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00549 05 W-X153-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00550 05 W-W001-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00551 05 W-REPORT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00552 05 W-WORKER-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00553 05 W-FOUND-IN-ATC-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00554 05 W-EMP-IN-ATC-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00555 05 W-MRPT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00556 05 W-RPT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00557 05 W-RPT-MISSING-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00558 05 W-RPT-DELETED-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00559 05 W-EMP-NBR-CHNG-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00560 05 W-EMP-FROM-FEIN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00561 05 W-PAY-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00562 05 W-EMP-MISSING-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00563 05 W-NOT-LIABLE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00564 05 W-MISS-RPT-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00565 05 W-DUP-SSN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00566 05 W-WAGE-MISMATCH-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00567 05 W-INVALID-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00568 05 W-PENDING-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00569 05 W-TOT-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00570 05 W-NO-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD422 00571 05 WRK-SSN PIC 9(09) VALUE 0. DESBD422 00572 DESBD422 00573 05 AMT-DISP1 PIC ----------9.99. DESBD422 00574 05 AMT-DISP2 PIC ----------9.99. DESBD422 00575 05 AMT-DISP3 PIC ----------9.99. DESBD422 00576 05 AMT-DISP4 PIC ----------9.99. DESBD422 00577 DESBD422 00578 DESBD422 00579 01 L001-LINK-AREA. DESBD422 00580 ++INCLUDE DTSIL001 DESBD422 00581 DESBD422 00582 01 L004-LINK-AREA. DESBD422 00583 ++INCLUDE DTSIL004 DESBD422 00584 DESBD422 00585 01 L005-LINK-AREA. DESBD422 00586 ++INCLUDE DTSIL005 DESBD422 00587 DESBD422 00588 01 L516-LINK-AREA. DESBD422 00589 ++INCLUDE DTSIL516 DESBD422 00590 DESBD422 00591 01 L601-LINK-AREA. DESBD422 00592 ++INCLUDE DTSIL601 DESBD422 00593 DESBD422 00594 01 L910-LINK-AREA. DESBD422 00595 ++INCLUDE DTSIL910 DESBD422 00596 DESBD422 00597 01 L982-LINK-AREA. DESBD422 00598 ++INCLUDE DTSIL982 DESBD422 00599 DESBD422 00600 01 MSKL-REC. DESBD422 00601 ++INCLUDE DTSIMSKL DESBD422 00602 DESBD422 00603 01 MHDR-REC. DESBD422 00604 ++INCLUDE DTSIMHDR DESBD422 00605 DESBD422 00606 01 MPRF-REC. DESBD422 00607 ++INCLUDE DTSIMPRF DESBD422 00608 DESBD422 00609 01 MRPT-REC. DESBD422 00610 ++INCLUDE DTSIMRPT DESBD422 00611 DESBD422 00612 01 MPAY-REC. DESBD422 00613 ++INCLUDE DTSIMPAY DESBD422 00614 DESBD422 00615 01 L921-LINK-AREA. DESBD422 00616 ++INCLUDE DTSIL921 DESBD422 00617 SKIP3 DESBD422 00618 01 ISKL-REC. DESBD422 00619 ++INCLUDE DTSIISKL DESBD422 00620 SKIP3 DESBD422 00621 01 IEIN-REC. DESBD422 00622 ++INCLUDE DTSIIEIN DESBD422 00623 DESBD422 00624 01 L923-LINK-AREA. DESBD422 00625 ++INCLUDE DTSIL923 DESBD422 00626 DESBD422 00627 01 ASKL-REC. DESBD422 00628 ++INCLUDE DTSIASKL DESBD422 00629 DESBD422 00630 01 AHDR-REC. DESBD422 00631 ++INCLUDE DTSIAHDR DESBD422 00632 DESBD422 00633 01 ARPT-REC. DESBD422 00634 ++INCLUDE DTSIARPT DESBD422 00635 EJECT DESBD422 00636 01 AATX-REC. DESBD422 00637 ++INCLUDE DTSIAATX DESBD422 00638 DESBD422 00639 01 APAY-REC. DESBD422 00640 ++INCLUDE DTSIAPAY DESBD422 00641 DESBD422 00642 01 L931-LINK-AREA. DESBD422 00643 ++INCLUDE DTSIL931 DESBD422 00644 DESBD422 00645 01 FSKL-REC. DESBD422 00646 ++INCLUDE DTSIFSKL DESBD422 00647 DESBD422 00648 01 L981-LINK-AREA. DESBD422 00649 ++INCLUDE DTSIL981 DESBD422 00650 SKIP3 DESBD422 00651 01 WWGH-REC. DESBD422 00652 ++INCLUDE DTSIWWGH DESBD422 00653 DESBD422 00654 01 WNAM-REC. DESBD422 00655 ++INCLUDE DTSIWNAM DESBD422 00656 DESBD422 00657 PROCEDURE DIVISION. DESBD422 00658 DESBD422 00659 DESBD422-MAIN. DESBD422 00660 DISPLAY 'DESBD422 11/01/2013'. DESBD422 00661 DESBD422 00662 PERFORM I0000-INIT THRU I0000-EXIT. DESBD422 00663 IF W-ERROR-YES-88 DESBD422 00664 MOVE 12 TO RETURN-CODE DESBD422 00665 GO TO DESBD422-MAIN-EXIT. DESBD422 00666 DESBD422 00667 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD422 00668 DESBD422 00669 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD422 00670 DESBD422 00671 DESBD422-MAIN-EXIT. DESBD422 00672 GOBACK. DESBD422 00673 DESBD422 00674 I0000-INIT. DESBD422 00675 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DESBD422 00676 DESBD422 00677 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD422 00678 MOVE L005-SLASH-DATE TO WRK-SLASH-DATE. DESBD422 00679 MOVE WRK-SLASH-MM TO WRK-PEND-MM. DESBD422 00680 MOVE WRK-SLASH-DD TO WRK-PEND-DD. DESBD422 00681 MOVE WRK-SLASH-YR TO WRK-PEND-YR. DESBD422 00682 MOVE L005-DATE TO L004-DATE. DESBD422 00683 PERFORM S004-FROM-DATE THRU S004-EXIT. DESBD422 00684 SUBTRACT 1 FROM L004-ABS-QTR. DESBD422 00685 PERFORM S004-FROM-ABS THRU S004-EXIT. DESBD422 00686 MOVE L004-QTR-5-9 TO W-DEFAULT-YRQ. DESBD422 00687 MOVE L004-SLASH-5-QTR TO W-DEFAULT-QTR-DISP.DESBD422 00688 DISPLAY 'DEFAULT QTR: ' W-DEFAULT-YRQ DESBD422 00689 ' ' W-DEFAULT-QTR-DISP. DESBD422 00690 DESBD422 00691 I0000-EXIT. DESBD422 00692 EXIT. DESBD422 00693 DESBD422 00694 I2000-OPEN-FILES. DESBD422 00695 PERFORM S1000-OPEN-TDEC-IN THRU S1000-EXIT. DESBD422 00696 IF W-ERROR-YES-88 DESBD422 00697 GO TO I2000-EXIT DESBD422 00698 END-IF. DESBD422 00699 DESBD422 00700 PERFORM S1400-OPEN-PENDING-FILE THRU S1400-EXIT. DESBD422 00701 IF W-ERROR-YES-88 DESBD422 00702 GO TO I2000-EXIT DESBD422 00703 END-IF. DESBD422 00704 DESBD422 00705 OPEN OUTPUT MISSING-REPORT DESBD422 00706 IF NOT MISSING-RPT-OK-88 DESBD422 00707 DISPLAY 'CANNOT OPEN MISSING RPT ' DESBD422 00708 MISSING-RPT-STATUS DESBD422 00709 SET W-ERROR-YES-88 TO TRUE DESBD422 00710 END-IF. DESBD422 00711 DESBD422 00712 OPEN OUTPUT WAGE-ERRORS DESBD422 00713 IF NOT WAGE-ERROR-OK-88 DESBD422 00714 DISPLAY 'CANNOT OPEN WAGE ERRORS ' DESBD422 00715 WAGE-ERROR-STATUS DESBD422 00716 SET W-ERROR-YES-88 TO TRUE DESBD422 00717 END-IF. DESBD422 00718 DESBD422 00719 OPEN OUTPUT RECORD-COUNTS DESBD422 00720 IF NOT RECORD-COUNT-OK-88 DESBD422 00721 DISPLAY 'CANNOT OPEN RECORD COUNTS ' DESBD422 00722 RECORD-COUNT-STATUS DESBD422 00723 SET W-ERROR-YES-88 TO TRUE DESBD422 00724 END-IF. DESBD422 00725 DESBD422 00726 PERFORM S1300-OPEN-X148-W4FILE THRU S1300-EXIT. DESBD422 00727 IF W-ERROR-YES-88 DESBD422 00728 GO TO I2000-EXIT DESBD422 00729 END-IF. DESBD422 00730 DESBD422 00731 PERFORM S1500-OPEN-W001-WAGE THRU S1500-EXIT. DESBD422 00732 IF W-ERROR-YES-88 DESBD422 00733 GO TO I2000-EXIT DESBD422 00734 END-IF. DESBD422 00735 DESBD422 00736 OPEN INPUT WWG2-FILE. DESBD422 00737 IF NOT WWG2-OK-88 DESBD422 00738 DISPLAY 'CANNOT OPEN WWG2 FILE ' WWG2-STATUS DESBD422 00739 SET W-ERROR-YES-88 TO TRUE DESBD422 00740 GO TO I2000-EXIT DESBD422 00741 END-IF. DESBD422 00742 DESBD422 00743 OPEN INPUT WITM-FILE. DESBD422 00744 IF NOT WITM-OK-88 DESBD422 00745 DISPLAY 'CANNOT OPEN WITM FILE ' WITM-STATUS DESBD422 00746 SET W-ERROR-YES-88 TO TRUE DESBD422 00747 GO TO I2000-EXIT DESBD422 00748 END-IF. DESBD422 00749 DESBD422 00750 OPEN OUTPUT WAGE-X153-FILE. DESBD422 00751 IF WAGE-X153-FILE-OK-88 DESBD422 00752 NEXT SENTENCE DESBD422 00753 ELSE DESBD422 00754 DISPLAY 'CANNOT OPEN X153 FILE ' WAGE-X153-STATUS DESBD422 00755 PERFORM S999-ABEND THRU S999-EXIT DESBD422 00756 END-IF. DESBD422 00757 DESBD422 00758 PERFORM S910A-OPEN-READ THRU S910A-EXIT. DESBD422 00759 PERFORM S921-OPEN-READ THRU S921-EXIT. DESBD422 00760 PERFORM S923A-OPEN-READ THRU S923A-EXIT. DESBD422 00761 PERFORM S931-OPEN-READ THRU S931-EXIT. DESBD422 00762 PERFORM S981A-OPEN-READ THRU S981A-EXIT. DESBD422 00763 PERFORM S982O-OPEN-UPDATE THRU S982O-EXIT. DESBD422 00764 DESBD422 00765 I2000-EXIT. DESBD422 00766 EXIT. DESBD422 00767 DESBD422 00768 P0000-PROCESS. DESBD422 00769 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT. DESBD422 00770 IF TDEC-IN-EOF-88 DESBD422 00771 DISPLAY 'INPUT FILE IS EMPTY' DESBD422 00772 GO TO P0000-EXIT DESBD422 00773 END-IF. DESBD422 00774 DESBD422 00775 PERFORM UNTIL TDEC-IN-EOF-88 DESBD422 00776 IF W-CURR-EMP = ZERO DESBD422 00777 IF X154-BATCH = W-RPT-BATCH DESBD422 00778 AND X154-ITEM = W-RPT-ITEM DESBD422 00779 AND X154-EMP-NAME = W-EMP-NAME DESBD422 00780 PERFORM P3000-PROCESS-WAGE THRU P3000-EXIT DESBD422 00781 ELSE DESBD422 00782 PERFORM P2000-FIND-RPT THRU P2000-EXIT DESBD422 00783 PERFORM P3000-PROCESS-WAGE THRU P3000-EXIT DESBD422 00784 END-IF DESBD422 00785 ELSE DESBD422 00786 IF X154-EMP-NO = W-CURR-EMP DESBD422 00787 AND X154-QUARTER = W-CURR-QTR DESBD422 00788 PERFORM P3000-PROCESS-WAGE THRU P3000-EXIT DESBD422 00789 ELSE DESBD422 00790 PERFORM P2000-FIND-RPT THRU P2000-EXIT DESBD422 00791 PERFORM P3000-PROCESS-WAGE THRU P3000-EXIT DESBD422 00792 END-IF DESBD422 00793 END-IF DESBD422 00794 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT DESBD422 00795 END-PERFORM. DESBD422 00796 DESBD422 00797 IF NOT W-RPT-FOUND-YES-88 DESBD422 00798 PERFORM P2010-NEW-EMP-QTR THRU P2010-EXIT DESBD422 00799 END-IF. DESBD422 00800 DESBD422 00801 P0000-EXIT. DESBD422 00802 EXIT. DESBD422 00803 DESBD422 00804 DESBD422 00805 P2000-FIND-RPT. DESBD422 00806 PERFORM P2010-NEW-EMP-QTR THRU P2010-EXIT. DESBD422 00807 DESBD422 00808 ADD +1 TO W-REPORT-CNT. DESBD422 00809 DESBD422 00810 SET W-EMP-FOUND-NO-88 TO TRUE. DESBD422 00811 SET W-RPT-FOUND-NO-88 TO TRUE. DESBD422 00812 SET W-VALID-QTR-NO-88 TO TRUE. DESBD422 00813 SET W-EMP-LIABLE-NO-88 TO TRUE. DESBD422 00814 SET W-PARTIAL-XFER-NO-88 TO TRUE. DESBD422 00815 DESBD422 00816 SET W-MISS-FOUND-NO-88 TO TRUE. DESBD422 00817 DESBD422 00818 MOVE +0 TO W-RPT-ITEM DESBD422 00819 W-W4-TOT-WAGE DESBD422 00820 W-WORKER-CNT DESBD422 00821 W-MRPT-ESTB-DATE DESBD422 00822 W-MRPT-TOT-WAGE DESBD422 00823 W-WGH-TOT-WAGE. DESBD422 00824 MOVE ZERO TO MSRP-EMP DESBD422 00825 MSRP-QTR DESBD422 00826 MSRP-TOT-WAGE. DESBD422 00827 MOVE SPACES TO W-MRPT-RESP-OPID. DESBD422 00828 DESBD422 00829 *& DESBD422 00830 *** IF X154-EMP-NO = 173150 DESBD422 00831 * IF X154-ITEM > ZERO DESBD422 00832 * DISPLAY 'P2000 - 1: ' X154-EMP-NO ' ' X154-SSN DESBD422 00833 * ' ' X154-QUARTER ' ' X154-BATCH ' ' X154-ITEM DESBD422 00834 * END-IF. DESBD422 00835 *& DESBD422 00836 MOVE X154-EMP-NO TO W-EMP-NO DESBD422 00837 W-RPT-EMP-NO DESBD422 00838 W-CURR-EMP. DESBD422 00839 MOVE X154-EMP-NAME TO W-EMP-NAME. DESBD422 00840 MOVE X154-FEIN TO W-FEIN. DESBD422 00841 DESBD422 00842 MOVE X154-QUARTER TO L004-QTR-5-9 DESBD422 00843 W-CURR-QTR. DESBD422 00844 PERFORM S004-FROM-5 THRU S004-EXIT. DESBD422 00845 IF L004-VALID-QTR DESBD422 00846 SET W-VALID-QTR-YES-88 TO TRUE DESBD422 00847 MOVE L004-QTR-5-9 TO W-YRQ DESBD422 00848 MOVE L004-SLASH-5-QTR TO W-SLASH-QTR DESBD422 00849 ELSE DESBD422 00850 SET W-VALID-QTR-YES-88 TO TRUE DESBD422 00851 ** DISPLAY '**1 INVALID QTR: ' X154-EMP-NO DESBD422 00852 ** ' ' X154-QUARTER DESBD422 00853 MOVE W-DEFAULT-YRQ TO W-YRQ DESBD422 00854 MOVE W-DEFAULT-QTR-DISP TO W-SLASH-QTR DESBD422 00855 ADD +1 TO W-INVALID-QTR-CNT DESBD422 00856 END-IF. DESBD422 00857 DESBD422 00858 MOVE X154-BATCH TO W-RPT-BATCH. DESBD422 00859 MOVE X154-ITEM TO W-RPT-ITEM. DESBD422 00860 DESBD422 00861 MOVE L005-DATE TO L001-FED-8-DATE-9. DESBD422 00862 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DESBD422 00863 IF L001-VALID-DATE DESBD422 00864 MOVE L001-SLASH-8-DATE TO W-ESTB-DATE DESBD422 00865 ELSE DESBD422 00866 MOVE SPACES TO W-ESTB-DATE DESBD422 00867 END-IF. DESBD422 00868 DESBD422 00869 DESBD422 00870 PERFORM P2100-FIND-EMPLOYER THRU P2100-EXIT. DESBD422 00871 DESBD422 00872 ** MODIFIED 2/4/2013 - QUARTER IN WAGE RECORD WILL REMAIN DESBD422 00873 ** UNCHANGED, BUT SEARCH FOR REPORT IN ATC WILL START WITH DESBD422 00874 ** THE FIRST QUARTER. DESBD422 00875 IF W-EMP-LIABLE-YES-88 DESBD422 00876 AND L516-ANN-SCHED-88 DESBD422 00877 MOVE W-YRQ TO L004-QTR-5-9 DESBD422 00878 MOVE 1 TO L004-QTR-5-Q DESBD422 00879 PERFORM S004-FROM-5 THRU S004-EXIT DESBD422 00880 MOVE L004-QTR-5-9 TO W-ANNUAL-YRQ DESBD422 00881 END-IF. DESBD422 00882 DESBD422 00883 IF W-VALID-QTR-NO-88 DESBD422 00884 GO TO P2000-EXIT DESBD422 00885 END-IF. DESBD422 00886 DESBD422 00887 IF W-EMP-FOUND-NO-88 DESBD422 00888 IF X154-ITEM > ZERO DESBD422 00889 NEXT SENTENCE DESBD422 00890 ELSE DESBD422 00891 GO TO P2000-EXIT DESBD422 00892 END-IF DESBD422 00893 END-IF. DESBD422 00894 DESBD422 00895 DESBD422 00896 IF W-RPT-EMP-NO > ZERO DESBD422 00897 PERFORM P2200-RPT-ON-FILE THRU P2200-EXIT DESBD422 00898 END-IF. DESBD422 00899 IF W-RPT-FOUND-NO-88 DESBD422 00900 PERFORM P2300-RPT-IN-ATC THRU P2300-EXIT DESBD422 00901 END-IF. DESBD422 00902 DESBD422 00903 IF W-RPT-FOUND-YES-88 DESBD422 00904 ADD +1 TO W-TOT-RPT-CNT DESBD422 00905 END-IF. DESBD422 00906 DESBD422 00907 *& IF W-RPT-FOUND-YES-88 DESBD422 00908 * PERFORM P2400-CHECK-WGH THRU P2400-EXIT DESBD422 00909 *& END-IF. DESBD422 00910 DESBD422 00911 P2000-EXIT. DESBD422 00912 EXIT. DESBD422 00913 DESBD422 00914 P2010-NEW-EMP-QTR. DESBD422 00915 IF W-W4-TOT-WAGE > 0 DESBD422 00916 AND W-RPT-FOUND-YES-88 DESBD422 00917 PERFORM P2800-WAGE-DIFF THRU P2800-EXIT DESBD422 00918 END-IF. DESBD422 00919 DESBD422 00920 ** IF W-WGH-TOT-WAGE > 0 DESBD422 00921 * MOVE W-W4-TOT-WAGE TO AMT-DISP1 DESBD422 00922 * MOVE W-MRPT-TOT-WAGE TO AMT-DISP2 DESBD422 00923 * MOVE W-WGH-TOT-WAGE TO AMT-DISP3 DESBD422 00924 * DISPLAY '**5 WGH WAGES: ' W-RPT-EMP-NO ' ' W-YRQ DESBD422 00925 * ' W4: ' AMT-DISP1 DESBD422 00926 * ' MRPT: ' AMT-DISP2 ' WGH: ' AMT-DISP3 DESBD422 00927 * ELSE DESBD422 00928 * DISPLAY '**6 NO WGH WAGES: ' W-RPT-EMP-NO ' ' W-YRQ DESBD422 00929 ** END-IF. DESBD422 00930 DESBD422 00931 IF W-REPORT-CNT > 0 DESBD422 00932 IF W-RPT-FOUND-NO-88 DESBD422 00933 PERFORM P2700-MISSING-RPT THRU P2700-EXIT DESBD422 00934 END-IF DESBD422 00935 END-IF. DESBD422 00936 DESBD422 00937 P2010-EXIT. DESBD422 00938 EXIT. DESBD422 00939 DESBD422 00940 P2100-FIND-EMPLOYER. DESBD422 00941 IF W-EMP-NO = ZERO DESBD422 00942 PERFORM P2130-FROM-FEIN THRU P2130-EXIT DESBD422 00943 END-IF. DESBD422 00944 PERFORM P2110-EMP-NBR-CHNG THRU P2110-EXIT DESBD422 00945 PERFORM P2120-READ-MPRF THRU P2120-EXIT. DESBD422 00946 DESBD422 00947 IF L516-NOT-LIABLE-88 DESBD422 00948 PERFORM P2140-SUCCESSOR THRU P2140-EXIT DESBD422 00949 IF L601-NO-SUCCESSOR-88 DESBD422 00950 MOVE MPRF-FEIN TO W-FEIN DESBD422 00951 PERFORM P2130-FROM-FEIN THRU P2130-EXIT DESBD422 00952 IF W-EMP-FOUND-NO-88 DESBD422 00953 GO TO P2100-EXIT DESBD422 00954 END-IF DESBD422 00955 END-IF DESBD422 00956 PERFORM P2120-READ-MPRF THRU P2120-EXIT DESBD422 00957 END-IF. DESBD422 00958 DESBD422 00959 ** IF W-EMP-FOUND-NO-88 DESBD422 00960 * IF X154-FEIN > ZERO DESBD422 00961 * PERFORM P2130-FROM-FEIN THRU P2130-EXIT DESBD422 00962 * PERFORM P2120-READ-MPRF THRU P2120-EXIT DESBD422 00963 * END-IF DESBD422 00964 ** END-IF. DESBD422 00965 DESBD422 00966 P2100-EXIT. DESBD422 00967 EXIT. DESBD422 00968 DESBD422 00969 P2110-EMP-NBR-CHNG. DESBD422 00970 SET W-EMP-NBR-CHNG-NO-88 TO TRUE. DESBD422 00971 MOVE W-EMP-NO TO WWG2-ORIG-EMP-NO. DESBD422 00972 MOVE ZERO TO WWG2-RPT-EMP-NO DESBD422 00973 WWG2-BATCH-NO DESBD422 00974 WWG2-ITEM-NO. DESBD422 00975 DESBD422 00976 START WWG2-FILE DESBD422 00977 KEY IS >= WWG2-KEY-AREA. DESBD422 00978 DESBD422 00979 IF WWG2-OK-88 DESBD422 00980 PERFORM UNTIL WWG2-EOF-88 DESBD422 00981 READ WWG2-FILE NEXT DESBD422 00982 DESBD422 00983 IF W-EMP-NO = ZERO DESBD422 00984 AND X154-ITEM > ZERO DESBD422 00985 PERFORM P2111-MISSING-EMP THRU P2111-EXIT DESBD422 00986 ELSE DESBD422 00987 PERFORM P2112-EMP-CHANGE THRU P2112-EXIT DESBD422 00988 END-IF DESBD422 00989 END-PERFORM DESBD422 00990 END-IF. DESBD422 00991 DESBD422 00992 P2110-EXIT. DESBD422 00993 EXIT. DESBD422 00994 DESBD422 00995 P2111-MISSING-EMP. DESBD422 00996 IF WWG2-ORIG-EMP-NO = W-EMP-NO DESBD422 00997 AND WWG2-BATCH-NO = W-RPT-BATCH DESBD422 00998 AND WWG2-ITEM-NO = X154-ITEM DESBD422 00999 ** DISPLAY 'P2110 EMP NBR CHNG. ORIG: ' W-EMP-NO DESBD422 01000 ** ' NEW ' WWG2-RPT-EMP-NO DESBD422 01001 MOVE WWG2-RPT-EMP-NO TO W-RPT-EMP-NO DESBD422 01002 W-EMP-NO DESBD422 01003 W-CURR-EMP DESBD422 01004 ADD +1 TO W-EMP-NBR-CHNG-CNT DESBD422 01005 SET WWG2-EOF-88 TO TRUE DESBD422 01006 END-IF. DESBD422 01007 DESBD422 01008 P2111-EXIT. DESBD422 01009 EXIT. DESBD422 01010 DESBD422 01011 P2112-EMP-CHANGE. DESBD422 01012 IF WWG2-ORIG-EMP-NO = W-EMP-NO DESBD422 01013 AND WWG2-BATCH-NO = W-RPT-BATCH DESBD422 01014 ** DISPLAY 'P2110 EMP NBR CHNG. ORIG: ' W-EMP-NO DESBD422 01015 ** ' NEW ' WWG2-RPT-EMP-NO DESBD422 01016 MOVE WWG2-RPT-EMP-NO TO W-RPT-EMP-NO DESBD422 01017 ADD +1 TO W-EMP-NBR-CHNG-CNT DESBD422 01018 SET WWG2-EOF-88 TO TRUE DESBD422 01019 END-IF. DESBD422 01020 DESBD422 01021 P2112-EXIT. DESBD422 01022 EXIT. DESBD422 01023 DESBD422 01024 P2120-READ-MPRF. DESBD422 01025 MOVE LOW-VALUES TO MPRF-KEY-AREA. DESBD422 01026 MOVE W-RPT-EMP-NO TO MPRF-EMP-NO. DESBD422 01027 SET MPRF-PRF-88 TO TRUE. DESBD422 01028 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DESBD422 01029 PERFORM S910F-READ THRU S910F-EXIT. DESBD422 01030 IF L910-OK-88 DESBD422 01031 SET W-EMP-FOUND-YES-88 TO TRUE DESBD422 01032 MOVE MSKL-REC TO MPRF-REC DESBD422 01033 IF W-VALID-QTR-YES-88 DESBD422 01034 MOVE W-YRQ TO L516-YRQ DESBD422 01035 PERFORM S516-LIABILITY-INFO THRU S516-EXIT DESBD422 01036 END-IF DESBD422 01037 ELSE DESBD422 01038 ADD +1 TO W-EMP-MISSING-CNT DESBD422 01039 *** DISPLAY 'EMPLOYER NOT FOUND: ' W-RPT-EMP-NO DESBD422 01040 END-IF. DESBD422 01041 DESBD422 01042 IF L516-NOT-LIABLE-88 DESBD422 01043 ADD +1 TO W-NOT-LIABLE-CNT DESBD422 01044 ** DISPLAY '**2 NOT LIABLE: ' W-RPT-EMP-NO ' ' W-YRQ DESBD422 01045 ELSE DESBD422 01046 SET W-EMP-LIABLE-YES-88 TO TRUE DESBD422 01047 END-IF. DESBD422 01048 DESBD422 01049 P2120-EXIT. DESBD422 01050 EXIT. DESBD422 01051 DESBD422 01052 P2130-FROM-FEIN. DESBD422 01053 MOVE ZERO TO W-FEIN-EMP-NO DESBD422 01054 W-HOLD-EMP-NO. DESBD422 01055 DESBD422 01056 MOVE LOW-VALUE TO IEIN-KEY-AREA DESBD422 01057 SET IEIN-EIN-88 TO TRUE DESBD422 01058 MOVE W-FEIN TO IEIN-FEIN DESBD422 01059 MOVE +0 TO IEIN-EMP-NO DESBD422 01060 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DESBD422 01061 PERFORM S921-START-BROWSE THRU S921-EXIT DESBD422 01062 MOVE ISKL-REC TO IEIN-REC DESBD422 01063 PERFORM DESBD422 01064 UNTIL L921-NO-REC-88 DESBD422 01065 OR W-FEIN-EMP-NO > ZERO DESBD422 01066 IF IEIN-FEIN = W-FEIN DESBD422 01067 PERFORM P2131-FIND-MPRF THRU P2131-EXIT DESBD422 01068 IF W-FEIN-EMP-NO = ZERO DESBD422 01069 PERFORM S921-READ-NEXT THRU S921-EXIT DESBD422 01070 MOVE ISKL-REC TO IEIN-REC DESBD422 01071 END-IF DESBD422 01072 ELSE DESBD422 01073 SET L921-NO-REC-88 TO TRUE DESBD422 01074 END-IF DESBD422 01075 END-PERFORM. DESBD422 01076 DESBD422 01077 IF W-FEIN-EMP-NO > ZERO DESBD422 01078 MOVE W-FEIN-EMP-NO TO W-RPT-EMP-NO DESBD422 01079 ELSE DESBD422 01080 IF W-HOLD-EMP-NO > ZERO DESBD422 01081 MOVE W-HOLD-EMP-NO TO W-RPT-EMP-NO DESBD422 01082 END-IF DESBD422 01083 END-IF. DESBD422 01084 DESBD422 01085 P2130-EXIT. DESBD422 01086 EXIT. DESBD422 01087 DESBD422 01088 P2131-FIND-MPRF. DESBD422 01089 MOVE LOW-VALUES TO MPRF-KEY-AREA. DESBD422 01090 MOVE IEIN-EMP-NO TO MPRF-EMP-NO. DESBD422 01091 SET MPRF-PRF-88 TO TRUE. DESBD422 01092 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DESBD422 01093 PERFORM S910F-READ THRU S910F-EXIT. DESBD422 01094 IF L910-OK-88 DESBD422 01095 MOVE MSKL-REC TO MPRF-REC DESBD422 01096 IF NOT MPRF-STATUS-ACT-88 DESBD422 01097 MOVE MPRF-EMP-NO TO W-HOLD-EMP-NO DESBD422 01098 ELSE DESBD422 01099 MOVE MPRF-EMP-NO TO W-FEIN-EMP-NO DESBD422 01100 END-IF DESBD422 01101 END-IF. DESBD422 01102 DESBD422 01103 P2131-EXIT. DESBD422 01104 EXIT. DESBD422 01105 DESBD422 01106 P2140-SUCCESSOR. DESBD422 01107 MOVE W-RPT-EMP-NO TO L601-EMP-NO. DESBD422 01108 MOVE 99999999 TO L601-EXP-TRN-EFF-DATE. DESBD422 01109 PERFORM S601-CALL-BU601 THRU S601-EXIT. DESBD422 01110 IF L601-SUCCESSOR-FOUND-88 DESBD422 01111 MOVE L601-ULTIMATE-SUCCESSOR TO W-RPT-EMP-NO DESBD422 01112 ELSE DESBD422 01113 IF L601-PARTIAL-TRANSFER-88 DESBD422 01114 SET W-PARTIAL-XFER-YES-88 TO TRUE DESBD422 01115 END-IF DESBD422 01116 END-IF. DESBD422 01117 DESBD422 01118 P2140-EXIT. DESBD422 01119 EXIT. DESBD422 01120 DESBD422 01121 P2200-RPT-ON-FILE. DESBD422 01122 MOVE W-RPT-EMP-NO TO MRPT-EMP-NO. DESBD422 01123 SET MRPT-RPT-88 TO TRUE. DESBD422 01124 MOVE W-YRQ TO MRPT-YRQ. DESBD422 01125 MOVE +0 TO MRPT-BATCH-NO DESBD422 01126 MOVE +0 TO MRPT-ITEM-NO. DESBD422 01127 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DESBD422 01128 PERFORM S910D-START-BROWSE THRU S910D-EXIT. DESBD422 01129 DESBD422 01130 PERFORM UNTIL L910-NO-REC-88 DESBD422 01131 MOVE MSKL-REC TO MRPT-REC DESBD422 01132 IF MRPT-WITHDRW-88 DESBD422 01133 PERFORM P2210-WITHDRAWN THRU P2210-EXIT DESBD422 01134 ELSE DESBD422 01135 ** IF W-RPT-BATCH < 10000 DESBD422 01136 * PERFORM P2230-BANK-BATCH THRU P2230-EXIT DESBD422 01137 * ELSE DESBD422 01138 * PERFORM P2220-REG-BATCH THRU P2220-EXIT DESBD422 01139 ** END-IF DESBD422 01140 IF MRPT-EMP-NO = W-RPT-EMP-NO DESBD422 01141 AND MRPT-YRQ = W-YRQ DESBD422 01142 AND MRPT-BATCH-NO = W-RPT-BATCH DESBD422 01143 SET W-RPT-FOUND-MRPT-88 TO TRUE DESBD422 01144 MOVE MRPT-ITEM-NO TO W-RPT-ITEM DESBD422 01145 MOVE MRPT-TOT-WAGE TO W-MRPT-TOT-WAGE DESBD422 01146 MOVE MRPT-RESPONSIBLE-OP-ID TO W-MRPT-RESP-OPID DESBD422 01147 MOVE MRPT-ESTB-DATE TO W-MRPT-ESTB-DATE DESBD422 01148 END-IF DESBD422 01149 END-IF DESBD422 01150 PERFORM S910E-READ-NEXT THRU S910E-EXIT DESBD422 01151 DESBD422 01152 END-PERFORM. DESBD422 01153 DESBD422 01154 IF W-RPT-FOUND-MRPT-88 DESBD422 01155 ADD +1 TO W-RPT-FOUND-CNT DESBD422 01156 ADD +1 TO W-MRPT-FOUND-CNT DESBD422 01157 ELSE DESBD422 01158 PERFORM P2240-EMP-YRQ THRU P2240-EXIT DESBD422 01159 IF W-RPT-FOUND-MRPT-88 DESBD422 01160 ADD +1 TO W-RPT-FOUND-CNT DESBD422 01161 ADD +1 TO W-MRPT-FOUND-CNT DESBD422 01162 END-IF DESBD422 01163 END-IF. DESBD422 01164 DESBD422 01165 P2200-EXIT. DESBD422 01166 EXIT. DESBD422 01167 DESBD422 01168 P2210-WITHDRAWN. DESBD422 01169 P2210-EXIT. DESBD422 01170 EXIT. DESBD422 01171 DESBD422 01172 P2220-REG-BATCH. DESBD422 01173 IF MRPT-EMP-NO = W-RPT-EMP-NO DESBD422 01174 AND MRPT-YRQ = W-YRQ DESBD422 01175 AND MRPT-BATCH-NO = W-RPT-BATCH DESBD422 01176 SET W-RPT-FOUND-MRPT-88 TO TRUE DESBD422 01177 MOVE MRPT-ITEM-NO TO W-RPT-ITEM DESBD422 01178 MOVE MRPT-TOT-WAGE TO W-MRPT-TOT-WAGE DESBD422 01179 MOVE MRPT-RESPONSIBLE-OP-ID TO W-MRPT-RESP-OPID DESBD422 01180 MOVE MRPT-ESTB-DATE TO W-MRPT-ESTB-DATE DESBD422 01181 END-IF. DESBD422 01182 DESBD422 01183 P2220-EXIT. DESBD422 01184 EXIT. DESBD422 01185 DESBD422 01186 P2230-BANK-BATCH. DESBD422 01187 IF MRPT-EMP-NO = W-RPT-EMP-NO DESBD422 01188 AND MRPT-YRQ = W-YRQ DESBD422 01189 ** DISPLAY 'P2230 ' MRPT-EMP-NO ' ' W-RPT-BATCH DESBD422 01190 ** ' ' MRPT-BATCH-NO ' ' MRPT-ITEM-NO DESBD422 01191 SET W-RPT-FOUND-MRPT-88 TO TRUE DESBD422 01192 MOVE MRPT-BATCH-NO TO W-RPT-BATCH DESBD422 01193 MOVE MRPT-ITEM-NO TO W-RPT-ITEM DESBD422 01194 MOVE MRPT-TOT-WAGE TO W-MRPT-TOT-WAGE DESBD422 01195 MOVE MRPT-RESPONSIBLE-OP-ID TO W-MRPT-RESP-OPID DESBD422 01196 MOVE MRPT-ESTB-DATE TO W-MRPT-ESTB-DATE DESBD422 01197 END-IF. DESBD422 01198 DESBD422 01199 P2230-EXIT. DESBD422 01200 EXIT. DESBD422 01201 DESBD422 01202 P2240-EMP-YRQ. DESBD422 01203 MOVE W-RPT-EMP-NO TO MRPT-EMP-NO. DESBD422 01204 SET MRPT-RPT-88 TO TRUE. DESBD422 01205 MOVE W-YRQ TO MRPT-YRQ. DESBD422 01206 MOVE +0 TO MRPT-BATCH-NO DESBD422 01207 MOVE +0 TO MRPT-ITEM-NO. DESBD422 01208 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DESBD422 01209 PERFORM S910D-START-BROWSE THRU S910D-EXIT. DESBD422 01210 DESBD422 01211 PERFORM UNTIL L910-NO-REC-88 DESBD422 01212 MOVE MSKL-REC TO MRPT-REC DESBD422 01213 IF MRPT-WITHDRW-88 DESBD422 01214 PERFORM P2210-WITHDRAWN THRU P2210-EXIT DESBD422 01215 ELSE DESBD422 01216 IF MRPT-EMP-NO = W-RPT-EMP-NO DESBD422 01217 AND MRPT-YRQ = W-YRQ DESBD422 01218 SET W-RPT-FOUND-MRPT-88 TO TRUE DESBD422 01219 ** DISPLAY 'P2240 ' MRPT-EMP-NO ' ' W-RPT-BATCH DESBD422 01220 ** ' ' MRPT-BATCH-NO ' ' MRPT-ITEM-NO DESBD422 01221 MOVE MRPT-BATCH-NO TO W-RPT-BATCH DESBD422 01222 MOVE MRPT-ITEM-NO TO W-RPT-ITEM DESBD422 01223 MOVE MRPT-TOT-WAGE TO W-MRPT-TOT-WAGE DESBD422 01224 MOVE MRPT-RESPONSIBLE-OP-ID TO W-MRPT-RESP-OPID DESBD422 01225 MOVE MRPT-ESTB-DATE TO W-MRPT-ESTB-DATE DESBD422 01226 END-IF DESBD422 01227 END-IF DESBD422 01228 PERFORM S910E-READ-NEXT THRU S910E-EXIT DESBD422 01229 DESBD422 01230 END-PERFORM. DESBD422 01231 P2240-EXIT. DESBD422 01232 EXIT. DESBD422 01233 DESBD422 01234 P2300-RPT-IN-ATC. DESBD422 01235 IF X154-ITEM > ZERO DESBD422 01236 PERFORM P2500-BATCH-ITEM THRU P2500-EXIT DESBD422 01237 GO TO P2300-EXIT DESBD422 01238 END-IF. DESBD422 01239 DESBD422 01240 MOVE W-RPT-BATCH TO ASKL-BATCH-NO. DESBD422 01241 MOVE +0 TO ASKL-ITEM-NO. DESBD422 01242 DESBD422 01243 PERFORM S923B-START-BROWSE THRU S923B-EXIT. DESBD422 01244 DESBD422 01245 PERFORM UNTIL L923-NO-REC-88 DESBD422 01246 EVALUATE TRUE DESBD422 01247 WHEN ASKL-RPT-88 DESBD422 01248 PERFORM P2310-ARPT THRU P2310-EXIT DESBD422 01249 WHEN ASKL-ATX-88 DESBD422 01250 PERFORM P2320-AATX THRU P2320-EXIT DESBD422 01251 DESBD422 01252 END-EVALUATE DESBD422 01253 DESBD422 01254 IF L923-NO-REC-88 DESBD422 01255 NEXT SENTENCE DESBD422 01256 ELSE DESBD422 01257 PERFORM S923C-READ-NEXT THRU S923C-EXIT DESBD422 01258 END-IF DESBD422 01259 DESBD422 01260 END-PERFORM. DESBD422 01261 DESBD422 01262 DESBD422 01263 P2300-EXIT. DESBD422 01264 EXIT. DESBD422 01265 DESBD422 01266 P2310-ARPT. DESBD422 01267 MOVE ASKL-REC TO ARPT-REC. DESBD422 01268 IF ARPT-NOT-PROCESSED-88 DESBD422 01269 AND ARPT-EMP-NO = W-RPT-EMP-NO DESBD422 01270 AND ARPT-YRQ = W-YRQ DESBD422 01271 AND ARPT-BATCH-NO = W-RPT-BATCH DESBD422 01272 ** DISPLAY 'RPT IN ATC: ' ARPT-BATCH-NO DESBD422 01273 ** ' ' ARPT-ITEM-NO ' ' W-RPT-EMP-NO ' ' W-YRQ DESBD422 01274 SET W-RPT-FOUND-ATC-88 TO TRUE DESBD422 01275 ADD +1 TO W-FOUND-IN-ATC-CNT DESBD422 01276 ADD +1 TO W-RPT-FOUND-CNT DESBD422 01277 MOVE ARPT-ITEM-NO TO W-RPT-ITEM DESBD422 01278 MOVE ARPT-TOT-WAGE TO W-MRPT-TOT-WAGE DESBD422 01279 MOVE ARPT-RESPONSIBLE-OP-ID TO W-MRPT-RESP-OPID DESBD422 01280 MOVE ZERO TO W-MRPT-ESTB-DATE DESBD422 01281 SET L923-NO-REC-88 TO TRUE DESBD422 01282 END-IF. DESBD422 01283 DESBD422 01284 P2310-EXIT. DESBD422 01285 EXIT. DESBD422 01286 DESBD422 01287 P2320-AATX. DESBD422 01288 MOVE ASKL-REC TO AATX-REC. DESBD422 01289 IF AATX-NOT-PROCESSED-88 DESBD422 01290 AND AATX-EMP-NO = W-RPT-EMP-NO DESBD422 01291 AND AATX-YRQ = W-ANNUAL-YRQ DESBD422 01292 AND AATX-BATCH-NO = W-RPT-BATCH DESBD422 01293 ** DISPLAY 'ATX IN ATC: ' AATX-BATCH-NO DESBD422 01294 ** ' ' AATX-ITEM-NO ' ' W-RPT-EMP-NO ' ' W-YRQ DESBD422 01295 SET W-RPT-FOUND-ATC-88 TO TRUE DESBD422 01296 ADD +1 TO W-FOUND-IN-ATC-CNT DESBD422 01297 ADD +1 TO W-RPT-FOUND-CNT DESBD422 01298 MOVE AATX-ITEM-NO TO W-RPT-ITEM DESBD422 01299 MOVE AATX-TOT-WAGE TO W-MRPT-TOT-WAGE DESBD422 01300 MOVE AATX-RESPONSIBLE-OP-ID TO W-MRPT-RESP-OPID DESBD422 01301 MOVE ZERO TO W-MRPT-ESTB-DATE DESBD422 01302 SET L923-NO-REC-88 TO TRUE DESBD422 01303 END-IF. DESBD422 01304 DESBD422 01305 P2320-EXIT. DESBD422 01306 EXIT. DESBD422 01307 DESBD422 01308 P2400-CHECK-WGH. DESBD422 01309 MOVE W-RPT-EMP-NO TO WWGH-EMP-NO. DESBD422 01310 MOVE W-YRQ TO WWGH-YRQ. DESBD422 01311 MOVE +0 TO WWGH-SSN. DESBD422 01312 PERFORM S981D-START-BROWSE THRU S981D-EXIT. DESBD422 01313 PERFORM UNTIL L981-NO-REC-88 DESBD422 01314 IF WWGH-EMP-NO = W-RPT-EMP-NO DESBD422 01315 AND WWGH-YRQ = W-YRQ DESBD422 01316 ADD WWGH-EARNINGS TO W-WGH-TOT-WAGE DESBD422 01317 PERFORM S981E-READ-NEXT THRU S981E-EXIT DESBD422 01318 ELSE DESBD422 01319 SET L981-NO-REC-88 TO TRUE DESBD422 01320 END-IF DESBD422 01321 END-PERFORM. DESBD422 01322 DESBD422 01323 P2400-EXIT. DESBD422 01324 EXIT. DESBD422 01325 DESBD422 01326 DESBD422 01327 *************************************************************** DESBD422 01328 * CHECK FOR ANY TRANSACTION FOR THE EMPLOYER IN THE ATC FILE DESBD422 01329 *************************************************************** DESBD422 01330 P2500-BATCH-ITEM. DESBD422 01331 MOVE W-RPT-BATCH TO ASKL-BATCH-NO. DESBD422 01332 MOVE X154-ITEM TO ASKL-ITEM-NO. DESBD422 01333 DESBD422 01334 PERFORM S923D-READ THRU S923D-EXIT. DESBD422 01335 IF L923-OK-88 DESBD422 01336 SET W-MISS-FOUND-YES-88 TO TRUE DESBD422 01337 EVALUATE TRUE DESBD422 01338 WHEN ASKL-RPT-88 DESBD422 01339 PERFORM P2510-ARPT THRU P2510-EXIT DESBD422 01340 WHEN ASKL-ATX-88 DESBD422 01341 PERFORM P2520-AATX THRU P2520-EXIT DESBD422 01342 END-EVALUATE DESBD422 01343 ELSE DESBD422 01344 PERFORM P2540-FROM-WITM THRU P2540-EXIT DESBD422 01345 END-IF. DESBD422 01346 DESBD422 01347 ** IF W-RPT-FOUND-YES-88 DESBD422 01348 * IF W-RPT-FOUND-MRPT-88 DESBD422 01349 * MOVE 'POSTED' TO W-RPT-FOUND-TEXT DESBD422 01350 * ELSE DESBD422 01351 * MOVE 'TRANSACTION' TO W-RPT-FOUND-TEXT DESBD422 01352 * END-IF DESBD422 01353 * DISPLAY W-CURR-EMP ' ' W-YRQ DESBD422 01354 * ' ' W-RPT-BATCH ' ' W-RPT-ITEM ' ' DESBD422 01355 * W-RPT-FOUND-TEXT DESBD422 01356 ** END-IF. DESBD422 01357 P2500-EXIT. DESBD422 01358 EXIT. DESBD422 01359 DESBD422 01360 P2510-ARPT. DESBD422 01361 MOVE ASKL-REC TO ARPT-REC. DESBD422 01362 IF ARPT-BATCH-NO = W-RPT-BATCH DESBD422 01363 AND ARPT-ITEM-NO = X154-ITEM DESBD422 01364 MOVE ARPT-EMP-NO TO W-RPT-EMP-NO DESBD422 01365 MOVE ARPT-ITEM-NO TO W-RPT-ITEM DESBD422 01366 MOVE ARPT-TOT-WAGE TO W-MRPT-TOT-WAGE DESBD422 01367 MOVE ARPT-RESPONSIBLE-OP-ID TO W-MRPT-RESP-OPID DESBD422 01368 MOVE ZERO TO W-MRPT-ESTB-DATE DESBD422 01369 IF ARPT-NOT-PROCESSED-88 DESBD422 01370 PERFORM P2511-ATC THRU P2511-EXIT DESBD422 01371 ELSE DESBD422 01372 PERFORM P2512-RPT THRU P2512-EXIT DESBD422 01373 END-IF DESBD422 01374 END-IF. DESBD422 01375 DESBD422 01376 P2510-EXIT. DESBD422 01377 EXIT. DESBD422 01378 DESBD422 01379 P2511-ATC. DESBD422 01380 SET W-RPT-FOUND-ATC-88 TO TRUE DESBD422 01381 ADD +1 TO W-FOUND-IN-ATC-CNT DESBD422 01382 ADD +1 TO W-RPT-FOUND-CNT. DESBD422 01383 DESBD422 01384 P2511-EXIT. DESBD422 01385 EXIT. DESBD422 01386 DESBD422 01387 P2512-RPT. DESBD422 01388 SET W-RPT-FOUND-MRPT-88 TO TRUE DESBD422 01389 ADD +1 TO W-FOUND-IN-ATC-CNT DESBD422 01390 ADD +1 TO W-RPT-FOUND-CNT. DESBD422 01391 DESBD422 01392 P2512-EXIT. DESBD422 01393 EXIT. DESBD422 01394 DESBD422 01395 P2520-AATX. DESBD422 01396 MOVE ASKL-REC TO AATX-REC. DESBD422 01397 IF AATX-BATCH-NO = W-RPT-BATCH DESBD422 01398 AND AATX-ITEM-NO = X154-ITEM DESBD422 01399 MOVE AATX-EMP-NO TO W-RPT-EMP-NO DESBD422 01400 MOVE AATX-ITEM-NO TO W-RPT-ITEM DESBD422 01401 MOVE AATX-TOT-WAGE TO W-MRPT-TOT-WAGE DESBD422 01402 MOVE AATX-RESPONSIBLE-OP-ID TO W-MRPT-RESP-OPID DESBD422 01403 MOVE ZERO TO W-MRPT-ESTB-DATE DESBD422 01404 IF AATX-NOT-PROCESSED-88 DESBD422 01405 PERFORM P2521-ATC THRU P2521-EXIT DESBD422 01406 ELSE DESBD422 01407 PERFORM P2522-RPT THRU P2522-EXIT DESBD422 01408 END-IF DESBD422 01409 END-IF. DESBD422 01410 DESBD422 01411 P2520-EXIT. DESBD422 01412 EXIT. DESBD422 01413 DESBD422 01414 P2521-ATC. DESBD422 01415 SET W-RPT-FOUND-ATC-88 TO TRUE DESBD422 01416 ADD +1 TO W-FOUND-IN-ATC-CNT DESBD422 01417 ADD +1 TO W-RPT-FOUND-CNT. DESBD422 01418 DESBD422 01419 P2521-EXIT. DESBD422 01420 EXIT. DESBD422 01421 DESBD422 01422 P2522-RPT. DESBD422 01423 SET W-RPT-FOUND-MRPT-88 TO TRUE DESBD422 01424 ADD +1 TO W-FOUND-IN-ATC-CNT DESBD422 01425 ADD +1 TO W-RPT-FOUND-CNT. DESBD422 01426 DESBD422 01427 P2522-EXIT. DESBD422 01428 EXIT. DESBD422 01429 DESBD422 01430 *P2530-APAY. DESBD422 01431 * MOVE ASKL-REC TO APAY-REC. DESBD422 01432 * IF APAY-EMP-NO = W-RPT-EMP-NO DESBD422 01433 * ADD +1 TO W-EMP-IN-ATC-CNT DESBD422 01434 * DISPLAY 'ATC EMP PAY: ' APAY-BATCH-NO ' ' APAY-ITEM-NO DESBD422 01435 * ' ' APAY-PROCESSED-DATE DESBD422 01436 * END-IF. DESBD422 01437 * DESBD422 01438 *P2530-EXIT. DESBD422 01439 * EXIT. DESBD422 01440 DESBD422 01441 P2540-FROM-WITM. DESBD422 01442 ** DISPLAY 'P2540 - 1: ' W-RPT-EMP-NO DESBD422 01443 ** ' ' W-CURR-QTR ' ' W-RPT-BATCH ' ' X154-ITEM. DESBD422 01444 DESBD422 01445 MOVE W-RPT-BATCH TO WITM-BATCH-NO. DESBD422 01446 MOVE X154-ITEM TO WITM-ITEM-NO. DESBD422 01447 MOVE W-CURR-QTR TO WITM-YRQ. DESBD422 01448 DESBD422 01449 READ WITM-FILE. DESBD422 01450 IF WITM-OK-88 DESBD422 01451 MOVE WITM-EMP-NO TO W-RPT-EMP-NO DESBD422 01452 SET W-RPT-FOUND-MRPT-88 TO TRUE DESBD422 01453 ADD +1 TO W-MRPT-FOUND-CNT DESBD422 01454 ADD +1 TO W-RPT-FOUND-CNT DESBD422 01455 ** DISPLAY 'P2540 - 2: ' W-RPT-EMP-NO DESBD422 01456 ** ELSE DESBD422 01457 ** DISPLAY 'P2540 NO REC ' WITM-STATUS DESBD422 01458 END-IF. DESBD422 01459 DESBD422 01460 DESBD422 01461 P2540-EXIT. DESBD422 01462 EXIT. DESBD422 01463 DESBD422 01464 P2600-WAGE-ERROR. DESBD422 01465 IF W-RPT1-FIRST-TIME-YES-88 DESBD422 01466 SET W-RPT1-FIRST-TIME-NO-88 TO TRUE DESBD422 01467 WRITE WAGE-ERROR-REC FROM W-WAGE-ERROR-HDR DESBD422 01468 END-IF. DESBD422 01469 DESBD422 01470 MOVE W-RPT-BATCH TO WERR-BATCH. DESBD422 01471 MOVE W-RPT-EMP-NO TO WERR-EMP. DESBD422 01472 IF W-YRQ = ZERO DESBD422 01473 MOVE X154-QUARTER TO WERR-QTR DESBD422 01474 ELSE DESBD422 01475 MOVE W-SLASH-QTR TO WERR-QTR DESBD422 01476 END-IF. DESBD422 01477 MOVE W-W4-TOT-WAGE TO WERR-W4-WAGE. DESBD422 01478 MOVE W-MRPT-TOT-WAGE TO WERR-MRPT-WAGE. DESBD422 01479 MOVE W-DIFF TO WERR-DIFFERENCE DESBD422 01480 MOVE W-WORKER-CNT TO WERR-WORKER-CNT. DESBD422 01481 MOVE W-ESTB-DATE TO WERR-WAGE-DATE. DESBD422 01482 MOVE W-MRPT-ESTB-DATE TO L001-FED-8-DATE-9. DESBD422 01483 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DESBD422 01484 IF L001-VALID-DATE DESBD422 01485 MOVE L001-SLASH-8-DATE TO WERR-RPT-DATE DESBD422 01486 ELSE DESBD422 01487 MOVE SPACES TO WERR-RPT-DATE DESBD422 01488 END-IF. DESBD422 01489 MOVE W-MRPT-RESP-OPID TO WERR-RESP-OPID. DESBD422 01490 DESBD422 01491 ADD +1 TO W-WAGE-MISMATCH-CNT. DESBD422 01492 DESBD422 01493 WRITE WAGE-ERROR-REC FROM W-WAGE-ERROR-REC. DESBD422 01494 DESBD422 01495 ** DISPLAY '**3 WAGE DIFF: ' W-RPT-EMP-NO ' ' W-YRQ DESBD422 01496 * ' TDEC ' WERR-W4-WAGE ' MRPT ' WERR-MRPT-WAGE DESBD422 01497 * ' DIFF ' WERR-DIFFERENCE DESBD422 01498 ** ' ' W-WORKER-CNT ' ' MRPT-RESPONSIBLE-OP-ID. DESBD422 01499 P2600-EXIT. DESBD422 01500 EXIT. DESBD422 01501 DESBD422 01502 P2700-MISSING-RPT. DESBD422 01503 ** DISPLAY 'NO RPT: ' W-EMP-NO ' ' W-YRQ. DESBD422 01504 ADD +1 TO W-RPT-MISSING-CNT. DESBD422 01505 DESBD422 01506 IF W-RPT-ITEM > ZERO DESBD422 01507 ADD +1 TO W-RPT-DELETED-CNT DESBD422 01508 END-IF. DESBD422 01509 DESBD422 01510 IF W-RPT2-FIRST-TIME-YES-88 DESBD422 01511 SET W-RPT2-FIRST-TIME-NO-88 TO TRUE DESBD422 01512 WRITE MISSING-REPORT-REC FROM W-MISSING-RPT-HDR DESBD422 01513 END-IF. DESBD422 01514 DESBD422 01515 MOVE W-RPT-EMP-NO TO MSRP-EMP. DESBD422 01516 MOVE W-EMP-NAME TO MSRP-EMP-NAME. DESBD422 01517 MOVE W-FEIN TO MSRP-FEIN. DESBD422 01518 MOVE W-RPT-BATCH TO MSRP-BATCH. DESBD422 01519 MOVE W-RPT-ITEM TO MSRP-ITEM. DESBD422 01520 IF W-YRQ = ZERO DESBD422 01521 MOVE X154-QUARTER TO MSRP-QTR DESBD422 01522 ELSE DESBD422 01523 MOVE W-SLASH-QTR TO MSRP-QTR DESBD422 01524 END-IF. DESBD422 01525 DESBD422 01526 IF L516-ANN-SCHED-88 DESBD422 01527 MOVE L516-FILING-SCHED-CD TO MSRP-FILING-SCHED DESBD422 01528 ELSE DESBD422 01529 MOVE SPACES TO MSRP-FILING-SCHED DESBD422 01530 END-IF. DESBD422 01531 DESBD422 01532 MOVE W-ESTB-DATE TO MSRP-DATE. DESBD422 01533 MOVE W-W4-TOT-WAGE TO MSRP-TOT-WAGE. DESBD422 01534 DESBD422 01535 EVALUATE TRUE DESBD422 01536 WHEN W-PARTIAL-XFER-YES-88 DESBD422 01537 SET MSRP-RSN-PART-XFER-88 TO TRUE DESBD422 01538 WHEN W-RPT-ITEM > ZERO DESBD422 01539 SET MSRP-RSN-RPT-DELETED-88 TO TRUE DESBD422 01540 WHEN W-EMP-FOUND-NO-88 DESBD422 01541 SET MSRP-RSN-NOT-FOUND-88 TO TRUE DESBD422 01542 WHEN W-EMP-LIABLE-NO-88 DESBD422 01543 SET MSRP-RSN-NOT-LIABLE-88 TO TRUE DESBD422 01544 WHEN W-VALID-QTR-NO-88 DESBD422 01545 SET MSRP-RSN-INVALID-QTR-88 TO TRUE DESBD422 01546 WHEN W-RPT-FOUND-NO-88 DESBD422 01547 SET MSRP-RSN-RPT-NOT-FOUND-88 TO TRUE DESBD422 01548 END-EVALUATE. DESBD422 01549 DESBD422 01550 WRITE MISSING-REPORT-REC FROM W-MISSING-RPT-REC. DESBD422 01551 DESBD422 01552 P2700-EXIT. DESBD422 01553 EXIT. DESBD422 01554 DESBD422 01555 P2800-WAGE-DIFF. DESBD422 01556 COMPUTE W-DIFF = (W-MRPT-TOT-WAGE - W-W4-TOT-WAGE). DESBD422 01557 IF W-DIFF < 0 DESBD422 01558 COMPUTE W-DIFF = W-DIFF * -1 DESBD422 01559 END-IF. DESBD422 01560 IF W-DIFF > W-WORKER-CNT DESBD422 01561 OR W-MRPT-RESP-OPID = 'MAG UC30' DESBD422 01562 PERFORM P2600-WAGE-ERROR THRU P2600-EXIT DESBD422 01563 END-IF. DESBD422 01564 DESBD422 01565 P2800-EXIT. DESBD422 01566 EXIT. DESBD422 01567 DESBD422 01568 P3000-PROCESS-WAGE. DESBD422 01569 MOVE X154-SSN TO WRK-SSN. DESBD422 01570 IF W-CURR-SSN = WRK-SSN DESBD422 01571 AND WRK-YRQ = X154-QUARTER DESBD422 01572 **NH CHANGES DESBD422 01573 ** AND W-YRQ = X154-QUARTER DESBD422 01574 **NH CHANGES DESBD422 01575 AND W-CURR-WAGES = X154-EARNINGS DESBD422 01576 ADD +1 TO W-DUP-SSN-CNT DESBD422 01577 DISPLAY 'DUP SSN: ' X154-SSN ' ' W-RPT-EMP-NO DESBD422 01578 ' ' W-YRQ ' ' X154-EARNINGS DESBD422 01579 GO TO P3000-EXIT DESBD422 01580 ELSE DESBD422 01581 **NH CHANGES DESBD422 01582 ** MOVE X154-QUARTER TO W-YRQ DESBD422 01583 **NH CHANGES DESBD422 01584 MOVE X154-QUARTER TO WRK-YRQ DESBD422 01585 MOVE WRK-SSN TO W-CURR-SSN DESBD422 01586 MOVE X154-EARNINGS TO W-CURR-WAGES DESBD422 01587 END-IF. DESBD422 01588 DESBD422 01589 ADD X154-EARNINGS TO W-W4-TOT-WAGE. DESBD422 01590 ADD +1 TO W-WORKER-CNT. DESBD422 01591 DESBD422 01592 IF WRK-SSN = 000000000 DESBD422 01593 OR WRK-SSN = 111111111 DESBD422 01594 OR WRK-SSN = 222222222 DESBD422 01595 OR WRK-SSN = 333333333 DESBD422 01596 OR WRK-SSN = 444444444 DESBD422 01597 OR WRK-SSN = 555555555 DESBD422 01598 OR WRK-SSN = 666666666 DESBD422 01599 OR WRK-SSN = 777777777 DESBD422 01600 OR WRK-SSN = 888888888 DESBD422 01601 OR WRK-SSN = 999999999 DESBD422 01602 PERFORM P3500-WRITE-X153 THRU P3500-EXIT DESBD422 01603 GO TO P3000-EXIT DESBD422 01604 END-IF. DESBD422 01605 DESBD422 01606 IF W-RPT-FOUND-NO-88 DESBD422 01607 PERFORM S1420-WRITE-PENDING THRU S1420-EXIT DESBD422 01608 ELSE DESBD422 01609 IF W-RPT-FOUND-ATC-88 DESBD422 01610 PERFORM P3400-WRITE-W001 THRU P3400-EXIT DESBD422 01611 ELSE DESBD422 01612 PERFORM P3300-WRITE-X148-W4FILE THRU P3300-EXIT DESBD422 01613 END-IF DESBD422 01614 END-IF. DESBD422 01615 DESBD422 01616 PERFORM P3100-UPDATE-NAME THRU P3100-EXIT. DESBD422 01617 DESBD422 01618 P3000-EXIT. DESBD422 01619 EXIT. DESBD422 01620 DESBD422 01621 P3100-UPDATE-NAME. DESBD422 01622 IF W-RPT-EMP-NO = 055673 DESBD422 01623 DISPLAY 'P3100 NAME ' W-RPT-EMP-NO ' ' DESBD422 01624 'XXX-XX-' WRK-SSN(6:4) DESBD422 01625 ' ' X154-LAST-NAME ' ' X154-FIRST-NAME. DESBD422 01626 DESBD422 01627 MOVE LOW-VALUE TO WNAM-REC. DESBD422 01628 MOVE WRK-SSN TO WNAM-SSN. DESBD422 01629 MOVE +0 TO DESBD422 01630 WNAM-NINES-COMPLEMENT-ABSTIME. DESBD422 01631 DESBD422 01632 PERFORM S982A-START-BROWSE THRU S982A-EXIT. DESBD422 01633 DESBD422 01634 IF NOT L982-OK-88 DESBD422 01635 PERFORM P3110-ADD-NAME THRU P3110-EXIT DESBD422 01636 GO TO P3100-EXIT DESBD422 01637 ELSE DESBD422 01638 IF WNAM-SSN = WRK-SSN DESBD422 01639 NEXT SENTENCE DESBD422 01640 ELSE DESBD422 01641 PERFORM P3110-ADD-NAME THRU P3110-EXIT DESBD422 01642 GO TO P3100-EXIT DESBD422 01643 END-IF DESBD422 01644 END-IF. DESBD422 01645 DESBD422 01646 IF WNAM-LAST-NAME = X154-LAST-NAME DESBD422 01647 AND WNAM-FIRST-NAME = X154-FIRST-NAME DESBD422 01648 ** DISPLAY 'NAME EQUAL ' WNAM-LAST-NAME ' ' WNAM-FIRST-NAME DESBD422 01649 ** ' ' X154-LAST-NAME ' ' X154-FIRST-NAME DESBD422 01650 GO TO P3100-EXIT DESBD422 01651 END-IF. DESBD422 01652 DESBD422 01653 IF WNAM-TYPE-3CHAR-88 DESBD422 01654 PERFORM P3120-REWRITE-NAME THRU P3120-EXIT DESBD422 01655 ELSE DESBD422 01656 PERFORM P3110-ADD-NAME THRU P3110-EXIT DESBD422 01657 END-IF. DESBD422 01658 DESBD422 01659 P3100-EXIT. DESBD422 01660 EXIT. DESBD422 01661 DESBD422 01662 P3110-ADD-NAME. DESBD422 01663 DESBD422 01664 IF W-RPT-EMP-NO = 055673 DESBD422 01665 DISPLAY 'ADD NAME P3110 ' W-RPT-EMP-NO DESBD422 01666 ' XXX-XX-' WRK-SSN(6:4). DESBD422 01667 DESBD422 01668 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD422 01669 ADD +1000 TO L005-ABSTIME. DESBD422 01670 PERFORM S005-ABSTIME THRU S005-EXIT. DESBD422 01671 MOVE L005-NINES-COMPLEMENT-ABSTIME DESBD422 01672 TO WNAM-NINES-COMPLEMENT-ABSTIME. DESBD422 01673 MOVE WRK-SSN TO WNAM-SSN. DESBD422 01674 MOVE X154-LAST-NAME TO WNAM-LAST-NAME. DESBD422 01675 MOVE X154-FIRST-NAME TO WNAM-FIRST-NAME. DESBD422 01676 MOVE SPACES TO WNAM-MID-INIT. DESBD422 01677 SET WNAM-TYPE-FULL-88 TO TRUE. DESBD422 01678 PERFORM S982C-WRITE THRU S982C-EXIT. DESBD422 01679 ** DISPLAY ' REC ADDED ' WRK-SSN ' ' X154-LAST-NAME ' ' DESBD422 01680 ** X154-FIRST-NAME. DESBD422 01681 ADD +1 TO WRK-WNAM-CNT. DESBD422 01682 DESBD422 01683 P3110-EXIT. DESBD422 01684 EXIT. DESBD422 01685 DESBD422 01686 P3120-REWRITE-NAME. DESBD422 01687 *& DESBD422 01688 IF W-RPT-EMP-NO = 055673 DESBD422 01689 DISPLAY 'UPD NAME P3120 XXX-XX-' WRK-SSN(6:4) DESBD422 01690 ' ' X154-LAST-NAME ' ' X154-FIRST-NAME. DESBD422 01691 *& DESBD422 01692 MOVE X154-LAST-NAME TO WNAM-LAST-NAME. DESBD422 01693 MOVE X154-FIRST-NAME TO WNAM-FIRST-NAME. DESBD422 01694 MOVE SPACES TO WNAM-MID-INIT. DESBD422 01695 SET WNAM-TYPE-FULL-88 TO TRUE. DESBD422 01696 DESBD422 01697 PERFORM S982D-REWRITE THRU S982D-EXIT. DESBD422 01698 DESBD422 01699 ** DISPLAY ' REC UPDT ' WRK-SSN ' ' X154-LAST-NAME ' ' DESBD422 01700 ** X154-FIRST-NAME. DESBD422 01701 ADD +1 TO WRK-WNAM-CNT. DESBD422 01702 DESBD422 01703 P3120-EXIT. DESBD422 01704 EXIT. DESBD422 01705 DESBD422 01706 DESBD422 01707 P3300-WRITE-X148-W4FILE. DESBD422 01708 *& DESBD422 01709 * DISPLAY 'P33 ' W-RPT-EMP-NO ' ' W-YRQ ' ' X154-SSN DESBD422 01710 * ' ' W-RPT-BATCH ' ' W-RPT-ITEM. DESBD422 01711 *& DESBD422 01712 DESBD422 01713 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. DESBD422 01714 MOVE WRK-SSN TO W4-SSN. DESBD422 01715 MOVE W-RPT-EMP-NO TO W4-ACCOUNT. DESBD422 01716 MOVE X154-EMP-NAME TO W4-EMP-NAME. DESBD422 01717 MOVE W-YRQ TO W4-QUARTER. DESBD422 01718 MOVE 'W4' TO W4-TRAN-ID. DESBD422 01719 MOVE '2' TO W4-AFFI-CODE. DESBD422 01720 MOVE 'XXX' TO W4-NAME-CHECK. DESBD422 01721 MOVE X154-EARNINGS TO W4-QUARTER-EARNINGS. DESBD422 01722 MOVE L001-FED-8-DATE-X TO W4-DATE-ENTERED. DESBD422 01723 MOVE 0 TO W4-TIME-ENTERED. DESBD422 01724 MOVE '00062999' TO W4-TRAN-OPER-ID. DESBD422 01725 DESBD422 01726 PERFORM S1320-WRITE-X148-W4WAGE THRU S1320-EXIT. DESBD422 01727 DESBD422 01728 P3300-EXIT. DESBD422 01729 EXIT. DESBD422 01730 DESBD422 01731 P3400-WRITE-W001. DESBD422 01732 *& DESBD422 01733 * DISPLAY 'P34 ' W-RPT-EMP-NO ' ' W-YRQ ' ' X154-SSN DESBD422 01734 * ' ' W-RPT-BATCH ' ' W-RPT-ITEM . DESBD422 01735 *& DESBD422 01736 MOVE W-RPT-BATCH TO W001-BATCH-NO. DESBD422 01737 MOVE W-RPT-ITEM TO W001-ITEM-NO. DESBD422 01738 ADD 1 TO W-SEQ-NO. DESBD422 01739 MOVE W-SEQ-NO TO W001-SEQ-NO. DESBD422 01740 MOVE W-RPT-EMP-NO TO W001-EMP-NO. DESBD422 01741 MOVE WRK-SSN TO W001-SSN. DESBD422 01742 ** DISPLAY ' TDEC SSN ' X154-SSN. DESBD422 01743 ** DISPLAY ' WRK SSN ' WRK-SSN. DESBD422 01744 ** DISPLAY ' W001 SSN ' W001-SSN. DESBD422 01745 SET W001-SSN-VALID-88 TO TRUE. DESBD422 01746 MOVE X154-FIRST-NAME TO W001-FIRST-NAME DESBD422 01747 MOVE SPACES TO W001-MID-INIT DESBD422 01748 MOVE X154-LAST-NAME TO W001-LAST-NAME. DESBD422 01749 MOVE W-YRQ TO W001-YRQ. DESBD422 01750 MOVE X154-EARNINGS TO W001-WAGE-CHNG. DESBD422 01751 MOVE ZERO TO W001-TAX-WAGE. DESBD422 01752 SET W001-WAGE-VALID-88 TO TRUE. DESBD422 01753 MOVE ZERO TO W001-CURR-WAGE DESBD422 01754 W001-PRIOR-WAGE. DESBD422 01755 MOVE W-ESTB-DATE TO W001-RECEIVED-DATE. DESBD422 01756 MOVE ZERO TO W001-RECEIVED-TIME. DESBD422 01757 MOVE SPACES TO W001-RESPONSIBLE-OP-ID. DESBD422 01758 SET W001-PAPER-RPT-88 TO TRUE. DESBD422 01759 DESBD422 01760 PERFORM S1520-WRITE-W001-WAGE THRU S1520-EXIT. DESBD422 01761 DESBD422 01762 P3400-EXIT. DESBD422 01763 EXIT. DESBD422 01764 DESBD422 01765 P3500-WRITE-X153. DESBD422 01766 MOVE W-RPT-BATCH TO X153-BATCH. DESBD422 01767 MOVE W-RPT-ITEM TO X153-ITEM. DESBD422 01768 MOVE W-RPT-EMP-NO TO X153-EMP-NO. DESBD422 01769 MOVE W-SLASH-QTR TO X153-QUARTER. DESBD422 01770 MOVE X154-EARNINGS TO X153-EARNINGS. DESBD422 01771 MOVE X154-LAST-NAME TO X153-LAST-NAME. DESBD422 01772 MOVE X154-FIRST-NAME TO X153-FIRST-NAME. DESBD422 01773 MOVE W-ESTB-DATE TO X153-DATE. DESBD422 01774 SET X153-PAPER-RPT-88 TO TRUE. DESBD422 01775 DESBD422 01776 PERFORM S1521-WRITE-X153-WAGE THRU S1521-EXIT. DESBD422 01777 DESBD422 01778 P3500-EXIT. DESBD422 01779 EXIT. DESBD422 01780 DESBD422 01781 *P4000-BANK-BATCH. DESBD422 01782 * MOVE +0 TO ASKL-BATCH-NO DESBD422 01783 * ASKL-ITEM-NO. DESBD422 01784 * DESBD422 01785 * PERFORM S923B-START-BROWSE THRU S923B-EXIT. DESBD422 01786 * DESBD422 01787 * PERFORM UNTIL L923-NO-REC-88 DESBD422 01788 * IF ASKL-HDR-88 DESBD422 01789 * MOVE ASKL-REC TO AHDR-REC DESBD422 01790 * DISPLAY 'P4000 ' AHDR-BATCH-NO ' ' AHDR-BANK-BATCH-NO DESBD422 01791 * IF AHDR-BANK-BATCH-NO = X154-BATCH DESBD422 01792 * DISPLAY 'P4000 ' AHDR-BATCH-NO DESBD422 01793 * ' ' AHDR-ITEM-NO ' ' AHDR-BANK-BATCH-NO DESBD422 01794 * MOVE AHDR-BATCH-NO TO X154-BATCH DESBD422 01795 * SET L923-NO-REC-88 TO TRUE DESBD422 01796 * END-IF DESBD422 01797 * END-IF DESBD422 01798 * IF NOT L923-NO-REC-88 DESBD422 01799 * PERFORM S923C-READ-NEXT THRU S923C-EXIT DESBD422 01800 * END-IF DESBD422 01801 * DESBD422 01802 * END-PERFORM. DESBD422 01803 * DESBD422 01804 *P4000-EXIT. DESBD422 01805 * EXIT. DESBD422 01806 DESBD422 01807 T0000-TERMINATE. DESBD422 01808 DESBD422 01809 DISPLAY ' '. DESBD422 01810 DISPLAY ' '. DESBD422 01811 DESBD422 01812 DISPLAY '*** DESBD422 TERMINATION STATISTICS ***'. DESBD422 01813 DESBD422 01814 DISPLAY ' '. DESBD422 01815 DESBD422 01816 DISPLAY ' '. DESBD422 01817 DISPLAY 'TDEC RECORDS READ : 'DESBD422 01818 W-TDEC-IN-CNT. DESBD422 01819 MOVE W-TDEC-IN-CNT TO WC-REC-IN-CNT. DESBD422 01820 WRITE RECORD-COUNT-REC FROM WC-REC-IN. DESBD422 01821 DESBD422 01822 MOVE W-REPORT-CNT TO WC-TOT-RPTS-CNT DESBD422 01823 DISPLAY ' '. DESBD422 01824 DISPLAY 'X148 RECORDS WRITTEN - W4 : 'DESBD422 01825 W-X148-CNT. DESBD422 01826 DESBD422 01827 DISPLAY ' '. DESBD422 01828 DISPLAY 'W001 RECORDS WRITTEN : 'DESBD422 01829 W-W001-CNT. DESBD422 01830 DESBD422 01831 COMPUTE WC-X148-CNT = W-X148-CNT + W-W001-CNT. DESBD422 01832 WRITE RECORD-COUNT-REC FROM WC-X148. DESBD422 01833 DESBD422 01834 DISPLAY ' '. DESBD422 01835 DISPLAY 'PENDING RECORDS WRITTEN : 'DESBD422 01836 W-PENDING-CNT. DESBD422 01837 MOVE W-PENDING-CNT TO WC-HELD-CNT. DESBD422 01838 WRITE RECORD-COUNT-REC FROM WC-WAGES-HELD. DESBD422 01839 DESBD422 01840 DISPLAY '*******************************************'. DESBD422 01841 DISPLAY ' '. DESBD422 01842 DISPLAY 'TOTAL REPORTS : 'DESBD422 01843 W-REPORT-CNT. DESBD422 01844 MOVE W-REPORT-CNT TO WC-TOT-RPTS-CNT DESBD422 01845 WRITE RECORD-COUNT-REC FROM WC-TOT-RPTS. DESBD422 01846 DESBD422 01847 DISPLAY ' '. DESBD422 01848 DISPLAY 'REPORTS FOUND : 'DESBD422 01849 W-RPT-FOUND-CNT. DESBD422 01850 MOVE W-RPT-FOUND-CNT TO WC-RPTS-FOUND-CNT. DESBD422 01851 WRITE RECORD-COUNT-REC FROM WC-RPTS-FOUND. DESBD422 01852 DESBD422 01853 DISPLAY ' '. DESBD422 01854 DISPLAY 'REPORTS ALREADY POSTED : 'DESBD422 01855 W-MRPT-FOUND-CNT. DESBD422 01856 MOVE W-MRPT-FOUND-CNT TO WC-MRPT-FOUND-CNT. DESBD422 01857 WRITE RECORD-COUNT-REC FROM WC-MRPT-FOUND. DESBD422 01858 DESBD422 01859 DISPLAY ' '. DESBD422 01860 DISPLAY 'FOUND IN ATC FILE : 'DESBD422 01861 W-FOUND-IN-ATC-CNT. DESBD422 01862 MOVE W-FOUND-IN-ATC-CNT TO WC-ATC-FOUND-CNT. DESBD422 01863 WRITE RECORD-COUNT-REC FROM WC-ATC-FOUND. DESBD422 01864 DESBD422 01865 DISPLAY ' '. DESBD422 01866 DISPLAY 'REPORTS PROBABLY DELETED : 'DESBD422 01867 W-RPT-DELETED-CNT. DESBD422 01868 MOVE W-RPT-DELETED-CNT TO WC-RPT-DELETED-CNT. DESBD422 01869 WRITE RECORD-COUNT-REC FROM WC-RPT-DELETED. DESBD422 01870 DESBD422 01871 DISPLAY ' '. DESBD422 01872 DISPLAY 'REPORTS MISSING : 'DESBD422 01873 W-RPT-MISSING-CNT ' ' W-PENDING-CNT. DESBD422 01874 MOVE W-RPT-MISSING-CNT TO WC-RPT-MISSING-CNT. DESBD422 01875 WRITE RECORD-COUNT-REC FROM WC-RPT-MISSING. DESBD422 01876 DESBD422 01877 DISPLAY '*********************************************'. DESBD422 01878 DISPLAY ' '. DESBD422 01879 DISPLAY 'EMPLOYER NUMBERS CHANGED : 'DESBD422 01880 W-EMP-NBR-CHNG-CNT. DESBD422 01881 MOVE W-EMP-NBR-CHNG-CNT TO WC-EMP-CHANGED-CNT. DESBD422 01882 WRITE RECORD-COUNT-REC FROM WC-EMP-CHANGED. DESBD422 01883 DESBD422 01884 DISPLAY ' '. DESBD422 01885 DISPLAY 'EMPLOYER NOT FOUND : 'DESBD422 01886 W-EMP-MISSING-CNT. DESBD422 01887 MOVE W-EMP-MISSING-CNT TO WC-NO-EMP-CNT. DESBD422 01888 WRITE RECORD-COUNT-REC FROM WC-NO-EMP. DESBD422 01889 DESBD422 01890 DISPLAY ' '. DESBD422 01891 DISPLAY 'EMPLOYER NOT LIABLE : 'DESBD422 01892 W-NOT-LIABLE-CNT. DESBD422 01893 MOVE W-NOT-LIABLE-CNT TO WC-NOT-LIABLE-CNT. DESBD422 01894 WRITE RECORD-COUNT-REC FROM WC-NOT-LIABLE. DESBD422 01895 DESBD422 01896 DISPLAY ' '. DESBD422 01897 DISPLAY 'INVALID QUARTERS : 'DESBD422 01898 W-INVALID-QTR-CNT. DESBD422 01899 MOVE W-INVALID-QTR-CNT TO WC-INVALID-QTR-CNT. DESBD422 01900 WRITE RECORD-COUNT-REC FROM WC-INVALID-QTR. DESBD422 01901 DESBD422 01902 DISPLAY ' '. DESBD422 01903 DISPLAY 'WAGE DISCREPANCIES : 'DESBD422 01904 W-WAGE-MISMATCH-CNT DESBD422 01905 MOVE W-WAGE-MISMATCH-CNT TO WC-WAGE-DIFF-CNT. DESBD422 01906 WRITE RECORD-COUNT-REC FROM WC-WAGE-DIFF. DESBD422 01907 DESBD422 01908 DISPLAY ' '. DESBD422 01909 DISPLAY 'BAD SSNS WRITTEN TO X153 FILE : 'DESBD422 01910 W-X153-CNT. DESBD422 01911 * MOVE W-DUP-SSN-CNT TO WC-DUP-SSN-CNT. DESBD422 01912 * WRITE RECORD-COUNT-REC FROM WC-DUP-SSN. DESBD422 01913 DESBD422 01914 DISPLAY ' '. DESBD422 01915 DISPLAY 'DUPLICATE SSNS : 'DESBD422 01916 W-DUP-SSN-CNT. DESBD422 01917 MOVE W-DUP-SSN-CNT TO WC-DUP-SSN-CNT. DESBD422 01918 WRITE RECORD-COUNT-REC FROM WC-DUP-SSN. DESBD422 01919 DESBD422 01920 DESBD422 01921 PERFORM S1020-CLOSE-TDEC-IN THRU S1020-EXIT. DESBD422 01922 ** PERFORM S1230-CLOSE-TDEC-OUT THRU S1230-EXIT. DESBD422 01923 PERFORM S1330-CLOSE-X148-W4FILE THRU S1330-EXIT. DESBD422 01924 PERFORM S1430-CLOSE-PENDING-FILE THRU S1430-EXIT. DESBD422 01925 PERFORM S1530-CLOSE-W001-WAGE THRU S1530-EXIT. DESBD422 01926 PERFORM S1531-CLOSE-X153-WAGE THRU S1531-EXIT. DESBD422 01927 DESBD422 01928 CLOSE WWG2-FILE DESBD422 01929 WITM-FILE DESBD422 01930 MISSING-REPORT DESBD422 01931 WAGE-ERRORS DESBD422 01932 RECORD-COUNTS. DESBD422 01933 DESBD422 01934 PERFORM S910C-CLOSE THRU S910C-EXIT. DESBD422 01935 PERFORM S921-CLOSE THRU S921-EXIT. DESBD422 01936 PERFORM S923E-CLOSE THRU S923E-EXIT. DESBD422 01937 PERFORM S981C-CLOSE THRU S981C-EXIT. DESBD422 01938 PERFORM S982F-CLOSE THRU S982F-EXIT. DESBD422 01939 PERFORM S931-CLOSE THRU S931-EXIT. DESBD422 01940 DESBD422 01941 T0000-EXIT. DESBD422 01942 EXIT. DESBD422 01943 DESBD422 01944 S001-FROM-FED-8. DESBD422 01945 SET L001-FROM-FED-8 TO TRUE. DESBD422 01946 GO TO S001-DATE. DESBD422 01947 DESBD422 01948 S001-FROM-CAL-8. DESBD422 01949 SET L001-FROM-CAL-8 TO TRUE. DESBD422 01950 GO TO S001-DATE. DESBD422 01951 DESBD422 01952 S001-FROM-ABS-DAY. DESBD422 01953 SET L001-FROM-ABS-DAY TO TRUE. DESBD422 01954 GO TO S001-DATE. DESBD422 01955 DESBD422 01956 S001-DATE. DESBD422 01957 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD422 01958 S001-EXIT. DESBD422 01959 EXIT. DESBD422 01960 DESBD422 01961 S004-FROM-DATE. DESBD422 01962 SET L004-FROM-DATE TO TRUE. DESBD422 01963 GO TO S004-QTR. DESBD422 01964 DESBD422 01965 S004-FROM-5. DESBD422 01966 SET L004-FROM-5 TO TRUE. DESBD422 01967 GO TO S004-QTR. DESBD422 01968 DESBD422 01969 S004-FROM-ABS. DESBD422 01970 SET L004-FROM-ABS TO TRUE. DESBD422 01971 GO TO S004-QTR. DESBD422 01972 DESBD422 01973 S004-FROM-3. DESBD422 01974 SET L004-FROM-3 TO TRUE. DESBD422 01975 GO TO S004-QTR. DESBD422 01976 DESBD422 01977 S004-QTR. DESBD422 01978 CALL 'DTSBU004' USING L004-LINK-AREA. DESBD422 01979 S004-EXIT. DESBD422 01980 DESBD422 01981 S005-FROM-SYS. DESBD422 01982 SET L005-FROM-SYS TO TRUE. DESBD422 01983 GO TO S005-ABSTIME. DESBD422 01984 DESBD422 01985 S005-ABSTIME. DESBD422 01986 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD422 01987 S005-EXIT. DESBD422 01988 EXIT. DESBD422 01989 DESBD422 01990 S516-LIABILITY-INFO. DESBD422 01991 CALL 'DTSBU516' USING L516-LINK-AREA DESBD422 01992 MPRF-REC. DESBD422 01993 S516-EXIT. DESBD422 01994 EXIT. DESBD422 01995 DESBD422 01996 S601-CALL-BU601. DESBD422 01997 CALL 'DTSBU601' USING L601-LINK-AREA. DESBD422 01998 S601-EXIT. DESBD422 01999 EXIT. DESBD422 02000 DESBD422 02001 S910A-OPEN-READ. DESBD422 02002 SET L910-OPEN-READ-88 TO TRUE. DESBD422 02003 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD422 02004 DESBD422 02005 S910A-EXIT. DESBD422 02006 EXIT. DESBD422 02007 DESBD422 02008 S910C-CLOSE. DESBD422 02009 SET L910-CLOSE-88 TO TRUE. DESBD422 02010 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD422 02011 DESBD422 02012 S910C-EXIT. DESBD422 02013 EXIT. DESBD422 02014 DESBD422 02015 S910D-START-BROWSE. DESBD422 02016 SET L910-START-BROWSE-88 TO TRUE. DESBD422 02017 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD422 02018 DESBD422 02019 S910D-EXIT. DESBD422 02020 EXIT. DESBD422 02021 DESBD422 02022 S910E-READ-NEXT. DESBD422 02023 SET L910-READ-NEXT-88 TO TRUE. DESBD422 02024 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD422 02025 DESBD422 02026 S910E-EXIT. DESBD422 02027 EXIT. DESBD422 02028 DESBD422 02029 S910F-READ. DESBD422 02030 SET L910-READ-88 TO TRUE. DESBD422 02031 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD422 02032 DESBD422 02033 S910F-EXIT. DESBD422 02034 EXIT. DESBD422 02035 DESBD422 02036 S910Z-MSTR-I. DESBD422 02037 CALL 'DTSBU910' USING L910-LINK-AREA DESBD422 02038 MSKL-REC. DESBD422 02039 S910Z-EXIT. DESBD422 02040 EXIT. DESBD422 02041 DESBD422 02042 S921-OPEN-READ. DESBD422 02043 SET L921-OPEN-READ-88 TO TRUE. DESBD422 02044 GO TO S921-AIX-IO. DESBD422 02045 DESBD422 02046 S921-READ. DESBD422 02047 SET L921-READ-88 TO TRUE. DESBD422 02048 GO TO S921-AIX-IO. DESBD422 02049 DESBD422 02050 S921-START-BROWSE. DESBD422 02051 SET L921-START-BROWSE-88 TO TRUE. DESBD422 02052 GO TO S921-AIX-IO. DESBD422 02053 DESBD422 02054 S921-READ-NEXT. DESBD422 02055 SET L921-READ-NEXT-88 TO TRUE. DESBD422 02056 GO TO S921-AIX-IO. DESBD422 02057 DESBD422 02058 S921-CLOSE. DESBD422 02059 SET L921-CLOSE-88 TO TRUE. DESBD422 02060 GO TO S921-AIX-IO. DESBD422 02061 DESBD422 02062 S921-AIX-IO. DESBD422 02063 CALL 'DTSBU921' USING L921-LINK-AREA DESBD422 02064 ISKL-REC. DESBD422 02065 S921-EXIT. DESBD422 02066 EXIT. DESBD422 02067 DESBD422 02068 S923A-OPEN-READ. DESBD422 02069 SET L923-OPEN-READ-88 TO TRUE. DESBD422 02070 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD422 02071 DESBD422 02072 S923A-EXIT. DESBD422 02073 EXIT. DESBD422 02074 DESBD422 02075 S923B-START-BROWSE. DESBD422 02076 SET L923-START-BROWSE-88 TO TRUE. DESBD422 02077 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD422 02078 DESBD422 02079 S923B-EXIT. DESBD422 02080 EXIT. DESBD422 02081 DESBD422 02082 S923C-READ-NEXT. DESBD422 02083 SET L923-READ-NEXT-88 TO TRUE. DESBD422 02084 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD422 02085 DESBD422 02086 S923C-EXIT. DESBD422 02087 EXIT. DESBD422 02088 DESBD422 02089 S923D-READ. DESBD422 02090 SET L923-READ-88 TO TRUE. DESBD422 02091 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD422 02092 DESBD422 02093 S923D-EXIT. DESBD422 02094 EXIT. DESBD422 02095 DESBD422 02096 S923E-CLOSE. DESBD422 02097 SET L923-CLOSE-88 TO TRUE. DESBD422 02098 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD422 02099 DESBD422 02100 S923E-EXIT. DESBD422 02101 EXIT. DESBD422 02102 DESBD422 02103 DESBD422 02104 S923Z-ATC-IO. DESBD422 02105 CALL 'DTSBU923' USING L923-LINK-AREA DESBD422 02106 ASKL-REC. DESBD422 02107 S923Z-EXIT. DESBD422 02108 EXIT. DESBD422 02109 DESBD422 02110 S931-OPEN-READ. DESBD422 02111 SET L931-OPEN-READ-88 TO TRUE. DESBD422 02112 GO TO S931-REF-IO. DESBD422 02113 DESBD422 02114 S931-CLOSE. DESBD422 02115 SET L931-CLOSE-88 TO TRUE. DESBD422 02116 GO TO S931-REF-IO. DESBD422 02117 DESBD422 02118 S931-REF-IO. DESBD422 02119 CALL 'DTSBU931' USING L931-LINK-AREA DESBD422 02120 FSKL-REC. DESBD422 02121 S931-EXIT. DESBD422 02122 EXIT. DESBD422 02123 DESBD422 02124 S981A-OPEN-READ. DESBD422 02125 SET L981-OPEN-READ-88 TO TRUE. DESBD422 02126 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD422 02127 DESBD422 02128 S981A-EXIT. DESBD422 02129 EXIT. DESBD422 02130 DESBD422 02131 S981C-CLOSE. DESBD422 02132 SET L981-CLOSE-88 TO TRUE. DESBD422 02133 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD422 02134 DESBD422 02135 S981C-EXIT. DESBD422 02136 EXIT. DESBD422 02137 DESBD422 02138 S981D-START-BROWSE. DESBD422 02139 SET L981-START-BROWSE-88 TO TRUE. DESBD422 02140 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD422 02141 DESBD422 02142 S981D-EXIT. DESBD422 02143 EXIT. DESBD422 02144 DESBD422 02145 S981E-READ-NEXT. DESBD422 02146 SET L981-READ-NEXT-88 TO TRUE. DESBD422 02147 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD422 02148 DESBD422 02149 S981E-EXIT. DESBD422 02150 EXIT. DESBD422 02151 DESBD422 02152 S981F-READ. DESBD422 02153 SET L981-READ-88 TO TRUE. DESBD422 02154 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD422 02155 DESBD422 02156 S981F-EXIT. DESBD422 02157 EXIT. DESBD422 02158 DESBD422 02159 S981Z-WAGE-I. DESBD422 02160 CALL 'DTSBU981' USING L981-LINK-AREA DESBD422 02161 WWGH-REC. DESBD422 02162 S981Z-EXIT. DESBD422 02163 EXIT. DESBD422 02164 S982O-OPEN-UPDATE. DESBD422 02165 SET L982-OPEN-UPDATE-88 TO TRUE. DESBD422 02166 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD422 02167 DESBD422 02168 S982O-EXIT. DESBD422 02169 EXIT. DESBD422 02170 DESBD422 02171 S982A-START-BROWSE. DESBD422 02172 SET L982-START-BROWSE-88 TO TRUE. DESBD422 02173 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD422 02174 DESBD422 02175 S982A-EXIT. DESBD422 02176 EXIT. DESBD422 02177 DESBD422 02178 S982B-READ-NEXT. DESBD422 02179 SET L982-READ-NEXT-88 TO TRUE. DESBD422 02180 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD422 02181 DESBD422 02182 S982B-EXIT. DESBD422 02183 EXIT. DESBD422 02184 S982C-WRITE. DESBD422 02185 SET L982-WRITE-88 TO TRUE. DESBD422 02186 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD422 02187 DESBD422 02188 S982C-EXIT. DESBD422 02189 EXIT. DESBD422 02190 DESBD422 02191 S982D-REWRITE. DESBD422 02192 SET L982-REWRITE-88 TO TRUE. DESBD422 02193 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD422 02194 DESBD422 02195 S982D-EXIT. DESBD422 02196 EXIT. DESBD422 02197 S982F-CLOSE. DESBD422 02198 SET L982-CLOSE-88 TO TRUE. DESBD422 02199 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD422 02200 DESBD422 02201 S982F-EXIT. DESBD422 02202 EXIT. DESBD422 02203 DESBD422 02204 S982Z-WNAM-IO. DESBD422 02205 CALL 'DTSBU982' USING L982-LINK-AREA DESBD422 02206 WNAM-REC. DESBD422 02207 S982Z-EXIT. DESBD422 02208 EXIT. DESBD422 02209 DESBD422 02210 S1000-OPEN-TDEC-IN. DESBD422 02211 OPEN INPUT TDEC-TRAN-IN DESBD422 02212 IF NOT TDEC-IN-OK-88 DESBD422 02213 DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS DESBD422 02214 SET W-ERROR-YES-88 TO TRUE DESBD422 02215 END-IF. DESBD422 02216 DESBD422 02217 S1000-EXIT. DESBD422 02218 EXIT. DESBD422 02219 DESBD422 02220 S1010-READ-TDEC-IN. DESBD422 02221 * READ TDEC-TRAN-IN INTO ESP-TRANSACTION-AREA. DESBD422 02222 READ TDEC-TRAN-IN. DESBD422 02223 IF TDEC-IN-OK-88 DESBD422 02224 ADD +1 TO W-TDEC-IN-CNT DESBD422 02225 ELSE DESBD422 02226 IF TDEC-IN-EOF-88 DESBD422 02227 DISPLAY 'EOF' DESBD422 02228 ELSE DESBD422 02229 DISPLAY 'CANNOT READ TDEC INPUT ' TDEC-IN-STATUS DESBD422 02230 END-IF DESBD422 02231 END-IF. DESBD422 02232 DESBD422 02233 S1010-EXIT. DESBD422 02234 EXIT. DESBD422 02235 DESBD422 02236 S1020-CLOSE-TDEC-IN. DESBD422 02237 CLOSE TDEC-TRAN-IN. DESBD422 02238 DESBD422 02239 S1020-EXIT. DESBD422 02240 EXIT. DESBD422 02241 DESBD422 02242 S1300-OPEN-X148-W4FILE. DESBD422 02243 OPEN OUTPUT WAGE-X148-W4FILE. DESBD422 02244 IF NOT WAGE-X148-OK-88 DESBD422 02245 DISPLAY 'CANNOT OPEN X148 W4FILE ' WAGE-X148-STATUS DESBD422 02246 SET W-ERROR-YES-88 TO TRUE DESBD422 02247 END-IF. DESBD422 02248 DESBD422 02249 S1300-EXIT. DESBD422 02250 EXIT. DESBD422 02251 DESBD422 02252 S1320-WRITE-X148-W4WAGE. DESBD422 02253 MOVE ESP-TRANSACTION-AREA TO WAGE-X148-W4REC. DESBD422 02254 DESBD422 02255 WRITE WAGE-X148-W4REC. DESBD422 02256 DESBD422 02257 IF WAGE-X148-OK-88 DESBD422 02258 NEXT SENTENCE DESBD422 02259 ELSE DESBD422 02260 PERFORM S999-ABEND THRU S999-EXIT. DESBD422 02261 ADD +1 TO W-X148-CNT. DESBD422 02262 DESBD422 02263 S1320-EXIT. DESBD422 02264 EXIT. DESBD422 02265 DESBD422 02266 S1330-CLOSE-X148-W4FILE. DESBD422 02267 CLOSE WAGE-X148-W4FILE. DESBD422 02268 DESBD422 02269 S1330-EXIT. DESBD422 02270 EXIT. DESBD422 02271 DESBD422 02272 S1400-OPEN-PENDING-FILE. DESBD422 02273 OPEN OUTPUT PENDING-FILE. DESBD422 02274 IF NOT PENDING-OK-88 DESBD422 02275 DISPLAY 'CANNOT OPEN PENDING FILE ' PENDING-STATUS DESBD422 02276 SET W-ERROR-YES-88 TO TRUE DESBD422 02277 END-IF. DESBD422 02278 DESBD422 02279 S1400-EXIT. DESBD422 02280 EXIT. DESBD422 02281 DESBD422 02282 S1420-WRITE-PENDING. DESBD422 02283 IF X154-PEND-DATE > SPACES DESBD422 02284 NEXT SENTENCE DESBD422 02285 ELSE DESBD422 02286 MOVE WRK-PEND-DATE TO X154-PEND-DATE. DESBD422 02287 WRITE PENDING-REC FROM TDEC-TRAN-IN-REC. DESBD422 02288 IF NOT PENDING-OK-88 DESBD422 02289 DISPLAY 'CANNOT WRITE PENDING ' PENDING-STATUS DESBD422 02290 SET W-ERROR-YES-88 TO TRUE DESBD422 02291 ELSE DESBD422 02292 ADD +1 TO W-PENDING-CNT DESBD422 02293 END-IF. DESBD422 02294 DESBD422 02295 S1420-EXIT. DESBD422 02296 EXIT. DESBD422 02297 DESBD422 02298 S1430-CLOSE-PENDING-FILE. DESBD422 02299 CLOSE PENDING-FILE. DESBD422 02300 DESBD422 02301 S1430-EXIT. DESBD422 02302 EXIT. DESBD422 02303 DESBD422 02304 S1500-OPEN-W001-WAGE. DESBD422 02305 OPEN OUTPUT WAGE-W001-FILE. DESBD422 02306 IF NOT WAGE-W001-OK-88 DESBD422 02307 DISPLAY 'CANNOT OPEN W001 WAGE ' WAGE-W001-STATUS DESBD422 02308 SET W-ERROR-YES-88 TO TRUE DESBD422 02309 END-IF. DESBD422 02310 DESBD422 02311 S1500-EXIT. DESBD422 02312 EXIT. DESBD422 02313 DESBD422 02314 S1520-WRITE-W001-WAGE. DESBD422 02315 WRITE WAGE-W001-REC FROM W-W001-REC. DESBD422 02316 IF NOT WAGE-W001-OK-88 DESBD422 02317 DISPLAY 'CANNOT WRITE W001 WAGE ' WAGE-W001-STATUS DESBD422 02318 SET W-ERROR-YES-88 TO TRUE DESBD422 02319 ELSE DESBD422 02320 ADD +1 TO W-W001-CNT DESBD422 02321 END-IF. DESBD422 02322 DESBD422 02323 S1520-EXIT. DESBD422 02324 EXIT. DESBD422 02325 DESBD422 02326 S1521-WRITE-X153-WAGE. DESBD422 02327 WRITE WAGE-X153-REC FROM WRK-X153-REC. DESBD422 02328 IF NOT WAGE-X153-FILE-OK-88 DESBD422 02329 DISPLAY 'CANNOT WRITE X153 WAGE ' WAGE-X153-STATUS DESBD422 02330 SET W-ERROR-YES-88 TO TRUE DESBD422 02331 ELSE DESBD422 02332 ADD +1 TO W-X153-CNT DESBD422 02333 END-IF. DESBD422 02334 DESBD422 02335 S1521-EXIT. DESBD422 02336 EXIT. DESBD422 02337 DESBD422 02338 S1530-CLOSE-W001-WAGE. DESBD422 02339 CLOSE WAGE-W001-FILE. DESBD422 02340 DESBD422 02341 S1530-EXIT. DESBD422 02342 EXIT. DESBD422 02343 DESBD422 02344 S1531-CLOSE-X153-WAGE. DESBD422 02345 CLOSE WAGE-X153-FILE. DESBD422 02346 DESBD422 02347 S1531-EXIT. DESBD422 02348 EXIT. DESBD422 02349 S999-ABEND. DESBD422 02350 DISPLAY '*** I/O MODULE ABENDING'. DESBD422 02351 DESBD422 02352 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD422 02353 S999-EXIT. DESBD422 02354 EXIT. DESBD422