00001 IDENTIFICATION DIVISION. 07/03/24 00002 PROGRAM-ID. DTSZX551. DTSZX551 00003 AUTHOR. NGC. LV024 00004 DATE-WRITTEN. APRIL 2005. DTSZX551 00005 DATE-COMPILED. DTSZX551 00006 SKIP3 DTSZX551 00007 ***** DTSZX551 00008 * DTSZX551 00009 * >>> PROCESSING FOR WEB REPORTS AND WAGES FOR AMENDED REPORTS CL*17 00010 * >>> MODIFIED TO CREATE BATCH AND ITEM NUMBERS. THEY DTSZX551 00011 * >>> WILL EITHER BE GROUPED INTO ACCOUNTING BATCHES DTSZX551 00012 * >>> IN THE WEB APPLICATION, OR CONTINUE TO GO THROUGH DTSZX551 00013 * >>> DTSBD140. MOVED AMENDMENT SEQ NUMBER TO T28 LOG NO FOR CL*17 00014 * >>> CORRECT SORT PROCESSING. CL*17 00015 * CL*17 00016 * FUNCTION: EDIT REPORT DATA FROM WEB APPLICATION. DTSZX551 00017 * DTSZX551 00018 * MODIFICATION HISTORY: DTSZX551 00019 * DTSZX551 00020 * 04-05-2005 INITIAL DEVELOPMENT DTSZX551 00021 * REFERENCE RFP: WEB REPORTING DTSZX551 00022 * DTSZX551 00023 * 10-21-2008 MODIFIED FOR NEW VERSION OF DTSIX144. DTSZX551 00024 * NEW RECORD INCLUDES EMPLOYEE NAME. DTSZX551 00025 * REFERENCE RFP: WEB REPORTING. DTSZX551 00026 * DTSZX551 00027 * DTSZX551 00028 * 10-21-2009 MODIFIED TO SEPARATE REPORT PROCESSING FROM DTSZX551 00029 * NEW WAGE-ONLY PROCESSING. P5000 CHANGED TO DTSZX551 00030 * DETERMINE WHETHER ONLY WAGES OR WAGES DTSZX551 00031 * ASSOCIATED WITH A REPORT ARE PRESENT. DTSZX551 00032 * IF ONLY WAGES ARE PRESENT, COPY THE DTSZX551 00033 * TEMPORARY WAGE FILE TO THE OUTPUT WAGE FILE. DTSZX551 00034 * IF PROCESSING A REPORT, VERIFY THAT THE REPORTED DTSZX551 00035 * AMOUNTS MATCH THE CALCULATED AMOUNTS, AND COPY DTSZX551 00036 * BOTH THE REPORT AND WAGE TEMPORARY FILES DTSZX551 00037 * TO THE OUTPUT. DTSZX551 00038 * REFERENCE RFP: MAG MEDIA WAGE ONLY GD DTSZX551 00039 * DTSZX551 00040 * 06-09-2010 MODIFIED FOR IN-HOUSE CASHIERING. DTSZX551 00041 * REFERENCE RFP: IN-HOUSE CASHIERING GD DTSZX551 00042 * DTSZX551 00043 * 11-10-2010 MODIFIED FOR WEB REPORTING. GD DTSZX551 00044 * DTSZX551 00045 * DTSZX551 00046 * DTSZX551 00047 * 12-05-2016 MODIFIED PROGRAM TO WRITE T28 RECORDS WITH CL*17 00048 * THE AMENDMENT SEQ NUMBER MOVED TO T28-LOG-NO CL*17 00049 * FOR PROPER SORT AND PROCESSING BY BD140. CL*17 00050 ***** DTSZX551 00051 SKIP3 DTSZX551 00052 ENVIRONMENT DIVISION. DTSZX551 00053 DTSZX551 00054 CONFIGURATION SECTION. DTSZX551 00055 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSZX551 00056 DTSZX551 00057 INPUT-OUTPUT SECTION. DTSZX551 00058 DTSZX551 00059 FILE-CONTROL. DTSZX551 00060 DTSZX551 00061 SELECT TEMP-BTC-FILE ASSIGN TO X451BTC DTSZX551 00062 FILE STATUS IS TEMP-BTC-STATUS. DTSZX551 00063 DTSZX551 00064 SELECT PEND-X140-FILE ASSIGN TO PENDX140 DTSZX551 00065 FILE STATUS IS REPT-140-STATUS. DTSZX551 00066 DTSZX551 00067 SELECT PEND-X144-FILE ASSIGN TO PENDX144 DTSZX551 00068 FILE STATUS IS WAGE-144-STATUS. DTSZX551 00069 DTSZX551 00070 SELECT PEND-X147-FILE ASSIGN TO PENDX147 DTSZX551 00071 FILE STATUS IS WAGE-144-STATUS. DTSZX551 00072 DTSZX551 00073 SELECT PEND-X145-FILE ASSIGN TO PENDX145 DTSZX551 00074 FILE STATUS IS PAYT-145-STATUS. DTSZX551 00075 DTSZX551 00076 SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP DTSZX551 00077 FILE STATUS IS WAGE-TEMP-STATUS. DTSZX551 00078 DTSZX551 00079 SELECT WAGE-FILE-OUT ASSIGN TO DTSFW4GE DTSZX551 00080 FILE STATUS IS WAGE-OUT-STATUS. DTSZX551 00081 DTSZX551 00082 SELECT BATCH-XREF-FILE ASSIGN TO BX214422 DTSZX551 00083 FILE STATUS IS BATCH-XREF-STATUS. DTSZX551 00084 DTSZX551 00085 SELECT REPT-PAID-FILE ASSIGN TO X451RPT1 DTSZX551 00086 FILE STATUS IS REPT-STATUS. DTSZX551 00087 DTSZX551 00088 SELECT REPT-PEND-FILE ASSIGN TO X451RPT2 DTSZX551 00089 FILE STATUS IS REPT-STATUS. DTSZX551 00090 DTSZX551 00091 DTSZX551 00092 DATA DIVISION. DTSZX551 00093 DTSZX551 00094 FILE SECTION. DTSZX551 00095 DTSZX551 00096 FD TEMP-BTC-FILE DTSZX551 00097 RECORDING MODE IS V DTSZX551 00098 BLOCK CONTAINS 0 RECORDS. DTSZX551 00099 DTSZX551 00100 01 TEMP-BTC-REC. DTSZX551 00101 ++INCLUDE DTSIRVAR DTSZX551 00102 DTSZX551 00103 01 TSKL-REC. DTSZX551 00104 ++INCLUDE DTSITSKL DTSZX551 00105 DTSZX551 00106 FD WAGE-FILE-TEMP DTSZX551 00107 RECORDING MODE IS F DTSZX551 00108 BLOCK CONTAINS 0 RECORDS DTSZX551 00109 LABEL RECORDS ARE OMITTED. DTSZX551 00110 DTSZX551 00111 01 WAGE-TEMP-REC PIC X(128). DTSZX551 00112 DTSZX551 00113 FD WAGE-FILE-OUT DTSZX551 00114 RECORDING MODE IS F DTSZX551 00115 BLOCK CONTAINS 0 RECORDS DTSZX551 00116 LABEL RECORDS ARE OMITTED. DTSZX551 00117 DTSZX551 00118 01 WAGE-OUT-REC PIC X(80). DTSZX551 00119 DTSZX551 00120 FD BATCH-XREF-FILE DTSZX551 00121 RECORDING MODE IS F DTSZX551 00122 BLOCK CONTAINS 0 RECORDS DTSZX551 00123 LABEL RECORDS ARE OMITTED. DTSZX551 00124 DTSZX551 00125 01 BATCH-XREF-REC PIC X(30). DTSZX551 00126 DTSZX551 00127 DTSZX551 00128 FD PEND-X140-FILE DTSZX551 00129 RECORDING MODE IS F DTSZX551 00130 BLOCK CONTAINS 0 RECORDS DTSZX551 00131 LABEL RECORDS ARE OMITTED. DTSZX551 00132 DTSZX551 00133 01 PEND-X140-REC PIC X(512). DTSZX551 00134 DTSZX551 00135 FD PEND-X144-FILE DTSZX551 00136 RECORDING MODE IS F DTSZX551 00137 BLOCK CONTAINS 0 RECORDS DTSZX551 00138 LABEL RECORDS ARE OMITTED. DTSZX551 00139 DTSZX551 00140 01 PEND-X144-REC PIC X(512). DTSZX551 00141 DTSZX551 00142 FD PEND-X145-FILE DTSZX551 00143 RECORDING MODE IS F DTSZX551 00144 BLOCK CONTAINS 0 RECORDS DTSZX551 00145 LABEL RECORDS ARE OMITTED. DTSZX551 00146 DTSZX551 00147 01 PEND-X145-REC PIC X(512). DTSZX551 00148 DTSZX551 00149 FD REPT-PAID-FILE DTSZX551 00150 RECORDING MODE IS F DTSZX551 00151 BLOCK CONTAINS 0 RECORDS DTSZX551 00152 LABEL RECORDS ARE OMITTED. DTSZX551 00153 DTSZX551 00154 01 REPT-PAID-REC PIC X(133). DTSZX551 00155 DTSZX551 00156 FD PEND-X147-FILE DTSZX551 00157 RECORDING MODE IS F DTSZX551 00158 BLOCK CONTAINS 0 RECORDS DTSZX551 00159 LABEL RECORDS ARE OMITTED. DTSZX551 00160 DTSZX551 00161 01 PEND-X147-REC PIC X(512). DTSZX551 00162 DTSZX551 00163 DTSZX551 00164 DTSZX551 00165 FD REPT-PEND-FILE DTSZX551 00166 RECORDING MODE IS F DTSZX551 00167 BLOCK CONTAINS 0 RECORDS DTSZX551 00168 LABEL RECORDS ARE OMITTED. DTSZX551 00169 DTSZX551 00170 01 REPT-PEND-REC PIC X(133). DTSZX551 00171 DTSZX551 00172 DTSZX551 00173 WORKING-STORAGE SECTION. DTSZX551 001735 77 PAN-VALET PICTURE X(24) VALUE '024DTSZX551 07/03/24'. DTSZX551 00174 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX422 10/07/14'. DTSZX551 00175 77 PAN-VALET PICTURE X(24) VALUE '047DTSBX422 09/27/14'. DTSZX551 00176 SKIP3 DTSZX551 00177 01 WRK-AREA. DTSZX551 00178 05 W-ABEND-CD PIC S9(04) COMP VALUE 436. DTSZX551 00179 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX436'.DTSZX551 00180 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSZX551 00181 05 WSP-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0.DTSZX551 00182 DTSZX551 00183 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSZX551 00184 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSZX551 00185 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSZX551 00186 DTSZX551 00187 05 WSP-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSZX551 00188 05 WSP-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSZX551 00189 05 WSP-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSZX551 00190 DTSZX551 00191 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSZX551 00192 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSZX551 00193 88 W-PREV-RPT-NULL-88 VALUE 'XXX'. DTSZX551 00194 88 W-PREV-REC-PRF-88 VALUE '102'. DTSZX551 00195 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSZX551 00196 88 W-PREV-REC-NAME-88 VALUE '106'. DTSZX551 00197 88 W-PREV-REC-RATE-88 VALUE '108'. DTSZX551 00198 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSZX551 00199 88 W-PREV-REC-OPO-88 VALUE '120'. DTSZX551 00200 88 W-PREV-REC-REL-88 VALUE '130'. DTSZX551 00201 88 W-PREV-REC-IND-88 VALUE '132'. DTSZX551 00202 88 W-PREV-REC-RPT-88 VALUE '140'. DTSZX551 00203 88 W-PREV-RPT-RPT-88 VALUE '140'. DTSZX551 00204 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSZX551 00205 88 W-PREV-RPT-WAGE-88 VALUE '144'. DTSZX551 00206 88 W-PREV-REC-PAY-88 VALUE '145'. DTSZX551 00207 88 W-PREV-RPT-PAY-88 VALUE '145'. DTSZX551 00208 88 W-PREV-REC-BHDR-88 VALUE '149'. DTSZX551 00209 DTSZX551 00210 05 TEMP-BTC-STATUS PIC X(02). DTSZX551 00211 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSZX551 00212 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSZX551 00213 DTSZX551 00214 05 WAGE-TEMP-STATUS PIC X(02). DTSZX551 00215 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSZX551 00216 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSZX551 00217 DTSZX551 00218 05 WAGE-OUT-STATUS PIC X(02). DTSZX551 00219 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSZX551 00220 DTSZX551 00221 05 BATCH-XREF-STATUS PIC X(02). DTSZX551 00222 88 BATCH-XREF-OK-88 VALUE '00'. DTSZX551 00223 DTSZX551 00224 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSZX551 00225 DTSZX551 00226 05 WAGE-TRANS-STATUS PIC X(02). DTSZX551 00227 88 WAGE-TRANS-FILE-OK-88 VALUE '00' '97'. DTSZX551 00228 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. DTSZX551 00229 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. DTSZX551 00230 DTSZX551 00231 05 REPT-140-STATUS PIC X(02). DTSZX551 00232 88 REPT-140-OK-88 VALUE '00' '97'. DTSZX551 00233 88 REPT-140--NO-REC-88 VALUE '10' '23'. DTSZX551 00234 DTSZX551 00235 05 WAGE-144-STATUS PIC X(02). DTSZX551 00236 88 WAGE-144-OK-88 VALUE '00' '97'. DTSZX551 00237 88 WAGE-144--NO-REC-88 VALUE '10' '23'. DTSZX551 00238 DTSZX551 00239 05 PAYT-145-STATUS PIC X(02). DTSZX551 00240 88 PAYT-145-OK-88 VALUE '00' '97'. DTSZX551 00241 88 PAYT-145-NO-REC-88 VALUE '10' '23'. DTSZX551 00242 DTSZX551 00243 DTSZX551 00244 05 REPT-STATUS PIC X(02). DTSZX551 00245 88 REPT-STATUS-OK-88 VALUE '00'. DTSZX551 00246 88 REPT-STATUS-EOF-88 VALUE '10'. DTSZX551 00247 DTSZX551 00248 05 W-RPT-DUPL-IND PIC X(01) VALUE 'N'. CL**5 00249 88 W-RPT-DUPL-YES-88 VALUE 'Y'. CL**5 00250 88 W-RPT-DUPL-NO-88 VALUE 'N'. CL**5 00251 DTSZX551 00252 CL**5 00253 05 W-RPT-ERROR-IND PIC X(01) VALUE 'N'. CL**5 00254 88 W-RPT-ERROR-YES-88 VALUE 'Y'. CL**5 00255 88 W-RPT-ERROR-NO-88 VALUE 'N'. CL**5 00256 CL**5 00257 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSZX551 00258 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSZX551 00259 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSZX551 00260 DTSZX551 00261 05 W-X145-PAYMENT-FOUND-IND PIC X(01) VALUE 'N'. DTSZX551 00262 88 W-X145-PAYMENT-YES-88 VALUE 'Y'. DTSZX551 00263 88 W-X145-PAYMENT-NO-88 VALUE 'N'. DTSZX551 00264 DTSZX551 00265 05 W-WRITE-T025-TRAN PIC X(01) VALUE 'N'. DTSZX551 00266 88 W-WRITE-T025-TRAN-YES-88 VALUE 'Y'. DTSZX551 00267 88 W-WRITE-T025-TRAN-NO-88 VALUE 'N'. DTSZX551 00268 DTSZX551 00269 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSZX551 00270 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSZX551 00271 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSZX551 00272 DTSZX551 00273 05 W-RPT-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSZX551 00274 88 W-RPT-IN-PROGRESS-YES-88 VALUE 'Y'. DTSZX551 00275 88 W-RPT-IN-PROGRESS-NO-88 VALUE 'N'. DTSZX551 00276 DTSZX551 00277 05 W-WAGE-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSZX551 00278 88 W-WAGE-IN-PROGRESS-YES-88 VALUE 'Y'. DTSZX551 00279 88 W-WAGE-IN-PROGRESS-NO-88 VALUE 'N'. DTSZX551 00280 DTSZX551 00281 05 W-ARPT-MAX PIC S9(04) COMP VALUE +100. DTSZX551 00282 05 W-ARPT-LAST PIC S9(04) COMP VALUE +0. DTSZX551 00283 05 RSUB PIC S9(04) COMP VALUE +0. DTSZX551 00284 05 W-ARPT-TABLE. DTSZX551 00285 10 W-ARPT-ENTRY OCCURS 100 TIMES PIC X(128). DTSZX551 00286 DTSZX551 00287 05 W-EMP-NO PIC S9(07) COMP-3. DTSZX551 00288 05 W-X140-DUP PIC S9(03) COMP-3 VALUE +0. DTSZX551 00289 05 W-TRAN-CNT PIC S9(03) COMP-3 VALUE +0. DTSZX551 00290 05 W-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSZX551 00291 05 W-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSZX551 00292 05 WS-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSZX551 00293 05 W-CURR-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSZX551 00294 05 W-CURR-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSZX551 00295 05 W-WAIVER-QTR PIC S9(05) COMP-3 VALUE +0. DTSZX551 00296 05 W-X140-REPORT-QTR PIC S9(05) COMP-3. DTSZX551 00297 05 W-X145-PAYMENT-QTR PIC S9(05) COMP-3. DTSZX551 00298 05 W-X144-WAGE-QTR PIC S9(05) COMP-3. DTSZX551 00299 05 W-X147-WAGE-QTR PIC S9(05) COMP-3. DTSZX551 00300 05 WRK-REPORT-QTR PIC 9(05). DTSZX551 00301 05 W-X145-TRACE-NO PIC X(13) VALUE SPACES. DTSZX551 00302 05 W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO. DTSZX551 00303 10 W-X145-TRACE-NO-A PIC 9(08). DTSZX551 00304 10 W-X145-TRACE-NO-B PIC 9(05). DTSZX551 00305 05 W-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSZX551 00306 05 W-TAX-WAGE PIC S9(11)V99 VALUE +0. DTSZX551 00307 05 W-EXX-WAGE PIC S9(11)V99 VALUE +0. CL**3 00308 05 W-WRKR-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSZX551 00309 05 W-WRKR-TAX-WAGE PIC S9(11)V99 VALUE +0. DTSZX551 00310 05 WS-X140-REMITTANCE PIC S9(09)V99 VALUE +0. DTSZX551 00311 05 W-X140-REMITTANCE PIC S9(09)V99 VALUE +0. DTSZX551 00312 05 W-X145-REMITTANCE PIC S9(09)V99 VALUE +0. DTSZX551 00313 05 W-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. DTSZX551 00314 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. DTSZX551 00315 05 W-X145-RECEIVED-DATE PIC S9(09) COMP-3. DTSZX551 00316 05 W-X140-RECEIVED-DATE PIC S9(09) COMP-3. DTSZX551 00317 05 W-ESTB-DATE PIC S9(09) COMP-3. DTSZX551 00318 05 W-X145-DEPOSIT-DATE PIC S9(09) COMP-3. DTSZX551 00319 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSZX551 00320 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSZX551 00321 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSZX551 00322 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSZX551 00323 05 W-WRKR-CNT-TOTAL PIC S9(07) COMP-3. DTSZX551 00324 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSZX551 00325 05 W-SSN PIC S9(09) COMP-3. DTSZX551 00326 05 W-EARNINGS-X PIC X(12). DTSZX551 00327 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSZX551 00328 PIC 9(09).99. DTSZX551 00329 05 W-EARNINGS PIC S9(09)V99. DTSZX551 00330 05 W-WORKER-NAME. DTSZX551 00331 10 W-WRKR-FIRST-NAME PIC X(15). DTSZX551 00332 10 W-WRKR-MID-INIT PIC X(01). DTSZX551 00333 10 W-WRKR-LAST-NAME PIC X(20). DTSZX551 00334 DTSZX551 00335 05 W-RPT-TYPE PIC X(02). DTSZX551 00336 88 W-ORIG-88 VALUE 'OR'. DTSZX551 00337 88 W-EMP-AMEND-88 VALUE 'EA'. DTSZX551 00338 88 W-AUDIT-88 VALUE 'AU'. DTSZX551 00339 88 W-FLD-SUP-88 VALUE 'FS'. DTSZX551 00340 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSZX551 00341 88 W-ESTIM-88 VALUE 'ES'. DTSZX551 00342 88 W-WITHDRW-88 VALUE 'WD'. DTSZX551 00343 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSZX551 00344 'FS' 'AC'. DTSZX551 00345 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSZX551 00346 'FS' 'AC' 'ES'. DTSZX551 00347 DTSZX551 00348 05 W-PAY-TYPE PIC X(02). DTSZX551 00349 88 W-PAY-ORIG-88 VALUE 'OR'. DTSZX551 00350 88 W-PAY-REG-88 VALUE 'PA'. DTSZX551 00351 88 W-VALID-PAY-88 VALUE 'OR' 'PA'. DTSZX551 00352 DTSZX551 00353 DTSZX551 00354 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSZX551 00355 DTSZX551 00356 05 W-MNTE-SUBJECT PIC X(40). DTSZX551 00357 88 W-MNTE-NOT-LIAB-88 VALUE DTSZX551 00358 'REASON FOR NOT-LIABLE DETERMINATION '. DTSZX551 00359 88 W-MNTE-KEY-WORD-88 VALUE DTSZX551 00360 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSZX551 00361 88 W-MNTE-DATA-ENTRY-88 VALUE DTSZX551 00362 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSZX551 00363 88 W-MNTE-RELATIONSHIP-88 VALUE DTSZX551 00364 'WEB REGISTRATION RELATED EMPLOYER '. DTSZX551 00365 DTSZX551 00366 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSZX551 00367 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSZX551 00368 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSZX551 00369 DTSZX551 00370 05 TSUB1 PIC S9(04) COMP. DTSZX551 00371 05 TSUB2 PIC S9(04) COMP. DTSZX551 00372 05 W-LAST-SPACE PIC S9(04) COMP. DTSZX551 00373 DTSZX551 00374 05 W-MNTE-LINE PIC X(72). DTSZX551 00375 DTSZX551 00376 05 W-SLASH-DATE PIC X(10). DTSZX551 00377 05 FILLER REDEFINES W-SLASH-DATE. DTSZX551 00378 10 W-SLASH-DT-MM PIC X(02). DTSZX551 00379 10 FILLER PIC X(01). DTSZX551 00380 10 W-SLASH-DT-DD PIC X(02). DTSZX551 00381 10 FILLER PIC X(01). DTSZX551 00382 10 W-SLASH-DT-CCYY PIC X(04). DTSZX551 00383 DTSZX551 00384 05 WRK-CURR-RUN-DATE PIC 9(08). DTSZX551 00385 05 FILLER REDEFINES WRK-CURR-RUN-DATE. DTSZX551 00386 10 WRK-CURR-CCYY PIC 9(04). DTSZX551 00387 10 WRK-CURR-MO PIC 9(02). DTSZX551 00388 10 WRK-CURR-DD PIC 9(02). DTSZX551 00389 DTSZX551 00390 05 WRK-CURR-RPT-DATE. DTSZX551 00391 10 RPT-CURR-MO PIC 9(02). DTSZX551 00392 10 FILLER PIC X(01) VALUE '/'. DTSZX551 00393 10 RPT-CURR-DD PIC 9(02). DTSZX551 00394 10 FILLER PIC X(01) VALUE '/'. DTSZX551 00395 10 RPT-CURR-CCYY PIC 9(04). DTSZX551 00396 DTSZX551 00397 05 W-SLASH-QTR PIC X(06). DTSZX551 00398 05 FILLER REDEFINES W-SLASH-QTR. DTSZX551 00399 10 W-SLASH-QTR-CCYY PIC X(04). DTSZX551 00400 10 FILLER PIC X(01). DTSZX551 00401 10 W-SLASH-QTR-Q PIC X(01). DTSZX551 00402 DTSZX551 00403 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00404 * BATCH HEADER DTSZX551 00405 05 W-X149-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00406 * REPORT DTSZX551 00407 05 W-X140-RED-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00408 05 W-X140-DUP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00409 05 W-X140-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00410 05 W-X140-PEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00411 05 W-X140-PRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00412 05 W-X140-SAV-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00413 * EMPLOYEE WAGES DTSZX551 00414 05 W-X144-RED-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00415 05 W-X144-DUP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00416 05 W-X144-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00417 05 W-X144-PEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00418 05 W-X144-PRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00419 05 W-X144-SAV-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00420 DTSZX551 00421 * AMENDED WAGES DELETED DTSZX551 00422 05 W-X147-RED-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00423 05 W-X147-DUP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00424 05 W-X147-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00425 05 W-X147-PEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00426 05 W-X147-PRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00427 05 W-X147-SAV-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00428 DTSZX551 00429 * EMPLOYER PAYMENT DTSZX551 00430 05 W-X145-RED-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00431 05 W-X145-DUP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00432 05 W-X145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00433 05 W-X145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00434 05 W-X145-PRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00435 05 W-X145-ZRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00436 05 W-X145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00437 * EMPLOYEE W4 COUNT DTSZX551 00438 05 W-W4-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00439 05 W-W2-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00440 DTSZX551 00441 ** 05 W-T027-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00442 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00443 05 W-T028-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00444 05 W-T028-WRITEE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00445 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00446 05 W-T025-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00447 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00448 05 W-ARPT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00449 05 W-BX214-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00450 DTSZX551 00451 05 W-X140-LENGTH PIC S9(04) COMP. DTSZX551 00452 05 W-X144-LENGTH PIC S9(04) COMP. DTSZX551 00453 05 W-X145-LENGTH PIC S9(04) COMP. DTSZX551 00454 05 W-X147-LENGTH PIC S9(04) COMP. DTSZX551 00455 DTSZX551 00456 05 W-AMT-DISP1 PIC ----------9.99. DTSZX551 00457 05 W-AMT-DISP2 PIC ----------9.99. DTSZX551 00458 *RW1 DTSZX551 00459 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 00460 05 DISPLAY-CNT PIC Z(06)9. DTSZX551 00461 05 WRK-MPRF-EMP-NO PIC 9(06). DTSZX551 00462 *RW2 DTSZX551 00463 DTSZX551 00464 01 MESSAGE-AREA. DTSZX551 00465 *** FATAL ERRORS MSG-A DTSZX551 00466 05 MSG-A1. DTSZX551 00467 10 FILLER PIC X(32) DTSZX551 00468 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSZX551 00469 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSZX551 00470 01 HEADER-1. DTSZX551 00471 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 00472 05 FILLER PIC X(49) VALUE '140R1'. DTSZX551 00473 05 FILLER PIC X(60) VALUE DTSZX551 00474 'DISTRICT OF COLUMBIA'. DTSZX551 00475 05 FILLER PIC X(06) VALUE 'DATE:'. DTSZX551 00476 05 HDR1-LRCM-SYS-DATE PIC X(10). DTSZX551 00477 01 HEADER-2. DTSZX551 00478 05 FILLER PIC X(54) VALUE SPACES. DTSZX551 00479 05 FILLER PIC X(56) VALUE DTSZX551 00480 'TAX DIVISION'. DTSZX551 00481 05 FILLER PIC X(06) VALUE 'TIME:'. DTSZX551 00482 05 HDR2-LRCM-SYS-TIME PIC X(08). DTSZX551 00483 DTSZX551 00484 01 HEADER-3. DTSZX551 00485 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 00486 05 FILLER PIC X(38) VALUE DTSZX551 00487 'ROUTE TO: TAX ACCOUNTING STAFF'. DTSZX551 00488 05 HDR3-LITERAL PIC X(43) VALUE DTSZX551 00489 ' ESSP DAILY AMENDED REPORTS RELEASED '. CL*18 00490 05 FILLER PIC X(28) VALUE SPACES. DTSZX551 00491 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSZX551 00492 05 HDR3-PAGE PIC ZZ,ZZ9. DTSZX551 00493 DTSZX551 00494 01 HEADER-31. DTSZX551 00495 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 00496 05 FILLER PIC X(38) VALUE DTSZX551 00497 'ROUTE TO: TAX ACCOUNTING STAFF'. DTSZX551 00498 05 HDR3-LITERAL PIC X(43) VALUE DTSZX551 00499 ' ESSP DAILY AMENDED REPORTS IN ERROR '. CL*18 00500 05 FILLER PIC X(28) VALUE SPACES. DTSZX551 00501 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSZX551 00502 05 HDR31-PAGE PIC ZZ,ZZ9. DTSZX551 00503 DTSZX551 00504 01 HEADER-4. DTSZX551 00505 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 00506 05 FILLER PIC X(132) VALUE SPACES. DTSZX551 00507 01 HEADER-42. DTSZX551 00508 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00509 05 FILLER PIC X(34) VALUE DTSZX551 00510 ' '. DTSZX551 00511 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00512 05 FILLER PIC X(25) VALUE DTSZX551 00513 ' '. DTSZX551 00514 05 FILLER PIC X(03) VALUE SPACES. DTSZX551 00515 05 FILLER PIC X(43) VALUE DTSZX551 00516 ' ESSP-CALC TPA/EMPL DIFF'. DTSZX551 00517 05 FILLER PIC X(30) VALUE DTSZX551 00518 ' EMPLOYEES '. DTSZX551 00519 DTSZX551 00520 01 HEADER-5. DTSZX551 00521 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00522 05 FILLER PIC X(34) VALUE DTSZX551 00523 'EMP NO NAME QTR RECV-DATE'. DTSZX551 00524 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00525 05 FILLER PIC X(25) VALUE DTSZX551 00526 ' TOTAL-AMT EXCESS-AMT '. DTSZX551 00527 05 FILLER PIC X(03) VALUE SPACES. DTSZX551 00528 05 FILLER PIC X(34) VALUE DTSZX551 00529 ' TAX-AMT AMT-DUE PAID-AMT'. DTSZX551 00530 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00531 05 HDR5-NAME PIC X(28) VALUE DTSZX551 00532 '-/+ ----- MONTHLY COUNT'. DTSZX551 00533 DTSZX551 00534 01 HEADER-6. DTSZX551 00535 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 00536 05 FILLER PIC X(132) VALUE SPACES. DTSZX551 00537 01 DETAIL-LINE-1. DTSZX551 00538 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 00539 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. DTSZX551 00540 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 00541 15 X434-NAME-CHECK PIC X(04) VALUE SPACES. DTSZX551 00542 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 00543 15 X434-QTR PIC X(06). DTSZX551 00544 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 00545 15 X434-RCVD-DATE PIC X(10). DTSZX551 00546 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00547 15 X434-TOT-WAGE PIC --------9.99. DTSZX551 00548 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00549 15 X434-EXC-WAGE PIC --------9.99. DTSZX551 00550 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00551 15 X434-TAX-WAGE PIC --------9.99. DTSZX551 00552 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00553 15 X434-X140-REMIT PIC -------9.99. DTSZX551 00554 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00555 15 X434-X145-REMIT PIC -------9.99. DTSZX551 00556 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00557 15 X434-DIFF PIC ------9.99. DTSZX551 00558 * 15 X434-MESSAGE PIC X(20). DTSZX551 00559 15 X434-M1-CNT PIC ZZZZZZ9. DTSZX551 00560 15 X434-M2-CNT PIC ZZZZZZ9. DTSZX551 00561 15 X434-M3-CNT PIC ZZZZZZ9. DTSZX551 00562 DTSZX551 00563 01 DETAIL-PEND-1. DTSZX551 00564 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 00565 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. DTSZX551 00566 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 00567 15 P434-NAME-CHECK PIC X(04) VALUE SPACES. DTSZX551 00568 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 00569 15 P434-QTR PIC X(06). DTSZX551 00570 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 00571 15 P434-RCVD-DATE PIC X(10). DTSZX551 00572 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00573 15 P434-TOT-WAGE PIC --------9.99. DTSZX551 00574 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00575 15 P434-EXC-WAGE PIC --------9.99. DTSZX551 00576 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00577 15 P434-TAX-WAGE PIC --------9.99. DTSZX551 00578 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00579 15 P434-X140-REMIT PIC --------9.99. DTSZX551 00580 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 00581 15 P434-X145-REMIT PIC --------9.99. DTSZX551 00582 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 00583 15 P434-MESSAGE PIC X(30). DTSZX551 00584 DTSZX551 00585 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. DTSZX551 00586 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. DTSZX551 00587 DTSZX551 00588 01 FOOTING-LINE-3. DTSZX551 00589 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 00590 05 WS-FOOTING-CNT PIC ZZ,ZZ9. DTSZX551 00591 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00592 05 FILLER PIC X(45) VALUE DTSZX551 00593 'TOTAL PAYMENT RELEASED TO DUTAS '. DTSZX551 00594 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00595 DTSZX551 00596 01 FOOTING-LINE-4. DTSZX551 00597 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 00598 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. DTSZX551 00599 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00600 05 FILLER PIC X(34) VALUE DTSZX551 00601 ' # OF PAYMENTS HAD ERRORS '. DTSZX551 00602 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00603 DTSZX551 00604 01 FOOTING-LINE-5. DTSZX551 00605 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 00606 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. DTSZX551 00607 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00608 05 FILLER PIC X(40) VALUE DTSZX551 00609 ' # OF ZERO PAYMENTS DISCARDED '. DTSZX551 00610 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00611 01 FOOTING-LINE-6. DTSZX551 00612 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 00613 05 WS-X140-RED-CNT PIC ZZ,ZZ9. DTSZX551 00614 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00615 05 FILLER PIC X(45) VALUE DTSZX551 00616 'TOTAL REPORT RELEASED TO DUTAS '. DTSZX551 00617 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00618 01 FOOTING-LINE-7. DTSZX551 00619 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 00620 05 WS-X140-ERR-CNT PIC ZZ,ZZ9. DTSZX551 00621 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00622 05 FILLER PIC X(34) VALUE DTSZX551 00623 ' # OF REPORTS HAD ERRORS '. DTSZX551 00624 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00625 DTSZX551 00626 01 FOOTING-LINE-8. DTSZX551 00627 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 00628 05 WS-X140-PEN-CNT PIC ZZ,ZZ9. DTSZX551 00629 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00630 05 FILLER PIC X(40) VALUE DTSZX551 00631 ' # OF REPORTS DUTAS CANNOT PROCESS '. DTSZX551 00632 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00633 DTSZX551 00634 01 FOOTING-LINE-9. DTSZX551 00635 05 FILLER PIC X(24) VALUE SPACES. DTSZX551 00636 05 WS-X144-RED-CNT PIC ZZZ,ZZ9. DTSZX551 00637 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00638 05 FILLER PIC X(45) VALUE DTSZX551 00639 'TOTAL WAGES RELEASED TO DUTAS '. DTSZX551 00640 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00641 01 FOOTING-LINE-10. DTSZX551 00642 05 FILLER PIC X(24) VALUE SPACES. DTSZX551 00643 05 WS-X144-ERR-CNT PIC ZZZ,ZZ9. DTSZX551 00644 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00645 05 FILLER PIC X(34) VALUE DTSZX551 00646 ' # OF WAGES HAD ERRORS '. DTSZX551 00647 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00648 DTSZX551 00649 01 FOOTING-LINE-11. DTSZX551 00650 05 FILLER PIC X(24) VALUE SPACES. DTSZX551 00651 05 WS-X144-PEN-CNT PIC ZZZ,ZZ9. DTSZX551 00652 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00653 05 FILLER PIC X(40) VALUE DTSZX551 00654 ' # OF WAGES DUTAS CANNOT PROCESS '. DTSZX551 00655 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00656 01 FOOTING-LINE-12. DTSZX551 00657 05 FILLER PIC X(19) VALUE SPACES. DTSZX551 00658 05 WS-TOT-REMIT PIC $$$$$$$$9.99. DTSZX551 00659 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00660 05 FILLER PIC X(45) VALUE DTSZX551 00661 ' TOTAL PAYMENTS APPLIED TO DUTAS'. DTSZX551 00662 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00663 DTSZX551 00664 01 FOOTING-LINE-15. DTSZX551 00665 05 FILLER PIC X(19) VALUE SPACES. DTSZX551 00666 05 WS-TOT-CREDIT PIC $$$$$$$$9.99. DTSZX551 00667 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 00668 05 FILLER PIC X(45) VALUE DTSZX551 00669 ' TOTAL CREDITS APPLIED TO DUTAS'. DTSZX551 00670 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 00671 DTSZX551 00672 01 FOOTING-LINE-13. DTSZX551 00673 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 00674 05 FILLER PIC X(67) VALUE DTSZX551 00675 '*** END ESSP/DUTAS FINAL RPT/PAY/WAGE PROCESSING ***'. DTSZX551 00676 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. DTSZX551 00677 DTSZX551 00678 01 T003-REC. DTSZX551 00679 ++INCLUDE DTSIT003 DTSZX551 00680 DTSZX551 00681 01 T025-REC. DTSZX551 00682 ++INCLUDE DTSIT025 DTSZX551 00683 DTSZX551 00684 *01 T027-REC. DTSZX551 00685 *++INCLUDE DTSIT027 DTSZX551 00686 DTSZX551 00687 01 T028-REC. DTSZX551 00688 ++INCLUDE DTSIT028 DTSZX551 00689 DTSZX551 00690 DTSZX551 00691 01 W001-REC. DTSZX551 00692 ++INCLUDE DTSIW001 DTSZX551 00693 DTSZX551 00694 01 WAGE-TRANS-AREA. DTSZX551 00695 05 ESP-TRANSACTION-AREA PIC X(80). DTSZX551 00696 ++INCLUDE EWGTRNW4 DTSZX551 00697 DTSZX551 00698 ++INCLUDE EWGTRNW2 DTSZX551 00699 DTSZX551 00700 DTSZX551 00701 * ACCOUNTING BATCH HEADER DTSZX551 00702 01 X149-REC. DTSZX551 00703 ++INCLUDE DTSIX149 DTSZX551 00704 DTSZX551 00705 * REPORT DTSZX551 00706 01 X140-REC. DTSZX551 00707 ++INCLUDE DTSIX140 DTSZX551 00708 DTSZX551 00709 * EMPLOYEE WAGES DTSZX551 00710 01 X144-REC. DTSZX551 00711 ++INCLUDE DTSIX144 DTSZX551 00712 DTSZX551 00713 * EMPLOYEE AMENDED WAGES -W2 DTSZX551 00714 01 X147-REC. DTSZX551 00715 ++INCLUDE DTSIX147 DTSZX551 00716 DTSZX551 00717 * PAYMENTS DTSZX551 00718 01 X145-REC. DTSZX551 00719 ++INCLUDE DTSIX145 DTSZX551 00720 DTSZX551 00721 * BATCH - PSEUDO-BATCH XREF DTSZX551 00722 01 X214-REC. DTSZX551 00723 ++INCLUDE DTSIX214 DTSZX551 00724 DTSZX551 00725 * ERRORS DTSZX551 00726 *01 X907-REC. DTSZX551 00727 ***INCLUDE DTSIX907 DTSZX551 00728 DTSZX551 00729 01 L001-LINK-AREA. DTSZX551 00730 ++INCLUDE DTSIL001 DTSZX551 00731 DTSZX551 00732 01 L003-LINK-AREA. DTSZX551 00733 ++INCLUDE DTSIL003 DTSZX551 00734 DTSZX551 00735 01 L004-LINK-AREA. DTSZX551 00736 ++INCLUDE DTSIL004 DTSZX551 00737 DTSZX551 00738 01 L516-LINK-AREA. DTSZX551 00739 ++INCLUDE DTSIL516 DTSZX551 00740 DTSZX551 00741 01 L910-LINK-AREA. DTSZX551 00742 ++INCLUDE DTSIL910 DTSZX551 00743 01 MSKL-REC. DTSZX551 00744 ++INCLUDE DTSIMSKL DTSZX551 00745 DTSZX551 00746 01 MHDR-REC. DTSZX551 00747 ++INCLUDE DTSIMHDR DTSZX551 00748 DTSZX551 00749 01 MPRF-REC. DTSZX551 00750 ++INCLUDE DTSIMPRF DTSZX551 00751 DTSZX551 00752 01 MSOL-REC. DTSZX551 00753 ++INCLUDE DTSIMSOL DTSZX551 00754 DTSZX551 00755 01 MRPT-REC. DTSZX551 00756 ++INCLUDE DTSIMRPT DTSZX551 00757 DTSZX551 00758 01 MQTR-REC. DTSZX551 00759 ++INCLUDE DTSIMQTR DTSZX551 00760 DTSZX551 00761 01 MOPO-REC. DTSZX551 00762 ++INCLUDE DTSIMOPO DTSZX551 00763 DTSZX551 00764 01 MTAD-REC. DTSZX551 00765 ++INCLUDE DTSIMTAD DTSZX551 00766 DTSZX551 00767 01 MNTE-REC. DTSZX551 00768 ++INCLUDE DTSIMNTE DTSZX551 00769 DTSZX551 00770 01 L921-LINK-AREA. DTSZX551 00771 ++INCLUDE DTSIL921 DTSZX551 00772 SKIP3 DTSZX551 00773 01 ISKL-REC. DTSZX551 00774 ++INCLUDE DTSIISKL DTSZX551 00775 SKIP3 DTSZX551 00776 01 IEIN-REC. DTSZX551 00777 ++INCLUDE DTSIIEIN DTSZX551 00778 DTSZX551 00779 01 L923-LINK-AREA. DTSZX551 00780 ++INCLUDE DTSIL923 DTSZX551 00781 EJECT DTSZX551 00782 01 ASKL-REC. DTSZX551 00783 ++INCLUDE DTSIASKL DTSZX551 00784 EJECT DTSZX551 00785 01 AHDR-REC. DTSZX551 00786 ++INCLUDE DTSIAHDR DTSZX551 00787 EJECT DTSZX551 00788 01 ARPT-REC. DTSZX551 00789 ++INCLUDE DTSIARPT DTSZX551 00790 EJECT DTSZX551 00791 01 APAY-REC. DTSZX551 00792 ++INCLUDE DTSIAPAY DTSZX551 00793 DTSZX551 00794 01 L927-LINK-AREA. DTSZX551 00795 ++INCLUDE DTSIL927 DTSZX551 00796 DTSZX551 00797 01 L931-LINK-AREA. DTSZX551 00798 ++INCLUDE DTSIL931 DTSZX551 00799 DTSZX551 00800 01 FSKL-REC. DTSZX551 00801 ++INCLUDE DTSIFSKL DTSZX551 00802 DTSZX551 00803 01 R140-REC. DTSZX551 00804 ++INCLUDE DTSIR140 DTSZX551 00805 DTSZX551 00806 LINKAGE DTSZX551 00807 SECTION. DTSZX551 00808 DTSZX551 00809 01 LX42-LINK-AREA. DTSZX551 00810 ++INCLUDE DTSILX42 DTSZX551 00811 DTSZX551 00812 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSZX551 00813 DTSZX551 00814 DTSBX436-MAIN. DTSZX551 00815 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA DTSZX551 00816 MOVE LX42-RPT-ERROR-IND TO W-RPT-ERROR-IND. DTSZX551 00817 DTSZX551 00818 * IF W-RPT-ERROR-YES-88 DTSZX551 00819 * DISPLAY 'BX436 LX42 EMP REC HAS ERROR ' LX42-EMP-NO DTSZX551 00820 * ' ' LX42-RPT-ERROR-IND ' ' W-RPT-ERROR-IND DTSZX551 00821 * ELSE DTSZX551 00822 * DISPLAY 'BX436 EMP REC HAS NO ERROR ' W-RPT-ERROR-IND DTSZX551 00823 * END-IF. DTSZX551 00824 DTSZX551 00825 EVALUATE TRUE DTSZX551 00826 WHEN LX42-INITIALIZE-88 DTSZX551 00827 PERFORM I0000-INITIATE THRU I0000-EXIT DTSZX551 00828 DTSZX551 00829 WHEN LX42-NEW-EMPLOYER-88 DTSZX551 00830 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSZX551 00831 DTSZX551 00832 WHEN LX42-PROCESS-88 DTSZX551 00833 PERFORM P0000-PROCESS THRU P0000-EXIT DTSZX551 00834 DTSZX551 00835 WHEN LX42-TERMINATE-88 DTSZX551 00836 DISPLAY ' TERMINATE 430' DTSZX551 00837 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSZX551 00838 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSZX551 00839 DTSZX551 00840 END-EVALUATE. DTSZX551 00841 DTSZX551 00842 IF LX42-PROCESS-88 DTSZX551 00843 MOVE W-RPT-ERROR-IND TO LX42-RPT-ERROR-IND DTSZX551 00844 END-IF. DTSZX551 00845 DTSZX551 00846 DTSBX436-MAIN-EXIT. DTSZX551 00847 GOBACK. DTSZX551 00848 DTSZX551 00849 I0000-INITIATE. DTSZX551 00850 SET W-RPT-ERROR-NO-88 TO TRUE. DTSZX551 00851 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSZX551 00852 DTSZX551 00853 MOVE LENGTH OF X140-REC TO W-X140-LENGTH. DTSZX551 00854 MOVE LENGTH OF X144-REC TO W-X144-LENGTH. DTSZX551 00855 MOVE LENGTH OF X145-REC TO W-X145-LENGTH. DTSZX551 00856 MOVE LENGTH OF X147-REC TO W-X147-LENGTH. DTSZX551 00857 DTSZX551 00858 * FOR VARIABLE REPORT FILE. DTSZX551 00859 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSZX551 00860 MOVE '140' TO R140-REC-TYPE. DTSZX551 00861 DTSZX551 00862 MOVE LX42-CURR-RUN-DATE TO L004-DATE. DTSZX551 00863 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSZX551 00864 SUBTRACT +5 FROM L004-ABS-QTR. DTSZX551 00865 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSZX551 00866 MOVE L004-QTR-5-9 TO W-WAIVER-QTR. DTSZX551 00867 DISPLAY 'BX451 CURR RUN DATE ' LX42-CURR-RUN-DATE. DTSZX551 00868 * DISPLAY 'BX436 WAIVE QTR ' W-WAIVER-QTR. DTSZX551 00869 DTSZX551 00870 MOVE LX42-CURR-RUN-DATE TO WRK-CURR-RUN-DATE. DTSZX551 00871 MOVE WRK-CURR-CCYY TO RPT-CURR-CCYY DTSZX551 00872 MOVE WRK-CURR-MO TO RPT-CURR-MO DTSZX551 00873 MOVE WRK-CURR-DD TO RPT-CURR-DD DTSZX551 00874 DISPLAY 'RPT CURR RUN DATE ' WRK-CURR-RPT-DATE. DTSZX551 00875 MOVE WRK-CURR-RPT-DATE TO HDR1-LRCM-SYS-DATE. DTSZX551 00876 DTSZX551 00877 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSZX551 00878 IF W-FATAL-ERROR-YES-88 DTSZX551 00879 GO TO I0000-EXIT DTSZX551 00880 END-IF. DTSZX551 00881 DTSZX551 00882 MOVE +0 TO W-ARPT-LAST. DTSZX551 00883 PERFORM DTSZX551 00884 VARYING RSUB FROM +1 BY +1 DTSZX551 00885 UNTIL RSUB > W-ARPT-MAX DTSZX551 00886 MOVE LOW-VALUES TO W-ARPT-ENTRY (RSUB) DTSZX551 00887 END-PERFORM. DTSZX551 00888 DTSZX551 00889 I0000-EXIT. DTSZX551 00890 EXIT. DTSZX551 00891 DTSZX551 00892 I2000-OPEN-FILES. DTSZX551 00893 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSZX551 00894 IF W-FATAL-ERROR-YES-88 DTSZX551 00895 DISPLAY 'CANNOT OPEN TEMP X436BTC FILE ' DTSZX551 00896 TEMP-BTC-STATUS DTSZX551 00897 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00898 END-IF. DTSZX551 00899 DTSZX551 00900 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSZX551 00901 IF W-FATAL-ERROR-YES-88 DTSZX551 00902 DISPLAY 'CANNOT OPEN WAGE TEMP FILE ' DTSZX551 00903 WAGE-TEMP-STATUS DTSZX551 00904 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00905 END-IF. DTSZX551 00906 DTSZX551 00907 PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT. DTSZX551 00908 IF W-FATAL-ERROR-YES-88 DTSZX551 00909 DISPLAY 'CANNOT OPEN WAGE OUT FILE ' DTSZX551 00910 WAGE-OUT-STATUS DTSZX551 00911 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00912 END-IF. DTSZX551 00913 DTSZX551 00914 OPEN OUTPUT BATCH-XREF-FILE. DTSZX551 00915 IF BATCH-XREF-OK-88 DTSZX551 00916 NEXT SENTENCE DTSZX551 00917 ELSE DTSZX551 00918 DISPLAY 'CANNOT OPEN BATCH XREF FILE ' DTSZX551 00919 BATCH-XREF-STATUS DTSZX551 00920 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00921 END-IF. DTSZX551 00922 DTSZX551 00923 DTSZX551 00924 OPEN OUTPUT PEND-X140-FILE. DTSZX551 00925 IF REPT-140-OK-88 DTSZX551 00926 NEXT SENTENCE DTSZX551 00927 ELSE DTSZX551 00928 DISPLAY 'CANNOT OPEN AMENDS X140 FILE' DTSZX551 00929 REPT-140-STATUS DTSZX551 00930 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00931 END-IF. DTSZX551 00932 DTSZX551 00933 OPEN OUTPUT PEND-X144-FILE. DTSZX551 00934 IF WAGE-144-OK-88 DTSZX551 00935 NEXT SENTENCE DTSZX551 00936 ELSE DTSZX551 00937 DISPLAY 'CANNOT OPEN AMENDS X144 FILE' DTSZX551 00938 WAGE-144-STATUS DTSZX551 00939 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00940 END-IF. DTSZX551 00941 DTSZX551 00942 DTSZX551 00943 OPEN OUTPUT PEND-X147-FILE. DTSZX551 00944 IF WAGE-144-OK-88 DTSZX551 00945 NEXT SENTENCE DTSZX551 00946 ELSE DTSZX551 00947 DISPLAY 'CANNOT OPEN AMENDS X147 FILE' DTSZX551 00948 WAGE-144-STATUS DTSZX551 00949 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00950 END-IF. DTSZX551 00951 DTSZX551 00952 OPEN OUTPUT PEND-X145-FILE. DTSZX551 00953 IF PAYT-145-OK-88 DTSZX551 00954 NEXT SENTENCE DTSZX551 00955 ELSE DTSZX551 00956 DISPLAY 'CANNOT OPEN AMENDS X145 FILE' DTSZX551 00957 PAYT-145-STATUS DTSZX551 00958 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00959 END-IF. DTSZX551 00960 DTSZX551 00961 DTSZX551 00962 OPEN OUTPUT REPT-PEND-FILE. DTSZX551 00963 IF REPT-STATUS-OK-88 DTSZX551 00964 NEXT SENTENCE DTSZX551 00965 ELSE DTSZX551 00966 DISPLAY 'CANNOT OPEN REPORT PENDING FILE ' DTSZX551 00967 REPT-STATUS DTSZX551 00968 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00969 END-IF. DTSZX551 00970 DTSZX551 00971 OPEN OUTPUT REPT-PAID-FILE. DTSZX551 00972 IF REPT-STATUS-OK-88 DTSZX551 00973 NEXT SENTENCE DTSZX551 00974 ELSE DTSZX551 00975 DISPLAY 'CANNOT OPEN REPORT PAID FILE ' DTSZX551 00976 REPT-STATUS DTSZX551 00977 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 00978 END-IF. DTSZX551 00979 DTSZX551 00980 I2000-EXIT. DTSZX551 00981 EXIT. DTSZX551 00982 DTSZX551 00983 P0000-PROCESS. DTSZX551 00984 DTSZX551 00985 EVALUATE TRUE DTSZX551 00986 WHEN LX42-REC-TYPE-PAY-88 DTSZX551 00987 PERFORM P1000-PAYMENT THRU P1000-EXIT DTSZX551 00988 DTSZX551 00989 WHEN LX42-REC-TYPE-RPT-88 DTSZX551 00990 PERFORM P2000-REPORT THRU P2000-EXIT DTSZX551 00991 DTSZX551 00992 WHEN LX42-REC-TYPE-WAGE-88 DTSZX551 00993 PERFORM P3000-WAGES THRU P3000-EXIT DTSZX551 00994 DTSZX551 00995 WHEN LX42-REC-TYPE-AWAGE-88 DTSZX551 00996 PERFORM P3500-WAGES THRU P3500-EXIT DTSZX551 00997 DTSZX551 00998 WHEN OTHER DTSZX551 00999 DISPLAY 'DTSBX451 ABENDING - INVALID RECORD TYPE ' DTSZX551 01000 LX42-REC-TYPE DTSZX551 01001 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 01002 DTSZX551 01003 END-EVALUATE. DTSZX551 01004 DTSZX551 01005 P0000-EXIT. DTSZX551 01006 EXIT. DTSZX551 01007 P1000-PAYMENT. DTSZX551 01008 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSZX551 01009 MOVE LX42-DATA-AREA TO X145-REC. DTSZX551 01010 *& DTSZX551 01011 MOVE X145-EMP-NO TO W-EMP-NO. DTSZX551 01012 SET W-EMP-FOUND-NO-88 TO TRUE. DTSZX551 01013 DTSZX551 01014 ADD +1 TO W-X145-RED-CNT DTSZX551 01015 DISPLAY SPACE. DTSZX551 01016 DISPLAY 'BX451- NEW EMPLOYER PAYMENT ' X145-EMP-NO. DTSZX551 01017 * DISPLAY ' X145-KEY ' X145-EMP-NO. DTSZX551 01018 * DISPLAY 'LX145-KEY ' LX42-X145-KEY-AREA. DTSZX551 01019 DTSZX551 01020 * IF LX42-X145-EMP-NO = '999999' DTSZX551 01021 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01022 * MOVE SPACES TO R140-MESSAGE DTSZX551 01023 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01024 * STRING DTSZX551 01025 * 'PAYMENT CONTAINS ERRORS CANNOT PROCESS - PYMTS ' DTSZX551 01026 * DELIMITED BY SIZE DTSZX551 01027 * INTO R140-MESSAGE DTSZX551 01028 * END-STRING DTSZX551 01029 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01030 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01031 * MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 01032 * ADD +1 TO W-X145-ERR-CNT DTSZX551 01033 * ADD +1 TO W-X145-PEN-CNT DTSZX551 01034 * WRITE PEND-X145-REC FROM X145-REC DTSZX551 01035 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT DTSZX551 01036 * GO TO P1000-EXIT. DTSZX551 01037 DTSZX551 01038 DTSZX551 01039 * IF LX42-REC-TYPE-PAY-88 DTSZX551 01040 * IF LX42-X145-KEY-AREA = X145-EMP-NO AND DTSZX551 01041 * LX42-X145-QTR-AREA = X145-QTR DTSZX551 01042 * SET W-PREV-RPT-NULL-88 TO TRUE DTSZX551 01043 * ADD +1 TO W-X145-DUP-CNT DTSZX551 01044 * DISPLAY 'X145 DUPLICATE PAYMENT RECORD ' W-EMP-NO DTSZX551 01045 * ' ERR IND ' W-RPT-ERROR-IND DTSZX551 01046 * MOVE SPACES TO R140-MESSAGE DTSZX551 01047 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01048 * MOVE SPACES TO R140-MESSAGE DTSZX551 01049 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01050 * STRING DTSZX551 01051 * ': DUPLICATE PAYMENT RECORD ----PROCESS ' DTSZX551 01052 * DELIMITED BY SIZE DTSZX551 01053 * INTO R140-MESSAGE DTSZX551 01054 * END-STRING DTSZX551 01055 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01056 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01057 * ELSE DTSZX551 01058 * MOVE X145-EMP-NO TO LX42-X145-KEY-AREA DTSZX551 01059 * END-IF DTSZX551 01060 * END-IF. DTSZX551 01061 DTSZX551 01062 DTSZX551 01063 MOVE X145-EMP-NO TO LX42-X145-EMP-NO. DTSZX551 01064 MOVE X145-QTR TO LX42-X145-QTR-AREA DTSZX551 01065 DTSZX551 01066 * DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE. DTSZX551 01067 * IF W-PREV-RPT-NULL-88 OR DTSZX551 01068 * LX42-REC-TYPE-PAY-88 DTSZX551 01069 * SET W-PREV-RPT-PAY-88 TO TRUE DTSZX551 01070 * SET W-PREV-REC-PAY-88 TO TRUE DTSZX551 01071 ADD +1 TO W-X145-PRO-CNT DTSZX551 01072 PERFORM P1110-EDIT-PAYMENT THRU P1110-EXIT DTSZX551 01073 IF W-RPT-ERROR-NO-88 DTSZX551 01074 PERFORM P1112-CHECK-PAYMENT THRU P1112-EXIT DTSZX551 01075 IF W-RPT-ERROR-NO-88 DTSZX551 01076 * DISPLAY 'X145 PAYMENT REC PASS EDITS ' W-EMP-NO DTSZX551 01077 ADD +1 TO W-X145-SAV-CNT DTSZX551 01078 PERFORM P1120-SAVE-PAYMENT THRU P1120-EXIT DTSZX551 01079 ELSE DTSZX551 01080 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 01081 ADD +1 TO W-X145-ERR-CNT DTSZX551 01082 ADD +1 TO W-X145-PEN-CNT DTSZX551 01083 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01084 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT DTSZX551 01085 WRITE PEND-X145-REC FROM X145-REC DTSZX551 01086 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1 DTSZX551 01087 END-IF DTSZX551 01088 ELSE DTSZX551 01089 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 01090 ADD +1 TO W-X145-ERR-CNT DTSZX551 01091 ADD +1 TO W-X145-PEN-CNT DTSZX551 01092 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01093 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT DTSZX551 01094 WRITE PEND-X145-REC FROM X145-REC DTSZX551 01095 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1 DTSZX551 01096 END-IF. DTSZX551 01097 DTSZX551 01098 P1000-EXIT. DTSZX551 01099 EXIT. DTSZX551 01100 DTSZX551 01101 P1110-EDIT-PAYMENT. DTSZX551 01102 DTSZX551 01103 MOVE X145-PAY-TYPE TO W-PAY-TYPE. DTSZX551 01104 IF W-VALID-PAY-88 DTSZX551 01105 NEXT SENTENCE DTSZX551 01106 ELSE DTSZX551 01107 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01108 MOVE SPACES TO R140-MESSAGE DTSZX551 01109 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01110 STRING DTSZX551 01111 ':PAY- INVALID PAYMENT TYPE ' DTSZX551 01112 X145-PAY-TYPE DTSZX551 01113 DELIMITED BY SIZE DTSZX551 01114 INTO R140-MESSAGE DTSZX551 01115 END-STRING DTSZX551 01116 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 01117 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01118 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01119 END-IF. DTSZX551 01120 IF X145-QTR = SPACES DTSZX551 01121 MOVE '2015/1' TO W-SLASH-QTR DTSZX551 01122 ELSE DTSZX551 01123 MOVE X145-QTR TO W-SLASH-QTR. DTSZX551 01124 DTSZX551 01125 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR DTSZX551 01126 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q DTSZX551 01127 PERFORM S004-FROM-5 THRU S004-EXIT DTSZX551 01128 IF NOT L004-VALID-QTR DTSZX551 01129 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01130 MOVE SPACES TO R140-MESSAGE DTSZX551 01131 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01132 STRING DTSZX551 01133 ':PAY- INVALID QUARTER ' W-SLASH-QTR DTSZX551 01134 DELIMITED BY SIZE DTSZX551 01135 INTO R140-MESSAGE DTSZX551 01136 END-STRING DTSZX551 01137 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01138 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 01139 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01140 ELSE DTSZX551 01141 MOVE L004-QTR-5-9 TO W-X145-PAYMENT-QTR DTSZX551 01142 END-IF. DTSZX551 01143 DTSZX551 01144 * DISPLAY 'X145Q ' W-SLASH-QTR ' WQTR ' W-X145-PAYMENT-QTR DTSZX551 01145 DTSZX551 01146 MOVE X145-REMITTANCE TO W-X145-REMITTANCE. DTSZX551 01147 * DISPLAY 'W145REMITCE ' W-X145-REMITTANCE. DTSZX551 01148 * DISPLAY 'X145REMITCE ' X145-REMITTANCE. DTSZX551 01149 DTSZX551 01150 IF W-X145-REMITTANCE = ZEROS DTSZX551 01151 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01152 ADD +1 TO W-X145-ZRO-CNT DTSZX551 01153 MOVE SPACES TO R140-MESSAGE DTSZX551 01154 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01155 * STRING DTSZX551 01156 * 'X430- REVIEW REMITTANCE AMOUNT= 0 ' DTSZX551 01157 * DELIMITED BY SIZE DTSZX551 01158 * INTO R140-MESSAGE DTSZX551 01159 * END-STRING DTSZX551 01160 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01161 END-IF. DTSZX551 01162 DTSZX551 01163 MOVE ZEROS TO W-X145-RECEIVED-DATE DTSZX551 01164 MOVE X145-RCVD-DATE TO W-SLASH-DATE DTSZX551 01165 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSZX551 01166 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSZX551 01167 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSZX551 01168 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSZX551 01169 IF NOT L001-VALID-DATE DTSZX551 01170 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01171 MOVE SPACES TO R140-MESSAGE DTSZX551 01172 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01173 STRING DTSZX551 01174 ':PAY- INVALID RECEIVED DATE ' DTSZX551 01175 ' ' X145-RCVD-DATE DTSZX551 01176 DELIMITED BY SIZE DTSZX551 01177 INTO R140-MESSAGE DTSZX551 01178 END-STRING DTSZX551 01179 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01180 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01181 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 01182 ELSE DTSZX551 01183 MOVE L001-FED-8-DATE-9 TO W-X145-RECEIVED-DATE DTSZX551 01184 END-IF. DTSZX551 01185 DTSZX551 01186 P1110-EXIT. DTSZX551 01187 EXIT. DTSZX551 01188 DTSZX551 01189 P1112-CHECK-PAYMENT. DTSZX551 01190 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSZX551 01191 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSZX551 01192 SET MPRF-PRF-88 TO TRUE. DTSZX551 01193 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSZX551 01194 DTSZX551 01195 PERFORM S910-READ THRU S910-EXIT. DTSZX551 01196 IF L910-NO-REC-88 DTSZX551 01197 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01198 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 01199 MOVE SPACES TO R140-MESSAGE DTSZX551 01200 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01201 STRING DTSZX551 01202 ':EMP NOT ON DUTAS -CANNOT PAY ' DTSZX551 01203 X145-EMP-NO DTSZX551 01204 DELIMITED BY SIZE DTSZX551 01205 INTO R140-MESSAGE DTSZX551 01206 END-STRING DTSZX551 01207 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01208 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01209 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 01210 ELSE DTSZX551 01211 MOVE MSKL-REC TO MPRF-REC DTSZX551 01212 SET W-EMP-FOUND-YES-88 TO TRUE DTSZX551 01213 END-IF. DTSZX551 01214 DTSZX551 01215 P1112-EXIT. DTSZX551 01216 EXIT. DTSZX551 01217 DTSZX551 01218 P1120-SAVE-PAYMENT. DTSZX551 01219 IF W-X145-REMITTANCE = ZEROS DTSZX551 01220 GO TO P1120-EXIT. DTSZX551 01221 * DISPLAY ' SAVE PAYMENT RECORD ' W-EMP-NO. DTSZX551 01222 MOVE W-X145-REMITTANCE TO W-X145-TOT-REMIT-AMT. DTSZX551 01223 ADD W-X145-REMITTANCE TO W-TOT-REMIT-AMT. DTSZX551 01224 ADD +1 TO W-X145-SAV-CNT. DTSZX551 01225 PERFORM P2021-WRITE-T025 THRU P2021-EXIT. DTSZX551 01226 P1120-EXIT. DTSZX551 01227 EXIT. DTSZX551 01228 DTSZX551 01229 DTSZX551 01230 DTSZX551 01231 P2000-REPORT. DTSZX551 01232 MOVE LX42-DATA-AREA TO X140-REC. DTSZX551 01233 DTSZX551 01234 * SET W-RPT-IN-PROGRESS-YES-88 TO TRUE DTSZX551 01235 DTSZX551 01236 MOVE X140-EMP-NO TO W-EMP-NO. DTSZX551 01237 DTSZX551 01238 ADD +1 TO W-X140-RED-CNT. DTSZX551 01239 * DISPLAY ' PREV RPT REC TYPE ' W-PREV-REC-TYPE. DTSZX551 01240 * IF W-PREV-RPT-NULL-88 DTSZX551 01241 * SET W-PREV-RPT-RPT-88 TO TRUE DTSZX551 01242 * SET W-X145-PAYMENT-NO-88 TO TRUE DTSZX551 01243 * ELSE DTSZX551 01244 * SET W-X145-PAYMENT-YES-88 TO TRUE DTSZX551 01245 * END-IF. DTSZX551 01246 DTSZX551 01247 * IF LX42-REC-TYPE-RPT-88 CL**6 01248 * IF LX42-X140-KEY-AREA = X140-EMP-NO AND CL**6 01249 * LX42-X140-QTR-AREA = X140-QUARTER CL**6 01250 * SET W-RPT-ERROR-YES-88 TO TRUE CL**6 01251 * ADD +1 TO W-X140-DUP-CNT CL**6 01252 * ADD +1 TO W-X140-PEN-CNT CL**6 01253 * DISPLAY ':ERROR-RPT DUPLICATE REPORT D ' CL**6 01254 * ' ERR IND ' W-RPT-ERROR-IND CL**6 01255 * MOVE SPACES TO R140-MESSAGE CL**6 01256 * MOVE W-EMP-NO TO R140-EMP-NO CL**6 01257 * STRING CL**6 01258 * ':RPT- DUPLICATE REPORT RECORD ' CL**6 01259 * DELIMITED BY SIZE CL**6 01260 * INTO R140-MESSAGE CL**6 01261 * END-STRING CL**6 01262 * MOVE R140-MESSAGE TO P434-MESSAGE CL**6 01263 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL**6 01264 * PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL**6 01265 * WRITE PEND-X140-REC FROM X140-REC CL**6 01266 * MOVE '999999' TO LX42-X140-EMP-NO CL**6 01267 * GO TO P2000-EXIT CL**6 01268 * ELSE CL**6 01269 * MOVE X140-EMP-NO TO LX42-X140-KEY-AREA CL**6 01270 * END-IF CL**6 01271 * END-IF. CL**6 01272 DTSZX551 01273 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 01274 MOVE X140-EMP-NO TO LX42-X140-EMP-NO. DTSZX551 01275 MOVE X140-QUARTER TO LX42-X140-QTR-AREA DTSZX551 01276 SET W-EMP-FOUND-NO-88 TO TRUE. DTSZX551 01277 DTSZX551 01278 * IF LX42-X145-EMP-NO = '999999' DTSZX551 01279 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01280 * MOVE SPACES TO R140-MESSAGE DTSZX551 01281 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01282 * STRING DTSZX551 01283 * ':PAY RECORD INVALID -RPT BYPASSED ' DTSZX551 01284 * DELIMITED BY SIZE DTSZX551 01285 ** INTO R140-MESSAGE DTSZX551 01286 * END-STRING DTSZX551 01287 * MOVE '999999' TO LX42-X140-EMP-NO DTSZX551 01288 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01289 * ADD +1 TO W-X140-PEN-CNT DTSZX551 01290 * WRITE PEND-X140-REC FROM X140-REC DTSZX551 01291 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01292 * PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT DTSZX551 01293 * GO TO P2000-EXIT. DTSZX551 01294 DTSZX551 01295 SET W-PREV-RPT-RPT-88 TO TRUE. DTSZX551 01296 DTSZX551 01297 DTSZX551 01298 PERFORM P2010-EDIT-REPORT THRU P2010-EXIT DTSZX551 01299 DTSZX551 01300 IF W-RPT-ERROR-YES-88 DTSZX551 01301 MOVE '999999' TO LX42-X140-EMP-NO DTSZX551 01302 DISPLAY ' REPORT HAS ERRORS - DATA ERRORS' DTSZX551 01303 GO TO P2000-EDIT-REPORT-CONTINUE. DTSZX551 01304 DTSZX551 01305 PERFORM P2012-CHECK-MPRF THRU P2012-EXIT DTSZX551 01306 IF W-RPT-ERROR-YES-88 DTSZX551 01307 MOVE '999999' TO LX42-X140-EMP-NO DTSZX551 01308 DISPLAY ' REPORT HAS ERRORS - MPRF ERRORS' DTSZX551 01309 GO TO P2000-EDIT-REPORT-CONTINUE. DTSZX551 01310 DTSZX551 01311 PERFORM P2013-CHECK-MQTR THRU P2013-EXIT DTSZX551 01312 IF W-RPT-ERROR-YES-88 DTSZX551 01313 MOVE '999999' TO LX42-X140-EMP-NO DTSZX551 01314 DISPLAY ' REPORT HAS ERRORS - CANNOT-AMEND' DTSZX551 01315 GO TO P2000-EDIT-REPORT-CONTINUE. DTSZX551 01316 DTSZX551 01317 P2000-EDIT-REPORT-CONTINUE. DTSZX551 01318 IF W-RPT-ERROR-YES-88 DTSZX551 01319 SET W-RPT-ERROR-NO-88 TO TRUE CL**8 01320 MOVE SPACES TO R140-MESSAGE DTSZX551 01321 * MOVE W-EMP-NO TO R140-EMP-NO CL**8 01322 * STRING CL**8 01323 * ': REPORT CONTAINS ERRORS CANNOT AMEND ' CL**8 01324 * ' ' X140-QUARTER CL**8 01325 * DELIMITED BY SIZE CL**8 01326 * INTO R140-MESSAGE CL**8 01327 * END-STRING CL**8 01328 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL**8 01329 ADD +1 TO W-X140-PEN-CNT DTSZX551 01330 WRITE PEND-X140-REC FROM X140-REC DTSZX551 01331 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT DTSZX551 01332 * MOVE R140-MESSAGE TO P434-MESSAGE CL**8 01333 GO TO P2000-EXIT. DTSZX551 01334 DTSZX551 01335 PERFORM P2020-SAVE-EXT-REPORT THRU P2020-EXIT. DTSZX551 01336 ADD +1 TO W-X140-SAV-CNT. DTSZX551 01337 DTSZX551 01338 DTSZX551 01339 P2000-EXIT. DTSZX551 01340 EXIT. DTSZX551 01341 DTSZX551 01342 P2010-EDIT-REPORT. DTSZX551 01343 MOVE X140-QUARTER TO W-SLASH-QTR. DTSZX551 01344 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSZX551 01345 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSZX551 01346 PERFORM S004-FROM-5 THRU S004-EXIT. DTSZX551 01347 IF NOT L004-VALID-QTR DTSZX551 01348 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01349 MOVE SPACES TO R140-MESSAGE DTSZX551 01350 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01351 STRING DTSZX551 01352 ':RPT- INVALID QUARTER ' DTSZX551 01353 X140-QUARTER DTSZX551 01354 DELIMITED BY SIZE DTSZX551 01355 INTO R140-MESSAGE DTSZX551 01356 END-STRING DTSZX551 01357 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01358 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01359 ELSE DTSZX551 01360 MOVE L004-QTR-5-9 TO W-X140-REPORT-QTR DTSZX551 01361 END-IF. DTSZX551 01362 DTSZX551 01363 MOVE X140-REPORT-TYPE TO W-RPT-TYPE. DTSZX551 01364 IF NOT W-RPT-TYPE-VALID-88 DTSZX551 01365 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01366 MOVE SPACES TO R140-MESSAGE DTSZX551 01367 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01368 STRING DTSZX551 01369 'ERROR-RPT INVALID REPORT TYPE ' DTSZX551 01370 X140-REPORT-TYPE DTSZX551 01371 DELIMITED BY SIZE DTSZX551 01372 INTO R140-MESSAGE DTSZX551 01373 END-STRING DTSZX551 01374 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01375 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01376 END-IF. DTSZX551 01377 DTSZX551 01378 IF W-RPT-TYPE NOT = 'EA' AND 'AC' DTSZX551 01379 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01380 MOVE SPACES TO R140-MESSAGE DTSZX551 01381 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01382 STRING DTSZX551 01383 ':RPT- NOT AMENDED TYPE - CANNOT PROCESS ' CL**6 01384 ' ' W-RPT-TYPE DTSZX551 01385 DELIMITED BY SIZE DTSZX551 01386 INTO R140-MESSAGE DTSZX551 01387 END-STRING DTSZX551 01388 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01389 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01390 END-IF. DTSZX551 01391 DTSZX551 01392 DTSZX551 01393 * IF W-CURR-RPT-QTR NOT = W-X140-REPORT-QTR DTSZX551 01394 * MOVE ZERO TO W-TOT-WAGE DTSZX551 01395 * MOVE W-X140-REPORT-QTR TO W-CURR-RPT-QTR DTSZX551 01396 * END-IF. DTSZX551 01397 MOVE X140-TOTAL-WAGES TO W-TOT-WAGE. DTSZX551 01398 MOVE X140-TAX-WAGES TO W-TAX-WAGE. DTSZX551 01399 COMPUTE W-EXX-WAGE = W-TOT-WAGE - W-TAX-WAGE. CL*14 01400 * MOVE W140-EXCESS-WAGES TO W-EXX-WAGE. CL*14 01401 DTSZX551 01402 * IF W-EMP-NO = 177462 DTSZX551 01403 * MOVE 1352.07 TO X140-REMITTANCE DTSZX551 01404 * DISPLAY ' X140-RMT ' X140-REMITTANCE. DTSZX551 01405 DTSZX551 01406 MOVE X140-REMITTANCE TO W-X140-REMITTANCE. DTSZX551 01407 * DISPLAY ' W-X140-RMT ' W-X140-REMITTANCE. DTSZX551 01408 *& DTSZX551 01409 DTSZX551 01410 * DISPLAY ' PAY FOUND IND ' W-X145-PAYMENT-FOUND-IND. DTSZX551 01411 DTSZX551 01412 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE > 0 DTSZX551 01413 * MOVE SPACES TO R140-MESSAGE DTSZX551 01414 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01415 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01416 * STRING DTSZX551 01417 * 'ESSP AMT DUE > 0 AND NO PAYMT ' DTSZX551 01418 * DELIMITED BY SIZE DTSZX551 01419 * INTO R140-MESSAGE DTSZX551 01420 * END-STRING DTSZX551 01421 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01422 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01423 * GO TO P2010-EDIT-CONTINUE DTSZX551 01424 * END-IF. DTSZX551 01425 DTSZX551 01426 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE = 0 DTSZX551 01427 * MOVE SPACES TO R140-MESSAGE DTSZX551 01428 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01429 * STRING DTSZX551 01430 * 'X140 REMIT AMT = 0 AND NO X145 FOUND -PROCESS ' DTSZX551 01431 * ' ' X140-REMITTANCE DTSZX551 01432 * DELIMITED BY SIZE DTSZX551 01433 * INTO R140-MESSAGE DTSZX551 01434 * END-STRING DTSZX551 01435 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01436 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01437 * GO TO P2010-EDIT-CONTINUE DTSZX551 01438 * END-IF. DTSZX551 01439 DTSZX551 01440 * IF W-X145-TOT-REMIT-AMT > W-X140-REMITTANCE DTSZX551 01441 * MOVE SPACES TO R140-MESSAGE DTSZX551 01442 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01443 * SET W-WRITE-T025-TRAN-YES-88 TO TRUE DTSZX551 01444 * STRING DTSZX551 01445 * 'X430 X145-PAY AMT > X140-REMIT AMT --PROCESS 'DTSZX551 01446 * X145-REMITTANCE ' ' X140-REMITTANCE DTSZX551 01447 * DELIMITED BY SIZE DTSZX551 01448 * INTO R140-MESSAGE DTSZX551 01449 * END-STRING DTSZX551 01450 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01451 * END-IF. DTSZX551 01452 DTSZX551 01453 * IF W-X145-TOT-REMIT-AMT < W-X140-REMITTANCE DTSZX551 01454 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01455 * MOVE SPACES TO R140-MESSAGE DTSZX551 01456 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01457 * STRING DTSZX551 01458 * 'X430 X145-PAY AMT < X140-REMIT AMT ' DTSZX551 01459 * X145-REMITTANCE ' ' X140-REMITTANCE DTSZX551 01460 * DELIMITED BY SIZE DTSZX551 01461 * INTO R140-MESSAGE DTSZX551 01462 * END-STRING DTSZX551 01463 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01464 * END-IF. DTSZX551 01465 DTSZX551 01466 * IF W-X145-TOT-REMIT-AMT > 0 AND W-X140-REMITTANCE = 0 DTSZX551 01467 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01468 * MOVE SPACES TO R140-MESSAGE DTSZX551 01469 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01470 * STRING DTSZX551 01471 * 'X430 X145-PAY AMT > 0 AND X140-REMIT AMT = 0 ' DTSZX551 01472 * X145-REMITTANCE ' ' X140-REMITTANCE DTSZX551 01473 * DELIMITED BY SIZE DTSZX551 01474 * INTO R140-MESSAGE DTSZX551 01475 * END-STRING DTSZX551 01476 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01477 * END-IF. DTSZX551 01478 DTSZX551 01479 * IF W-X145-TOT-REMIT-AMT = W-X140-REMITTANCE DTSZX551 01480 * ADD 1 TO W-T028-WRITEE-CNT DTSZX551 01481 * SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 01482 * MOVE SPACES TO R140-MESSAGE DTSZX551 01483 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01484 * STRING DTSZX551 01485 * 'X430 ++++ X145-REMIT AMT = X140-REMIT AMT ' DTSZX551 01486 * X145-REMITTANCE ' ' X140-REMITTANCE DTSZX551 01487 * DELIMITED BY SIZE DTSZX551 01488 * INTO R140-MESSAGE DTSZX551 01489 * END-STRING DTSZX551 01490 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01491 * END-IF. DTSZX551 01492 DTSZX551 01493 P2010-EDIT-CONTINUE. DTSZX551 01494 * DISPLAY 'BX436 P1210: ' W-EMP-NO ' TAX: ' X140-TAX-WAGES DTSZX551 01495 * ' TOT: ' X140-TOTAL-WAGES ' RMT: ' W-X140-REMITTANCE DTSZX551 01496 *& DTSZX551 01497 MOVE ZERO TO W-X140-RECEIVED-DATE. DTSZX551 01498 MOVE X140-RCVD-DATE TO W-SLASH-DATE. DTSZX551 01499 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSZX551 01500 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSZX551 01501 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSZX551 01502 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSZX551 01503 IF NOT L001-VALID-DATE DTSZX551 01504 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01505 MOVE SPACES TO R140-MESSAGE DTSZX551 01506 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01507 STRING DTSZX551 01508 ':RPT- INVALID RECEIVED DATE ' DTSZX551 01509 X140-RCVD-DATE DTSZX551 01510 DELIMITED BY SIZE DTSZX551 01511 INTO R140-MESSAGE DTSZX551 01512 END-STRING DTSZX551 01513 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01514 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01515 ELSE DTSZX551 01516 MOVE L001-FED-8-DATE-9 TO W-X140-RECEIVED-DATE DTSZX551 01517 END-IF. DTSZX551 01518 DTSZX551 01519 MOVE ZERO TO W-CHK-SCAN-DATE. DTSZX551 01520 * IF X140-IN-HOUSE-88 DTSZX551 01521 * MOVE X140-CHECK-SCAN-DT TO W-SLASH-DATE DTSZX551 01522 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSZX551 01523 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSZX551 01524 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSZX551 01525 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSZX551 01526 * IF NOT L001-VALID-DATE DTSZX551 01527 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01528 * MOVE SPACES TO R140-MESSAGE DTSZX551 01529 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01530 * STRING DTSZX551 01531 * 'REPORT: INVALID CHK SCAN DATE ' DTSZX551 01532 * X140-CHECK-SCAN-DT DTSZX551 01533 * DELIMITED BY SIZE DTSZX551 01534 * INTO R140-MESSAGE DTSZX551 01535 * END-STRING DTSZX551 01536 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01537 ** DISPLAY R140-MESSAGE DTSZX551 01538 * ELSE DTSZX551 01539 * MOVE L001-FED-8-DATE-9 TO W-CHK-SCAN-DATE DTSZX551 01540 * END-IF DTSZX551 01541 * END-IF. DTSZX551 01542 DTSZX551 01543 MOVE X140-WRKR-CNT-1ST-MNTH TO W-1ST-MNTH-CNT. DTSZX551 01544 MOVE X140-WRKR-CNT-2ND-MNTH TO W-2ND-MNTH-CNT. DTSZX551 01545 MOVE X140-WRKR-CNT-3RD-MNTH TO W-3RD-MNTH-CNT. DTSZX551 01546 MOVE X140-WRKR-CNT-TOTAL TO W-WRKR-CNT-TOTAL. DTSZX551 01547 DTSZX551 01548 DTSZX551 01549 P2010-EXIT. DTSZX551 01550 EXIT. DTSZX551 01551 DTSZX551 01552 P2012-CHECK-MPRF. DTSZX551 01553 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSZX551 01554 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSZX551 01555 SET MPRF-PRF-88 TO TRUE. DTSZX551 01556 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSZX551 01557 DTSZX551 01558 PERFORM S910-READ THRU S910-EXIT. DTSZX551 01559 DTSZX551 01560 IF L910-OK-88 DTSZX551 01561 MOVE MSKL-REC TO MPRF-REC DTSZX551 01562 MOVE W-X140-REPORT-QTR TO L516-YRQ DTSZX551 01563 PERFORM S516-LIABILITY-INFO THRU S516-EXIT DTSZX551 01564 IF L516-LIABLE-88 DTSZX551 01565 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 01566 SET W-EMP-FOUND-YES-88 TO TRUE DTSZX551 01567 DISPLAY 'P2012 -EMPL FOUND LIAB FOR QTR ' MPRF-EMP-NO CL**9 01568 GO TO P2012-EXIT DTSZX551 01569 ELSE DTSZX551 01570 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01571 MOVE SPACES TO R140-MESSAGE DTSZX551 01572 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01573 STRING DTSZX551 01574 ':EMP NOT LIABLE FOR QTRLY RPT -CANNOT AMEND' DTSZX551 01575 X140-QUARTER DTSZX551 01576 DELIMITED BY SIZE DTSZX551 01577 INTO R140-MESSAGE DTSZX551 01578 END-STRING DTSZX551 01579 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01580 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01581 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 01582 GO TO P2012-EXIT DTSZX551 01583 ELSE DTSZX551 01584 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01585 MOVE SPACES TO R140-MESSAGE DTSZX551 01586 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01587 STRING DTSZX551 01588 ':EMP NOT FOUND ON DUTAS-CANNOT AMEND RPT' DTSZX551 01589 X140-EMP-NO DTSZX551 01590 DELIMITED BY SIZE DTSZX551 01591 INTO R140-MESSAGE DTSZX551 01592 END-STRING DTSZX551 01593 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 01594 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01595 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 01596 END-IF. DTSZX551 01597 DTSZX551 01598 P2012-EXIT. DTSZX551 01599 EXIT. DTSZX551 01600 DTSZX551 01601 DTSZX551 01602 P2013-CHECK-MQTR. DTSZX551 01603 DISPLAY 'P2013 X140 REPORT FROM ESSP- ' CL*19 01604 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. CL*19 01605 DISPLAY ' ' CL*19 01606 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSZX551 01607 MOVE W-EMP-NO TO MQTR-EMP-NO. DTSZX551 01608 SET MQTR-QTR-88 TO TRUE. DTSZX551 01609 MOVE W-X140-REPORT-QTR TO MQTR-YRQ. DTSZX551 01610 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSZX551 01611 DTSZX551 01612 PERFORM S910-READ THRU S910-EXIT. DTSZX551 01613 DTSZX551 01614 IF L910-NO-REC-88 DTSZX551 01615 DISPLAY 'P2013 -ORIG RPT NOT FOUND ' L910-RESULT-IND CL**6 01616 ELSE DTSZX551 01617 IF L910-OK-88 DTSZX551 01618 DISPLAY 'P2013 MQTR REC FOUND ' L910-RESULT-IND CL**6 01619 ELSE DTSZX551 01620 DISPLAY 'P2013 X430 NOT SURE ' L910-RESULT-IND. DTSZX551 01621 DTSZX551 01622 IF L910-NO-REC-88 DTSZX551 01623 DISPLAY 'P2013- ORIG RPT NOT ON ZUTAS- CANNOT AMEND ' CL*19 01624 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO DTSZX551 01625 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01626 MOVE SPACES TO R140-MESSAGE DTSZX551 01627 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01628 STRING DTSZX551 01629 'P2013 -ORIG REPORT NOT IN ZUTAS - CANNOT AMEND' CL*19 01630 W-RPT-TYPE DTSZX551 01631 DELIMITED BY SIZE DTSZX551 01632 INTO R140-MESSAGE DTSZX551 01633 END-STRING DTSZX551 01634 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 01635 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01636 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 01637 GO TO P2013-EXIT. DTSZX551 01638 DTSZX551 01639 DTSZX551 01640 MOVE MSKL-REC TO MQTR-REC DTSZX551 01641 DTSZX551 01642 DISPLAY 'P2013- QTR RPT FOUND ON DUTAS ' CL**6 01643 MQTR-EMP-NO ' ' MQTR-YRQ ' RPT-TYP ' MQTR-CURR-RPT-TYPE DTSZX551 01644 ' PUR-IND ' MQTR-PURSUED-RPT-IND DTSZX551 01645 ' CUT-OFF ' MQTR-MISS-RPT-CUTOFF-CD DTSZX551 01646 DTSZX551 01647 *ZADD CL*23 01648 IF MQTR-EMP-NO = 346251 CL*23 01649 SET W-EMP-FOUND-NO-88 TO TRUE CL*23 01650 GO TO P2013-EXIT. CL*23 01651 CL*23 01652 *ZEND CL*23 01653 CL*23 01654 * IF MQTR-CURR-MISSING-88 CL*24 01655 IF MQTR-CURR-ESTIM-88 CL*24 01656 DISPLAY 'X431 ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL*22 01657 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO DTSZX551 01658 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01659 MOVE SPACES TO R140-MESSAGE DTSZX551 01660 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01661 STRING DTSZX551 01662 'P2013 -ORIG REPORT NOT IN DUTAS - CANNOT AMEND' DTSZX551 01663 W-RPT-TYPE DTSZX551 01664 DELIMITED BY SIZE DTSZX551 01665 INTO R140-MESSAGE DTSZX551 01666 END-STRING DTSZX551 01667 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 01668 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01669 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 01670 GO TO P2013-EXIT. DTSZX551 01671 DTSZX551 01672 IF MQTR-CURR-ORIG-88 OR DTSZX551 01673 MQTR-CURR-ORIG-ANN-NL-88 DTSZX551 01674 DISPLAY 'X432 ORIG RPT FOUND ON DUTAS- PROCESS AMEND ' CL*22 01675 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO DTSZX551 01676 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 01677 MOVE SPACES TO R140-MESSAGE DTSZX551 01678 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01679 STRING DTSZX551 01680 'P2013 -ORIG REPORT IN DUTAS - PROCESS AMEND' DTSZX551 01681 W-RPT-TYPE DTSZX551 01682 DELIMITED BY SIZE DTSZX551 01683 INTO R140-MESSAGE DTSZX551 01684 END-STRING DTSZX551 01685 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 01686 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**2 01687 GO TO P2013-EXIT. CL**2 01688 DTSZX551 01689 IF MQTR-CURR-AMEND-88 OR CL**2 01690 MQTR-CURR-AUDIT-88 OR CL**2 01691 MQTR-CURR-ADMIN-88 OR CL**2 01692 MQTR-CURR-FIELD-88 CL**2 01693 PERFORM P2113-CHECK-MRPT THRU P2113-EXIT CL**6 01694 ELSE CL**6 01695 DISPLAY 'X433 ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL*22 01696 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO CL**6 01697 SET W-RPT-ERROR-YES-88 TO TRUE CL**6 01698 MOVE SPACES TO R140-MESSAGE CL**6 01699 MOVE W-EMP-NO TO R140-EMP-NO CL**6 01700 STRING CL**6 01701 'P2013 -ORIG REPORT NOT IN DUTAS - CANNOT AMEND' CL**6 01702 W-RPT-TYPE CL**6 01703 DELIMITED BY SIZE CL**6 01704 INTO R140-MESSAGE CL**6 01705 END-STRING CL**6 01706 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 01707 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**6 01708 SET W-EMP-FOUND-NO-88 TO TRUE CL**6 01709 GO TO P2013-EXIT. CL**6 01710 CL**2 01711 IF W-RPT-DUPL-YES-88 CL**3 01712 DISPLAY 'X434 DUPLICATE AMENDMENT--- CANNOT AMEND ' CL*22 01713 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO CL**7 01714 SET W-RPT-ERROR-YES-88 TO TRUE CL**7 01715 MOVE SPACES TO R140-MESSAGE CL**7 01716 MOVE W-EMP-NO TO R140-EMP-NO CL**7 01717 STRING CL**7 01718 'MRPT-DUPLICATE AMENDMENT -CANNOT AMEND' CL**7 01719 W-RPT-TYPE CL**7 01720 DELIMITED BY SIZE CL**7 01721 INTO R140-MESSAGE CL**7 01722 END-STRING CL**7 01723 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 01724 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**7 01725 SET W-EMP-FOUND-NO-88 TO TRUE CL**7 01726 GO TO P2013-EXIT. CL**7 01727 CL**7 01728 SET W-RPT-DUPL-NO-88 TO TRUE CL**7 01729 PERFORM P2015-CHECK-MQTR-DUP THRU P2015-EXIT. CL**7 01730 CL**3 01731 IF W-RPT-DUPL-NO-88 CL**3 01732 SET W-RPT-ERROR-NO-88 TO TRUE CL**2 01733 MOVE SPACES TO R140-MESSAGE CL**2 01734 MOVE W-EMP-NO TO R140-EMP-NO CL**2 01735 STRING CL**2 01736 'P2013 -NO DUP REPORT IN DUTAS - PROCESS AMEND' CL**3 01737 W-RPT-TYPE CL**2 01738 DELIMITED BY SIZE CL**2 01739 INTO R140-MESSAGE CL**2 01740 END-STRING CL**2 01741 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 01742 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**2 01743 GO TO P2013-EXIT CL**3 01744 ELSE CL**3 01745 SET W-RPT-ERROR-YES-88 TO TRUE CL**3 01746 MOVE SPACES TO R140-MESSAGE CL**3 01747 MOVE W-EMP-NO TO R140-EMP-NO CL**3 01748 STRING CL**3 01749 ':DUPLICATE AMENDMENT ---CANNOT AMEND RPT' CL**3 01750 X140-EMP-NO CL**3 01751 DELIMITED BY SIZE CL**3 01752 INTO R140-MESSAGE CL**3 01753 END-STRING CL**3 01754 MOVE R140-MESSAGE TO P434-MESSAGE CL**3 01755 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**3 01756 SET W-EMP-FOUND-NO-88 TO TRUE CL**3 01757 END-IF. CL**3 01758 CL**2 01759 P2013-EXIT. DTSZX551 01760 EXIT. DTSZX551 01761 DTSZX551 01762 P2015-CHECK-MQTR-DUP. CL**3 01763 DISPLAY 'P2015 FOUND AMENDED MQTR CHECK FOR DUPS ' CL*15 01764 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. CL*15 01765 CL*15 01766 IF MPRF-CLASS-SELF-INS-88 CL*15 01767 MOVE ZERO TO W-EXX-WAGE CL*15 01768 W-TAX-WAGE. CL*15 01769 CL*15 01770 IF W-TOT-WAGE = MQTR-TOT-WAGE AND CL**3 01771 W-EXX-WAGE = MQTR-EXCESS-WAGE AND CL**3 01772 W-TAX-WAGE = MQTR-TAX-WAGE CL**3 01773 SET W-RPT-DUPL-YES-88 TO TRUE. CL**3 01774 P2015-EXIT. EXIT. CL**3 01775 CL**3 01776 DTSZX551 01777 P2113-CHECK-MRPT. DTSZX551 01778 DISPLAY 'P2113 - X140 REPORT FROM ESSP- ' CL**7 01779 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. DTSZX551 01780 DISPLAY ' ' DTSZX551 01781 SET W-RPT-DUPL-NO-88 TO TRUE CL**3 01782 MOVE LOW-VALUE TO MRPT-KEY-AREA. DTSZX551 01783 MOVE W-EMP-NO TO MRPT-EMP-NO. DTSZX551 01784 SET MRPT-RPT-88 TO TRUE. DTSZX551 01785 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. DTSZX551 01786 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSZX551 01787 DTSZX551 01788 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSZX551 01789 IF L910-OK-88 DTSZX551 01790 PERFORM P2116-SCAN-MRPT THRU P2116-EXIT DTSZX551 01791 UNTIL L910-NO-REC-88 DTSZX551 01792 ELSE DTSZX551 01793 * SET W-RPT-DUPL-YES-88 TO TRUE CL**8 01794 DISPLAY 'MRPT -ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL**7 01795 W-EMP-NO ' ' W-X140-REPORT-QTR DTSZX551 01796 DISPLAY ' ' DTSZX551 01797 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01798 MOVE SPACES TO R140-MESSAGE DTSZX551 01799 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 01800 STRING DTSZX551 01801 'P2013 -ORIG REPORT NOT IN DUTAS CANNOT AMEND ' DTSZX551 01802 W-RPT-TYPE DTSZX551 01803 DELIMITED BY SIZE DTSZX551 01804 INTO R140-MESSAGE DTSZX551 01805 END-STRING DTSZX551 01806 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 01807 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 01808 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 01809 GO TO P2113-EXIT. DTSZX551 01810 DTSZX551 01811 P2113-EXIT. DTSZX551 01812 EXIT. DTSZX551 01813 P2116-SCAN-MRPT. DTSZX551 01814 MOVE MSKL-REC TO MRPT-REC. DTSZX551 01815 IF MRPT-YRQ = W-X140-REPORT-QTR DTSZX551 01816 NEXT SENTENCE DTSZX551 01817 ELSE DTSZX551 01818 IF MRPT-YRQ > W-X140-REPORT-QTR DTSZX551 01819 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 01820 SET L910-NO-REC-88 TO TRUE DTSZX551 01821 GO TO P2116-EXIT DTSZX551 01822 ELSE DTSZX551 01823 GO TO P2116-READ-NEXT DTSZX551 01824 END-IF DTSZX551 01825 END-IF. DTSZX551 01826 DTSZX551 01827 IF MRPT-SUPPLEM-88 CL**2 01828 PERFORM P2117-CHECK-MRPT-DUP THRU P2117-EXIT CL**3 01829 END-IF. DTSZX551 01830 DTSZX551 01831 P2116-READ-NEXT. DTSZX551 01832 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSZX551 01833 IF L910-NO-REC-88 DTSZX551 01834 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 01835 SET W-RPT-ERROR-YES-88 TO TRUE. DTSZX551 01836 P2116-EXIT. EXIT. DTSZX551 01837 P2117-CHECK-MRPT-DUP. CL**2 01838 IF MPRF-CLASS-SELF-INS-88 CL*15 01839 MOVE ZERO TO W-EXX-WAGE CL*15 01840 W-TAX-WAGE. CL*15 01841 * IF MRPT-EMP-NO = 051334 CL*10 01842 IF MRPT-EMP-NO = 316710 CL*10 01843 DISPLAY 'P2117 FOUND AMENDED CHECK FOR DUPS ' CL**9 01844 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE CL**9 01845 DISPLAY ' WTOT ' W-TOT-WAGE ' MTOT ' MRPT-TOT-WAGE CL*11 01846 DISPLAY ' WEXX ' W-EXX-WAGE ' MEXX ' MRPT-EXCESS-WAGE CL*11 01847 DISPLAY ' WTAX ' W-TAX-WAGE ' MTAX ' MRPT-TAX-WAGE. CL*11 01848 CL**9 01849 IF W-TOT-WAGE = MRPT-TOT-WAGE AND CL**3 01850 W-EXX-WAGE = MRPT-EXCESS-WAGE AND CL**3 01851 W-TAX-WAGE = MRPT-TAX-WAGE CL**3 01852 SET W-RPT-ERROR-YES-88 TO TRUE CL**8 01853 SET L910-NO-REC-88 TO TRUE CL**8 01854 SET W-RPT-DUPL-YES-88 TO TRUE. CL**8 01855 P2117-EXIT. EXIT. CL**2 01856 DTSZX551 01857 P2119-CHECK-MRPT-ORIG. CL**4 01858 DISPLAY 'P2119 X140 X140 REPORT FROM ESSP- ' CL**4 01859 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. CL**4 01860 DISPLAY ' ' CL**4 01861 MOVE LOW-VALUE TO MRPT-KEY-AREA. CL**4 01862 MOVE W-EMP-NO TO MRPT-EMP-NO. CL**4 01863 SET MRPT-RPT-88 TO TRUE. CL**4 01864 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL**4 01865 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. CL**4 01866 CL**4 01867 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**4 01868 IF L910-OK-88 CL**4 01869 PERFORM P2120-SCAN-MRPT THRU P2120-EXIT CL**4 01870 UNTIL L910-NO-REC-88 CL**4 01871 ELSE CL**4 01872 DISPLAY 'X451 ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL**4 01873 W-EMP-NO ' ' W-X140-REPORT-QTR CL**4 01874 DISPLAY ' ' CL**4 01875 SET W-RPT-ERROR-YES-88 TO TRUE CL**4 01876 MOVE SPACES TO R140-MESSAGE CL**4 01877 MOVE W-EMP-NO TO R140-EMP-NO CL**4 01878 STRING CL**4 01879 'P2013 -ORIG REPORT NOT IN DUTAS CANNOT AMEND ' CL**4 01880 W-RPT-TYPE CL**4 01881 DELIMITED BY SIZE CL**4 01882 INTO R140-MESSAGE CL**4 01883 END-STRING CL**4 01884 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 01885 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 01886 SET W-EMP-FOUND-NO-88 TO TRUE CL**4 01887 GO TO P2119-EXIT. CL**4 01888 CL**4 01889 CL**4 01890 P2119-EXIT. CL**4 01891 EXIT. CL**4 01892 P2120-SCAN-MRPT. CL**4 01893 MOVE MSKL-REC TO MRPT-REC. CL**4 01894 IF MRPT-YRQ = W-X140-REPORT-QTR CL**4 01895 NEXT SENTENCE CL**4 01896 ELSE CL**4 01897 IF MRPT-YRQ > W-X140-REPORT-QTR CL**4 01898 SET W-RPT-ERROR-YES-88 TO TRUE CL**4 01899 SET L910-NO-REC-88 TO TRUE CL**4 01900 GO TO P2120-EXIT CL**4 01901 ELSE CL**4 01902 GO TO P2120-READ-NEXT CL**4 01903 END-IF CL**4 01904 END-IF. CL**4 01905 CL**4 01906 IF MRPT-ESTIM-88 OR MRPT-WITHDRW-88 CL**4 01907 GO TO P2120-READ-NEXT CL**4 01908 ELSE CL**4 01909 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 01910 SET L910-NO-REC-88 TO TRUE CL**4 01911 MOVE SPACES TO R140-MESSAGE CL**4 01912 MOVE W-EMP-NO TO R140-EMP-NO CL**4 01913 STRING CL**4 01914 ':ORIGINAL RPT EXIST IN DUTAS -CONVERT EMP COUNTS' CL**4 01915 X140-QUARTER CL**4 01916 DELIMITED BY SIZE CL**4 01917 INTO R140-MESSAGE CL**4 01918 END-STRING CL**4 01919 MOVE R140-MESSAGE TO P434-MESSAGE CL**4 01920 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 01921 GO TO P2120-EXIT CL**4 01922 END-IF. CL**4 01923 P2120-READ-NEXT. CL**4 01924 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**4 01925 IF L910-NO-REC-88 CL**4 01926 SET W-EMP-FOUND-NO-88 TO TRUE CL**4 01927 SET W-RPT-ERROR-YES-88 TO TRUE. CL**4 01928 CL**4 01929 P2120-EXIT. CL**4 01930 EXIT. CL**4 01931 CL**4 01932 P2020-SAVE-EXT-REPORT. DTSZX551 01933 * DISPLAY 'P2020-SAVE-EXT-REPORT ' DTSZX551 01934 ************************************************************ DTSZX551 01935 * DUE TO CONVERSION ERROR CHECK IS MADE WHEN EMPLOYEE COUNT DTSZX551 01936 * IS = ALL 9. GET ORIGINAL REPORT AND MOVE EMPLOYEE COINT DTSZX551 01937 * TO AMEND REPORT COUNTS ZL1 9/06/15 DTSZX551 01938 ************************************************************ DTSZX551 01939 IF W-1ST-MNTH-CNT = 9999999 OR DTSZX551 01940 W-2ND-MNTH-CNT = 9999999 OR DTSZX551 01941 W-3RD-MNTH-CNT = 9999999 DTSZX551 01942 PERFORM P2119-CHECK-MRPT-ORIG THRU P2119-EXIT CL**4 01943 IF W-RPT-ERROR-YES-88 DTSZX551 01944 MOVE SPACES TO R140-MESSAGE DTSZX551 01945 DISPLAY DTSZX551 01946 'P2013 -FATAL ERROR REPORT NOT ON MRPT AMEND ' DTSZX551 01947 W-RPT-TYPE DTSZX551 01948 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 01949 ELSE DTSZX551 01950 MOVE MRPT-1ST-MTH-EMPL-CNT TO W-1ST-MNTH-CNT DTSZX551 01951 MOVE MRPT-2ND-MTH-EMPL-CNT TO W-2ND-MNTH-CNT DTSZX551 01952 MOVE MRPT-3RD-MTH-EMPL-CNT TO W-3RD-MNTH-CNT DTSZX551 01953 MOVE MRPT-TOTAL-EMPL-CNT TO W-WRKR-CNT-TOTAL. DTSZX551 01954 DTSZX551 01955 DTSZX551 01956 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSZX551 01957 MOVE '028' TO T028-REC-TYPE. DTSZX551 01958 DTSZX551 01959 MOVE W-EMP-NO TO T028-EMP-NO. DTSZX551 01960 MOVE 'WEBESSP ' TO T028-ORIGIN. CL*16 01961 MOVE LX42-SYS-DATE TO T028-SYS-DATE. DTSZX551 01962 MOVE LX42-SYS-TIME TO T028-SYS-TIME. DTSZX551 01963 SET T028-AMEND-RPT-88 TO TRUE. CL*16 01964 DTSZX551 01965 MOVE LX42-EXT-PSEUDO-BATCH TO T028-PSEUDO-BATCH-NO. DTSZX551 01966 MOVE LX42-EXT-PSEUDO-ITEM TO T028-PSEUDO-ITEM-NO. DTSZX551 01967 DTSZX551 01968 MOVE W-X140-REPORT-QTR TO T028-YRQ. DTSZX551 01969 IF W-EMP-FOUND-YES-88 DTSZX551 01970 MOVE MPRF-PRIMARY-NAME (1:4) DTSZX551 01971 TO T028-NAME-CHECK DTSZX551 01972 ELSE DTSZX551 01973 MOVE SPACES TO T028-NAME-CHECK DTSZX551 01974 END-IF. DTSZX551 01975 MOVE W-RPT-TYPE TO T028-RPT-TYPE. DTSZX551 01976 DTSZX551 01977 MOVE X140-CHECK-SEQ-NBR TO T028-LOG-NBR. CL*16 01978 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSZX551 01979 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSZX551 01980 MOVE W-X140-RECEIVED-DATE TO T028-RECEIVED-DATE. DTSZX551 01981 MOVE ZEROS TO T028-DEPOSIT-DATE. DTSZX551 01982 DTSZX551 01983 MOVE W-TOT-WAGE TO T028-TOT-WAGE. DTSZX551 01984 DTSZX551 01985 IF W-EMP-FOUND-NO-88 DTSZX551 01986 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSZX551 01987 MOVE W-EXX-WAGE TO T028-EXCESS-WAGE CL*12 01988 * COMPUTE T028-EXCESS-WAGE = CL*12 01989 * (T028-TOT-WAGE - T028-TAX-WAGE) CL*12 01990 ELSE DTSZX551 01991 IF MPRF-CLASS-SELF-INS-88 DTSZX551 01992 MOVE ZERO TO T028-TAX-WAGE DTSZX551 01993 T028-EXCESS-WAGE DTSZX551 01994 ELSE DTSZX551 01995 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSZX551 01996 MOVE W-EXX-WAGE TO T028-EXCESS-WAGE CL*12 01997 * COMPUTE T028-EXCESS-WAGE = CL*12 01998 * (T028-TOT-WAGE - T028-TAX-WAGE) CL*12 01999 END-IF DTSZX551 02000 END-IF. DTSZX551 02001 DTSZX551 02002 MOVE W-1ST-MNTH-CNT TO T028-1ST-MTH-EMPL-CNT. DTSZX551 02003 MOVE W-2ND-MNTH-CNT TO T028-2ND-MTH-EMPL-CNT. DTSZX551 02004 MOVE W-3RD-MNTH-CNT TO T028-3RD-MTH-EMPL-CNT. DTSZX551 02005 MOVE W-1ST-MNTH-CNT TO T028-TOTAL-EMPL-CNT DTSZX551 02006 DTSZX551 02007 IF W-2ND-MNTH-CNT > T028-TOTAL-EMPL-CNT DTSZX551 02008 MOVE W-2ND-MNTH-CNT TO T028-TOTAL-EMPL-CNT. DTSZX551 02009 DTSZX551 02010 IF W-3RD-MNTH-CNT > T028-TOTAL-EMPL-CNT DTSZX551 02011 MOVE W-3RD-MNTH-CNT TO T028-TOTAL-EMPL-CNT. DTSZX551 02012 DTSZX551 02013 * DISPLAY ' X145 PAY AMT ' X145-REMITTANCE DTSZX551 02014 * DISPLAY ' X140 PAY AMT ' X140-REMITTANCE DTSZX551 02015 DTSZX551 02016 MOVE W-X145-TOT-REMIT-AMT TO W-X140-REMITTANCE DTSZX551 02017 MOVE ZEROS TO T028-REMIT-AMT. DTSZX551 02018 DTSZX551 02019 * ADD W-X145-TOT-REMIT-AMT TO W-TOT-REMIT-AMT. DTSZX551 02020 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSZX551 02021 DTSZX551 02022 MOVE ZERO TO T028-TRACE-NO. DTSZX551 02023 DTSZX551 02024 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSZX551 02025 MOVE 'WEBESSP ' TO T028-RESPONSIBLE-OP-ID. DTSZX551 02026 DTSZX551 02027 * DISPLAY 'BX436 WEB RPT ' X140-EMP-NO ' ' X140-QUARTER. DTSZX551 02028 PERFORM S1032-WRITE-TEMP-T028 THRU S1032-EXIT. DTSZX551 02029 DTSZX551 02030 PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT. DTSZX551 02031 DTSZX551 02032 * DISPLAY W-EMP-NO ',' T028-TOT-WAGE DTSZX551 02033 * ',' T028-EXCESS-WAGE DTSZX551 02034 * ',' T028-TAX-WAGE DTSZX551 02035 * ',' X140-REMITTANCE DTSZX551 02036 * ',' X145-REMITTANCE. DTSZX551 02037 DTSZX551 02038 IF W-X140-REMITTANCE > 0 DTSZX551 02039 ADD 1 TO W-T028-WRITE-CNT DTSZX551 02040 ELSE DTSZX551 02041 ADD 1 TO W-T028-WRITE-CNT DTSZX551 02042 ADD 1 TO W-T028-WRITEO-CNT. DTSZX551 02043 DTSZX551 02044 * IF W-WRITE-T025-TRAN-YES-88 DTSZX551 02045 * PERFORM P2021-WRITE-T025 THRU P2021-EXIT DTSZX551 02046 * ELSE DTSZX551 02047 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 02048 MOVE SPACES TO R140-MESSAGE DTSZX551 02049 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02050 STRING DTSZX551 02051 'X451 -:>AMENDED REPORT ADDED TO DUTAS - ' X140-QUARTERDTSZX551 02052 DELIMITED BY SIZE DTSZX551 02053 INTO R140-MESSAGE DTSZX551 02054 END-STRING DTSZX551 02055 PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSZX551 02056 P2020-EXIT. DTSZX551 02057 EXIT. DTSZX551 02058 DTSZX551 02059 P2021-WRITE-T025. DTSZX551 02060 ** DTSZX551 02061 **PAYMENT TRANSACTION REMIT AMT > THAN REPORT REMIT AMT, SUBTRACT DTSZX551 02062 **DIFFERENCE AND WRITE A PA T025 TRANSACTION. DTSZX551 02063 ** DTSZX551 02064 DISPLAY 'PAYMENT OK ' X145-EMP-NO. DTSZX551 02065 DTSZX551 02066 MOVE LENGTH OF T025-REC TO T025-LENGTH DTSZX551 02067 MOVE '025' TO T025-REC-TYPE. DTSZX551 02068 DTSZX551 02069 MOVE W-EMP-NO TO T025-EMP-NO. DTSZX551 02070 MOVE 'WEB PAY' TO T025-ORIGIN. DTSZX551 02071 MOVE LX42-SYS-DATE TO T025-SYS-DATE. DTSZX551 02072 MOVE LX42-SYS-TIME TO T025-SYS-TIME. DTSZX551 02073 * DTSZX551 02074 MOVE W-X145-PAYMENT-QTR TO T025-APPLIC-YRQ DTSZX551 02075 MOVE 'PA' TO T025-PAY-TYPE DTSZX551 02076 DTSZX551 02077 MOVE SPACES TO T025-APPLIC-IND. DTSZX551 02078 MOVE ZERO TO T025-APPLIC-BATCH-NO DTSZX551 02079 T025-APPLIC-ITEM-NO. DTSZX551 02080 DTSZX551 02081 IF W-EMP-FOUND-YES-88 DTSZX551 02082 MOVE MPRF-PRIMARY-NAME (1:4) DTSZX551 02083 TO T025-NAME-CHECK DTSZX551 02084 ELSE DTSZX551 02085 MOVE SPACES TO T025-NAME-CHECK DTSZX551 02086 END-IF. DTSZX551 02087 DTSZX551 02088 MOVE W-X145-RECEIVED-DATE TO T025-RECEIVED-DATE DTSZX551 02089 T025-DEPOSIT-DATE. DTSZX551 02090 DTSZX551 02091 MOVE W-X145-TOT-REMIT-AMT TO W-T025-REMIT-AMT DTSZX551 02092 DTSZX551 02093 MOVE W-T025-REMIT-AMT TO T025-REMIT-AMT. DTSZX551 02094 DTSZX551 02095 DTSZX551 02096 IF X145-TRACE-NO > SPACES DTSZX551 02097 MOVE X145-TRACE-NO TO T025-TRACE-NO DTSZX551 02098 ELSE DTSZX551 02099 MOVE ZEROS TO T025-TRACE-NO. DTSZX551 02100 DTSZX551 02101 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. DTSZX551 02102 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. DTSZX551 02103 DTSZX551 02104 * MOVE T025-REC TO TSKL-REC. DTSZX551 02105 * PERFORM S927B-WRITE THRU S927B-EXIT. DTSZX551 02106 DTSZX551 02107 PERFORM S1033-WRITE-TEMP-T025 THRU S1033-EXIT. DTSZX551 02108 ADD +1 TO W-T025-WRITE-CNT. DTSZX551 02109 DTSZX551 02110 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT. DTSZX551 02111 WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. DTSZX551 02112 MOVE ZEROS TO W-T025-REMIT-AMT DTSZX551 02113 W-X145-TOT-REMIT-AMT DTSZX551 02114 W-X140-REMITTANCE. DTSZX551 02115 DTSZX551 02116 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. DTSZX551 02117 DTSZX551 02118 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 02119 MOVE SPACES TO R140-MESSAGE DTSZX551 02120 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02121 STRING DTSZX551 02122 'X430 -: >>>>> PAYMENT T025 CREATED ' DTSZX551 02123 'REMIT AMT' DTSZX551 02124 DELIMITED BY SIZE DTSZX551 02125 INTO R140-MESSAGE DTSZX551 02126 END-STRING DTSZX551 02127 PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSZX551 02128 P2021-EXIT. DTSZX551 02129 EXIT. DTSZX551 02130 DTSZX551 02131 DTSZX551 02132 P3000-WAGES. DTSZX551 02133 MOVE LX42-DATA-AREA TO X144-REC. DTSZX551 02134 * DISPLAY 'X144: ' X144-REC. DTSZX551 02135 MOVE X144-EMP-NO TO W-EMP-NO. DTSZX551 02136 * DTSZX551 02137 ADD +1 TO W-X144-RED-CNT DTSZX551 02138 SET W-RPT-ERROR-NO-88 TO TRUE. DTSZX551 02139 * SET W-PREV-REC-WAGE-88 TO TRUE. DTSZX551 02140 * DTSZX551 02141 * DISPLAY 'LX-E ' LX42-X140-EMP-NO ' X145-E ' W-EMP-NO. DTSZX551 02142 * IF LX42-X145-EMP-NO = '999999' OR DTSZX551 02143 * LX42-X140-EMP-NO = '999999' OR DTSZX551 02144 * LX42-X145-EMP-NO = SPACES OR DTSZX551 02145 * LX42-X140-EMP-NO = SPACES OR DTSZX551 02146 * W-PREV-RPT-NULL-88 DTSZX551 02147 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02148 * MOVE SPACES TO R140-MESSAGE DTSZX551 02149 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02150 * STRING DTSZX551 02151 * 'X430 -: X144 WAGES HAS NO X140 REPORT -- CANCEL - WAGES 'DTSZX551 02152 * ' ' X144-QUARTER DTSZX551 02153 * DELIMITED BY SIZE DTSZX551 02154 * INTO R140-MESSAGE DTSZX551 02155 * END-STRING DTSZX551 02156 * WRITE PEND-X144-REC FROM X144-REC DTSZX551 02157 * ADD +1 TO W-X144-ERR-CNT DTSZX551 02158 * ADD +1 TO W-X144-PEN-CNT DTSZX551 02159 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT DTSZX551 02160 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02161 * GO TO P3000-EXIT. DTSZX551 02162 DTSZX551 02163 * DTSZX551 02164 * IF W-PREV-RPT-RPT-88 DTSZX551 02165 * OR W-PREV-RPT-WAGE-88 DTSZX551 02166 * SET W-PREV-RPT-WAGE-88 TO TRUE DTSZX551 02167 ADD +1 TO W-X144-PRO-CNT DTSZX551 02168 PERFORM P3010-EDIT-WAGES THRU P3010-EXIT DTSZX551 02169 IF W-RPT-ERROR-NO-88 DTSZX551 02170 PERFORM P3011-WRITE-WAGES-X144 THRU P3011-EXIT DTSZX551 02171 ADD +1 TO W-X144-SAV-CNT DTSZX551 02172 ELSE DTSZX551 02173 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02174 MOVE SPACES TO R140-MESSAGE DTSZX551 02175 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02176 STRING DTSZX551 02177 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' DTSZX551 02178 ' ' X144-SSN DTSZX551 02179 DELIMITED BY SIZE DTSZX551 02180 INTO R140-MESSAGE DTSZX551 02181 END-STRING DTSZX551 02182 ADD +1 TO W-X144-ERR-CNT DTSZX551 02183 ADD +1 TO W-X144-PEN-CNT DTSZX551 02184 WRITE PEND-X144-REC FROM X144-REC DTSZX551 02185 PERFORM P6000-WRITE-PEND-X144 THRU P6000-EXIT DTSZX551 02186 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02187 GO TO P3000-EXIT. DTSZX551 02188 * ELSE DTSZX551 02189 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02190 * MOVE SPACES TO R140-MESSAGE DTSZX551 02191 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02192 * STRING DTSZX551 02193 * 'X430 -: REPORT RECORD X140 NOT FOUND OR MISSING ' DTSZX551 02194 * ' ' X144-SSN DTSZX551 02195 * DELIMITED BY SIZE DTSZX551 02196 * INTO R140-MESSAGE DTSZX551 02197 * END-STRING DTSZX551 02198 * WRITE PEND-X144-REC FROM X144-REC DTSZX551 02199 * ADD +1 TO W-X144-ERR-CNT DTSZX551 02200 * ADD +1 TO W-X144-PEN-CNT DTSZX551 02201 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT DTSZX551 02202 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02203 * END-IF. DTSZX551 02204 DTSZX551 02205 P3000-EXIT. DTSZX551 02206 EXIT. DTSZX551 02207 DTSZX551 02208 P3010-EDIT-WAGES. DTSZX551 02209 * DISPLAY 'P3010-EDIT-WAGES ' DTSZX551 02210 * DISPLAY 'X144-QUARTER ' X144-QUARTER DTSZX551 02211 MOVE X144-QUARTER TO W-SLASH-QTR. DTSZX551 02212 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSZX551 02213 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSZX551 02214 PERFORM S004-FROM-5 THRU S004-EXIT. DTSZX551 02215 IF NOT L004-VALID-QTR DTSZX551 02216 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02217 MOVE SPACES TO R140-MESSAGE DTSZX551 02218 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02219 STRING DTSZX551 02220 ': WAGE RECORD HAS INVALID QUARTER ' DTSZX551 02221 X144-QUARTER ' ' X144-SSN DTSZX551 02222 DELIMITED BY SIZE DTSZX551 02223 INTO R140-MESSAGE DTSZX551 02224 END-STRING DTSZX551 02225 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02226 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02227 ELSE DTSZX551 02228 MOVE L004-QTR-5-9 TO W-X144-WAGE-QTR DTSZX551 02229 END-IF. DTSZX551 02230 DTSZX551 02231 * IF L004-QTR-5-9 NOT = W-X140-REPORT-QTR DTSZX551 02232 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02233 * MOVE SPACES TO R140-MESSAGE DTSZX551 02234 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02235 * MOVE W-X140-REPORT-QTR TO WRK-REPORT-QTR DTSZX551 02236 * STRING DTSZX551 02237 * ':WAGE QTR NOT = RPT QTR ' DTSZX551 02238 * X144-QUARTER ' ' WRK-REPORT-QTR DTSZX551 02239 * DELIMITED BY SIZE DTSZX551 02240 * INTO R140-MESSAGE DTSZX551 02241 * END-STRING DTSZX551 02242 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02243 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02244 * END-IF. DTSZX551 02245 DTSZX551 02246 IF X144-SSN NOT NUMERIC DTSZX551 02247 * DISPLAY 'X144-SSN ' X144-SSN DTSZX551 02248 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02249 MOVE SPACES TO R140-MESSAGE DTSZX551 02250 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02251 STRING DTSZX551 02252 ':WAGE RECORD NON-NUMERIC SSN ' DTSZX551 02253 X144-SSN DTSZX551 02254 DELIMITED BY SIZE DTSZX551 02255 INTO R140-MESSAGE DTSZX551 02256 END-STRING DTSZX551 02257 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02258 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02259 ELSE DTSZX551 02260 MOVE X144-SSN TO W-SSN DTSZX551 02261 END-IF. DTSZX551 02262 DTSZX551 02263 IF X144-SSN = ZEROS DTSZX551 02264 * DISPLAY 'X144-SSN ' X144-SSN DTSZX551 02265 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02266 MOVE SPACES TO R140-MESSAGE DTSZX551 02267 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02268 STRING DTSZX551 02269 ':WAGE RECORD SSN = ZEROS ' DTSZX551 02270 X144-SSN DTSZX551 02271 DELIMITED BY SIZE DTSZX551 02272 INTO R140-MESSAGE DTSZX551 02273 END-STRING DTSZX551 02274 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02275 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02276 ELSE DTSZX551 02277 MOVE X144-SSN TO W-SSN DTSZX551 02278 END-IF. DTSZX551 02279 DTSZX551 02280 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME DTSZX551 02281 * ' FN: ' X144-FIRST-NAME. DTSZX551 02282 * IF X144-LAST-NAME = SPACES DTSZX551 02283 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02284 * MOVE SPACES TO R140-MESSAGE DTSZX551 02285 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02286 * STRING DTSZX551 02287 * ':WARNING-SSN LNAME IS BLANK ' DTSZX551 02288 * X144-SSN DTSZX551 02289 * DELIMITED BY SIZE DTSZX551 02290 * INTO R140-MESSAGE DTSZX551 02291 * END-STRING DTSZX551 02292 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02293 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02294 * END-IF. DTSZX551 02295 DTSZX551 02296 * IF X144-FIRST-NAME = SPACES DTSZX551 02297 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02298 * MOVE SPACES TO R140-MESSAGE DTSZX551 02299 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02300 * STRING DTSZX551 02301 * ':WARNING - SSN FNAME IS BLANK ' DTSZX551 02302 * X144-SSN DTSZX551 02303 * DELIMITED BY SIZE DTSZX551 02304 * INTO R140-MESSAGE DTSZX551 02305 * END-STRING DTSZX551 02306 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02307 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02308 * END-IF. DTSZX551 02309 DTSZX551 02310 * IF W-CURR-WAGE-QTR NOT = W-WAGE-QTR DTSZX551 02311 * MOVE ZERO TO W-WRKR-TOT-WAGE DTSZX551 02312 * MOVE W-WAGE-QTR TO W-CURR-WAGE-QTR DTSZX551 02313 * END-IF. DTSZX551 02314 DTSZX551 02315 * MOVE X144-EARNINGS TO W-EARNINGS-X. DTSZX551 02316 * MOVE W-EARNINGS-9 TO W-EARNINGS. DTSZX551 02317 * ADD W-EARNINGS TO W-WRKR-TOT-WAGE. DTSZX551 02318 * DISPLAY 'X144-LAST-NAME ' X144-LAST-NAME DTSZX551 02319 * MOVE X144-LAST-NAME TO W-WRKR-LAST-NAME. DTSZX551 02320 * MOVE X144-FIRST-NAME TO W-WRKR-FIRST-NAME. DTSZX551 02321 * MOVE X144-MID-INIT TO W-WRKR-MID-INIT. DTSZX551 02322 DTSZX551 02323 P3010-EXIT. DTSZX551 02324 EXIT. DTSZX551 02325 DTSZX551 02326 P3011-WRITE-WAGES-X144. DTSZX551 02327 DTSZX551 02328 ************************************************************** DTSZX551 02329 * WRITE W4 WAGES FOR DOCS DTSZX551 02330 ************************************************************** DTSZX551 02331 * DTSZX551 02332 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. DTSZX551 02333 MOVE X144-SSN TO W4-SSN. DTSZX551 02334 MOVE 'W4' TO W4-TRAN-ID. DTSZX551 02335 MOVE '00044001' TO W4-TRAN-OPER-ID. DTSZX551 02336 MOVE LX42-CURR-RUN-DATE TO W4-DATE-ENTERED. DTSZX551 02337 MOVE ZEROS TO W4-TIME-ENTERED. DTSZX551 02338 MOVE X144-LAST-NAME (1:3) TO W4-NAME-CHECK. DTSZX551 02339 MOVE W-X144-WAGE-QTR TO W4-QUARTER. DTSZX551 02340 MOVE X144-EARNINGS TO W4-QUARTER-EARNINGS. DTSZX551 02341 MOVE 2 TO W4-AFFI-CODE. DTSZX551 02342 MOVE X144-EMP-NO TO W4-ACCOUNT. DTSZX551 02343 MOVE MPRF-PRIMARY-NAME (1:4) TO W4-EMP-NAME. DTSZX551 02344 DTSZX551 02345 * MOVE ESP-TRANSACTION-AREA TO WAGE-TRANS-REC. DTSZX551 02346 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. DTSZX551 02347 DTSZX551 02348 * WRITE WAGE-TRANS-REC. DTSZX551 02349 WRITE WAGE-OUT-REC. DTSZX551 02350 DTSZX551 02351 IF WAGE-TEMP-STATUS-OK-88 DTSZX551 02352 ADD +1 TO W-W4-CNT DTSZX551 02353 * DISPLAY 'WRITE W4 ' W4-ACCOUNT ' ' W4-QUARTER DTSZX551 02354 * ' ' W4-SSN DTSZX551 02355 ELSE DTSZX551 02356 DISPLAY 'ERROR WRITING W4- WAGE FILE ' DTSZX551 02357 WAGE-TEMP-STATUS DTSZX551 02358 END-IF. DTSZX551 02359 DTSZX551 02360 DTSZX551 02361 P3011-EXIT. DTSZX551 02362 EXIT. DTSZX551 02363 DTSZX551 02364 P3500-WAGES. DTSZX551 02365 MOVE LX42-DATA-AREA TO X147-REC. DTSZX551 02366 * DISPLAY 'X144: ' X144-REC. DTSZX551 02367 MOVE X147-EMP-NO TO W-EMP-NO. DTSZX551 02368 * DTSZX551 02369 ADD +1 TO W-X147-RED-CNT DTSZX551 02370 SET W-RPT-ERROR-NO-88 TO TRUE. DTSZX551 02371 DTSZX551 02372 ADD +1 TO W-X147-PRO-CNT DTSZX551 02373 PERFORM P3510-EDIT-WAGES THRU P3510-EXIT DTSZX551 02374 IF W-RPT-ERROR-NO-88 DTSZX551 02375 PERFORM P3511-WRITE-WAGES-X147 THRU P3511-EXIT DTSZX551 02376 ADD +1 TO W-X147-SAV-CNT DTSZX551 02377 ELSE DTSZX551 02378 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02379 MOVE SPACES TO R140-MESSAGE DTSZX551 02380 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02381 STRING DTSZX551 02382 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' DTSZX551 02383 ' ' X147-SSN DTSZX551 02384 DELIMITED BY SIZE DTSZX551 02385 INTO R140-MESSAGE DTSZX551 02386 END-STRING DTSZX551 02387 ADD +1 TO W-X147-ERR-CNT DTSZX551 02388 ADD +1 TO W-X147-PEN-CNT DTSZX551 02389 WRITE PEND-X147-REC FROM X147-REC DTSZX551 02390 PERFORM P7000-WRITE-PEND-X147 THRU P7000-EXIT DTSZX551 02391 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02392 GO TO P3500-EXIT. DTSZX551 02393 DTSZX551 02394 P3500-EXIT. DTSZX551 02395 EXIT. DTSZX551 02396 DTSZX551 02397 P3510-EDIT-WAGES. DTSZX551 02398 * DISPLAY 'P3010-EDIT-WAGES ' DTSZX551 02399 * DISPLAY 'X144-QUARTER ' X144-QUARTER DTSZX551 02400 MOVE X147-QUARTER TO W-SLASH-QTR. DTSZX551 02401 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSZX551 02402 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSZX551 02403 PERFORM S004-FROM-5 THRU S004-EXIT. DTSZX551 02404 IF NOT L004-VALID-QTR DTSZX551 02405 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02406 MOVE SPACES TO R140-MESSAGE DTSZX551 02407 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02408 STRING DTSZX551 02409 ': WAGE RECORD HAS INVALID QUARTER ' DTSZX551 02410 X147-QUARTER ' ' X147-SSN DTSZX551 02411 DELIMITED BY SIZE DTSZX551 02412 INTO R140-MESSAGE DTSZX551 02413 END-STRING DTSZX551 02414 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02415 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02416 ELSE DTSZX551 02417 MOVE L004-QTR-5-9 TO W-X147-WAGE-QTR DTSZX551 02418 END-IF. DTSZX551 02419 DTSZX551 02420 DTSZX551 02421 IF X147-SSN NOT NUMERIC DTSZX551 02422 * DISPLAY 'X144-SSN ' X144-SSN DTSZX551 02423 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02424 MOVE SPACES TO R140-MESSAGE DTSZX551 02425 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02426 STRING DTSZX551 02427 ':WAGE RECORD NON-NUMERIC SSN ' DTSZX551 02428 X147-SSN DTSZX551 02429 DELIMITED BY SIZE DTSZX551 02430 INTO R140-MESSAGE DTSZX551 02431 END-STRING DTSZX551 02432 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02433 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02434 ELSE DTSZX551 02435 MOVE X147-SSN TO W-SSN DTSZX551 02436 END-IF. DTSZX551 02437 DTSZX551 02438 IF X147-SSN = ZEROS DTSZX551 02439 * DISPLAY 'X147-SSN ' X147-SSN DTSZX551 02440 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 02441 MOVE SPACES TO R140-MESSAGE DTSZX551 02442 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02443 STRING DTSZX551 02444 ':WAGE RECORD SSN = ZEROS ' DTSZX551 02445 X147-SSN DTSZX551 02446 DELIMITED BY SIZE DTSZX551 02447 INTO R140-MESSAGE DTSZX551 02448 END-STRING DTSZX551 02449 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02450 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 02451 ELSE DTSZX551 02452 MOVE X147-SSN TO W-SSN DTSZX551 02453 END-IF. DTSZX551 02454 DTSZX551 02455 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME DTSZX551 02456 * ' FN: ' X144-FIRST-NAME. DTSZX551 02457 DTSZX551 02458 P3510-EXIT. DTSZX551 02459 EXIT. DTSZX551 02460 DTSZX551 02461 P3511-WRITE-WAGES-X147. DTSZX551 02462 DTSZX551 02463 ************************************************************** DTSZX551 02464 * WRITE W2 WAGES FOR DOCS DTSZX551 02465 ************************************************************** DTSZX551 02466 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. DTSZX551 02467 MOVE X147-SSN TO W2-SSN. DTSZX551 02468 MOVE 'W2' TO W2-TRAN-ID. DTSZX551 02469 MOVE '00044001' TO W2-OPER-ID. DTSZX551 02470 MOVE LX42-CURR-RUN-DATE TO W2-DATE-ENTERED. DTSZX551 02471 MOVE ZEROS TO W2-TIME-ENTERED. DTSZX551 02472 MOVE 3 TO W2-OP-CAUSE. DTSZX551 02473 MOVE SPACES TO W2-NAME. DTSZX551 02474 MOVE W-X147-WAGE-QTR TO W2-QTR. DTSZX551 02475 MOVE X147-EMP-NO TO W2-ACCOUNT-NUMBER DTSZX551 02476 DTSZX551 02477 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. DTSZX551 02478 DTSZX551 02479 WRITE WAGE-OUT-REC. DTSZX551 02480 DTSZX551 02481 IF WAGE-TEMP-STATUS-OK-88 DTSZX551 02482 ADD +1 TO W-W2-CNT DTSZX551 02483 * DISPLAY 'WRITE W2 ' W4-ACCOUNT ' ' W2-QUARTER DTSZX551 02484 * ' ' W2-SSN DTSZX551 02485 ELSE DTSZX551 02486 DISPLAY 'ERROR WRITING W2- WAGE FILE ' DTSZX551 02487 WAGE-TEMP-STATUS DTSZX551 02488 END-IF. DTSZX551 02489 DTSZX551 02490 DTSZX551 02491 P3511-EXIT. DTSZX551 02492 EXIT. DTSZX551 02493 P4000-WRITE-X434-PAID-REPT. DTSZX551 02494 DTSZX551 02495 MOVE X140-EMP-NO TO X434-EMP-NO DTSZX551 02496 MOVE X140-QUARTER TO X434-QTR DTSZX551 02497 * IF W-EMP-FOUND-YES-88 DTSZX551 02498 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 02499 * TO X434-NAME-CHECK DTSZX551 02500 * ELSE DTSZX551 02501 MOVE 'RPT' TO X434-NAME-CHECK DTSZX551 02502 * END-IF. DTSZX551 02503 DTSZX551 02504 MOVE X140-RCVD-DATE TO X434-RCVD-DATE DTSZX551 02505 MOVE T028-TOT-WAGE TO X434-TOT-WAGE DTSZX551 02506 MOVE T028-EXCESS-WAGE TO X434-EXC-WAGE DTSZX551 02507 MOVE T028-TAX-WAGE TO X434-TAX-WAGE DTSZX551 02508 MOVE X140-REMITTANCE TO X434-X140-REMIT DTSZX551 02509 WS-X140-REMITTANCE DTSZX551 02510 MOVE W-X140-REMITTANCE TO X434-X145-REMIT DTSZX551 02511 DTSZX551 02512 COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - DTSZX551 02513 WS-X140-REMITTANCE. DTSZX551 02514 DTSZX551 02515 MOVE W-T025-REMIT-AMT TO X434-DIFF. DTSZX551 02516 ADD W-T025-REMIT-AMT TO WS-T025-REMIT-AMT. DTSZX551 02517 DTSZX551 02518 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 02519 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 02520 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 02521 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 02522 DTSZX551 02523 * IF W-ERROR-NO-88 DTSZX551 02524 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 02525 * ELSE DTSZX551 02526 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 02527 * MOVE R140-MESSAGE TO X434-MESSAGE DTSZX551 02528 DTSZX551 02529 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. DTSZX551 02530 WRITE REPT-PAID-REC FROM DETAIL-LINE-1 AFTER 1. DTSZX551 02531 ADD 1 TO WS-LINE-CNT2. DTSZX551 02532 ADD +1 TO WS-NUMBER-ONE. DTSZX551 02533 DTSZX551 02534 DTSZX551 02535 P4000-EXIT. DTSZX551 02536 EXIT. DTSZX551 02537 P4100-PRINT-HEADER. DTSZX551 02538 IF WS-LINE-CNT GREATER 58 OR DTSZX551 02539 WS-LINE-CNT2 GREATER 58 DTSZX551 02540 MOVE +0 TO WS-LINE-CNT DTSZX551 02541 MOVE +0 TO WS-LINE-CNT2 DTSZX551 02542 ADD +1 TO WS-PAGE-CNT DTSZX551 02543 MOVE WS-PAGE-CNT TO HDR3-PAGE DTSZX551 02544 MOVE ' -/+ ----- MONTHLY COUNT' TO HDR5-NAME DTSZX551 02545 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE DTSZX551 02546 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 DTSZX551 02547 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 DTSZX551 02548 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 DTSZX551 02549 WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 DTSZX551 02550 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 DTSZX551 02551 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 DTSZX551 02552 ADD +6 TO WS-LINE-CNT2. DTSZX551 02553 P4100-EXIT. DTSZX551 02554 EXIT. DTSZX551 02555 DTSZX551 02556 P4200-PRINT-HEADER. DTSZX551 02557 IF WSP-LINE-CNT GREATER 58 OR DTSZX551 02558 WSP-LINE-CNT2 GREATER 58 DTSZX551 02559 MOVE +0 TO WSP-LINE-CNT DTSZX551 02560 MOVE +0 TO WSP-LINE-CNT2 DTSZX551 02561 ADD +1 TO WSP-PAGE-CNT DTSZX551 02562 MOVE WSP-PAGE-CNT TO HDR31-PAGE DTSZX551 02563 MOVE ' * REASON FOR PENDING *' TO HDR5-NAME DTSZX551 02564 WRITE REPT-PEND-REC FROM HEADER-1 AFTER TOP-OF-PAGE DTSZX551 02565 WRITE REPT-PEND-REC FROM HEADER-2 AFTER 1 DTSZX551 02566 WRITE REPT-PEND-REC FROM HEADER-31 AFTER 1 DTSZX551 02567 WRITE REPT-PEND-REC FROM HEADER-4 AFTER 1 DTSZX551 02568 WRITE REPT-PEND-REC FROM HEADER-42 AFTER 1 DTSZX551 02569 WRITE REPT-PEND-REC FROM HEADER-5 AFTER 1 DTSZX551 02570 WRITE REPT-PEND-REC FROM HEADER-6 AFTER 1 DTSZX551 02571 ADD +6 TO WSP-LINE-CNT2. DTSZX551 02572 P4200-EXIT. DTSZX551 02573 EXIT. DTSZX551 02574 DTSZX551 02575 DTSZX551 02576 P5000-NEW-EMP. DTSZX551 02577 *& DTSZX551 02578 DISPLAY ' 5000-NEW-EMP ' W-EMP-NO ' ' W-PREV-REC-TYPE DTSZX551 02579 ' ERROR-IND ' W-RPT-ERROR-IND. DTSZX551 02580 * IF W-PREV-RPT-PAY-88 AND DTSZX551 02581 * W-RPT-ERROR-NO-88 DTSZX551 02582 * LX42-X140-EMP-NO = SPACES AND DTSZX551 02583 * LX42-X145-EMP-NO = SPACES DTSZX551 02584 * ADD +1 TO W-X145-PEN-CNT DTSZX551 02585 * WRITE PEND-X145-REC FROM X145-REC DTSZX551 02586 * MOVE SPACES TO R140-MESSAGE DTSZX551 02587 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 02588 * STRING DTSZX551 02589 * ': NO REPORT FOR PAYMENT ' DTSZX551 02590 * DELIMITED BY SIZE DTSZX551 02591 * INTO R140-MESSAGE DTSZX551 02592 * END-STRING DTSZX551 02593 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02594 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT DTSZX551 02595 * PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSZX551 02596 DTSZX551 02597 * DISPLAY 'BX436 P5000-NEW-RPT-PAY ' W-EMP-NO ' ' LX42-EMP-NO.DTSZX551 02598 DTSZX551 02599 MOVE LX42-EMP-NO TO W-EMP-NO. DTSZX551 02600 SET W-RPT-ERROR-NO-88 TO TRUE. DTSZX551 02601 * SET W-PREV-REC-NULL-88 TO TRUE. DTSZX551 02602 SET W-PREV-RPT-NULL-88 TO TRUE. DTSZX551 02603 MOVE ZERO TO W-X140-REPORT-QTR DTSZX551 02604 W-X145-PAYMENT-QTR DTSZX551 02605 W-X144-WAGE-QTR DTSZX551 02606 W-TOT-WAGE DTSZX551 02607 W-TAX-WAGE DTSZX551 02608 W-EXX-WAGE CL*12 02609 W-WRKR-TOT-WAGE DTSZX551 02610 W-X145-REMITTANCE DTSZX551 02611 W-X140-REMITTANCE DTSZX551 02612 W-X140-RECEIVED-DATE DTSZX551 02613 W-X145-DEPOSIT-DATE DTSZX551 02614 W-X145-RECEIVED-DATE DTSZX551 02615 W-1ST-MNTH-CNT DTSZX551 02616 W-2ND-MNTH-CNT DTSZX551 02617 W-3RD-MNTH-CNT DTSZX551 02618 W-SSN DTSZX551 02619 W-EARNINGS DTSZX551 02620 W-EMP-WAGE-CNT DTSZX551 02621 W-SEQ-NO DTSZX551 02622 W-T025-REMIT-AMT DTSZX551 02623 W-X145-TOT-REMIT-AMT DTSZX551 02624 W-X140-REMITTANCE DTSZX551 02625 LX42-X140-KEY-AREA DTSZX551 02626 LX42-X144-KEY-AREA DTSZX551 02627 LX42-X145-KEY-AREA. DTSZX551 02628 DTSZX551 02629 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. DTSZX551 02630 DTSZX551 02631 DTSZX551 02632 MOVE SPACES TO W-WRKR-FIRST-NAME DTSZX551 02633 W-WRKR-LAST-NAME DTSZX551 02634 W-WRKR-MID-INIT DTSZX551 02635 W-X145-PAYMENT-FOUND-IND DTSZX551 02636 LX42-X140-EMP-NO DTSZX551 02637 LX42-X144-EMP-NO DTSZX551 02638 LX42-X145-EMP-NO DTSZX551 02639 LX42-X140-QTR-AREA DTSZX551 02640 LX42-X144-QTR-AREA DTSZX551 02641 P434-MESSAGE DTSZX551 02642 LX42-X145-QTR-AREA. DTSZX551 02643 DTSZX551 02644 INITIALIZE X140-REC DTSZX551 02645 X144-REC DTSZX551 02646 X145-REC. DTSZX551 02647 DTSZX551 02648 *& DTSZX551 02649 * DISPLAY ' 5000-INI-EMP ' W-PREV-REC-TYPE DTSZX551 02650 * ' W-RROR-IND ' W-RPT-ERROR-IND DTSZX551 02651 * 'LX-W-RROR-IND ' W-RPT-ERROR-IND. DTSZX551 02652 P5000-EXIT. DTSZX551 02653 EXIT. DTSZX551 02654 DTSZX551 02655 P6000-WRITE-PEND-X145. DTSZX551 02656 DTSZX551 02657 MOVE X145-EMP-NO TO P434-EMP-NO DTSZX551 02658 MOVE X145-QTR TO P434-QTR DTSZX551 02659 * IF W-EMP-FOUND-YES-88 DTSZX551 02660 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 02661 * TO P434-NAME-CHECK DTSZX551 02662 * ELSE DTSZX551 02663 MOVE 'PAY' TO P434-NAME-CHECK DTSZX551 02664 * END-IF. DTSZX551 02665 DTSZX551 02666 MOVE X145-RCVD-DATE TO P434-RCVD-DATE DTSZX551 02667 MOVE ZEROS TO P434-TOT-WAGE DTSZX551 02668 MOVE ZEROS TO P434-EXC-WAGE DTSZX551 02669 * MOVE ZEROS TO P434-EXC-WAGE DTSZX551 02670 MOVE ZEROS TO P434-TAX-WAGE DTSZX551 02671 MOVE ZEROS TO P434-X140-REMIT DTSZX551 02672 MOVE W-X145-TOT-REMIT-AMT TO P434-X145-REMIT DTSZX551 02673 DTSZX551 02674 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 02675 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 02676 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 02677 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 02678 DTSZX551 02679 * IF W-ERROR-NO-88 DTSZX551 02680 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 02681 * ELSE DTSZX551 02682 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 02683 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02684 DTSZX551 02685 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. DTSZX551 02686 ADD 1 TO WS-LINE-CNT2. DTSZX551 02687 ADD +1 TO WS-NUMBER-ONE. DTSZX551 02688 GO TO P6000-EXIT. DTSZX551 02689 DTSZX551 02690 P6000-WRITE-PEND-X140. DTSZX551 02691 DTSZX551 02692 MOVE X140-EMP-NO TO P434-EMP-NO DTSZX551 02693 MOVE X140-QUARTER TO P434-QTR DTSZX551 02694 * IF W-EMP-FOUND-YES-88 DTSZX551 02695 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 02696 * TO P434-NAME-CHECK DTSZX551 02697 * ELSE DTSZX551 02698 MOVE 'RPT' TO P434-NAME-CHECK DTSZX551 02699 * END-IF. DTSZX551 02700 DTSZX551 02701 MOVE X140-RCVD-DATE TO P434-RCVD-DATE DTSZX551 02702 MOVE X140-TOTAL-WAGES TO P434-TOT-WAGE DTSZX551 02703 MOVE ZEROS TO P434-EXC-WAGE DTSZX551 02704 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE DTSZX551 02705 MOVE X140-TAX-WAGES TO P434-TAX-WAGE DTSZX551 02706 MOVE X140-REMITTANCE TO P434-X140-REMIT DTSZX551 02707 MOVE ZEROS TO P434-X145-REMIT DTSZX551 02708 DTSZX551 02709 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 02710 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 02711 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 02712 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 02713 DTSZX551 02714 * IF W-ERROR-NO-88 DTSZX551 02715 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 02716 * ELSE DTSZX551 02717 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 02718 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02719 DTSZX551 02720 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. DTSZX551 02721 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. DTSZX551 02722 ADD 1 TO WSP-LINE-CNT2. DTSZX551 02723 ADD +1 TO WSP-NUMBER-ONE. DTSZX551 02724 GO TO P6000-EXIT. DTSZX551 02725 DTSZX551 02726 P6000-WRITE-PEND-X144. DTSZX551 02727 DTSZX551 02728 MOVE X140-EMP-NO TO P434-EMP-NO DTSZX551 02729 MOVE X140-QUARTER TO P434-QTR DTSZX551 02730 * IF W-EMP-FOUND-YES-88 DTSZX551 02731 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 02732 * TO P434-NAME-CHECK DTSZX551 02733 * ELSE DTSZX551 02734 MOVE 'WAGE' TO P434-NAME-CHECK DTSZX551 02735 * END-IF. DTSZX551 02736 DTSZX551 02737 MOVE SPACES TO P434-RCVD-DATE DTSZX551 02738 MOVE ZEROS TO P434-TOT-WAGE DTSZX551 02739 MOVE ZEROS TO P434-EXC-WAGE DTSZX551 02740 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE DTSZX551 02741 MOVE ZEROS TO P434-TAX-WAGE DTSZX551 02742 MOVE ZEROS TO P434-X140-REMIT DTSZX551 02743 MOVE ZEROS TO P434-X145-REMIT DTSZX551 02744 DTSZX551 02745 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 02746 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 02747 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 02748 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 02749 DTSZX551 02750 * IF W-ERROR-NO-88 DTSZX551 02751 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 02752 * ELSE DTSZX551 02753 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 02754 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02755 DTSZX551 02756 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. DTSZX551 02757 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. DTSZX551 02758 ADD 1 TO WSP-LINE-CNT2. DTSZX551 02759 ADD +1 TO WSP-NUMBER-ONE. DTSZX551 02760 DTSZX551 02761 DTSZX551 02762 DTSZX551 02763 P6000-EXIT. DTSZX551 02764 EXIT. DTSZX551 02765 DTSZX551 02766 P7000-WRITE-PEND-X147. DTSZX551 02767 DTSZX551 02768 MOVE X147-EMP-NO TO P434-EMP-NO DTSZX551 02769 MOVE X147-QUARTER TO P434-QTR DTSZX551 02770 * IF W-EMP-FOUND-YES-88 DTSZX551 02771 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 02772 * TO P434-NAME-CHECK DTSZX551 02773 * ELSE DTSZX551 02774 MOVE 'WAGE' TO P434-NAME-CHECK DTSZX551 02775 * END-IF. DTSZX551 02776 DTSZX551 02777 MOVE SPACES TO P434-RCVD-DATE DTSZX551 02778 MOVE ZEROS TO P434-TOT-WAGE DTSZX551 02779 MOVE ZEROS TO P434-EXC-WAGE DTSZX551 02780 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE DTSZX551 02781 MOVE ZEROS TO P434-TAX-WAGE DTSZX551 02782 MOVE ZEROS TO P434-X140-REMIT DTSZX551 02783 MOVE ZEROS TO P434-X145-REMIT DTSZX551 02784 DTSZX551 02785 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 02786 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 02787 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 02788 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 02789 DTSZX551 02790 * IF W-ERROR-NO-88 DTSZX551 02791 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 02792 * ELSE DTSZX551 02793 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 02794 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 02795 DTSZX551 02796 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. DTSZX551 02797 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. DTSZX551 02798 ADD 1 TO WSP-LINE-CNT2. DTSZX551 02799 ADD +1 TO WSP-NUMBER-ONE. DTSZX551 02800 DTSZX551 02801 DTSZX551 02802 DTSZX551 02803 P7000-EXIT. DTSZX551 02804 EXIT. DTSZX551 02805 DTSZX551 02806 T0000-TERMINATE. DTSZX551 02807 IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO DTSZX551 02808 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT DTSZX551 02809 END-IF. DTSZX551 02810 MOVE W-X145-RED-CNT TO WS-FOOTING-CNT. DTSZX551 02811 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. DTSZX551 02812 MOVE W-X145-ZRO-CNT TO WS-X145-PEN-CNT. DTSZX551 02813 MOVE W-X140-RED-CNT TO WS-X140-RED-CNT. DTSZX551 02814 MOVE W-X140-ERR-CNT TO WS-X140-ERR-CNT. DTSZX551 02815 MOVE W-X140-PEN-CNT TO WS-X140-PEN-CNT. DTSZX551 02816 MOVE W-X144-RED-CNT TO WS-X144-RED-CNT. DTSZX551 02817 MOVE W-X144-ERR-CNT TO WS-X144-ERR-CNT. DTSZX551 02818 MOVE W-X144-PEN-CNT TO WS-X144-PEN-CNT. DTSZX551 02819 MOVE W-TOT-REMIT-AMT TO WS-TOT-REMIT. DTSZX551 02820 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1. DTSZX551 02821 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1. DTSZX551 02822 WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1. DTSZX551 02823 WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1. DTSZX551 02824 WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. DTSZX551 02825 WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. DTSZX551 02826 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1. DTSZX551 02827 WRITE REPT-PAID-REC FROM FOOTING-LINE-8 AFTER 1. DTSZX551 02828 WRITE REPT-PAID-REC FROM FOOTING-LINE-9 AFTER 1. DTSZX551 02829 WRITE REPT-PAID-REC FROM FOOTING-LINE-10 AFTER 1. DTSZX551 02830 WRITE REPT-PAID-REC FROM FOOTING-LINE-11 AFTER 1. DTSZX551 02831 WRITE REPT-PAID-REC FROM FOOTING-LINE-12 AFTER 1. DTSZX551 02832 WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 1. DTSZX551 02833 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1. DTSZX551 02834 DTSZX551 02835 DISPLAY ' '. DTSZX551 02836 DTSZX551 02837 DTSZX551 02838 DISPLAY ' '. DTSZX551 02839 DISPLAY '***************************************'. DTSZX551 02840 DISPLAY '*** DTSBX451 TERMINATION AMENDED RPTS**'. DTSZX551 02841 DISPLAY '*** ESSP-CLEARING RPT/PAYMTS/WAGES ***'. DTSZX551 02842 DISPLAY '***************************************'. DTSZX551 02843 DISPLAY ' '. DTSZX551 02844 DTSZX551 02845 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSZX551 02846 DTSZX551 02847 DISPLAY '***************************************'. DTSZX551 02848 DTSZX551 02849 CLOSE WAGE-FILE-OUT DTSZX551 02850 PEND-X140-FILE DTSZX551 02851 PEND-X144-FILE DTSZX551 02852 PEND-X147-FILE DTSZX551 02853 REPT-PAID-FILE DTSZX551 02854 REPT-PEND-FILE DTSZX551 02855 PEND-X145-FILE DTSZX551 02856 TEMP-BTC-FILE DTSZX551 02857 BATCH-XREF-FILE. DTSZX551 02858 T0000-EXIT. DTSZX551 02859 EXIT. DTSZX551 02860 DTSZX551 02861 DTSZX551 02862 T2000-DISPLAY-TOTALS. DTSZX551 02863 DISPLAY '***** QUARTERLY REPORTS ************* '. DTSZX551 02864 DISPLAY 'TOTAL X140-REPORT RECORDS READ..........: ' DTSZX551 02865 W-X140-RED-CNT. DTSZX551 02866 DTSZX551 02867 DISPLAY ' NO OF X140-REPORTS PASSED ALL EDITS....: ' DTSZX551 02868 W-X140-SAV-CNT. DTSZX551 02869 DTSZX551 02870 DISPLAY ' NO OF X140-REPORTS T028 TRANS WRITTEN..: ' DTSZX551 02871 W-T028-WRITE-CNT. DTSZX551 02872 DTSZX551 02873 * DISPLAY ' ##T028 TRANS WRITTEN - REMIT AMT ZERO.: ' DTSZX551 02874 * W-T028-WRITEO-CNT. DTSZX551 02875 DTSZX551 02876 * DISPLAY ' #T028 TRANS WRITTEN - REMIT AMT EQUAL: ' DTSZX551 02877 * W-T028-WRITEE-CNT. DTSZX551 02878 DISPLAY ' NO OF X140-REPORTS WRITTEN TO PENDING..: ' DTSZX551 02879 W-X140-PEN-CNT. DTSZX551 02880 DISPLAY ' NO OF X140-REPORTS HAS ERRORS..........: ' DTSZX551 02881 W-X140-ERR-CNT. DTSZX551 02882 DISPLAY ' NO OF X140-REPORTS HAS DUPLICATE.......: ' DTSZX551 02883 W-X140-DUP-CNT. DTSZX551 02884 DTSZX551 02885 DISPLAY ' '. DTSZX551 02886 DISPLAY '***** QUARTERLY PAYMENTS ********* '. DTSZX551 02887 DISPLAY 'TOTAL X145-PAYMENTS RECORDS READ.......: ' DTSZX551 02888 W-X145-RED-CNT. DTSZX551 02889 DTSZX551 02890 DISPLAY ' NO OF X145-PAYMENTS PASSED ALL EDITS...: ' DTSZX551 02891 W-X145-SAV-CNT. DTSZX551 02892 DTSZX551 02893 DISPLAY ' NO OF X145-PAYMENTS T025 TRANS WRITTEN.: ' DTSZX551 02894 W-T025-WRITE-CNT. DTSZX551 02895 DTSZX551 02896 DISPLAY ' ## T025 TRANS WRITTEN-ZERO REMIT....: ' DTSZX551 02897 W-T025-WRITEO-CNT. DTSZX551 02898 DTSZX551 02899 DISPLAY ' NO OF X145-PAYMENTS WRITTEN TO PENDING.: ' DTSZX551 02900 W-X145-PEN-CNT. DTSZX551 02901 DISPLAY ' NO OF X145-PAYMENTS HAS ERRORS.........: ' DTSZX551 02902 W-X145-ERR-CNT. DTSZX551 02903 DISPLAY ' NO OF X145-PAYMENTS HAS DUPLICATE......: ' DTSZX551 02904 W-X145-DUP-CNT. DTSZX551 02905 DTSZX551 02906 DISPLAY ' '. DTSZX551 02907 DISPLAY '***** QUARTERLY WAGES ************* '. DTSZX551 02908 DISPLAY 'TOTAL X144-WAGES RECORDS READ..........: ' DTSZX551 02909 W-X144-RED-CNT. DTSZX551 02910 DTSZX551 02911 DISPLAY ' NO OF X144-WAGES PASSED ALL EDITS......: ' DTSZX551 02912 W-X144-SAV-CNT. DTSZX551 02913 DTSZX551 02914 DISPLAY ' NO OF X144-WAGES W004 TRANS WRITTEN....: ' DTSZX551 02915 W-W4-CNT. DTSZX551 02916 DTSZX551 02917 DISPLAY ' NO OF X144-WAGES WRITTEN TO PENDING....: ' DTSZX551 02918 W-X144-PEN-CNT. DTSZX551 02919 DISPLAY ' NO OF X144-WAGES HAS ERRORS............: ' DTSZX551 02920 W-X144-ERR-CNT. DTSZX551 02921 DISPLAY ' NO OF X144-WAGES HAS DUPLICATE.........: ' DTSZX551 02922 W-X144-DUP-CNT. DTSZX551 02923 DTSZX551 02924 DTSZX551 02925 DISPLAY ' '. DTSZX551 02926 DISPLAY '***** AMENDED WAGES DELETED ****** '. DTSZX551 02927 DISPLAY 'TOTAL X147-WAGES RECORDS READ..........: ' DTSZX551 02928 W-X147-RED-CNT. DTSZX551 02929 DTSZX551 02930 DISPLAY ' NO OF X147-WAGES PASSED ALL EDITS......: ' DTSZX551 02931 W-X147-SAV-CNT. DTSZX551 02932 DTSZX551 02933 DISPLAY ' NO OF X147-WAGES W004 TRANS WRITTEN....: ' DTSZX551 02934 W-W2-CNT. DTSZX551 02935 DTSZX551 02936 DISPLAY ' NO OF X147-WAGES WRITTEN TO PENDING....: ' DTSZX551 02937 W-X147-PEN-CNT. DTSZX551 02938 DISPLAY ' NO OF X147-WAGES HAS ERRORS............: ' DTSZX551 02939 W-X147-ERR-CNT. DTSZX551 02940 DISPLAY ' NO OF X147-WAGES HAS DUPLICATE.........: ' DTSZX551 02941 W-X147-DUP-CNT. DTSZX551 02942 DTSZX551 02943 DTSZX551 02944 DISPLAY ' '. DTSZX551 02945 DISPLAY '***** END REPORTS/WAGES AND PAYMENTS **** '. DTSZX551 02946 DTSZX551 02947 T2000-EXIT. DTSZX551 02948 EXIT. DTSZX551 02949 DTSZX551 02950 S001-FROM-FED-8. DTSZX551 02951 SET L001-FROM-FED-8 TO TRUE. DTSZX551 02952 GO TO S001-DATE. DTSZX551 02953 DTSZX551 02954 S001-FROM-CAL-8. DTSZX551 02955 SET L001-FROM-CAL-8 TO TRUE. DTSZX551 02956 GO TO S001-DATE. DTSZX551 02957 DTSZX551 02958 S001-FROM-ABS-DAY. DTSZX551 02959 SET L001-FROM-ABS-DAY TO TRUE. DTSZX551 02960 GO TO S001-DATE. DTSZX551 02961 DTSZX551 02962 S001-DATE. DTSZX551 02963 CALL 'DTSBU001' USING L001-LINK-AREA. DTSZX551 02964 S001-EXIT. DTSZX551 02965 EXIT. DTSZX551 02966 DTSZX551 02967 S003-AGENCY-DAY. DTSZX551 02968 SET L003-AGENCY-DAY TO TRUE. DTSZX551 02969 GO TO S003-WORK-DAY. DTSZX551 02970 DTSZX551 02971 S003-WORK-DAY. DTSZX551 02972 CALL 'DTSBU003' USING L003-LINK-AREA. DTSZX551 02973 S003-EXIT. DTSZX551 02974 EXIT. DTSZX551 02975 DTSZX551 02976 S004-FROM-5. DTSZX551 02977 SET L004-FROM-5 TO TRUE. DTSZX551 02978 GO TO S004-YRQ. DTSZX551 02979 DTSZX551 02980 S004-FROM-DATE. DTSZX551 02981 SET L004-FROM-DATE TO TRUE. DTSZX551 02982 GO TO S004-YRQ. DTSZX551 02983 DTSZX551 02984 S004-FROM-ABS. DTSZX551 02985 SET L004-FROM-ABS TO TRUE. DTSZX551 02986 GO TO S004-YRQ. DTSZX551 02987 DTSZX551 02988 S004-YRQ. DTSZX551 02989 CALL 'DTSBU004' USING L004-LINK-AREA. DTSZX551 02990 DTSZX551 02991 S004-EXIT. DTSZX551 02992 EXIT. DTSZX551 02993 DTSZX551 02994 S516-LIABILITY-INFO. DTSZX551 02995 CALL 'DTSBU516' USING L516-LINK-AREA DTSZX551 02996 MPRF-REC. DTSZX551 02997 S516-EXIT. DTSZX551 02998 EXIT. DTSZX551 02999 DTSZX551 03000 S910-OPEN-READ. DTSZX551 03001 SET L910-OPEN-READ-88 TO TRUE. DTSZX551 03002 GO TO S910-MSTR-IO. DTSZX551 03003 DTSZX551 03004 S910-READ. DTSZX551 03005 SET L910-READ-88 TO TRUE. DTSZX551 03006 GO TO S910-MSTR-IO. DTSZX551 03007 DTSZX551 03008 S910-START-BROWSE. DTSZX551 03009 SET L910-START-BROWSE-88 TO TRUE. DTSZX551 03010 GO TO S910-MSTR-IO. DTSZX551 03011 DTSZX551 03012 S910-READ-NEXT. DTSZX551 03013 SET L910-READ-NEXT-88 TO TRUE. DTSZX551 03014 GO TO S910-MSTR-IO. DTSZX551 03015 DTSZX551 03016 S910-CLOSE. DTSZX551 03017 SET L910-CLOSE-88 TO TRUE. DTSZX551 03018 GO TO S910-MSTR-IO. DTSZX551 03019 DTSZX551 03020 S910-MSTR-IO. DTSZX551 03021 CALL 'DTSBU910' USING L910-LINK-AREA DTSZX551 03022 MSKL-REC. DTSZX551 03023 S910-EXIT. DTSZX551 03024 EXIT. DTSZX551 03025 DTSZX551 03026 S921-OPEN-READ. DTSZX551 03027 SET L921-OPEN-READ-88 TO TRUE. DTSZX551 03028 GO TO S921-AIX-IO. DTSZX551 03029 DTSZX551 03030 S921-READ. DTSZX551 03031 SET L921-READ-88 TO TRUE. DTSZX551 03032 GO TO S921-AIX-IO. DTSZX551 03033 DTSZX551 03034 S921-START-BROWSE. DTSZX551 03035 SET L921-START-BROWSE-88 TO TRUE. DTSZX551 03036 GO TO S921-AIX-IO. DTSZX551 03037 DTSZX551 03038 S921-READ-NEXT. DTSZX551 03039 SET L921-READ-NEXT-88 TO TRUE. DTSZX551 03040 GO TO S921-AIX-IO. DTSZX551 03041 DTSZX551 03042 S921-CLOSE. DTSZX551 03043 SET L921-CLOSE-88 TO TRUE. DTSZX551 03044 GO TO S921-AIX-IO. DTSZX551 03045 DTSZX551 03046 S921-AIX-IO. DTSZX551 03047 CALL 'DTSBU921' USING L921-LINK-AREA DTSZX551 03048 ISKL-REC. DTSZX551 03049 S921-EXIT. DTSZX551 03050 EXIT. DTSZX551 03051 DTSZX551 03052 S923-OPEN-UPDATE. DTSZX551 03053 SET L923-OPEN-UPDATE-88 TO TRUE. DTSZX551 03054 GO TO S923-ATC-CALL. DTSZX551 03055 DTSZX551 03056 S923-WRITE. DTSZX551 03057 SET L923-WRITE-88 TO TRUE. DTSZX551 03058 GO TO S923-ATC-CALL. DTSZX551 03059 DTSZX551 03060 S923-CLOSE. DTSZX551 03061 SET L923-CLOSE-88 TO TRUE. DTSZX551 03062 GO TO S923-ATC-CALL. DTSZX551 03063 DTSZX551 03064 S923-ATC-CALL. DTSZX551 03065 CALL 'DTSBU923' USING L923-LINK-AREA DTSZX551 03066 ASKL-REC. DTSZX551 03067 S923-EXIT. DTSZX551 03068 EXIT. DTSZX551 03069 DTSZX551 03070 *S927A-OPEN. DTSZX551 03071 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSZX551 03072 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX551 03073 * DTSZX551 03074 *S927A-EXIT. DTSZX551 03075 * EXIT. DTSZX551 03076 DTSZX551 03077 S927B-WRITE. DTSZX551 03078 SET L927-WRITE-88 TO TRUE. DTSZX551 03079 PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX551 03080 DTSZX551 03081 S927B-EXIT. DTSZX551 03082 EXIT. DTSZX551 03083 DTSZX551 03084 *S927C-CLOSE. DTSZX551 03085 * SET L927-CLOSE-88 TO TRUE. DTSZX551 03086 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX551 03087 * DTSZX551 03088 *S927C-EXIT. DTSZX551 03089 * EXIT. DTSZX551 03090 DTSZX551 03091 S927Z-IO. DTSZX551 03092 CALL 'DTSBU927' USING L927-LINK-AREA DTSZX551 03093 TSKL-REC. DTSZX551 03094 S927Z-EXIT. DTSZX551 03095 EXIT. DTSZX551 03096 DTSZX551 03097 S931-OPEN-READ. DTSZX551 03098 SET L931-OPEN-READ-88 TO TRUE. DTSZX551 03099 GO TO S931-REF-IO. DTSZX551 03100 DTSZX551 03101 S931-CLOSE. DTSZX551 03102 SET L931-CLOSE-88 TO TRUE. DTSZX551 03103 GO TO S931-REF-IO. DTSZX551 03104 DTSZX551 03105 S931-REF-IO. DTSZX551 03106 CALL 'DTSBU931' USING L931-LINK-AREA DTSZX551 03107 FSKL-REC. DTSZX551 03108 S931-EXIT. DTSZX551 03109 EXIT. DTSZX551 03110 DTSZX551 03111 S1032-WRITE-TEMP-T028. DTSZX551 03112 MOVE T028-LENGTH TO VAR-CHAR-CNT. DTSZX551 03113 MOVE T028-REC TO TEMP-BTC-REC. DTSZX551 03114 WRITE TEMP-BTC-REC. DTSZX551 03115 IF TEMP-BTC-STATUS-OK-88 DTSZX551 03116 NEXT SENTENCE DTSZX551 03117 ELSE DTSZX551 03118 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 03119 DISPLAY 'CANNOT WRITE TEMP T028: ' DTSZX551 03120 TEMP-BTC-STATUS DTSZX551 03121 END-IF. DTSZX551 03122 DTSZX551 03123 S1032-EXIT. DTSZX551 03124 EXIT. DTSZX551 03125 DTSZX551 03126 S1033-WRITE-TEMP-T025. DTSZX551 03127 MOVE T025-LENGTH TO VAR-CHAR-CNT. DTSZX551 03128 MOVE T025-REC TO TEMP-BTC-REC. DTSZX551 03129 WRITE TEMP-BTC-REC. DTSZX551 03130 IF TEMP-BTC-STATUS-OK-88 DTSZX551 03131 NEXT SENTENCE DTSZX551 03132 ELSE DTSZX551 03133 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 03134 DISPLAY 'CANNOT WRITE TEMP T025: ' DTSZX551 03135 TEMP-BTC-STATUS DTSZX551 03136 END-IF. DTSZX551 03137 DTSZX551 03138 S1033-EXIT. DTSZX551 03139 EXIT. DTSZX551 03140 DTSZX551 03141 S1040-OPEN-TEMP-BTC-OUT. DTSZX551 03142 OPEN OUTPUT TEMP-BTC-FILE. DTSZX551 03143 IF TEMP-BTC-STATUS-OK-88 DTSZX551 03144 NEXT SENTENCE DTSZX551 03145 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSZX551 03146 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSZX551 03147 ELSE DTSZX551 03148 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03149 DISPLAY 'CANNOT OPEN TEMP BTC FILE OUTPUT: ' DTSZX551 03150 TEMP-BTC-STATUS DTSZX551 03151 END-IF. DTSZX551 03152 DTSZX551 03153 S1040-EXIT. DTSZX551 03154 EXIT. DTSZX551 03155 DTSZX551 03156 S1050-OPEN-TEMP-BTC-IN. DTSZX551 03157 OPEN INPUT TEMP-BTC-FILE. DTSZX551 03158 IF TEMP-BTC-STATUS-OK-88 DTSZX551 03159 NEXT SENTENCE DTSZX551 03160 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSZX551 03161 *** DISPLAY 'TEMP BTC OPENED INP ' DTSZX551 03162 ELSE DTSZX551 03163 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03164 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSZX551 03165 TEMP-BTC-STATUS DTSZX551 03166 END-IF. DTSZX551 03167 DTSZX551 03168 S1050-EXIT. DTSZX551 03169 EXIT. DTSZX551 03170 DTSZX551 03171 S1060-CLOSE-TEMP-BTC. DTSZX551 03172 CLOSE TEMP-BTC-FILE. DTSZX551 03173 IF TEMP-BTC-STATUS-OK-88 DTSZX551 03174 *** DISPLAY 'TEMP-BTC CLOSED' DTSZX551 03175 NEXT SENTENCE DTSZX551 03176 ELSE DTSZX551 03177 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03178 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSZX551 03179 TEMP-BTC-STATUS DTSZX551 03180 END-IF. DTSZX551 03181 DTSZX551 03182 S1060-EXIT. DTSZX551 03183 EXIT. DTSZX551 03184 DTSZX551 03185 S1070-READ-TEMP-BTC. DTSZX551 03186 READ TEMP-BTC-FILE. DTSZX551 03187 IF TEMP-BTC-STATUS-OK-88 DTSZX551 03188 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSZX551 03189 ELSE DTSZX551 03190 IF TEMP-BTC-STATUS-EOF-88 DTSZX551 03191 NEXT SENTENCE DTSZX551 03192 ELSE DTSZX551 03193 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSZX551 03194 TEMP-BTC-STATUS DTSZX551 03195 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03196 END-IF DTSZX551 03197 END-IF. DTSZX551 03198 DTSZX551 03199 S1070-EXIT. DTSZX551 03200 EXIT. DTSZX551 03201 DTSZX551 03202 S1100-OPEN-WAGE-TEMP-OUT. DTSZX551 03203 OPEN OUTPUT WAGE-FILE-TEMP. DTSZX551 03204 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 03205 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03206 DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: ' DTSZX551 03207 WAGE-TEMP-STATUS DTSZX551 03208 END-IF. DTSZX551 03209 DTSZX551 03210 S1100-EXIT. DTSZX551 03211 EXIT. DTSZX551 03212 DTSZX551 03213 S1110-CLOSE-WAGE-TEMP. DTSZX551 03214 CLOSE WAGE-FILE-TEMP. DTSZX551 03215 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 03216 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03217 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSZX551 03218 WAGE-TEMP-STATUS DTSZX551 03219 END-IF. DTSZX551 03220 DTSZX551 03221 S1110-EXIT. DTSZX551 03222 EXIT. DTSZX551 03223 DTSZX551 03224 S1120-WRITE-WAGE-TEMP. DTSZX551 03225 WRITE WAGE-TEMP-REC FROM W001-REC. DTSZX551 03226 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 03227 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03228 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSZX551 03229 WAGE-TEMP-STATUS DTSZX551 03230 END-IF. DTSZX551 03231 DTSZX551 03232 S1120-EXIT. DTSZX551 03233 EXIT. DTSZX551 03234 DTSZX551 03235 S1130-OPEN-WAGE-TEMP-IN. DTSZX551 03236 OPEN INPUT WAGE-FILE-TEMP. DTSZX551 03237 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 03238 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03239 DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: ' DTSZX551 03240 WAGE-TEMP-STATUS DTSZX551 03241 END-IF. DTSZX551 03242 DTSZX551 03243 S1130-EXIT. DTSZX551 03244 EXIT. DTSZX551 03245 DTSZX551 03246 S1140-READ-WAGE-TEMP. DTSZX551 03247 READ WAGE-FILE-TEMP INTO W001-REC. DTSZX551 03248 IF WAGE-TEMP-STATUS-EOF-88 DTSZX551 03249 NEXT SENTENCE DTSZX551 03250 ELSE DTSZX551 03251 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 03252 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03253 DISPLAY 'READ ERROR ON WAGE TEMP FILE: ' DTSZX551 03254 WAGE-TEMP-STATUS DTSZX551 03255 END-IF DTSZX551 03256 END-IF. DTSZX551 03257 DTSZX551 03258 S1140-EXIT. DTSZX551 03259 EXIT. DTSZX551 03260 DTSZX551 03261 S1150-OPEN-WAGE-FILE-OUT. DTSZX551 03262 OPEN OUTPUT WAGE-FILE-OUT. DTSZX551 03263 IF NOT WAGE-OUT-STATUS-OK-88 DTSZX551 03264 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03265 DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: ' DTSZX551 03266 WAGE-OUT-STATUS DTSZX551 03267 END-IF. DTSZX551 03268 DTSZX551 03269 S1150-EXIT. DTSZX551 03270 EXIT. DTSZX551 03271 DTSZX551 03272 S1160-CLOSE-WAGE-OUT. DTSZX551 03273 CLOSE WAGE-FILE-OUT. DTSZX551 03274 IF NOT WAGE-OUT-STATUS-OK-88 DTSZX551 03275 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03276 DISPLAY 'CANNOT CLOSE WAGE FILE: ' DTSZX551 03277 WAGE-OUT-STATUS DTSZX551 03278 END-IF. DTSZX551 03279 DTSZX551 03280 S1160-EXIT. DTSZX551 03281 EXIT. DTSZX551 03282 DTSZX551 03283 S1170-WRITE-WAGE-OUT. DTSZX551 03284 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. DTSZX551 03285 WRITE WAGE-OUT-REC. DTSZX551 03286 IF NOT WAGE-OUT-STATUS-OK-88 DTSZX551 03287 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 03288 DISPLAY 'CANNOT WRITE WAGE OUT FILE: ' DTSZX551 03289 WAGE-OUT-STATUS DTSZX551 03290 END-IF. DTSZX551 03291 DTSZX551 03292 S1170-EXIT. DTSZX551 03293 EXIT. DTSZX551 03294 DTSZX551 03295 S946-WRITE-R140. DTSZX551 03296 CALL 'DTSBU946' USING R140-REC. DTSZX551 03297 DTSZX551 03298 S946-EXIT. DTSZX551 03299 EXIT. DTSZX551 03300 DTSZX551 03301 S999-ABEND. DTSZX551 03302 CALL 'DTSBU999' USING W-ABEND-CD. DTSZX551 03303 S999-EXIT. DTSZX551 03304 EXIT. DTSZX551 03305 DTSZX551