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

2866 lines
227 KiB
COBOL
Raw Blame History

00001 IDENTIFICATION DIVISION. 03/10/25
00002 PROGRAM-ID. DTSBX430. DTSBX430
00003 AUTHOR. NGC. LV253
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 '253DTSBX430 03/10/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. CL253
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
Reference in New Issue View Git Blame Copy Permalink