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