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