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