1269 lines
100 KiB
COBOL
1269 lines
100 KiB
COBOL
00001 IDENTIFICATION DIVISION. 03/05/04
|
|
00002 PROGRAM-ID. EFTBD140. EFTBD140
|
|
00003 AUTHOR. NORTHROP GRUMMAN. LV118
|
|
00004 DATE-WRITTEN. JULY 2003. CL131
|
|
00005 DATE-COMPILED. EFTBD140
|
|
00006 SKIP3 EFTBD140
|
|
00007 ***** EFTBD140
|
|
00008 * EFTBD140
|
|
00009 * FUNCTION: READ THE DAILY FILE OF ELECTRONIC REPORT DATA CL131
|
|
00010 * SENT FROM GOVONE WEB REPORTING SYSTEM TO DOES. CL195
|
|
00011 * IT BUILDS DTSIT027 QUARTERLY TAX RPT TRANS REC CL105
|
|
00012 * AND WRITES THESE RECORDS TO THE DAILY BTC FILE CL243
|
|
00013 * WHICH IS INPUT TO THE NIGHTLY ACCOUNTING UPDATE. CL131
|
|
00014 * IT ALSO WRITES DTSIW001 WAGE TRANSACTION RECORD CL**8
|
|
00015 * TO THE WTC FILE. CL**8
|
|
00016 * THE QUARTERLY REPORT PROCESSING PROGRAM (DTSBD371) CL131
|
|
00017 * WILL RELEASE THE WAGE TRANSACTIONS FOR PROCESSING CL131
|
|
00018 * WHEN IT SUCCESSFULLY ADDS A QUARTERLY REPORT RECS CL138
|
|
00019 * (MRPT) TO THE TAX MASTER FILE. CL131
|
|
00020 * CL131
|
|
00021 * MODIFICATION LOG: EFTBD140
|
|
00022 * EFTBD140
|
|
00023 * 07/01/03 INITIAL DEVELOPMENT CL131
|
|
00024 * WORK ORDER: PROGRAMMER: RW1 CL**3
|
|
00025 * CL**3
|
|
00026 * 99/99/99 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
|
00027 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
|
00028 * WORK ORDER: PROGRAMMER: XXX CL**3
|
|
00029 * EFTBD140
|
|
00030 * DESCRIPTION: EFTBD140
|
|
00031 * EFTBD140
|
|
00032 * INITIATION: EFTBD140
|
|
00033 * NONE CL*91
|
|
00034 * EFTBD140
|
|
00035 * INPUT FILE FORMATS: CL131
|
|
00036 * EFTIFDPT PAYMENT TRANSACTION CL131
|
|
00037 * EFTIFQTF QUARTERLY TAX REPORT TRANSACTION CL131
|
|
00038 * EFTIFCQW EMPLOYEE CURRENT QUARTER WAGES CL248
|
|
00039 * CL131
|
|
00040 * OUTPUT FILE FORMATS: CL131
|
|
00041 * DTSIT027 QUARTERLY TAX REPORT TRANSACTION CL138
|
|
00042 * DTSIW001 WAGE TRANSACTION CL131
|
|
00043 * CL*50
|
|
00044 * PROCESSING: EFTBD140
|
|
00045 * SORT THE TRANSACTIONS BY TRACE NUMBER AND RECORD TYPE. CL132
|
|
00046 * THIS WILL GROUP ALL RECORDS FROM THE SAME QUARTERLY CL131
|
|
00047 * REPORT TRANSACTION TOGETHER. WITHIN THE TRACE NUMBER, CL131
|
|
00048 * THE RECORDS WILL BE IN THE FOLLOWING ORDER: REPORT CL131
|
|
00049 * RECORD, PAYMENT RECORD, WAGE RECORDS. TRANSACTION FOR CL131
|
|
00050 * PAYMENT OF A BALANCE DUE OCCURS SINGLY, AND HAVE NO CL131
|
|
00051 * RELATED RECORDS. CL131
|
|
00052 * ALL RECORDS WITH THE SAME TRACE NUMBER ARE PART OF THE CL131
|
|
00053 * TRANSACTION (I.E., A COMPLETE QUARTERLY REPORT CONSISTS CL131
|
|
00054 * OF THE TAX PORTION OF THE REPORT, THE PAYMENT AND THE CL131
|
|
00055 * WAGES). CL131
|
|
00056 * CL131
|
|
00057 * TERMINATION: EFTBD140
|
|
00058 * OUTPUT STATISTICAL RECORDS COUNT. CL*50
|
|
00059 * EFTBD140
|
|
00060 * RECORDS READ: EFTBD140
|
|
00061 * MASTER: CL**3
|
|
00062 * VSAM MPRF FILE CL188
|
|
00063 * CL**3
|
|
00064 * ALTERNATE INDEX: EFTBD140
|
|
00065 * NONE. EFTBD140
|
|
00066 * EFTBD140
|
|
00067 * REFERENCE: EFTBD140
|
|
00068 * NONE. EFTBD140
|
|
00069 * EFTBD140
|
|
00070 * RECORDS UPDATED: CL**3
|
|
00071 * NONE CL249
|
|
00072 * EFTBD140
|
|
00073 * REPORT RECORDS WRITTEN: EFTBD140
|
|
00074 * R907 ERROR REPORT RECORDS. CL188
|
|
00075 * CL*50
|
|
00076 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: CL241
|
|
00077 * T027 RECORDS CL243
|
|
00078 * CL131
|
|
00079 * WAGE TRANSACTION COLLECTION RECORDS WRITTEN: CL131
|
|
00080 * W001 RECORDS CL131
|
|
00081 * EFTBD140
|
|
00082 * MODULES CALLED: EFTBD140
|
|
00083 * DTSBU001 DATE CONVERSION/EDIT. EFTBD140
|
|
00084 * DTSBU004 QUARERLY SUMMARY REPORT REC. CL*47
|
|
00085 * DTSBU910 VSAM MASTER FILES I/O. CL*74
|
|
00086 * DTSBU927 VARIABLE LENGTH RECORDS BTC OUTPUT. CL*96
|
|
00087 * DTSBU941 VARIABLE LENGTH RECORDS INPUT 1. CL134
|
|
00088 * DTSBU947 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 2. CL133
|
|
00089 * DTSBU983 BATCH WAGE TRANSACTION FILE INPUT/OUTPUT. CL176
|
|
00090 * CL176
|
|
00091 * VERMONT REFERENCE: EFTBD140
|
|
00092 * NONE. EFTBD140
|
|
00093 * EFTBD140
|
|
00094 ***** EFTBD140
|
|
00095 SKIP3 CL*13
|
|
00096 ENVIRONMENT DIVISION. EFTBD140
|
|
00097 CL*58
|
|
00098 INPUT-OUTPUT SECTION. CL*58
|
|
00099 CL*86
|
|
00100 FILE-CONTROL. CL*86
|
|
00101 SELECT WAGE-TRAN-FILE ASSIGN TO DTSFW001 CL*86
|
|
00102 FILE STATUS IS WAGE-STATUS. CL*86
|
|
00103 CL*58
|
|
00104 DATA DIVISION. CL*86
|
|
00105 CL*86
|
|
00106 FILE SECTION. CL*86
|
|
00107 CL*86
|
|
00108 FD WAGE-TRAN-FILE CL*86
|
|
00109 RECORDING MODE IS F CL*94
|
|
00110 LABEL RECORDS ARE STANDARD CL*94
|
|
00111 BLOCK CONTAINS 0 CHARACTERS. CL*86
|
|
00112 SKIP1 CL*86
|
|
00113 01 WAGE-TRAN-REC. CL*86
|
|
00114 ++INCLUDE DTSIWSKL CL*86
|
|
00115 CL*32
|
|
00116 CL*32
|
|
00117 WORKING-STORAGE SECTION. EFTBD140
|
|
001175 77 PAN-VALET PICTURE X(24) VALUE '118EFTBD140 03/05/04'. EFTBD140
|
|
00118 CL*40
|
|
00119 01 WRK-AREA. EFTBD140
|
|
00120 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +140. CL197
|
|
00121 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBD140'. CL197
|
|
00122 05 WRK-ABEND-MSG PIC X(60). CL*83
|
|
00123 CL*69
|
|
00124 05 EFT-STATUS PIC X(02). CL*58
|
|
00125 88 EFT-STATUS-OK-88 VALUE '00'. CL*58
|
|
00126 88 EFT-STATUS-EOF-88 VALUE '10'. CL177
|
|
00127 CL*32
|
|
00128 05 WAGE-STATUS PIC X(02). CL*86
|
|
00129 88 WAGE-STATUS-OK-88 VALUE '00'. CL*86
|
|
00130 88 WAGE-STATUS-EOF-88 VALUE '10'. CL*86
|
|
00131 CL*86
|
|
00132 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. CL*90
|
|
00133 CL*58
|
|
00134 05 WRK-TOT-WAGE PIC S9(11)V99 VALUE +0. CL*70
|
|
00135 05 WRK-EXCESS-WAGE PIC S9(09)V99 VALUE +0. CL*70
|
|
00136 CL*91
|
|
00137 05 WRK-MOPO-T002-IND PIC X(01). CL*91
|
|
00138 88 WRK-MOPO-T002-YES-88 VALUE 'Y'. CL*91
|
|
00139 88 WRK-MOPO-T002-NO-88 VALUE 'N'. CL*91
|
|
00140 CL*93
|
|
00141 05 WRK-MOPO-IND PIC X(01). CL*93
|
|
00142 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. CL*93
|
|
00143 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. CL*93
|
|
00144 CL*93
|
|
00145 05 ERR-UNEXPECTED-WAGE-IND PIC X(01). CL*65
|
|
00146 88 ERR-UNEXPECTED-WAGE-YES-88 VALUE 'Y'. CL*65
|
|
00147 88 ERR-UNEXPECTED-WAGE-NO-88 VALUE 'N'. CL*65
|
|
00148 EFTBD140
|
|
00149 05 ERR-T027-PASS-EDITS-IND PIC X(01). CL*65
|
|
00150 88 ERR-T027-PASS-EDITS-YES-88 VALUE 'Y'. CL*65
|
|
00151 88 ERR-T027-PASS-EDITS-NO-88 VALUE 'N'. CL*65
|
|
00152 CL239
|
|
00153 05 DISP-DATE PIC X(10) VALUE SPACES. CL*92
|
|
00154 05 DISP-TIME PIC X(08) VALUE SPACES. CL*92
|
|
00155 05 WRK-SYS-TIME PIC X(06) VALUE SPACES. CL*92
|
|
00156 05 WRK-SYS-DATE PIC X(08) VALUE SPACES. CL*92
|
|
00157 05 WRK-CURR-YR PIC 9(04) VALUE ZEROS. CL*92
|
|
00158 05 WRK-CURR-YRQ PIC S9(05) COMP-3. CL154
|
|
00159 CL154
|
|
00160 05 WRK-L001-JUL-DATE PIC 9(7) VALUE ZERO. CL*79
|
|
00161 05 FILLER REDEFINES WRK-L001-JUL-DATE. CL*79
|
|
00162 10 WRK-JULIAN-YR-1ST-3 PIC 9(3). CL*79
|
|
00163 10 WRK-JULIAN-YR-DAYS PIC 9(4). CL*79
|
|
00164 CL150
|
|
00165 05 WRK-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. CL*79
|
|
00166 05 FILLER REDEFINES WRK-PSEUDO-BATCH-NO. CL*79
|
|
00167 10 WRK-PSEUDO-YR-DAYS PIC 9(04). CL*79
|
|
00168 10 WRK-PSEUDO-BATCH-SEQ PIC 9(01). CL*79
|
|
00169 CL150
|
|
00170 05 WRK-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. CL*79
|
|
00171 05 WRK-SEQ-NO PIC 9(07) VALUE 0. CL*68
|
|
00172 CL150
|
|
00173 05 WRK-YRQ-AREA PIC 9(05). CL*78
|
|
00174 05 FILLER REDEFINES WRK-YRQ-AREA. CL*78
|
|
00175 10 WRK-YRQ-CCYY PIC 9(04). CL*78
|
|
00176 10 WRK-YRQ-Q PIC 9(01). CL*78
|
|
00177 CL*78
|
|
00178 05 WRK-EMP-NO PIC 9(06) VALUE 0. CL138
|
|
00179 05 WRK-CURR-PAY-TRACE-NO PIC 9(13) VALUE 0. CL*65
|
|
00180 05 WRK-RPT-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL*65
|
|
00181 05 WRK-PAY-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL*65
|
|
00182 05 WRK-WAGE-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL*65
|
|
00183 05 WRK-T027-CNT PIC S9(07) COMP-3 VALUE +0. CL*65
|
|
00184 05 WRK-W001-CNT PIC S9(07) COMP-3 VALUE +0. CL*65
|
|
00185 05 WRK-R907-CNT PIC S9(07) COMP-3 VALUE +0. CL*65
|
|
00186 05 WRK-FAIL-EDITS-CNT PIC S9(07) COMP-3 VALUE +0. CL*65
|
|
00187 05 WRK-T002-CONTACT-CNT PIC S9(07) COMP-3 VALUE +0. CL*92
|
|
00188 05 WRK-L076-NAME PIC X(32) VALUE SPACES. CL116
|
|
00189 CL*92
|
|
00190 05 WRK-MSG-TEXT. CL112
|
|
00191 10 WRK-MSG-LINE PIC X(32). CL116
|
|
00192 10 FILLER PIC X(02) VALUE SPACES. CL112
|
|
00193 10 FILLER PIC X(14) VALUE CL168
|
|
00194 'FQTF-EMP-NO = '. CL168
|
|
00195 * 10 WRK-ERR-PAY-AMT PIC 9(06)9.99. CL124
|
|
00196 10 WRK-ERR-PAY-AMT PIC X(10). CL124
|
|
00197 10 WRK-ERR-EMP-NO-X REDEFINES WRK-ERR-PAY-AMT. CL115
|
|
00198 15 WRK-ERR-EMP-NO PIC X(06). CL112
|
|
00199 15 FIL-EMP-NO PIC X(04). CL114
|
|
00200 10 WRK-ERR-PAY-TRACE-NO-X REDEFINES WRK-ERR-PAY-AMT. CL115
|
|
00201 15 WRK-ERR-PAY-TRACE-NO PIC X(05). CL114
|
|
00202 15 FIL-PAY-TRACE-NO PIC X(05). CL115
|
|
00203 10 WRK-ERR-PAY-DATE-X REDEFINES WRK-ERR-PAY-AMT. CL115
|
|
00204 15 WRK-ERR-PAY-DATE PIC X(08). CL112
|
|
00205 15 FIL-PAY-DATE PIC X(02). CL114
|
|
00206 10 WRK-ERR-PAY-TIME-X REDEFINES WRK-ERR-PAY-AMT. CL115
|
|
00207 15 WRK-ERR-PAY-TIME PIC X(06). CL112
|
|
00208 15 FIL-PAY-TIME PIC X(04). CL114
|
|
00209 CL166
|
|
00210 05 MSG1-AREA. CL*67
|
|
00211 10 MSG1-ID PIC X(03) VALUE '101'. CL*67
|
|
00212 10 MSG1-TEXT. CL*67
|
|
00213 15 FILLER PIC X(30) CL*67
|
|
00214 VALUE 'TOTAL WAGES DO NOT = REPORTED'. CL*99
|
|
00215 15 FILLER PIC X(30) CL*67
|
|
00216 VALUE ' TOTAL WAGES OR NO WAGES RECS '. CL*99
|
|
00217 15 FILLER PIC X(02) VALUE SPACES. CL*67
|
|
00218 15 MSG1-TRACE-NO PIC 9(13). CL*67
|
|
00219 CL169
|
|
00220 05 MSG2-AREA. CL*67
|
|
00221 10 MSG2-ID PIC X(03) VALUE '102'. CL*67
|
|
00222 10 MSG2-TEXT. CL*67
|
|
00223 15 FILLER PIC X(30) CL*67
|
|
00224 VALUE 'DUPLICATE PAYMENT FOUND '. CL*82
|
|
00225 15 FILLER PIC X(30) CL*67
|
|
00226 VALUE ' '. CL*82
|
|
00227 15 FILLER PIC X(02) VALUE SPACES. CL*67
|
|
00228 15 MSG2-TRACE-NO PIC 9(13). CL*67
|
|
00229 CL*67
|
|
00230 05 MSG3-AREA. CL*67
|
|
00231 10 MSG3-ID PIC X(03) VALUE '103'. CL*67
|
|
00232 10 MSG3-TEXT. CL*67
|
|
00233 15 FILLER PIC X(30) CL*67
|
|
00234 VALUE 'PAYMENT FOUND WITHOUT REPORT '. CL*82
|
|
00235 15 FILLER PIC X(30) CL*67
|
|
00236 VALUE ' '. CL*82
|
|
00237 15 FILLER PIC X(02) VALUE SPACES. CL*67
|
|
00238 15 MSG3-TRACE-NO PIC 9(13). CL*67
|
|
00239 CL*67
|
|
00240 05 MSG4-AREA. CL*67
|
|
00241 10 MSG4-ID PIC X(03) VALUE '104'. CL*67
|
|
00242 10 MSG4-TEXT. CL*67
|
|
00243 15 FILLER PIC X(30) CL*67
|
|
00244 VALUE 'PAYMENT AMT ON PAYMENT RECORD '. CL*97
|
|
00245 15 FILLER PIC X(30) CL*67
|
|
00246 VALUE 'NOT = PAYMENT AMT ON REPORT '. CL*97
|
|
00247 15 FILLER PIC X(02) VALUE SPACES. CL*67
|
|
00248 15 MSG4-TRACE-NO PIC 9(13). CL*67
|
|
00249 CL*67
|
|
00250 05 MSG5-AREA. CL*67
|
|
00251 10 MSG5-ID PIC X(03) VALUE '105'. CL*67
|
|
00252 10 MSG5-TEXT. CL*67
|
|
00253 15 FILLER PIC X(30) CL*67
|
|
00254 VALUE 'WAGE RECORD FOUND WITHOUT REPO'. CL*82
|
|
00255 15 FILLER PIC X(30) CL*67
|
|
00256 VALUE 'RT '. CL*82
|
|
00257 15 FILLER PIC X(02) VALUE SPACES. CL*67
|
|
00258 15 MSG5-TRACE-NO PIC 9(13). CL*67
|
|
00259 CL*67
|
|
00260 05 MSG6-AREA. CL*67
|
|
00261 10 MSG6-ID PIC X(03) VALUE '106'. CL*67
|
|
00262 10 MSG6-TEXT. CL*67
|
|
00263 15 FILLER PIC X(30) CL*67
|
|
00264 VALUE 'WAGE RECORD FOUND, BUT WAGES A'. CL*82
|
|
00265 15 FILLER PIC X(30) CL*67
|
|
00266 VALUE 'RE SUBMITTED ON TAPE '. CL*82
|
|
00267 15 FILLER PIC X(02) VALUE SPACES. CL*67
|
|
00268 15 MSG6-TRACE-NO PIC 9(13). CL*67
|
|
00269 CL*67
|
|
00270 05 MSG7-AREA. CL*67
|
|
00271 10 MSG7-ID PIC X(03) VALUE '107'. CL*67
|
|
00272 10 MSG7-TEXT. CL*67
|
|
00273 15 FILLER PIC X(30) CL*67
|
|
00274 VALUE 'WAGE RECORD FOUND, BUT ZERO WA'. CL*82
|
|
00275 15 FILLER PIC X(30) CL*67
|
|
00276 VALUE 'GES REPORTED '. CL*82
|
|
00277 15 FILLER PIC X(02) VALUE SPACES. CL*67
|
|
00278 15 MSG7-TRACE-NO PIC 9(13). CL*67
|
|
00279 CL*67
|
|
00280 05 MSG8-AREA. CL*81
|
|
00281 10 MSG8-ID PIC X(03) VALUE '108'. CL*81
|
|
00282 10 MSG8-TEXT. CL*81
|
|
00283 15 FILLER PIC X(30) CL*81
|
|
00284 VALUE 'NO MATCHING PAYMENT FOR REPORT'. CL*82
|
|
00285 15 FILLER PIC X(30) CL*81
|
|
00286 VALUE ' '. CL*82
|
|
00287 15 FILLER PIC X(02) VALUE SPACES. CL*81
|
|
00288 15 MSG8-TRACE-NO PIC 9(13). CL*81
|
|
00289 CL*93
|
|
00290 05 MSG9-AREA. CL*93
|
|
00291 10 MSG9-ID PIC X(03) VALUE '109'. CL*93
|
|
00292 10 MSG9-TEXT. CL*93
|
|
00293 15 FILLER PIC X(30) CL*93
|
|
00294 VALUE 'FQTF REPORT NAME IS INVALID '. CL*93
|
|
00295 15 FILLER PIC X(30) CL*93
|
|
00296 VALUE ' '. CL*93
|
|
00297 15 FILLER PIC X(02) VALUE SPACES. CL*93
|
|
00298 15 MSG9-TRACE-NO PIC 9(13). CL*93
|
|
00299 CL*81
|
|
00300 CL166
|
|
00301 05 WRK-ERROR-IND PIC X(01). CL152
|
|
00302 88 WRK-ERROR-YES-88 VALUE 'Y'. CL152
|
|
00303 88 WRK-ERROR-NO-88 VALUE 'N'. CL152
|
|
00304 CL159
|
|
00305 05 WRK-FIRST-READ-IND PIC X(01). CL159
|
|
00306 88 WRK-FIRST-READ-YES-88 VALUE 'Y'. CL159
|
|
00307 88 WRK-FIRST-READ-NO-88 VALUE 'N'. CL159
|
|
00308 CL*76
|
|
00309 05 WRK-MPRF-IND PIC X(01). EFTBD140
|
|
00310 88 WRK-MPRF-YES-88 VALUE 'Y'. EFTBD140
|
|
00311 88 WRK-MPRF-NO-88 VALUE 'N'. EFTBD140
|
|
00312 CL143
|
|
00313 05 WRK-FQTF-REC-WRITE-IND PIC X(01). CL143
|
|
00314 88 WRK-FQTF-REC-WRITE-YES-88 VALUE 'Y'. CL143
|
|
00315 88 WRK-FQTF-REC-WRITE-NO-88 VALUE 'N'. CL143
|
|
00316 CL*16
|
|
00317 01 WRK-PAYMENT-DATE PIC X(08). CL*85
|
|
00318 01 WRK-PAYMENT-DATE-9 REDEFINES WRK-PAYMENT-DATE CL*85
|
|
00319 PIC 9(08). CL*85
|
|
00320 01 WRK-PAYMENT-CCYYMMDD REDEFINES WRK-PAYMENT-DATE. CL*85
|
|
00321 10 WRK-DATE-CCYY PIC 9(04). CL*90
|
|
00322 10 WRK-DATE-MM PIC 9(02). CL*90
|
|
00323 10 WRK-DATE-DD PIC 9(02). CL*90
|
|
00324 CL*84
|
|
00325 01 WRK-PAYMENT-TIME PIC X(06). CL*85
|
|
00326 01 WRK-PAYMENT-TIME-9 REDEFINES WRK-PAYMENT-TIME CL*85
|
|
00327 PIC 9(06). CL*85
|
|
00328 01 WRK-PAYMENT-HHMMSS REDEFINES WRK-PAYMENT-TIME. CL101
|
|
00329 10 WRK-TIME-HH PIC 9(02). CL*90
|
|
00330 10 WRK-TIME-MM PIC 9(02). CL*90
|
|
00331 10 WRK-TIME-SS PIC 9(02). CL*90
|
|
00332 CL*74
|
|
00333 01 FQTF-REC. CL137
|
|
00334 ++INCLUDE EFTIFQTF CL137
|
|
00335 SKIP3 CL*58
|
|
00336 01 FDPT-REC. CL137
|
|
00337 ++INCLUDE EFTIFDPT CL137
|
|
00338 SKIP3 CL137
|
|
00339 01 FCQW-REC. CL183
|
|
00340 ++INCLUDE EFTIFCQW CL183
|
|
00341 SKIP3 CL137
|
|
00342 01 T027-REC. CL219
|
|
00343 ++INCLUDE DTSIT027 CL219
|
|
00344 SKIP3 CL219
|
|
00345 01 T002-REC. CL*91
|
|
00346 ++INCLUDE DTSIT002 CL*91
|
|
00347 SKIP3 CL*91
|
|
00348 01 R907-REC. CL219
|
|
00349 ++INCLUDE DTSIR907 CL219
|
|
00350 SKIP3 CL219
|
|
00351 01 L001-LINK-AREA. EFTBD140
|
|
00352 ++INCLUDE DTSIL001 EFTBD140
|
|
00353 EJECT EFTBD140
|
|
00354 01 L003-LINK-AREA. CL*56
|
|
00355 ++INCLUDE DTSIL003 CL*56
|
|
00356 EJECT CL*24
|
|
00357 01 L004-LINK-AREA. CL*56
|
|
00358 ++INCLUDE DTSIL004 CL*56
|
|
00359 EJECT CL*56
|
|
00360 01 L005-COMM-AREA. CL*61
|
|
00361 ++INCLUDE DTSIL005 CL*61
|
|
00362 EJECT CL100
|
|
00363 01 L516-LINK-AREA. EFTBD140
|
|
00364 ++INCLUDE DTSIL516 EFTBD140
|
|
00365 EJECT CL*92
|
|
00366 01 L076-LINK-AREA. CL116
|
|
00367 ++INCLUDE DTSIL076 CL116
|
|
00368 EJECT CL*92
|
|
00369 01 L910-LINK-AREA. CL*94
|
|
00370 ++INCLUDE DTSIL910 CL*94
|
|
00371 EJECT CL*94
|
|
00372 01 MSKL-REC. CL*70
|
|
00373 ++INCLUDE DTSIMSKL CL*70
|
|
00374 EJECT CL*70
|
|
00375 01 MPRF-REC. CL*70
|
|
00376 ++INCLUDE DTSIMPRF CL*70
|
|
00377 EJECT CL211
|
|
00378 01 MQTR-REC. CL*70
|
|
00379 ++INCLUDE DTSIMQTR CL*70
|
|
00380 EJECT CL*70
|
|
00381 01 MOPO-REC. CL*92
|
|
00382 ++INCLUDE DTSIMOPO CL*92
|
|
00383 EJECT CL*92
|
|
00384 01 L927-LINK-AREA. CL212
|
|
00385 ++INCLUDE DTSIL927 CL212
|
|
00386 EJECT CL212
|
|
00387 01 TSKL-REC. CL212
|
|
00388 ++INCLUDE DTSITSKL CL212
|
|
00389 EJECT CL212
|
|
00390 01 L985-LINK-AREA. CL*48
|
|
00391 ++INCLUDE DTSIL985 CL*48
|
|
00392 CL*68
|
|
00393 01 W001-REC. CL*68
|
|
00394 * 05 W001-LENGTH PIC S9(04) COMP. CL*86
|
|
00395 * 05 W001-DATA. CL*86
|
|
00396 ++INCLUDE DTSIW001 CL*68
|
|
00397 CL200
|
|
00398 LINKAGE SECTION. CL200
|
|
00399 01 EFT-REC-TYPE-LINK-AREA. CL200
|
|
00400 ++INCLUDE EFTIL100 CL200
|
|
00401 01 RSKL-REC. CL200
|
|
00402 ++INCLUDE EFTIRSKL CL200
|
|
00403 EJECT CL200
|
|
00404 CL200
|
|
00405 PROCEDURE DIVISION USING CL201
|
|
00406 EFT-REC-TYPE-LINK-AREA CL201
|
|
00407 RSKL-REC. CL211
|
|
00408 CL201
|
|
00409 IF EFT-L100-CMD-INIT-88 CL201
|
|
00410 PERFORM I0000-INITIALIZE THRU I0000-EXIT CL201
|
|
00411 ELSE CL201
|
|
00412 IF EFT-L100-CMD-PROCESS-88 CL201
|
|
00413 PERFORM P0000-PROCESS THRU P0000-EXIT CL201
|
|
00414 ELSE CL201
|
|
00415 IF EFT-L100-CMD-TERMINATE-88 CL*16
|
|
00416 PERFORM T0000-TERMINATE THRU T0000-EXIT CL201
|
|
00417 ELSE CL201
|
|
00418 DISPLAY 'INVALID CALL FROM BD100 ' CL*69
|
|
00419 PERFORM S999-ABEND THRU S999-EXIT. CL201
|
|
00420 CL201
|
|
00421 GOBACK. EFTBD140
|
|
00422 EJECT EFTBD140
|
|
00423 I0000-INITIALIZE. EFTBD140
|
|
00424 MOVE WRK-MOD-NAME TO R907-MODULE-NAME CL*71
|
|
00425 L985-MOD-NAME. CL*71
|
|
00426 MOVE LENGTH OF R907-REC TO R907-LENGTH. CL*67
|
|
00427 *** MOVE LENGTH OF W001-DATA TO W001-LENGTH. CL*86
|
|
00428 MOVE LENGTH OF T027-REC TO T027-LENGTH. CL*67
|
|
00429 MOVE LENGTH OF T002-REC TO T002-LENGTH. CL*91
|
|
00430 CL*91
|
|
00431 PERFORM I1000-SYS-DATE THRU I1000-EXIT. CL*74
|
|
00432 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CL*86
|
|
00433 PERFORM I3000-INIT-RECS THRU I3000-EXIT. CL*62
|
|
00434 CL179
|
|
00435 I0000-EXIT. EFTBD140
|
|
00436 EXIT. EFTBD140
|
|
00437 CL107
|
|
00438 I1000-SYS-DATE. CL*72
|
|
00439 SET L005-FROM-SYS TO TRUE. CL151
|
|
00440 PERFORM S005-SYS-DATE THRU S005-EXIT. CL151
|
|
00441 MOVE L005-DATE TO DISP-DATE. CL151
|
|
00442 MOVE L005-TIME TO DISP-TIME. CL151
|
|
00443 MOVE L005-SLASH-DATE TO WRK-SYS-DATE. CL151
|
|
00444 MOVE L005-DISPLAY-TIME TO WRK-SYS-TIME. CL151
|
|
00445 MOVE L005-SLASH-8-YR TO WRK-CURR-YR. CL151
|
|
00446 CL151
|
|
00447 MOVE L005-DATE TO L001-FED-8-DATE-9. CL151
|
|
00448 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL151
|
|
00449 MOVE L001-JUL-DATE TO WRK-L001-JUL-DATE. CL*79
|
|
00450 MOVE WRK-JULIAN-YR-DAYS TO WRK-PSEUDO-YR-DAYS. CL*79
|
|
00451 MOVE ZERO TO WRK-PSEUDO-BATCH-SEQ. CL*79
|
|
00452 MOVE 1 TO WRK-PSEUDO-ITEM-NO. CL*79
|
|
00453 CL*72
|
|
00454 MOVE L005-DATE TO L004-DATE. CL154
|
|
00455 SET L004-FROM-DATE TO TRUE. CL154
|
|
00456 PERFORM S004-YRQ THRU S004-EXIT. CL154
|
|
00457 MOVE L004-QTR-5-9 TO WRK-CURR-YRQ. CL154
|
|
00458 CL154
|
|
00459 DISPLAY ' '. CL*72
|
|
00460 DISPLAY 'CURRENT DATE ' DISP-DATE CL*69
|
|
00461 ' CURRENT-TIME ' DISP-TIME CL*69
|
|
00462 ' CURRENT YEAR ' WRK-CURR-YR CL*70
|
|
00463 ' STARTING BATCH ' WRK-PSEUDO-BATCH-NO CL*79
|
|
00464 ' ITEM ' WRK-PSEUDO-ITEM-NO. CL*79
|
|
00465 CL*69
|
|
00466 I1000-EXIT. CL*72
|
|
00467 EXIT. CL*72
|
|
00468 CL**1
|
|
00469 I2000-OPEN-FILES. CL*86
|
|
00470 OPEN OUTPUT WAGE-TRAN-FILE. CL*86
|
|
00471 IF NOT WAGE-STATUS-OK-88 CL*86
|
|
00472 DISPLAY 'WAGE FILE OPEN ERROR: ' WAGE-STATUS CL*87
|
|
00473 PERFORM S999-ABEND THRU S999-EXIT. CL*86
|
|
00474 CL*86
|
|
00475 CL*86
|
|
00476 I2000-EXIT. CL*86
|
|
00477 EXIT. CL*86
|
|
00478 CL*58
|
|
00479 I3000-INIT-RECS. CL*62
|
|
00480 INITIALIZE FQTF-DATA-AREA CL*62
|
|
00481 FDPT-DATA-AREA CL*62
|
|
00482 FCQW-DATA-AREA. CL*62
|
|
00483 CL*62
|
|
00484 MOVE ZERO TO T027-EMP-NO CL*84
|
|
00485 T027-SYS-DATE CL*84
|
|
00486 T027-SYS-TIME CL*84
|
|
00487 T027-PSEUDO-BATCH-NO CL*84
|
|
00488 T027-PSEUDO-ITEM-NO CL*84
|
|
00489 T027-YRQ CL*84
|
|
00490 T027-TOT-WAGE CL*84
|
|
00491 T027-EXCESS-WAGE CL*84
|
|
00492 T027-TAX-WAGE CL*84
|
|
00493 T027-REMIT-AMT CL*84
|
|
00494 T027-TOTAL-EMPL-CNT CL*84
|
|
00495 T027-1ST-MTH-EMPL-CNT CL*84
|
|
00496 T027-2ND-MTH-EMPL-CNT CL*84
|
|
00497 T027-3RD-MTH-EMPL-CNT CL*84
|
|
00498 T027-RECEIVED-DATE CL*84
|
|
00499 T027-DEPOSIT-DATE CL*84
|
|
00500 T027-TRACE-NO. CL*84
|
|
00501 CL*84
|
|
00502 MOVE SPACES TO T027-ORIGIN CL*84
|
|
00503 T027-TRN-TYPE CL*84
|
|
00504 T027-NAME-CHECK CL*84
|
|
00505 T027-RPT-TYPE CL*84
|
|
00506 T027-WAIVE-BOTH-IND CL*84
|
|
00507 T027-WAIVE-INT-IND CL*84
|
|
00508 T027-WAIVE-LATE-PEN-IND CL*84
|
|
00509 T027-RESPONSIBLE-ACTIVITY CL*84
|
|
00510 T027-RESPONSIBLE-OP-ID CL*84
|
|
00511 T027-PASSED-FULL-EDITS-IND. CL*84
|
|
00512 CL*84
|
|
00513 MOVE ZERO TO W001-BATCH-NO CL*84
|
|
00514 W001-ITEM-NO CL*84
|
|
00515 W001-SEQ-NO CL*84
|
|
00516 W001-EMP-NO CL*84
|
|
00517 W001-SSN CL*84
|
|
00518 W001-SSN-ERR-ID CL*84
|
|
00519 W001-NAME-ERR-ID CL*84
|
|
00520 W001-YRQ CL*84
|
|
00521 W001-WAGE-CHNG CL*84
|
|
00522 W001-WAGE-ERR-ID CL*84
|
|
00523 W001-CURR-WAGE CL*84
|
|
00524 W001-TAX-WAGE CL*84
|
|
00525 W001-PRIOR-WAGE CL*84
|
|
00526 W001-RECEIVED-DATE CL*84
|
|
00527 W001-RECEIVED-TIME. CL*84
|
|
00528 CL*84
|
|
00529 MOVE SPACES TO W001-NAME CL*84
|
|
00530 W001-RESPONSIBLE-OP-ID CL*84
|
|
00531 W001-SOURCE. CL*84
|
|
00532 CL*84
|
|
00533 I3000-EXIT. CL*62
|
|
00534 EXIT. CL*62
|
|
00535 CL*91
|
|
00536 I4000-INIT-T002. CL*91
|
|
00537 CL*93
|
|
00538 SET WRK-MOPO-T002-NO-88 TO TRUE. CL*91
|
|
00539 SET WRK-MOPO-FOUND-NO-88 TO TRUE. CL*93
|
|
00540 CL*93
|
|
00541 MOVE ZERO TO T002-EMP-NO CL*91
|
|
00542 T002-SYS-DATE CL*91
|
|
00543 T002-SYS-TIME. CL*91
|
|
00544 CL*91
|
|
00545 MOVE SPACES TO T002-ORIGIN CL*91
|
|
00546 T002-DATA-AREA. CL*91
|
|
00547 CL*91
|
|
00548 I4000-EXIT. CL*91
|
|
00549 EXIT. CL*91
|
|
00550 CL*91
|
|
00551 *************************************************************** CL*89
|
|
00552 * SORT THE TRANSACTIONS BY TRACE NUMBER AND RECORD TYPE. * CL*89
|
|
00553 * THIS WILL GROUP ALL RECORDS FROM THE SAME QUARTERLY * CL*89
|
|
00554 * REPORT TRANSACTION TOGETHER. WITHIN THE TRACE NUMBER, * CL*89
|
|
00555 * THE RECORDS WILL BE IN THE FOLLOWING ORDER: REPORT * CL*89
|
|
00556 * RECORD, PAYMENT RECORD, WAGE RECORDS. TRANSACTION FOR * CL*89
|
|
00557 * PAYMENT OF A BALANCE DUE OCCURS SINGLY, AND HAVE NO * CL*89
|
|
00558 * RELATED RECORDS. * CL*89
|
|
00559 *************************************************************** CL*89
|
|
00560 EFTBD140
|
|
00561 P0000-PROCESS. EFTBD140
|
|
00562 EVALUATE TRUE CL*62
|
|
00563 WHEN RSKL-TYPE-QTR-TAX-RPT-88 CL*62
|
|
00564 PERFORM P1000-REPORT THRU P1000-EXIT CL*62
|
|
00565 CL236
|
|
00566 WHEN RSKL-TYPE-PAYMENT-88 CL*62
|
|
00567 PERFORM P2000-PAYMENT THRU P2000-EXIT CL*62
|
|
00568 CL*62
|
|
00569 WHEN RSKL-TYPE-WAGE-IMP-88 CL*62
|
|
00570 PERFORM P3000-WAGE THRU P3000-EXIT CL*62
|
|
00571 CL*62
|
|
00572 WHEN OTHER CL*62
|
|
00573 DISPLAY 'INVALID RECORD TYPE ' RSKL-REC-TYPE CL*62
|
|
00574 ' ' RSKL-SUB-TYPE CL*62
|
|
00575 CL*62
|
|
00576 END-EVALUATE. CL*62
|
|
00577 CL*62
|
|
00578 CL232
|
|
00579 P0000-EXIT. EFTBD140
|
|
00580 EXIT. EFTBD140
|
|
00581 CL*72
|
|
00582 *************************************************************** CL*88
|
|
00583 * FOR EACH TAX FILE REPORT RECORD, A T027 TRANSACTION RECORD * CL*88
|
|
00584 * WILL BE CREATED. IF THE PAYMENT AMOUNT NOT MATCHED THE TAX * CL*88
|
|
00585 * FILE REPORT AMOUNT A R907 ERROR RECORD WILL BE WRITTE AND * CL*88
|
|
00586 * PRESENTS ON THE R907 ERRORS REPORT. * CL*88
|
|
00587 *************************************************************** CL*88
|
|
00588 CL*88
|
|
00589 P1000-REPORT. CL*62
|
|
00590 ADD +1 TO WRK-RPT-REC-CNT. CL*69
|
|
00591 IF FQTF-TRACE-NO > ZERO CL*62
|
|
00592 PERFORM P1100-CHK-TOT-WAGE THRU P1100-EXIT CL*69
|
|
00593 END-IF. CL*62
|
|
00594 CL*62
|
|
00595 PERFORM I3000-INIT-RECS THRU I3000-EXIT. CL*62
|
|
00596 CL*62
|
|
00597 MOVE ZERO TO WRK-TOT-WAGE CL*65
|
|
00598 WRK-CURR-PAY-TRACE-NO. CL*65
|
|
00599 CL*65
|
|
00600 SET ERR-T027-PASS-EDITS-YES-88 TO TRUE. CL*65
|
|
00601 SET ERR-UNEXPECTED-WAGE-NO-88 TO TRUE. CL*65
|
|
00602 CL*65
|
|
00603 MOVE RSKL-REC TO FQTF-REC. CL*63
|
|
00604 CL*63
|
|
00605 PERFORM P1200-EDIT-FQTF THRU P1200-EXIT. EFTBD140
|
|
00606 PERFORM P1300-WRITE-T027 THRU P1300-EXIT. EFTBD140
|
|
00607 PERFORM P1400-WRITE-T002 THRU P1400-EXIT. CL*90
|
|
00608 CL*62
|
|
00609 P1000-EXIT. CL*62
|
|
00610 EXIT. CL*62
|
|
00611 CL*63
|
|
00612 P1100-CHK-TOT-WAGE. CL*63
|
|
00613 CL*63
|
|
00614 IF WRK-TOT-WAGE NOT = FQTF-TOTAL-WAGES AND CL110
|
|
00615 FQTF-WAGE-RPT-IND = 'Y' CL110
|
|
00616 MOVE MSG1-ID TO R907-MSG-ID CL*67
|
|
00617 * MOVE FCQW-EMP-NO TO R907-EMP-NO CL101
|
|
00618 MOVE FQTF-EMP-NO TO R907-EMP-NO CL101
|
|
00619 * MOVE FCQW-EMPL-TRACE-NO TO MSG1-TRACE-NO CL*98
|
|
00620 MOVE FQTF-TRACE-NO TO MSG1-TRACE-NO CL*98
|
|
00621 MOVE MSG1-TEXT TO R907-MSG-TEXT CL*67
|
|
00622 PERFORM S946-WRITE-R907 THRU S946-EXIT CL*63
|
|
00623 ADD +1 TO WRK-R907-CNT CL*68
|
|
00624 DISPLAY 'BD140 P1100 TOT WAGE <> REP WAGE OR NO WAGE RECS' CL100
|
|
00625 ' FCQW-EMP-NO = ' FCQW-EMP-NO ' ' ' FQTF-EMP-NO = ' CL102
|
|
00626 FQTF-EMP-NO CL*96
|
|
00627 END-IF. CL*63
|
|
00628 CL*63
|
|
00629 P1100-EXIT. CL*63
|
|
00630 EXIT. CL*63
|
|
00631 CL*63
|
|
00632 P1200-EDIT-FQTF. EFTBD140
|
|
00633 PERFORM P1210-READ-MPRF THRU P1210-EXIT. EFTBD140
|
|
00634 IF WRK-MPRF-NO-88 EFTBD140
|
|
00635 GO TO P1200-EXIT EFTBD140
|
|
00636 ELSE EFTBD140
|
|
00637 PERFORM P1220-LIABILITY THRU P1220-EXIT EFTBD140
|
|
00638 PERFORM P1230-READ-MQTR THRU P1230-EXIT EFTBD140
|
|
00639 END-IF. EFTBD140
|
|
00640 P1200-EXIT. EFTBD140
|
|
00641 EXIT. EFTBD140
|
|
00642 EFTBD140
|
|
00643 P1210-READ-MPRF. EFTBD140
|
|
00644 MOVE LOW-VALUE TO MSKL-KEY-AREA. EFTBD140
|
|
00645 MOVE FQTF-EMP-NO TO MSKL-EMP-NO. EFTBD140
|
|
00646 SET MSKL-PRF-88 TO TRUE. EFTBD140
|
|
00647 PERFORM S910-READ THRU S910-EXIT. EFTBD140
|
|
00648 IF L910-NO-REC-88 EFTBD140
|
|
00649 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE CL*65
|
|
00650 SET WRK-MPRF-NO-88 TO TRUE EFTBD140
|
|
00651 DISPLAY 'BD140 P1210 NO MPRF ' FQTF-EMP-NO CL*77
|
|
00652 GO TO P1210-EXIT EFTBD140
|
|
00653 ELSE EFTBD140
|
|
00654 SET WRK-MPRF-YES-88 TO TRUE EFTBD140
|
|
00655 MOVE MSKL-REC TO MPRF-REC. EFTBD140
|
|
00656 EFTBD140
|
|
00657 IF NOT MPRF-CLASS-SUB-88 EFTBD140
|
|
00658 DISPLAY 'BD140 P1210 NOT SUB ' FQTF-EMP-NO CL*77
|
|
00659 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65
|
|
00660 EFTBD140
|
|
00661 IF MPRF-NOT-WRITTEN-OFF-88 EFTBD140
|
|
00662 NEXT SENTENCE EFTBD140
|
|
00663 ELSE EFTBD140
|
|
00664 DISPLAY 'BD140 P1210 WRITE-OFF ' FQTF-EMP-NO CL*77
|
|
00665 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65
|
|
00666 EFTBD140
|
|
00667 P1210-EXIT. EFTBD140
|
|
00668 EXIT. EFTBD140
|
|
00669 EFTBD140
|
|
00670 P1220-LIABILITY. EFTBD140
|
|
00671 MOVE FQTF-YRQ TO L516-YRQ. CL103
|
|
00672 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. EFTBD140
|
|
00673 IF L516-NOT-LIABLE-88 EFTBD140
|
|
00674 DISPLAY 'BD140 P1220 NOT LIAB ' FQTF-EMP-NO CL*77
|
|
00675 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65
|
|
00676 EFTBD140
|
|
00677 IF MPRF-CLASS-RATED-88 EFTBD140
|
|
00678 IF L516-NO-RATE-88 EFTBD140
|
|
00679 DISPLAY 'BD140 P1220 NO RATE ' FQTF-EMP-NO CL*77
|
|
00680 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65
|
|
00681 EFTBD140
|
|
00682 P1220-EXIT. EFTBD140
|
|
00683 EXIT. EFTBD140
|
|
00684 EFTBD140
|
|
00685 P1230-READ-MQTR. EFTBD140
|
|
00686 MOVE LOW-VALUES TO MQTR-KEY-AREA. EFTBD140
|
|
00687 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. EFTBD140
|
|
00688 SET MQTR-QTR-88 TO TRUE. EFTBD140
|
|
00689 MOVE FQTF-YRQ TO MQTR-YRQ. CL103
|
|
00690 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA EFTBD140
|
|
00691 PERFORM S910-READ THRU S910-EXIT. EFTBD140
|
|
00692 IF L910-NO-REC-88 EFTBD140
|
|
00693 NEXT SENTENCE EFTBD140
|
|
00694 ELSE EFTBD140
|
|
00695 MOVE MSKL-REC TO MQTR-REC EFTBD140
|
|
00696 IF MQTR-CURR-RCVD-88 EFTBD140
|
|
00697 DISPLAY 'BD140 P1230 RPT RCVD ' FQTF-EMP-NO CL*77
|
|
00698 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65
|
|
00699 EFTBD140
|
|
00700 P1230-EXIT. EFTBD140
|
|
00701 EXIT. EFTBD140
|
|
00702 EFTBD140
|
|
00703 P1300-WRITE-T027. EFTBD140
|
|
00704 MOVE 0 TO WRK-SEQ-NO. CL*79
|
|
00705 CL*79
|
|
00706 MOVE FQTF-EMP-NO TO T027-EMP-NO. CL*74
|
|
00707 MOVE 'WEBTXRPT' TO T027-ORIGIN. CL*63
|
|
00708 MOVE L005-DATE TO T027-SYS-DATE. CL*63
|
|
00709 MOVE L005-TIME TO T027-SYS-TIME. CL*63
|
|
00710 SET T027-WEB-RPT-88 TO TRUE. CL*63
|
|
00711 CL*63
|
|
00712 IF WRK-PSEUDO-ITEM-NO < 999 CL*79
|
|
00713 ADD 1 TO WRK-PSEUDO-ITEM-NO CL*79
|
|
00714 ELSE CL*63
|
|
00715 ADD 1 TO WRK-PSEUDO-BATCH-NO CL*79
|
|
00716 MOVE 1 TO WRK-PSEUDO-ITEM-NO CL*83
|
|
00717 END-IF. CL*83
|
|
00718 CL*63
|
|
00719 MOVE WRK-PSEUDO-BATCH-NO TO T027-PSEUDO-BATCH-NO. CL*79
|
|
00720 MOVE WRK-PSEUDO-ITEM-NO TO T027-PSEUDO-ITEM-NO. CL*79
|
|
00721 CL*63
|
|
00722 MOVE MPRF-PRIMARY-NAME TO T027-NAME-CHECK. EFTBD140
|
|
00723 SET T027-ORIG-88 TO TRUE. CL*63
|
|
00724 MOVE FQTF-YRQ TO T027-YRQ. CL103
|
|
00725 MOVE FQTF-TOTAL-WAGES TO T027-TOT-WAGE. CL*63
|
|
00726 COMPUTE WRK-EXCESS-WAGE = CL*63
|
|
00727 (FQTF-TOTAL-WAGES - FQTF-TOTAL-TAXABLE-WAGES). CL*63
|
|
00728 MOVE WRK-EXCESS-WAGE TO T027-EXCESS-WAGE. CL*63
|
|
00729 MOVE FQTF-TOTAL-TAXABLE-WAGES TO T027-TAX-WAGE. CL*63
|
|
00730 MOVE FQTF-PAYMENT-AMOUNT TO T027-REMIT-AMT. CL*63
|
|
00731 SET T027-WAIVE-BOTH-NO-88 TO TRUE. CL*63
|
|
00732 SET T027-WAIVE-INT-NO-88 TO TRUE. CL*75
|
|
00733 SET T027-WAIVE-LATE-PEN-NO-88 TO TRUE. CL*63
|
|
00734 MOVE FQTF-WORKER-CNT-1ST-MON TO T027-1ST-MTH-EMPL-CNT. CL*63
|
|
00735 MOVE FQTF-WORKER-CNT-2ND-MON TO T027-2ND-MTH-EMPL-CNT. CL*63
|
|
00736 MOVE FQTF-WORKER-CNT-3RD-MON TO T027-3RD-MTH-EMPL-CNT. CL*63
|
|
00737 COMPUTE T027-TOTAL-EMPL-CNT = CL*63
|
|
00738 (FQTF-WORKER-CNT-1ST-MON + CL*63
|
|
00739 FQTF-WORKER-CNT-2ND-MON + CL*63
|
|
00740 FQTF-WORKER-CNT-3RD-MON). CL*63
|
|
00741 MOVE FQTF-FILING-DATE TO T027-RECEIVED-DATE. CL*63
|
|
00742 CL*63
|
|
00743 MOVE T027-RECEIVED-DATE TO L001-FED-8-DATE-9. CL*63
|
|
00744 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL*63
|
|
00745 SET L003-NOT-WORK-DAY TO TRUE. CL*63
|
|
00746 PERFORM P1310-WORK-DAY-LOOP THRU P1310-EXIT EFTBD140
|
|
00747 UNTIL L003-IS-WORK-DAY. CL*63
|
|
00748 MOVE L001-FED-8-DATE-9 TO T027-DEPOSIT-DATE. CL*63
|
|
00749 CL*63
|
|
00750 MOVE FQTF-TRACE-NO TO T027-TRACE-NO. CL*76
|
|
00751 CL*76
|
|
00752 MOVE 'VOL' TO T027-RESPONSIBLE-ACTIVITY. CL*63
|
|
00753 MOVE SPACES TO T027-RESPONSIBLE-OP-ID. CL*63
|
|
00754 CL*63
|
|
00755 *& CL*85
|
|
00756 DISPLAY 'BD140 P1300 PASS EDITS ' CL*85
|
|
00757 ERR-T027-PASS-EDITS-IND. CL*85
|
|
00758 *& CL*85
|
|
00759 IF ERR-T027-PASS-EDITS-NO-88 CL*65
|
|
00760 SET T027-PASSED-FULL-EDITS-NO-88 TO TRUE EFTBD140
|
|
00761 ELSE EFTBD140
|
|
00762 SET T027-PASSED-FULL-EDITS-YES-88 TO TRUE. EFTBD140
|
|
00763 EFTBD140
|
|
00764 MOVE T027-REC TO TSKL-REC. CL*63
|
|
00765 PERFORM S927-WRITE THRU S927-EXIT. CL*63
|
|
00766 ADD 1 TO WRK-T027-CNT. CL*69
|
|
00767 CL*63
|
|
00768 P1300-EXIT. EFTBD140
|
|
00769 EXIT. CL*63
|
|
00770 CL*63
|
|
00771 P1310-WORK-DAY-LOOP. EFTBD140
|
|
00772 ADD +1 TO L001-JUL-ABS-DAY. EFTBD140
|
|
00773 EFTBD140
|
|
00774 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. EFTBD140
|
|
00775 EFTBD140
|
|
00776 MOVE L001-FED-8-DATE-9 TO L003-DATE. EFTBD140
|
|
00777 EFTBD140
|
|
00778 PERFORM S003-AGENCY-DAY THRU S003-EXIT. EFTBD140
|
|
00779 EFTBD140
|
|
00780 P1310-EXIT. EFTBD140
|
|
00781 EXIT. EFTBD140
|
|
00782 CL*90
|
|
00783 P1400-WRITE-T002. CL*90
|
|
00784 CL*91
|
|
00785 PERFORM I4000-INIT-T002 THRU I4000-EXIT CL*91
|
|
00786 PERFORM P1410-MOPO THRU P1410-EXIT CL*92
|
|
00787 PERFORM P1420-CONT-NAME THRU P1420-EXIT CL*92
|
|
00788 PERFORM P1430-CONT-PHONE THRU P1430-EXIT CL*92
|
|
00789 CL*91
|
|
00790 IF WRK-MOPO-T002-YES-88 CL*91
|
|
00791 PERFORM P1440-MOPO-T002 THRU P1440-EXIT. CL*91
|
|
00792 CL*90
|
|
00793 P1400-EXIT. CL*90
|
|
00794 EXIT. CL*90
|
|
00795 CL*91
|
|
00796 P1410-MOPO. CL*91
|
|
00797 CL*91
|
|
00798 MOVE LOW-VALUES TO MOPO-KEY-AREA. CL*91
|
|
00799 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. CL*91
|
|
00800 SET MOPO-OPO-88 TO TRUE. CL*91
|
|
00801 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. CL*91
|
|
00802 CL*91
|
|
00803 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*91
|
|
00804 IF L910-NO-REC-88 CL*91
|
|
00805 NEXT SENTENCE CL*91
|
|
00806 ELSE CL*91
|
|
00807 PERFORM CL*91
|
|
00808 UNTIL L910-NO-REC-88 CL*91
|
|
00809 OR WRK-MOPO-FOUND-YES-88 CL*91
|
|
00810 MOVE MSKL-REC TO MOPO-REC CL108
|
|
00811 IF MOPO-TYPE-RPT-BSNS-88 CL112
|
|
00812 MOVE MOPO-REC TO MSKL-REC CL*91
|
|
00813 DISPLAY 'MOPO FOU ' MOPO-VOICE-1 CL108
|
|
00814 SET WRK-MOPO-FOUND-YES-88 TO TRUE CL108
|
|
00815 ELSE CL*91
|
|
00816 PERFORM S910-READ-NEXT THRU S910-EXIT CL*91
|
|
00817 END-IF CL*91
|
|
00818 END-PERFORM CL*91
|
|
00819 END-IF. CL*91
|
|
00820 CL*91
|
|
00821 P1410-EXIT. CL*91
|
|
00822 EXIT. CL*91
|
|
00823 CL*91
|
|
00824 P1420-CONT-NAME. CL*91
|
|
00825 CL*91
|
|
00826 IF FQTF-LAST-NAME = SPACES CL*92
|
|
00827 SET WRK-MOPO-T002-NO-88 TO TRUE CL113
|
|
00828 DISPLAY 'T002 NOT ADDED NO NAME ' FQTF-EMP-NO CL114
|
|
00829 GO TO P1420-EXIT. CL*91
|
|
00830 CL113
|
|
00831 MOVE FQTF-FIRST-NAME TO L076-NAMEF CL116
|
|
00832 MOVE FQTF-MIDDLE-INITIAL TO L076-NAMEI CL116
|
|
00833 MOVE FQTF-LAST-NAME TO L076-NAMEL CL116
|
|
00834 CL*91
|
|
00835 PERFORM S076-NAME THRU S076-EXIT CL116
|
|
00836 IF L076-NAME-INVALID CL116
|
|
00837 SET WRK-MOPO-T002-NO-88 TO TRUE CL113
|
|
00838 MOVE FQTF-EMP-NO TO R907-EMP-NO CL*93
|
|
00839 MOVE FQTF-TRACE-NO TO MSG9-TRACE-NO CL*93
|
|
00840 MOVE MSG9-TEXT TO R907-MSG-TEXT CL*93
|
|
00841 PERFORM S946-WRITE-R907 THRU S946-EXIT CL*93
|
|
00842 MOVE SPACES TO T002-CONTACT-NAME CL*91
|
|
00843 GO TO P1420-EXIT. CL*91
|
|
00844 CL*91
|
|
00845 MOVE L076-NAM TO T002-CONTACT-NAME CL116
|
|
00846 SET WRK-MOPO-T002-YES-88 TO TRUE. CL113
|
|
00847 CL*91
|
|
00848 P1420-EXIT. CL*91
|
|
00849 EXIT. CL*91
|
|
00850 CL*91
|
|
00851 P1430-CONT-PHONE. CL*91
|
|
00852 CL*91
|
|
00853 IF FQTF-FILING-TEL-NO = SPACES CL*92
|
|
00854 SET WRK-MOPO-T002-NO-88 TO TRUE CL113
|
|
00855 DISPLAY 'T002 NOT ADDED NO TEL ' FQTF-EMP-NO CL115
|
|
00856 GO TO P1430-EXIT. CL*91
|
|
00857 CL*91
|
|
00858 MOVE FQTF-FILING-TEL-NO TO T002-CONTACT-VOICE CL*92
|
|
00859 SET WRK-MOPO-T002-YES-88 TO TRUE. CL*91
|
|
00860 CL*91
|
|
00861 P1430-EXIT. CL*91
|
|
00862 EXIT. CL*91
|
|
00863 CL*91
|
|
00864 P1440-MOPO-T002. CL*91
|
|
00865 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL*91
|
|
00866 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL*91
|
|
00867 MOVE L005-DATE TO T002-SYS-DATE. CL*91
|
|
00868 MOVE L005-TIME TO T002-SYS-TIME. CL*91
|
|
00869 CL*91
|
|
00870 IF WRK-MOPO-FOUND-YES-88 CL*91
|
|
00871 SET T002-UPD-CONTACT-88 TO TRUE CL*91
|
|
00872 ELSE CL*91
|
|
00873 SET T002-ADD-CONTACT-88 TO TRUE CL*91
|
|
00874 END-IF. CL*91
|
|
00875 CL*91
|
|
00876 SET T002-CONTACT-RPT-BSNS-88 TO TRUE. CL112
|
|
00877 CL*91
|
|
00878 MOVE ZEROS TO T002-CONTACT-SSN CL113
|
|
00879 MOVE SPACES TO T002-CONTACT-TITLE CL113
|
|
00880 MOVE SPACES TO T002-CONTACT-FAX CL113
|
|
00881 MOVE SPACES TO T002-CONTACT-EMAIL CL113
|
|
00882 MOVE T002-REC TO TSKL-REC. CL*91
|
|
00883 PERFORM S927-WRITE THRU S927-EXIT. CL*92
|
|
00884 ADD +1 TO WRK-T002-CONTACT-CNT. CL*91
|
|
00885 CL*91
|
|
00886 P1440-EXIT. CL*91
|
|
00887 EXIT. CL*91
|
|
00888 CL*91
|
|
00889 P2000-PAYMENT. CL*62
|
|
00890 ADD +1 TO WRK-PAY-REC-CNT. CL*69
|
|
00891 MOVE RSKL-REC TO FDPT-REC. CL*65
|
|
00892 CL*65
|
|
00893 IF WRK-CURR-PAY-TRACE-NO > ZERO CL*66
|
|
00894 IF FDPT-EMP-NO = FQTF-EMP-NO CL*65
|
|
00895 PERFORM P2100-DUPLICATE-ERR THRU P2100-EXIT CL*67
|
|
00896 ELSE CL*65
|
|
00897 PERFORM P2200-MISSING-RPT-ERR THRU P2200-EXIT CL*67
|
|
00898 END-IF CL*65
|
|
00899 ELSE CL*66
|
|
00900 MOVE FDPT-EMP-NO TO WRK-CURR-PAY-TRACE-NO CL*69
|
|
00901 END-IF. CL*63
|
|
00902 CL*63
|
|
00903 IF FDPT-PAYMENT-TRACE-NO NOT = FQTF-TRACE-NO CL*70
|
|
00904 OR FDPT-EMP-NO NOT = FQTF-EMP-NO CL*69
|
|
00905 PERFORM P2200-MISSING-RPT-ERR THRU P2200-EXIT CL*69
|
|
00906 ELSE CL*69
|
|
00907 IF FDPT-PAYMENT-AMOUNT NOT = FQTF-PAYMENT-AMOUNT CL*69
|
|
00908 PERFORM P2300-PAYMENT-ERR THRU P2300-EXIT CL*69
|
|
00909 END-IF CL*62
|
|
00910 END-IF. CL*62
|
|
00911 CL*62
|
|
00912 P2000-EXIT. CL*62
|
|
00913 EXIT. CL*62
|
|
00914 CL*62
|
|
00915 P2100-DUPLICATE-ERR. EFTBD140
|
|
00916 EFTBD140
|
|
00917 MOVE MSG2-ID TO R907-MSG-ID CL*67
|
|
00918 MOVE FDPT-EMP-NO TO R907-EMP-NO CL*67
|
|
00919 MOVE FDPT-PAYMENT-TRACE-NO TO MSG2-TRACE-NO CL*70
|
|
00920 MOVE MSG2-TEXT TO R907-MSG-TEXT CL*67
|
|
00921 PERFORM S946-WRITE-R907 THRU S946-EXIT. EFTBD140
|
|
00922 DISPLAY 'BD140 P2100 DUP PMT ' FDPT-EMP-NO CL*77
|
|
00923 ADD +1 TO WRK-R907-CNT. CL*68
|
|
00924 EFTBD140
|
|
00925 P2100-EXIT. EFTBD140
|
|
00926 EXIT. EFTBD140
|
|
00927 EFTBD140
|
|
00928 P2200-MISSING-RPT-ERR. CL*70
|
|
00929 MOVE MSG3-ID TO R907-MSG-ID CL*67
|
|
00930 MOVE FDPT-EMP-NO TO R907-EMP-NO CL*67
|
|
00931 MOVE FDPT-PAYMENT-TRACE-NO TO MSG3-TRACE-NO CL*70
|
|
00932 MOVE MSG3-TEXT TO R907-MSG-TEXT CL*67
|
|
00933 PERFORM S946-WRITE-R907 THRU S946-EXIT. EFTBD140
|
|
00934 DISPLAY 'BD140 P2200 MISS RPT ' FDPT-EMP-NO CL*77
|
|
00935 ADD +1 TO WRK-R907-CNT. CL*68
|
|
00936 EFTBD140
|
|
00937 P2200-EXIT. EFTBD140
|
|
00938 EXIT. EFTBD140
|
|
00939 EFTBD140
|
|
00940 P2300-PAYMENT-ERR. EFTBD140
|
|
00941 MOVE MSG4-ID TO R907-MSG-ID CL*67
|
|
00942 MOVE FDPT-EMP-NO TO R907-EMP-NO CL*67
|
|
00943 MOVE FDPT-PAYMENT-TRACE-NO TO MSG4-TRACE-NO CL*70
|
|
00944 MOVE MSG4-TEXT TO R907-MSG-TEXT CL*67
|
|
00945 PERFORM S946-WRITE-R907 THRU S946-EXIT. EFTBD140
|
|
00946 DISPLAY 'BD140 P2300 PAY ERR ' FDPT-EMP-NO CL*77
|
|
00947 ADD +1 TO WRK-R907-CNT. CL*68
|
|
00948 EFTBD140
|
|
00949 P2300-EXIT. EFTBD140
|
|
00950 EXIT. EFTBD140
|
|
00951 EFTBD140
|
|
00952 P3000-WAGE. CL*63
|
|
00953 ADD +1 TO WRK-WAGE-REC-CNT. CL*69
|
|
00954 MOVE RSKL-REC TO FCQW-REC. CL*67
|
|
00955 CL*63
|
|
00956 ADD FCQW-EMPL-WAGES TO WRK-TOT-WAGE. CL*67
|
|
00957 CL*63
|
|
00958 PERFORM P3100-EDIT-CQW THRU P3100-EXIT. CL*79
|
|
00959 CL*80
|
|
00960 PERFORM P3200-WRITE-W001 THRU P3200-EXIT. CL*80
|
|
00961 CL*80
|
|
00962 P3000-EXIT. CL*63
|
|
00963 EXIT. CL*63
|
|
00964 CL*63
|
|
00965 P3100-EDIT-CQW. CL*79
|
|
00966 IF (FCQW-EMPL-TRACE-NO NOT = FQTF-TRACE-NO) CL104
|
|
00967 OR (FCQW-EMP-NO NOT = FQTF-EMP-NO) CL104
|
|
00968 PERFORM P3110-MISSING-REPORT-ERR THRU P3110-EXIT CL*80
|
|
00969 END-IF. CL*80
|
|
00970 CL*80
|
|
00971 IF FQTF-WAGE-RPT-NO-88 CL*80
|
|
00972 PERFORM P3120-UNEXPECTED-WAGE-ERR THRU P3120-EXIT CL*80
|
|
00973 END-IF. CL*80
|
|
00974 CL*80
|
|
00975 IF FQTF-TOTAL-WAGES = ZERO CL*80
|
|
00976 PERFORM P3130-ZERO-WAGE-ERR THRU P3130-EXIT CL*80
|
|
00977 END-IF. CL*81
|
|
00978 CL*80
|
|
00979 IF FQTF-PAYMENT-AMOUNT = ZERO CL111
|
|
00980 NEXT SENTENCE CL111
|
|
00981 ELSE CL111
|
|
00982 IF FDPT-PAYMENT-TRACE-NO = ZERO CL*80
|
|
00983 PERFORM P3140-MISSING-PAYMENT THRU P3140-EXIT CL*80
|
|
00984 END-IF. CL*81
|
|
00985 CL*80
|
|
00986 P3100-EXIT. CL*79
|
|
00987 EXIT. CL*79
|
|
00988 CL*79
|
|
00989 P3110-MISSING-REPORT-ERR. CL*80
|
|
00990 MOVE MSG5-ID TO R907-MSG-ID CL*67
|
|
00991 MOVE FCQW-EMP-NO TO R907-EMP-NO CL*67
|
|
00992 MOVE FCQW-EMPL-TRACE-NO TO MSG5-TRACE-NO CL*70
|
|
00993 MOVE MSG5-TEXT TO R907-MSG-TEXT CL*67
|
|
00994 CL*67
|
|
00995 PERFORM S946-WRITE-R907 THRU S946-EXIT. CL*67
|
|
00996 DISPLAY 'BD140 P3110 MSG5 ' CL117
|
|
00997 DISPLAY ' CQW ' FCQW-EMP-NO ' ' FCQW-EMPL-TRACE-NO CL118
|
|
00998 DISPLAY ' QTF ' FQTF-EMP-NO ' ' FQTF-TRACE-NO CL117
|
|
00999 ADD +1 TO WRK-R907-CNT. CL*68
|
|
01000 CL*67
|
|
01001 P3110-EXIT. CL*80
|
|
01002 EXIT. EFTBD140
|
|
01003 EFTBD140
|
|
01004 P3120-UNEXPECTED-WAGE-ERR. CL*80
|
|
01005 IF ERR-UNEXPECTED-WAGE-YES-88 CL*67
|
|
01006 GO TO P3120-EXIT CL*80
|
|
01007 ELSE CL*63
|
|
01008 SET ERR-UNEXPECTED-WAGE-YES-88 TO TRUE. CL*67
|
|
01009 CL*63
|
|
01010 MOVE MSG6-ID TO R907-MSG-ID CL*67
|
|
01011 MOVE FCQW-EMP-NO TO R907-EMP-NO CL*67
|
|
01012 MOVE FCQW-EMPL-TRACE-NO TO MSG6-TRACE-NO CL*70
|
|
01013 MOVE MSG6-TEXT TO R907-MSG-TEXT CL*67
|
|
01014 CL*67
|
|
01015 DISPLAY 'BD140 P3120 UNEXPECT ' FCQW-EMP-NO CL*80
|
|
01016 PERFORM S946-WRITE-R907 THRU S946-EXIT. CL*67
|
|
01017 ADD +1 TO WRK-R907-CNT. CL*68
|
|
01018 CL*67
|
|
01019 P3120-EXIT. CL*80
|
|
01020 EXIT. CL*63
|
|
01021 CL*63
|
|
01022 P3130-ZERO-WAGE-ERR. CL*80
|
|
01023 MOVE MSG7-ID TO R907-MSG-ID CL*67
|
|
01024 MOVE FCQW-EMP-NO TO R907-EMP-NO CL*67
|
|
01025 MOVE FCQW-EMPL-TRACE-NO TO MSG7-TRACE-NO CL*70
|
|
01026 MOVE MSG7-TEXT TO R907-MSG-TEXT CL*67
|
|
01027 CL*67
|
|
01028 DISPLAY 'BD140 P3130 ZERO WAGE ' CL117
|
|
01029 DISPLAY ' CQW ' FCQW-EMP-NO ' ' FCQW-EMPL-WAGES CL117
|
|
01030 DISPLAY ' QTF ' FQTF-EMP-NO ' ' FQTF-TOTAL-WAGES CL117
|
|
01031 PERFORM S946-WRITE-R907 THRU S946-EXIT. CL*67
|
|
01032 ADD +1 TO WRK-R907-CNT. CL*68
|
|
01033 CL*67
|
|
01034 P3130-EXIT. CL*80
|
|
01035 EXIT. EFTBD140
|
|
01036 EFTBD140
|
|
01037 P3140-MISSING-PAYMENT. CL*80
|
|
01038 MOVE MSG8-ID TO R907-MSG-ID CL*80
|
|
01039 MOVE FCQW-EMP-NO TO R907-EMP-NO CL*80
|
|
01040 MOVE FCQW-EMPL-TRACE-NO TO MSG8-TRACE-NO CL*80
|
|
01041 MOVE MSG8-TEXT TO R907-MSG-TEXT CL*80
|
|
01042 CL*80
|
|
01043 DISPLAY 'BD140 P3140 MISS PAY ' FCQW-EMP-NO CL*80
|
|
01044 PERFORM S946-WRITE-R907 THRU S946-EXIT. CL*80
|
|
01045 ADD +1 TO WRK-R907-CNT. CL*80
|
|
01046 CL*80
|
|
01047 P3140-EXIT. CL*80
|
|
01048 EXIT. CL*80
|
|
01049 CL*80
|
|
01050 P3200-WRITE-W001. CL*80
|
|
01051 MOVE WRK-PSEUDO-BATCH-NO TO W001-BATCH-NO. CL*79
|
|
01052 MOVE WRK-PSEUDO-ITEM-NO TO W001-ITEM-NO. CL*79
|
|
01053 ADD 1 TO WRK-SEQ-NO. CL*68
|
|
01054 MOVE WRK-SEQ-NO TO W001-SEQ-NO. CL*68
|
|
01055 MOVE FCQW-EMP-NO TO W001-EMP-NO. CL*68
|
|
01056 MOVE FCQW-SSN TO W001-SSN. CL*68
|
|
01057 SET W001-SSN-VALID-88 TO TRUE. CL*68
|
|
01058 MOVE FCQW-FIRST-NAME TO W001-FIRST-NAME. CL*68
|
|
01059 MOVE FCQW-MIDDLE-INITIAL TO W001-MID-INIT. CL*68
|
|
01060 MOVE FCQW-LAST-NAME TO W001-LAST-NAME. CL*68
|
|
01061 SET W001-NAME-VALID-88 TO TRUE. CL*68
|
|
01062 MOVE FCQW-YEAR TO WRK-YRQ-CCYY. CL*78
|
|
01063 MOVE FCQW-QTR TO WRK-YRQ-Q. CL*78
|
|
01064 MOVE WRK-YRQ-AREA TO W001-YRQ. CL*78
|
|
01065 MOVE FCQW-EMPL-WAGES TO W001-WAGE-CHNG. CL*68
|
|
01066 SET W001-WAGE-VALID-88 TO TRUE. CL*68
|
|
01067 MOVE ZERO TO W001-CURR-WAGE CL*68
|
|
01068 W001-TAX-WAGE CL*68
|
|
01069 W001-PRIOR-WAGE. CL*68
|
|
01070 IF T027-RECEIVED-DATE = ZERO CL*84
|
|
01071 MOVE L005-DATE TO W001-RECEIVED-DATE CL*84
|
|
01072 ELSE CL*84
|
|
01073 MOVE T027-RECEIVED-DATE TO W001-RECEIVED-DATE. CL*84
|
|
01074 MOVE L005-TIME TO W001-RECEIVED-TIME. CL*68
|
|
01075 MOVE SPACES TO W001-RESPONSIBLE-OP-ID. CL*68
|
|
01076 CL*68
|
|
01077 MOVE W001-REC TO WAGE-TRAN-REC. CL*86
|
|
01078 WRITE WAGE-TRAN-REC. CL*86
|
|
01079 IF NOT WAGE-STATUS-OK-88 CL*86
|
|
01080 DISPLAY 'CANNOT WRITE WAGE: ' WAGE-STATUS. CL*87
|
|
01081 *** PERFORM S985B-WRITE THRU S985B-EXIT. CL*86
|
|
01082 ADD +1 TO WRK-W001-CNT. CL*68
|
|
01083 CL*68
|
|
01084 P3200-EXIT. CL*80
|
|
01085 EXIT. CL*68
|
|
01086 CL*68
|
|
01087 T0000-TERMINATE. EFTBD140
|
|
01088 *** PERFORM S985C-CLOSE THRU S985C-EXIT. CL*73
|
|
01089 CLOSE WAGE-TRAN-FILE. CL*86
|
|
01090 CL*59
|
|
01091 DISPLAY ' '. CL221
|
|
01092 DISPLAY ' '. CL221
|
|
01093 CL*71
|
|
01094 DISPLAY '*** EFTBD140 TERMINATION STATISTICS ***'. CL197
|
|
01095 CL*71
|
|
01096 DISPLAY ' '. CL237
|
|
01097 DISPLAY 'REPORT TRANSACTION COUNT :' CL*69
|
|
01098 WRK-RPT-REC-CNT. CL*69
|
|
01099 CL223
|
|
01100 DISPLAY ' '. CL*98
|
|
01101 DISPLAY 'PAYMENT TRANSACTION COUNT :' CL*69
|
|
01102 WRK-PAY-REC-CNT. CL*69
|
|
01103 CL*98
|
|
01104 DISPLAY ' '. CL*79
|
|
01105 DISPLAY 'WAGE TRANSACTION COUNT :' CL*69
|
|
01106 WRK-WAGE-REC-CNT. CL*69
|
|
01107 CL*69
|
|
01108 DISPLAY ' '. CL*79
|
|
01109 DISPLAY 'T027 QUARTERLY TAX RPT OUTPUT TRAN (BTC FILE) :' CL106
|
|
01110 WRK-T027-CNT. CL*69
|
|
01111 CL*95
|
|
01112 DISPLAY 'T002 CONTACT STATUS TRANS RECS CNT (BTC FILE) :' CL107
|
|
01113 WRK-T002-CONTACT-CNT. CL*95
|
|
01114 CL190
|
|
01115 DISPLAY ' '. CL*79
|
|
01116 DISPLAY 'W001 WAGES OUTPUT TRANS REC COUNT (BWTC FILE) :' CL106
|
|
01117 WRK-W001-CNT. CL*69
|
|
01118 CL*92
|
|
01119 DISPLAY ' '. CL*95
|
|
01120 DISPLAY 'R907 ERROR REPORT RECORD COUNT :' CL*92
|
|
01121 WRK-R907-CNT. CL*92
|
|
01122 CL*92
|
|
01123 T0000-EXIT. EFTBD140
|
|
01124 EXIT. EFTBD140
|
|
01125 EJECT EFTBD140
|
|
01126 CL*59
|
|
01127 S001-FROM-FED-8. CL108
|
|
01128 SET L001-FROM-FED-8 TO TRUE. CL108
|
|
01129 GO TO S001-DATE. CL108
|
|
01130 CL108
|
|
01131 S001-FROM-ABS-DAY. CL108
|
|
01132 SET L001-FROM-ABS-DAY TO TRUE. CL108
|
|
01133 GO TO S001-DATE. CL108
|
|
01134 CL108
|
|
01135 S001-FROM-CAL-6. CL108
|
|
01136 SET L001-FROM-CAL-6 TO TRUE. CL108
|
|
01137 GO TO S001-DATE. CL108
|
|
01138 CL108
|
|
01139 S001-DATE. CL108
|
|
01140 CALL 'DTSBU001' USING L001-LINK-AREA. CL108
|
|
01141 S001-EXIT. CL108
|
|
01142 EXIT. CL108
|
|
01143 CL*56
|
|
01144 S003-AGENCY-DAY. CL*56
|
|
01145 SET L003-AGENCY-DAY TO TRUE. CL*56
|
|
01146 GO TO S003-WORK-DAY. CL*56
|
|
01147 CL*56
|
|
01148 S003-WORK-DAY. CL*56
|
|
01149 CALL 'DTSBU003' USING L003-LINK-AREA. CL*56
|
|
01150 S003-EXIT. CL*56
|
|
01151 EXIT. CL*56
|
|
01152 CL*56
|
|
01153 S004-FROM-3. CL*24
|
|
01154 SET L004-FROM-3 TO TRUE. CL*24
|
|
01155 GO TO S004-YRQ. CL*24
|
|
01156 CL*24
|
|
01157 S004-YRQ. CL*24
|
|
01158 CALL 'DTSBU004' USING L004-LINK-AREA. CL*24
|
|
01159 CL*24
|
|
01160 S004-EXIT. CL*24
|
|
01161 EXIT. CL*24
|
|
01162 CL*24
|
|
01163 S005-SYS-DATE. CL*61
|
|
01164 CALL 'DTSBU005' USING L005-COMM-AREA. CL*61
|
|
01165 CL*61
|
|
01166 S005-EXIT. CL*61
|
|
01167 EXIT. CL*61
|
|
01168 CL*78
|
|
01169 S516-LIABILITY-INFO. EFTBD140
|
|
01170 CALL 'DTSBU516' USING L516-LINK-AREA EFTBD140
|
|
01171 MPRF-REC. EFTBD140
|
|
01172 S516-EXIT. EFTBD140
|
|
01173 EXIT. EFTBD140
|
|
01174 EFTBD140
|
|
01175 S076-NAME. CL116
|
|
01176 CALL 'DTSBU076' USING L076-LINK-AREA. CL116
|
|
01177 CL*92
|
|
01178 S076-EXIT. CL116
|
|
01179 EXIT. CL*92
|
|
01180 CL*92
|
|
01181 S910-OPEN-READ. CL*70
|
|
01182 SET L910-OPEN-READ-88 TO TRUE. CL*70
|
|
01183 GO TO S910-MSTR-IO. CL*70
|
|
01184 CL*70
|
|
01185 S910-OPEN-UPDATE-NO-AIX. CL*70
|
|
01186 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. CL*70
|
|
01187 GO TO S910-MSTR-IO. CL*70
|
|
01188 CL*70
|
|
01189 S910-READ. CL*70
|
|
01190 SET L910-READ-88 TO TRUE. CL*70
|
|
01191 GO TO S910-MSTR-IO. CL*70
|
|
01192 CL*70
|
|
01193 S910-START-BROWSE. CL*70
|
|
01194 SET L910-START-BROWSE-88 TO TRUE. CL*70
|
|
01195 GO TO S910-MSTR-IO. CL*70
|
|
01196 CL*13
|
|
01197 S910-READ-NEXT. CL*70
|
|
01198 SET L910-READ-NEXT-88 TO TRUE. CL*70
|
|
01199 GO TO S910-MSTR-IO. CL*70
|
|
01200 CL*70
|
|
01201 S910-COUNT. CL*70
|
|
01202 SET L910-COUNT-88 TO TRUE. CL*70
|
|
01203 GO TO S910-MSTR-IO. CL*70
|
|
01204 CL*70
|
|
01205 S910-WRITE. CL*70
|
|
01206 SET L910-WRITE-88 TO TRUE. CL*70
|
|
01207 GO TO S910-MSTR-IO. CL*70
|
|
01208 CL*70
|
|
01209 S910-REWRITE. CL*70
|
|
01210 SET L910-REWRITE-88 TO TRUE. CL*70
|
|
01211 GO TO S910-MSTR-IO. CL*70
|
|
01212 CL*70
|
|
01213 S910-CLOSE. CL*70
|
|
01214 SET L910-CLOSE-88 TO TRUE. CL*70
|
|
01215 GO TO S910-MSTR-IO. CL*70
|
|
01216 CL*70
|
|
01217 S910-MSTR-IO. CL*70
|
|
01218 CALL 'DTSBU910' USING L910-LINK-AREA CL*70
|
|
01219 MSKL-REC. CL*70
|
|
01220 S910-EXIT. CL*70
|
|
01221 EXIT. CL*70
|
|
01222 CL212
|
|
01223 S927-WRITE. CL212
|
|
01224 SET L927-WRITE-88 TO TRUE. CL212
|
|
01225 GO TO S927-BTC-O. CL212
|
|
01226 CL212
|
|
01227 S927-BTC-O. CL212
|
|
01228 CALL 'DTSBU927' USING L927-LINK-AREA CL212
|
|
01229 TSKL-REC. CL212
|
|
01230 S927-EXIT. CL212
|
|
01231 EXIT. CL212
|
|
01232 CL215
|
|
01233 CL*48
|
|
01234 S985A-OPEN. CL*71
|
|
01235 SET L985-OPEN-UPDATE-88 TO TRUE. CL*71
|
|
01236 CALL 'DTSBU985' USING L985-LINK-AREA CL*71
|
|
01237 W001-REC. CL*71
|
|
01238 S985A-EXIT. CL*71
|
|
01239 EXIT. CL*71
|
|
01240 CL*71
|
|
01241 S985B-WRITE. CL*71
|
|
01242 SET L985-WRITE-88 TO TRUE. CL*48
|
|
01243 CALL 'DTSBU985' USING L985-LINK-AREA CL*48
|
|
01244 W001-REC. CL*68
|
|
01245 S985B-EXIT. CL*71
|
|
01246 EXIT. CL*48
|
|
01247 CL*48
|
|
01248 S985C-CLOSE. CL*71
|
|
01249 SET L985-CLOSE-88 TO TRUE. CL*71
|
|
01250 CALL 'DTSBU985' USING L985-LINK-AREA CL*71
|
|
01251 W001-REC. CL*71
|
|
01252 S985C-EXIT. CL*71
|
|
01253 EXIT. CL*71
|
|
01254 CL*71
|
|
01255 S946-WRITE-R907. CL*41
|
|
01256 CALL 'DTSBU946' USING R907-REC. CL*40
|
|
01257 CL218
|
|
01258 S946-EXIT. CL*49
|
|
01259 EXIT. CL218
|
|
01260 CL**9
|
|
01261 S999-ABEND. EFTBD140
|
|
01262 DISPLAY '*** EFTBD140 ABENDING : ' CL197
|
|
01263 WRK-ABEND-MSG. CL*83
|
|
01264 EFTBD140
|
|
01265 CALL 'DTSBU999' USING WRK-ABEND-CD. EFTBD140
|
|
01266 S999-EXIT. EFTBD140
|
|
01267 EXIT. EFTBD140
|