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