00001 IDENTIFICATION DIVISION. 03/29/04 00002 PROGRAM-ID. EFTBX100. EFTBX100 00003 AUTHOR. TRW. LV255 00004 DATE-WRITTEN. MARCH 2003. CL**2 00005 DATE-COMPILED. EFTBX100 00006 SKIP3 EFTBX100 00007 ***** EFTBX100 00008 * EFTBX100 00009 * EFTBX100 00010 * FUNCTION: EXTRACT EMPLOYER DATA FOR IVR ELECTRONIC CL**3 00011 * PAYMENT (EFT). THE EXTRACT RUNS EVERY DAY. CL**3 00012 * CL236 00013 * *** SPECIAL VERSION COMPILED IN HDVL TO USE NEW COPIES CL182 00014 * *** OF WGH FILE AND OTHER COMPONENTS CHANGED FOR WAGE CL248 00015 * *** UPDATES CL182 00016 * EFTBX100 00017 * MODIFICATION LOG: EFTBX100 00018 * EFTBX100 00019 * 03/07/2003 INITIAL DEVELOPMENT. CL**3 00020 * REFERENCE: EFT PROGRAMM: GD CL**3 00021 * EFTBX100 00022 * 04/01/2003 PROGRAM MODIFIED TO ADD THE EMPLOYER STATUS CL*39 00023 * DATA, EMPLOYER RATE, REPORT DUE DATE, AND CL*39 00024 * PRIOR BALANCE DUE FOR IVR ELECTRONIC PAY- CL*39 00025 * MENT PROCESSING. CL*39 00026 * PROGRAMMER: RW1 CL*39 00027 * CL234 00028 * 01/08/2004 MODIFIED PROCESS THAT DETERMINES CURRENT QTR CL234 00029 * REFERENCE: ENH051 PROGRAMMER: GD CL234 00030 * CL*39 00031 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL*39 00032 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL*39 00033 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL*39 00034 * EFTBX100 00035 * DESCRIPTION: EFTBX100 00036 * EFTBX100 00037 * SELECT EMPLOYERS MEETING EITHER OF THE FOLLOWING CRITERIA: CL**3 00038 * - THE EMPLOYER IS ACTIVE CL**3 00039 * - THE EMPLOYER IS INACTIVE AND HAS A BALANCE DUE. CL**3 00040 * EFTBX100 00041 * RECORDS READ: EFTBX100 00042 * EFTBX100 00043 * MASTER: EFTBX100 00044 * EFTBX100 00045 * MPRF CL**3 00046 * MQTR CL**9 00047 * EFTBX100 00048 * ALTERNATE INDEX: EFTBX100 00049 * EFTBX100 00050 * NONE. EFTBX100 00051 * EFTBX100 00052 * REFERENCE: EFTBX100 00053 * EFTBX100 00054 * EFTBX100 00055 * RECORDS UPDATED: EFTBX100 00056 * EFTBX100 00057 * NONE CL**3 00058 * CL**3 00059 * OUTPUT RECORDS WRITTEN: CL**3 00060 * EFTBX100 00061 * EFT-EMP-STATUS (RECORD LAYOUT: EFTFESR) CL125 00062 * CL**3 00063 * REPORT RECORDS WRITTEN: EFTBX100 00064 * EFTBX100 00065 * NONE. EFTBX100 00066 * EFTBX100 00067 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: EFTBX100 00068 * EFTBX100 00069 * NONE. CL**3 00070 * EFTBX100 00071 * EFTBX100 00072 * MODULES CALLED: EFTBX100 00073 * EFTBX100 00074 * DTSBU910 MASTER FILE I/O DRIVER. EFTBX100 00075 * DTSBU946 WRITE VARIABLE OUTPUT RECORD(S). CL121 00076 * DTSBU004 QUARTER CONVERSION/EDIT. CL*40 00077 * DTSBU516 DETERMINE LIABILITY, DUE DATE, CL*40 00078 * AND RATE FOR A GIVEN QUARTER. CL*40 00079 * DTSBU981 VSAM WAGES FILE I/O DRIVER. CL248 00080 * DTSBU982 VSAM SSN-NAME FILE I/O DRIVER. CL188 00081 * CL*75 00082 ***** EFTBX100 00083 EFTBX100 00084 ENVIRONMENT DIVISION. EFTBX100 00085 INPUT-OUTPUT SECTION. CL**3 00086 CL**3 00087 FILE-CONTROL. CL**3 00088 CL**3 00089 DATA DIVISION. EFTBX100 00090 FILE SECTION. CL**3 00091 CL**3 00092 WORKING-STORAGE SECTION. EFTBX100 000925 77 PAN-VALET PICTURE X(24) VALUE '255EFTBX100 03/29/04'. EFTBX100 00093 EFTBX100 00094 01 WRK-AREA. EFTBX100 00095 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +100. CL125 00096 05 ABEND-MSG PIC X(60). EFTBX100 00097 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBX100'. CL125 00098 EFTBX100 00099 05 WRK-LAST-QTR-DAY PIC S9(08) COMP VALUE +0. CL234 00100 05 WRK-PERIOD-START PIC S9(08) COMP VALUE +0. CL234 00101 05 WRK-PERIOD-END PIC S9(09) COMP-3 VALUE +0. CL234 00102 CL234 00103 05 WRK-EMP-SELECTED-IND PIC X(01). CL*62 00104 88 WRK-EMP-SELECTED-YES-88 VALUE 'Y'. CL*62 00105 88 WRK-EMP-SELECTED-NO-88 VALUE 'N'. CL*62 00106 EFTBX100 00107 05 WRK-MOPO-IND PIC X(01). CL217 00108 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. CL217 00109 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. CL217 00110 CL217 00111 05 EFT-STATUS PIC X(02). CL**3 00112 88 EFT-STATUS-OK-88 VALUE '00'. CL**3 00113 EFTBX100 00114 05 WRK-EMP-BALANCE PIC S9(09)V99 COMP-3 VALUE +0. CL**9 00115 05 WRK-TAX-DUE PIC S9(09)V99 COMP-3 VALUE +0. CL*13 00116 05 WRK-INT-DUE PIC S9(09)V99 COMP-3 VALUE +0. CL*13 00117 05 WRK-PEN-DUE PIC S9(09)V99 COMP-3 VALUE +0. CL*14 00118 CL**9 00119 05 WRK-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. CL107 00120 05 WRK-TEST-CNT PIC S9(07) COMP-3 VALUE +0. CL128 00121 05 WRK-EFT-WRITTEN-CNTFESR PIC S9(07) COMP-3 VALUE +0. CL123 00122 05 WRK-EFT-WRITTEN-CNTFEWR PIC S9(07) COMP-3 VALUE +0. CL123 00123 05 WRK-SUCC-CNT PIC S9(07) COMP-3 VALUE +0. CL*75 00124 05 WRK-MISSING-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. CL139 00125 05 WRK-MQTR-MISSING-CNT PIC S9(07) COMP-3 VALUE +0. CL183 00126 05 WRK-NO-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. CL148 00127 05 WRK-WAGES-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. CL149 00128 05 WRK-WAGES-OK-CNT PIC S9(07) COMP-3 VALUE +0. CL151 00129 05 WRK-WORKERS-CNT PIC S9(07) COMP-3 VALUE +0. CL152 00130 05 WRK-PCT PIC S9V9999 COMP-3 VALUE +0. CL140 00131 05 WRK-BAL-DUE-CNT PIC S9(07) COMP-3 VALUE +0. CL**6 00132 05 WRK-TOT-BAL-DUE PIC S9(11)V99 COMP-3 VALUE +0. CL**6 00133 CL107 00134 05 WRK-SSN-ERROR PIC S9(07) COMP-3 VALUE +0. CL107 00135 05 WRK-SSN-ERROR-DISP PIC --,---,--9. CL108 00136 05 WRK-AMT-DISP PIC --,---,---,--9.99. CL**7 00137 05 WRK-AMT-DISP1 PIC --,---,---,--9.99. CL*11 00138 05 WRK-PCT-DISP PIC ZZ9.9999-. CL142 00139 05 WRK-CURR-YRQ PIC S9(05) COMP-3 VALUE +0. CL*37 00140 05 WRK-CURR-YRQ-START PIC S9(09) COMP-3 VALUE +0. CL181 00141 05 WRK-CURR-YRQ-END PIC S9(09) COMP-3 VALUE +0. CL181 00142 05 WRK-LAST-RCVD-YRQ PIC S9(05) COMP-3 VALUE +0. CL111 00143 05 WRK-EARLIEST-YRQ PIC S9(05) COMP-3 VALUE +0. CL111 00144 05 WRK-DISP-CURR-YRQ PIC X(05). CL*37 00145 05 WRK-MQTR-YTD-WAGE PIC S9(11)V99 COMP-3 VALUE +0. CL135 00146 05 WRK-WGH-YTD-WAGE PIC S9(11)V99 COMP-3 VALUE +0. CL248 00147 CL159 00148 05 WRK-CURR-QTR-AREA. CL160 00149 15 WRK-CURR-QTR-5-X. CL159 00150 20 WRK-CURR-QTR-5-YR PIC 9(04). CL159 00151 20 WRK-CURR-QTR-5-Q PIC 9(01). CL159 00152 15 WRK-CURR-QTR-5-9 REDEFINES WRK-CURR-QTR-5-X CL159 00153 PIC 9(05). CL159 00154 CL159 00155 05 WRK-FIRST-QTR-AREA. CL*72 00156 15 WRK-FIRST-QTR-5-X. CL*72 00157 20 WRK-FIRST-QTR-5-YR PIC 9(04). CL*72 00158 20 WRK-FIRST-QTR-5-Q PIC 9(01). CL*72 00159 15 WRK-FIRST-QTR-5-9 REDEFINES WRK-FIRST-QTR-5-X CL*72 00160 PIC 9(05). CL*72 00161 CL*72 00162 05 WRK-FOURTH-QTR-AREA. CL*72 00163 15 WRK-FOURTH-QTR-5-X. CL*72 00164 20 WRK-FOURTH-QTR-5-YR PIC 9(04). CL*72 00165 20 WRK-FOURTH-QTR-5-Q PIC 9(01). CL*72 00166 15 WRK-FOURTH-QTR-5-9 REDEFINES WRK-FOURTH-QTR-5-X CL*72 00167 PIC 9(05). CL*72 00168 CL*72 00169 05 WRK-SSN-ERROR-IND PIC X(01). CL*72 00170 88 WRK-SSN-ERROR-YES-88 VALUE 'Y'. CL*72 00171 88 WRK-SSN-ERROR-NO-88 VALUE 'N'. CL*72 00172 CL*72 00173 05 TBL-SUB PIC S9(04) COMP. CL*72 00174 05 TBL-CNT PIC S9(04) COMP VALUE +0. CL*72 00175 05 TBL-MAX PIC S9(04) COMP CL*72 00176 VALUE +5000. CL110 00177 05 TBL-HIGHEST PIC S9(04) COMP VALUE +0. CL110 00178 05 SSN-SUB PIC S9(04) COMP. CL*72 00179 05 NXT-SUB PIC S9(04) COMP. CL*72 00180 05 WRK-MAX-SSN PIC S9(09) COMP-3 VALUE +0. CL*72 00181 CL*72 00182 05 WRK-INDEX-IND PIC X(01). CL*72 00183 88 WRK-INDEX-NULL-88 VALUE '0'. CL*72 00184 88 WRK-INDEX-POSITION-FOUND-88 VALUE '1'. CL*72 00185 88 WRK-INDEX-SSN-FOUND-88 VALUE '2'. CL*72 00186 88 WRK-INDEX-FOUND-88 VALUE '1' '2'. CL*72 00187 CL*72 00188 01 WAGE-TABLE-AREA. CL*72 00189 05 WAGE-TABLE OCCURS 5000 TIMES. CL110 00190 10 WAGE-SSN PIC 9(09). CL*72 00191 10 WAGE-NAME-AREA. CL*72 00192 15 WAGE-LAST-NAME PIC X(20). CL185 00193 15 WAGE-FIRST-NAME PIC X(15). CL*72 00194 15 WAGE-MI PIC X(01). CL*72 00195 10 WAGE-YTD-SUM PIC S9(11)V9(02). CL*72 00196 EJECT EFTBX100 00197 CL*72 00198 01 MSG-AREA. EFTBX100 00199 05 MSG1-AREA. EFTBX100 00200 10 MSG1-ID PIC X(03) VALUE '800'. CL**4 00201 10 MSG1-TEXT. EFTBX100 00202 15 FILLER PIC X(40) EFTBX100 00203 VALUE ' '. CL**4 00204 15 FILLER PIC X(40) EFTBX100 00205 VALUE ' '. EFTBX100 00206 CL209 00207 01 TALLY-AREA. CL209 00208 05 SLASH-NAME. CL212 00209 10 SLASH-NAME-CHAR OCCURS 34 TIMES PIC X(01). CL212 00210 05 FIRST-NAME PIC X(15) VALUE SPACE. CL210 00211 05 MIDDLE-INIT PIC X(01) VALUE SPACE. CL212 00212 05 LAST-NAME PIC X(20) VALUE SPACE. CL210 00213 05 NSUB PIC S9(04) COMP. CL240 00214 05 FSUB PIC S9(04) COMP. CL240 00215 05 LSUB PIC S9(04) COMP. CL240 00216 05 LAST-NAME-COMPLETE-IND PIC X(01). CL240 00217 88 LAST-NAME-COMPLETE-YES-88 VALUE 'Y'. CL240 00218 88 LAST-NAME-COMPLETE-NO-88 VALUE 'N'. CL240 00219 05 FIRST-NAME-COMPLETE-IND PIC X(01). CL240 00220 88 FIRST-NAME-COMPLETE-YES-88 VALUE 'Y'. CL240 00221 88 FIRST-NAME-COMPLETE-NO-88 VALUE 'N'. CL240 00222 05 MID-INIT-COMPLETE-IND PIC X(01). CL242 00223 88 MID-INIT-COMPLETE-YES-88 VALUE 'Y'. CL242 00224 88 MID-INIT-COMPLETE-NO-88 VALUE 'N'. CL242 00225 05 D-S PIC X(02) VALUE SPACE. CL209 00226 05 SLASH-TALLY PIC S9(04) COMP. CL209 00227 05 LAST-NAME-LEN PIC S9(04) COMP. CL209 00228 05 FIRST-MID-LEN PIC S9(04) COMP. CL212 00229 05 FIRST-NAME-LEN PIC S9(04) COMP. CL212 00230 05 TOTAL-LEN PIC S9(04) COMP. CL209 00231 EJECT EFTBX100 00232 01 FHDR-REC. CL123 00233 ++INCLUDE EFTIFHDR CL169 00234 CL*18 00235 01 FGRD-REC. CL179 00236 ++INCLUDE EFTIFGRD CL179 00237 CL179 00238 01 FESR-REC. CL123 00239 ++INCLUDE EFTIFESR CL123 00240 CL**8 00241 01 FEWR-REC. CL123 00242 ++INCLUDE EFTIFEWR CL123 00243 CL*72 00244 01 FTRL-REC. CL123 00245 ++INCLUDE EFTIFTRL CL169 00246 CL*18 00247 01 L001-LINK-AREA. CL235 00248 ++INCLUDE DTSIL001 CL235 00249 CL234 00250 01 L003-LINK-AREA. CL234 00251 ++INCLUDE DTSIL003 CL234 00252 CL234 00253 01 L004-LINK-AREA. CL*33 00254 ++INCLUDE DTSIL004 CL*33 00255 CL*33 00256 01 L516-LINK-AREA. CL*33 00257 ++INCLUDE DTSIL516 CL*33 00258 CL*32 00259 01 L600-LINK-AREA. CL*32 00260 ++INCLUDE DTSIL600 CL*32 00261 CL*16 00262 01 L101-LINK-AREA. CL**8 00263 ++INCLUDE DTSIL101 CL**8 00264 CL**9 00265 01 L910-LINK-AREA. CL**9 00266 ++INCLUDE DTSIL910 CL**9 00267 SKIP3 CL**9 00268 01 MSKL-REC. CL**9 00269 ++INCLUDE DTSIMSKL CL**9 00270 SKIP3 CL**9 00271 01 MQTR-REC. CL**9 00272 ++INCLUDE DTSIMQTR CL**9 00273 SKIP3 CL*28 00274 01 MFAE-REC. CL*28 00275 ++INCLUDE DTSIMFAE CL*28 00276 SKIP3 CL*48 00277 01 MOPO-REC. CL216 00278 ++INCLUDE DTSIMOPO CL216 00279 EJECT CL*48 00280 01 MTAD-REC. CL216 00281 ++INCLUDE DTSIMTAD CL216 00282 EJECT CL216 00283 01 L931-LINK-AREA. CL179 00284 ++INCLUDE DTSIL931 CL179 00285 EJECT CL179 00286 01 FSKL-REC. CL179 00287 ++INCLUDE DTSIFSKL CL179 00288 EJECT CL179 00289 01 FCYR-REC. CL179 00290 ++INCLUDE DTSIFCYR CL179 00291 CL179 00292 01 L981-LINK-AREA. CL248 00293 ++INCLUDE DTSIL981 CL248 00294 SKIP3 CL*72 00295 01 WWGH-REC. CL248 00296 ++INCLUDE DTSIWWGH CL248 00297 EJECT CL*72 00298 01 L982-LINK-AREA. CL185 00299 ++INCLUDE DTSIL982 CL185 00300 SKIP3 CL185 00301 01 WNAM-REC. CL185 00302 ++INCLUDE DTSIWNAM CL185 00303 EJECT CL185 00304 CL*72 00305 LINKAGE SECTION. EFTBX100 00306 SKIP3 EFTBX100 00307 01 LECM-LINK-AREA. EFTBX100 00308 ++INCLUDE DTSILECM EFTBX100 00309 CL**8 00310 01 MPRF-LINK-REC. EFTBX100 00311 ++INCLUDE DTSIMPRF EFTBX100 00312 EJECT EFTBX100 00313 PROCEDURE DIVISION USING LECM-LINK-AREA EFTBX100 00314 MPRF-LINK-REC. EFTBX100 00315 EFTBX100 00316 EVALUATE TRUE EFTBX100 00317 WHEN LECM-PROCESS-88 CL*22 00318 PERFORM P0000-PROCESS THRU P0000-EXIT EFTBX100 00319 EFTBX100 00320 WHEN LECM-INITIALIZE-88 CL*22 00321 PERFORM I0000-INITIALIZE THRU I0000-EXIT EFTBX100 00322 EFTBX100 00323 WHEN LECM-TERMINATE-88 CL*22 00324 PERFORM T0000-TERMINATE THRU T0000-EXIT EFTBX100 00325 EFTBX100 00326 WHEN OTHER CL*22 00327 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' EFTBX100 00328 TO ABEND-MSG EFTBX100 00329 PERFORM S999-ABEND THRU S999-EXIT CL*22 00330 END-EVALUATE. CL*22 00331 CL*22 00332 GOBACK. EFTBX100 00333 EJECT EFTBX100 00334 I0000-INITIALIZE. EFTBX100 00335 MOVE LECM-TRACE-IND TO L910-TRACE-IND CL*72 00336 L981-TRACE-IND CL248 00337 L982-TRACE-IND. CL186 00338 MOVE WRK-MOD-NAME TO L910-MOD-NAME CL**9 00339 L981-MOD-NAME CL248 00340 L982-MOD-NAME. CL186 00341 CL*73 00342 PERFORM I1000-SUBJECT-YRQ THRU I1000-EXIT. CL*73 00343 CL*73 00344 PERFORM I2000-OPEN-FILE THRU I2000-EXIT. CL*73 00345 EFTBX100 00346 SET LECM-MST-OPEN-READ-88 TO TRUE. CL*73 00347 SET LECM-REF-OPEN-READ-88 TO TRUE. CL179 00348 EFTBX100 00349 MOVE LENGTH OF FHDR-REC TO FHDR-LENGTH. CL179 00350 MOVE LENGTH OF FGRD-REC TO FGRD-LENGTH. CL179 00351 MOVE LENGTH OF FTRL-REC TO FTRL-LENGTH. CL179 00352 MOVE LENGTH OF FESR-REC TO FESR-LENGTH. CL179 00353 MOVE LENGTH OF FEWR-REC TO FEWR-LENGTH. CL179 00354 CL179 00355 PERFORM I3000-WRITE-GLOBAL-REC THRU I3000-EXIT. CL179 00356 PERFORM I4000-WRITE-HEADER THRU I4000-EXIT. CL179 00357 CL*19 00358 I0000-EXIT. EFTBX100 00359 EXIT. EFTBX100 00360 CL*73 00361 I1000-SUBJECT-YRQ. CL*73 00362 PERFORM I1100-LAST-QTR-WRK-DAY THRU I1100-EXIT. CL234 00363 *** MOVE LECM-SYS-DATE TO L004-DATE. CL234 00364 *& SET CURRENT DATE FOR TESTING CL163 00365 *& MOVE 20021001 TO L004-DATE. CL179 00366 CL234 00367 MOVE LECM-CURR-RUN-DATE TO L001-FED-8-DATE-9. CL253 00368 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL253 00369 DISPLAY 'CURRENT DATE IS: ' L001-SLASH-8-DATE. CL253 00370 CL253 00371 MOVE LECM-CURR-RUN-DATE TO L004-DATE. CL247 00372 PERFORM S004-FROM-DATE THRU S004-EXIT. CL247 00373 SUBTRACT +1 FROM L004-ABS-QTR. CL247 00374 PERFORM S004-FROM-ABS THRU S004-EXIT. CL247 00375 MOVE L004-QTR-5-9 TO WRK-FIRST-QTR-5-9 CL159 00376 WRK-FOURTH-QTR-5-9 CL159 00377 WRK-CURR-YRQ. CL159 00378 CL159 00379 MOVE L004-QTR-START-DATE TO WRK-CURR-YRQ-START. CL179 00380 MOVE L004-QTR-END-DATE TO WRK-CURR-YRQ-END. CL179 00381 CL179 00382 MOVE WRK-CURR-YRQ TO WRK-CURR-QTR-5-9. CL161 00383 CL159 00384 DISPLAY 'SUBJECT QUARTER IS: ' L004-SLASH-5-QTR CL253 00385 ' START ' WRK-CURR-YRQ-START CL234 00386 ' END ' WRK-CURR-YRQ-END. CL234 00387 CL159 00388 IF WRK-CURR-QTR-5-Q = 1 CL159 00389 SUBTRACT 1 FROM WRK-FIRST-QTR-5-YR CL159 00390 SUBTRACT 1 FROM WRK-FOURTH-QTR-5-YR CL160 00391 END-IF. CL159 00392 CL159 00393 MOVE 1 TO WRK-FIRST-QTR-5-Q. CL*73 00394 MOVE 4 TO WRK-FOURTH-QTR-5-Q. CL*73 00395 CL*73 00396 MOVE WRK-FIRST-QTR-5-9 TO L004-QTR-5-9. CL111 00397 PERFORM S004-FROM-5 THRU S004-EXIT. CL111 00398 SUBTRACT +8 FROM L004-ABS-QTR. CL111 00399 PERFORM S004-FROM-ABS THRU S004-EXIT. CL111 00400 MOVE L004-QTR-5-9 TO WRK-EARLIEST-YRQ. CL111 00401 CL111 00402 IF WRK-CURR-QTR-5-Q = 1 CL159 00403 DISPLAY 'SUBJECT QTR IS FIRST' CL255 00404 DISPLAY 'USING PREVIOUS YEAR WAGES TO FIND SSNS'. CL159 00405 CL159 00406 DISPLAY 'FIRST WAGE QUARTER: ' WRK-FIRST-QTR-5-9. CL254 00407 DISPLAY 'LAST WAGE QUARTER : ' WRK-FOURTH-QTR-5-9. CL254 00408 DISPLAY 'LAST REPORT CUTOFF QTR : ' WRK-EARLIEST-YRQ. CL111 00409 CL*73 00410 I1000-EXIT. CL*73 00411 EXIT. CL*73 00412 CL*73 00413 I1100-LAST-QTR-WRK-DAY. CL234 00414 MOVE LECM-CURR-RUN-DATE TO L004-DATE. CL247 00415 PERFORM S004-FROM-DATE THRU S004-EXIT. CL234 00416 MOVE L004-QTR-END-DATE TO L001-FED-8-DATE-9. CL234 00417 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL234 00418 MOVE L001-JUL-ABS-DAY TO WRK-LAST-QTR-DAY. CL234 00419 CL234 00420 MOVE L004-QTR-START-DATE TO L001-FED-8-DATE-9. CL234 00421 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL234 00422 MOVE L001-JUL-ABS-DAY TO WRK-PERIOD-START. CL234 00423 CL234 00424 PERFORM I1110-PREV-WRK-DAY THRU I1110-EXIT. CL234 00425 CL234 00426 I1100-EXIT. CL234 00427 EXIT. CL234 00428 CL234 00429 I1110-PREV-WRK-DAY. CL234 00430 MOVE WRK-LAST-QTR-DAY TO L001-JUL-ABS-DAY. CL234 00431 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. CL234 00432 MOVE L001-FED-8-DATE-9 TO L003-DATE CL234 00433 PERFORM S003-AGENCY-DAY THRU S003-EXIT CL234 00434 IF L003-IS-WORK-DAY CL234 00435 NEXT SENTENCE CL234 00436 ELSE CL234 00437 PERFORM CL234 00438 UNTIL L003-IS-WORK-DAY CL234 00439 OR L001-JUL-ABS-DAY < WRK-PERIOD-START CL234 00440 SUBTRACT +1 FROM L001-JUL-ABS-DAY CL234 00441 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT CL234 00442 MOVE L001-FED-8-DATE-9 TO L003-DATE CL234 00443 PERFORM S003-AGENCY-DAY THRU S003-EXIT CL234 00444 END-PERFORM CL234 00445 END-IF. CL234 00446 CL234 00447 IF L001-JUL-ABS-DAY < WRK-PERIOD-START CL234 00448 DISPLAY 'CANNOT FIND PREVIOUS WORK DAY' CL234 00449 ELSE CL234 00450 MOVE L001-FED-8-DATE-9 TO WRK-PERIOD-END CL234 00451 END-IF. CL234 00452 CL234 00453 I1110-EXIT. CL234 00454 EXIT. CL234 00455 CL234 00456 I2000-OPEN-FILE. CL**3 00457 ** OPEN OUTPUT EFT-EMP-STATUS. CL121 00458 ** IF EFT-STATUS-OK-88 CL121 00459 ** NEXT SENTENCE CL121 00460 ** ELSE CL121 00461 ** DISPLAY 'OPEN ERROR ON EFT FILE ' EFT-STATUS CL121 00462 ** PERFORM S999-ABEND THRU S999-EXIT. CL121 00463 CL*52 00464 PERFORM S981A-OPEN-READ THRU S981A-EXIT. CL248 00465 PERFORM S982C-OPEN-READ THRU S982C-EXIT. CL186 00466 CL*73 00467 I2000-EXIT. CL**3 00468 EXIT. CL**3 00469 CL*19 00470 I3000-WRITE-GLOBAL-REC. CL179 00471 PERFORM I3100-TAX-WAGE-BASE THRU I3100-EXIT. CL179 00472 CL179 00473 SET FHDR-TYPE-GLOBAL-DATA-88 TO TRUE. CL179 00474 SET FHDR-SUB-TYPE-HEADER-88 TO TRUE. CL123 00475 MOVE LECM-SYS-DATE TO FHDR-CREATE-DATE. CL123 00476 PERFORM S946-WRITE-HEADER THRU S946-EXIT. CL179 00477 CL*73 00478 SET FGRD-TYPE-GLOBAL-DATA-88 TO TRUE. CL179 00479 SET FGRD-SUB-TYPE-DATA-88 TO TRUE. CL179 00480 MOVE WRK-CURR-YRQ TO FGRD-CURR-QTR. CL179 00481 MOVE WRK-CURR-YRQ-START TO FGRD-CURR-QTR-START. CL179 00482 MOVE WRK-CURR-YRQ-END TO FGRD-CURR-QTR-END. CL179 00483 MOVE FCYR-TAXABLE-WAGE-BASE TO FGRD-TAXABLE-WAGE-BASE. CL179 00484 PERFORM S946-WRITE-GLOBAL THRU S946-EXIT. CL179 00485 CL179 00486 SET FTRL-TYPE-GLOBAL-DATA-88 TO TRUE. CL179 00487 SET FTRL-SUB-TYPE-TRAILER-88 TO TRUE. CL179 00488 MOVE 1 TO FTRL-RECORD-CNT. CL179 00489 MOVE ZERO TO FTRL-TOT-AMOUNT. CL179 00490 PERFORM S946-WRITE-TRAILER THRU S946-EXIT. CL179 00491 CL179 00492 I3000-EXIT. CL*19 00493 EXIT. CL*19 00494 CL*19 00495 I3100-TAX-WAGE-BASE. CL179 00496 MOVE LOW-VALUES TO FCYR-KEY-AREA. CL179 00497 SET FCYR-CYR-88 TO TRUE. CL179 00498 MOVE WRK-CURR-YRQ TO L004-QTR-5-9. CL179 00499 MOVE L004-QTR-5-YR TO FCYR-YR. CL179 00500 MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. CL179 00501 CL179 00502 PERFORM S931-READ THRU S931-EXIT. CL179 00503 IF L931-NO-REC-88 CL179 00504 DISPLAY 'CANNOT FIND TAXABLE WAGE BASE ' CL179 00505 PERFORM S999-ABEND THRU S999-EXIT CL179 00506 ELSE CL179 00507 MOVE FSKL-REC TO FCYR-REC. CL179 00508 CL179 00509 I3100-EXIT. CL179 00510 EXIT. CL179 00511 CL179 00512 I4000-WRITE-HEADER. CL179 00513 CL179 00514 SET FHDR-TYPE-EMP-STATUS-88 TO TRUE. CL179 00515 SET FHDR-SUB-TYPE-HEADER-88 TO TRUE. CL179 00516 CL179 00517 MOVE LECM-SYS-DATE TO FHDR-CREATE-DATE. CL179 00518 *** MOVE SPACES TO FHDR-FILLER. CL179 00519 CL179 00520 PERFORM S946-WRITE-HEADER THRU S946-EXIT. CL179 00521 * WRITE EFT-REC FROM HEADER-REC. CL179 00522 * IF EFT-STATUS-OK-88 CL179 00523 * NEXT SENTENCE CL179 00524 ** ELSE CL179 00525 * DISPLAY 'BAD WRITE ON EFT Y810 HEADER REC. ' EFT-STATUS CL179 00526 * PERFORM S999-ABEND THRU S999-EXIT. CL179 00527 CL179 00528 SET FHDR-TYPE-WAGE-EXP-88 TO TRUE. CL179 00529 SET FHDR-SUB-TYPE-HEADER-88 TO TRUE. CL179 00530 CL179 00531 MOVE LECM-SYS-DATE TO FHDR-CREATE-DATE. CL179 00532 *** MOVE SPACES TO FHDR-FILLER. CL179 00533 CL179 00534 PERFORM S946-WRITE-HEADER THRU S946-EXIT. CL179 00535 I4000-EXIT. CL179 00536 EXIT. CL179 00537 CL179 00538 P0000-PROCESS. EFTBX100 00539 ADD +1 TO WRK-MPRF-CNT. CL197 00540 SET WRK-EMP-SELECTED-YES-88 TO TRUE. CL*62 00541 CL*62 00542 *& >> COUNTER ADDED FOR TESTING << CL*62 00543 * IF WRK-MPRF-CNT > +100 CL230 00544 * GO TO P0000-EXIT. CL230 00545 *& CL*62 00546 CL**3 00547 *& CL199 00548 * IF MPRF-EMP-NO = 139037 CL253 00549 * DISPLAY '** P0000 ' MPRF-EMP-NO CL253 00550 * ' MPRF ENROLLED ' MPRF-EFT-ENROLLED-IND CL253 00551 * ELSE CL253 00552 * IF MPRF-EFT-ENROLLED-YES-88 CL253 00553 * DISPLAY '** ENROLLED ' MPRF-EMP-NO. CL253 00554 *& CL199 00555 IF MPRF-CLASS-SUB-88 CL*33 00556 NEXT SENTENCE CL*33 00557 ELSE CL*33 00558 GO TO P0000-EXIT. CL*33 00559 CL*60 00560 PERFORM P1000-LIABILITY-DATA THRU P1000-EXIT. CL*60 00561 *& CL199 00562 IF MPRF-EMP-NO = 139037 CL251 00563 DISPLAY '** P1000 ' MPRF-EMP-NO CL199 00564 ' ' WRK-EMP-SELECTED-IND. CL199 00565 *& CL199 00566 IF WRK-EMP-SELECTED-NO-88 CL*62 00567 GO TO P0000-EXIT. CL178 00568 CL*62 00569 PERFORM P2000-FISCAL-AGENT THRU P2000-EXIT. CL*60 00570 CL*70 00571 PERFORM P3000-BALANCE-DUE THRU P3000-EXIT. CL*60 00572 *& CL199 00573 IF MPRF-EMP-NO = 139037 CL251 00574 DISPLAY '** P3000 ' MPRF-EMP-NO CL199 00575 ' ' WRK-EMP-SELECTED-IND. CL199 00576 *& CL199 00577 IF WRK-EMP-SELECTED-NO-88 CL111 00578 GO TO P0000-EXIT. CL178 00579 CL*70 00580 PERFORM P4000-CURR-QTR-DATA THRU P4000-EXIT. CL*60 00581 CL*70 00582 PERFORM P5000-ADDRESS THRU P5000-EXIT. CL*60 00583 *& CL199 00584 IF MPRF-EMP-NO = 139037 CL251 00585 DISPLAY '** P4000 ' MPRF-EMP-NO CL199 00586 ' ' WRK-EMP-SELECTED-IND. CL199 00587 *& CL199 00588 IF WRK-EMP-SELECTED-NO-88 CL*62 00589 GO TO P0000-EXIT. CL178 00590 CL*62 00591 PERFORM P5500-CONTACT THRU P5500-EXIT. CL205 00592 *& CL129 00593 * IF WRK-TEST-CNT < +100 CL232 00594 * ADD +1 TO WRK-TEST-CNT CL232 00595 * GO TO P0000-EXIT CL232 00596 * ELSE CL232 00597 * MOVE +0 TO WRK-TEST-CNT. CL232 00598 *& CL129 00599 ADD +1 TO WRK-MPRF-CNT. CL195 00600 PERFORM P6000-BUILD-FESR-REC THRU P6000-EXIT. CL123 00601 CL*81 00602 PERFORM P7000-GET-WAGE-DATA THRU P7000-EXIT. CL254 00603 IF TBL-CNT > ZERO CL254 00604 IF WRK-SSN-ERROR-NO-88 CL254 00605 PERFORM P8000-WRITE-WAGES THRU P8000-EXIT. CL254 00606 CL196 00607 *& TURN OFF TAXABLE WAGE CALCULATION FOR ALL EMPLOYERS CL249 00608 SET FESR-CALC-TAX-WAGE-NO-88 TO TRUE. CL249 00609 *& CL249 00610 CL249 00611 *& CL199 00612 IF MPRF-EMP-NO = 139037 CL251 00613 DISPLAY '** WRITE ' MPRF-EMP-NO CL199 00614 ' ' WRK-EMP-SELECTED-IND. CL199 00615 *& CL199 00616 ADD +1 TO WRK-EFT-WRITTEN-CNTFESR. CL196 00617 PERFORM S946-WRITE-FESR THRU S946-EXIT. CL254 00618 CL135 00619 P0000-EXIT. EFTBX100 00620 EXIT. EFTBX100 00621 EFTBX100 00622 P1000-LIABILITY-DATA. CL*60 00623 *& CL250 00624 IF MPRF-EMP-NO = 139037 CL251 00625 DISPLAY '** P1000 - 1 ' MPRF-EMP-NO CL250 00626 ' ' WRK-EMP-SELECTED-IND CL250 00627 END-IF. CL250 00628 *& CL250 00629 IF MPRF-SUSPEND-COLL-YES-88 CL111 00630 OR MPRF-WRITE-OFF-DATE > ZERO CL112 00631 OR MPRF-PURSUED-RPT-CNT > 2 CL111 00632 IF MPRF-EFT-ENROLLED-NO-88 CL178 00633 MOVE 'N' TO WRK-EMP-SELECTED-IND CL178 00634 GO TO P1000-EXIT CL178 00635 END-IF CL178 00636 END-IF. CL111 00637 CL111 00638 IF MPRF-STATUS-INACT-88 CL127 00639 IF MPRF-TOT-BALANCE-AMT = ZERO CL127 00640 IF MPRF-EFT-ENROLLED-NO-88 CL178 00641 MOVE 'N' TO WRK-EMP-SELECTED-IND CL178 00642 GO TO P1000-EXIT CL178 00643 END-IF CL178 00644 END-IF CL127 00645 END-IF. CL127 00646 CL159 00647 IF MPRF-CLASS-RATED-88 CL*60 00648 SET FESR-EMPL-RATED-88 TO TRUE CL123 00649 ELSE CL*60 00650 IF MPRF-CLASS-SELF-INS-88 CL*60 00651 SET FESR-EMPL-SELF-INSURED-88 TO TRUE CL123 00652 ELSE CL*60 00653 MOVE 'N' TO WRK-EMP-SELECTED-IND CL*63 00654 GO TO P1000-EXIT CL*60 00655 END-IF CL*60 00656 END-IF. CL*60 00657 CL*62 00658 MOVE WRK-CURR-YRQ TO L516-YRQ. CL*60 00659 PERFORM S516-LIABILITY THRU S516-EXIT. CL*60 00660 CL*60 00661 IF L516-LIABLE-88 CL*60 00662 SET FESR-LIAB-YES-88 TO TRUE CL123 00663 ELSE CL*60 00664 SET FESR-LIAB-NO-88 TO TRUE CL123 00665 END-IF. CL*60 00666 CL*60 00667 *& CL250 00668 IF MPRF-EMP-NO = 139037 CL251 00669 DISPLAY '** P1000 - 4 ' MPRF-EMP-NO CL250 00670 ' ' WRK-CURR-YRQ CL250 00671 ' ' L516-LIABLE-IND CL250 00672 ' ' L516-RATE-IND CL250 00673 END-IF. CL250 00674 *& CL250 00675 IF L516-ANN-SCHED-88 CL*60 00676 SET FESR-ANN-SCHED-88 TO TRUE CL123 00677 ELSE CL*60 00678 SET FESR-QTRLY-SCHED-88 TO TRUE CL123 00679 END-IF. CL*60 00680 CL*60 00681 MOVE ZEROS TO FESR-EMPLOYER-RATE. CL123 00682 CL*60 00683 IF MPRF-CLASS-RATED-88 CL*60 00684 IF L516-RATE-88 CL*60 00685 MOVE L516-UI-RATE TO FESR-EMPLOYER-RATE CL123 00686 ELSE CL*60 00687 SET FESR-LIAB-NO-88 TO TRUE. CL123 00688 CL*60 00689 MOVE L516-DEFAULT-RPT-DUE-DATE TO FESR-REPORT-DUE-DATE. CL123 00690 P1000-EXIT. CL*60 00691 EXIT. CL*60 00692 CL*60 00693 P2000-FISCAL-AGENT. CL*60 00694 MOVE LOW-VALUES TO MFAE-KEY-AREA. CL*60 00695 MOVE MPRF-EMP-NO TO MFAE-EMP-NO. CL*60 00696 SET MFAE-FAE-88 TO TRUE. CL*60 00697 SET MFAE-SERVICE-UC30-88 TO TRUE. CL*60 00698 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. CL*60 00699 CL*60 00700 PERFORM S910-READ THRU S910-EXIT. CL*60 00701 CL*60 00702 IF L910-NO-REC-88 CL*60 00703 SET FESR-FISCAL-AGENT-NO-88 TO TRUE CL123 00704 ELSE CL*60 00705 SET FESR-FISCAL-AGENT-YES-88 TO TRUE CL123 00706 END-IF. CL*60 00707 CL*60 00708 P2000-EXIT. CL*60 00709 EXIT. CL*60 00710 CL*60 00711 *P1010-SUCCESSOR. CL*62 00712 * IF MPRF-STATUS-INACT-88 CL*62 00713 * NEXT SENTENCE CL*62 00714 * ELSE CL*62 00715 * GO TO P1010-EXIT. CL*62 00716 * CL*62 00717 * MOVE MPRF-EMP-NO TO L600-EMP-NO. CL*62 00718 * MOVE 99999999 TO L600-EXP-TRN-EFF-DATE. CL*62 00719 * CALL 'DTSBU600' USING L600-LINK-AREA. CL*62 00720 * IF L600-SUCCESSOR-FOUND-88 CL*62 00721 * ADD +1 TO WRK-SUCC-CNT CL*62 00722 * DISPLAY 'SUCCESSOR FOUND ' L600-ULTIMATE-SUCCESSOR. CL*62 00723 * CL*62 00724 *P1010-EXIT. CL*62 00725 * EXIT. CL*62 00726 CL*16 00727 P3000-BALANCE-DUE. CL*60 00728 MOVE ZERO TO WRK-EMP-BALANCE CL111 00729 WRK-LAST-RCVD-YRQ CL135 00730 WRK-MQTR-YTD-WAGE. CL135 00731 CL135 00732 MOVE LOW-VALUES TO MQTR-KEY-AREA. CL**9 00733 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. CL**9 00734 SET MQTR-QTR-88 TO TRUE. CL**9 00735 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL**9 00736 CL**9 00737 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**9 00738 CL**9 00739 PERFORM P3100-SCAN-MQTR THRU P3100-EXIT CL*60 00740 UNTIL L910-NO-REC-88. CL**9 00741 CL**8 00742 IF MPRF-CLASS-SELF-INS-88 CL200 00743 NEXT SENTENCE CL200 00744 ELSE CL200 00745 IF MPRF-STATUS-INACT-88 CL200 00746 IF WRK-LAST-RCVD-YRQ < WRK-EARLIEST-YRQ CL200 00747 IF MPRF-EFT-ENROLLED-NO-88 CL200 00748 MOVE 'N' TO WRK-EMP-SELECTED-IND. CL200 00749 CL111 00750 P3000-EXIT. CL*60 00751 EXIT. CL**8 00752 CL**8 00753 P3100-SCAN-MQTR. CL*60 00754 MOVE MSKL-REC TO MQTR-REC. CL**9 00755 CL**9 00756 IF MQTR-CURR-RCVD-88 CL111 00757 MOVE MQTR-YRQ TO WRK-LAST-RCVD-YRQ. CL111 00758 CL111 00759 PERFORM P3110-GET-BALANCES THRU P3110-EXIT. CL*63 00760 CL**9 00761 PERFORM P3120-GET-INTEREST THRU P3120-EXIT. CL*60 00762 CL**9 00763 PERFORM P3130-GET-YTD-WAGES THRU P3130-EXIT. CL135 00764 CL135 00765 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**9 00766 CL**9 00767 P3100-EXIT. CL*60 00768 EXIT. CL**9 00769 CL**9 00770 P3110-GET-BALANCES. CL*60 00771 MOVE ZERO TO WRK-TAX-DUE CL*12 00772 WRK-INT-DUE CL*14 00773 WRK-PEN-DUE. CL*14 00774 PERFORM CL**9 00775 VARYING MQTR-ACCT-IDX FROM 1 BY 1 CL**9 00776 UNTIL MQTR-ACCT-IDX GREATER THAN MQTR-ACCT-CNT CL**9 00777 EVALUATE TRUE CL*14 00778 WHEN MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) CL*14 00779 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*14 00780 TO WRK-TAX-DUE CL*12 00781 CL*14 00782 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) CL*14 00783 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*14 00784 TO WRK-INT-DUE CL*12 00785 CL*14 00786 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) CL*14 00787 OR MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) CL*14 00788 OR MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) CL*14 00789 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*14 00790 TO WRK-PEN-DUE CL*14 00791 END-EVALUATE CL*14 00792 END-PERFORM. CL**9 00793 CL**9 00794 COMPUTE WRK-EMP-BALANCE = WRK-EMP-BALANCE + CL*12 00795 (WRK-TAX-DUE + WRK-INT-DUE + WRK-PEN-DUE). CL*14 00796 CL**9 00797 *& CL*11 00798 * IF WRK-BAL-DUE-CNT < 100 CL*18 00799 * IF WRK-TAX-DUE > 0 CL*18 00800 * MOVE WRK-TAX-DUE TO WRK-AMT-DISP CL*18 00801 * MOVE WRK-INT-DUE TO WRK-AMT-DISP1 CL*18 00802 * DISPLAY MPRF-EMP-NO ' ' MQTR-YRQ CL*18 00803 * ' TAX ' WRK-AMT-DISP CL*18 00804 * ' INT ' WRK-AMT-DISP1 CL*18 00805 * ' PEN ' WRK-PEN-DUE. CL*18 00806 *& CL*11 00807 P3110-EXIT. CL*60 00808 EXIT. CL**9 00809 CL**9 00810 P3120-GET-INTEREST. CL*60 00811 MOVE WRK-TAX-DUE TO L101-PAID-CHNG. CL*12 00812 MOVE LECM-CURR-RUN-DATE TO L101-RECEIVED-DATE. CL*19 00813 SET L101-WAIVE-INT-NO-88 TO TRUE. CL**9 00814 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. CL**9 00815 MOVE MQTR-INT-AREA TO L101-INT-AREA. CL**9 00816 CL**9 00817 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. CL**9 00818 CL**9 00819 ADD L101-INT-CHARGE-CHNG TO WRK-EMP-BALANCE. CL**9 00820 CL**9 00821 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-EMP-BALANCE. CL**9 00822 CL**9 00823 *& CL*11 00824 * IF WRK-BAL-DUE-CNT < 100 CL*19 00825 * IF WRK-TAX-DUE > 0 CL*19 00826 * MOVE L101-INT-CHARGE-CHNG TO WRK-AMT-DISP CL*19 00827 * MOVE WRK-EMP-BALANCE TO WRK-AMT-DISP1 CL*19 00828 * DISPLAY ' INT ' WRK-AMT-DISP CL*19 00829 * ' EMP ' WRK-AMT-DISP1. CL*19 00830 *& CL*11 00831 P3120-EXIT. CL*60 00832 EXIT. CL**9 00833 CL*28 00834 P3130-GET-YTD-WAGES. CL135 00835 IF MQTR-YRQ >= WRK-FIRST-QTR-5-9 CL135 00836 AND MQTR-YRQ <= WRK-FOURTH-QTR-5-9 CL136 00837 ADD MQTR-TOT-WAGE TO WRK-MQTR-YTD-WAGE. CL135 00838 CL135 00839 P3130-EXIT. CL135 00840 EXIT. CL135 00841 CL135 00842 P4000-CURR-QTR-DATA. CL*60 00843 MOVE +0 TO WRK-WORKERS-CNT. CL152 00844 CL152 00845 MOVE LOW-VALUES TO MQTR-KEY-AREA. CL*61 00846 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. CL*61 00847 SET MQTR-QTR-88 TO TRUE. CL*61 00848 MOVE WRK-CURR-YRQ TO MQTR-YRQ. CL177 00849 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL*61 00850 CL*61 00851 PERFORM S910-READ THRU S910-EXIT. CL*61 00852 IF L910-NO-REC-88 CL*61 00853 SET FESR-QTR-REPORT-NO-88 TO TRUE CL229 00854 GO TO P4000-EXIT. CL*61 00855 CL*41 00856 MOVE MSKL-REC TO MQTR-REC. CL*41 00857 *& CL226 00858 IF MPRF-EMP-NO = 040192 OR 011708 CL233 00859 DISPLAY 'BX100 P4000 ' MPRF-EMP-NO CL226 00860 ' ' MQTR-CURR-RPT-TYPE ' ' MQTR-YRQ CL231 00861 ' DUE ' MQTR-RPT-DUE-DATE CL231 00862 ' TAX ' MQTR-TAX-WAGE. CL231 00863 *& CL226 00864 CL*41 00865 IF MQTR-RPT-DUE-DATE NOT = L516-DEFAULT-RPT-DUE-DATE CL*41 00866 MOVE MQTR-RPT-DUE-DATE TO FESR-REPORT-DUE-DATE CL123 00867 END-IF. CL*41 00868 CL*41 00869 IF MQTR-CURR-RCVD-88 CL237 00870 SET FESR-QTR-REPORT-YES-88 TO TRUE CL237 00871 ELSE CL237 00872 SET FESR-QTR-REPORT-NO-88 TO TRUE CL229 00873 END-IF. CL237 00874 CL*41 00875 IF MQTR-INT-CHARGE-MANUAL-88 OR CL*42 00876 (LECM-SYS-DATE >= MQTR-WAIVE-INT-START-DATE AND CL*42 00877 LECM-SYS-DATE <= MQTR-WAIVE-INT-END-DATE) CL*41 00878 SET FESR-CHRG-INTEREST-NO-88 TO TRUE CL123 00879 END-IF. CL*41 00880 CL*41 00881 IF MQTR-PEN-CHARGE-MANUAL-88 OR CL*42 00882 (LECM-SYS-DATE >= MQTR-WAIVE-PEN-START-DATE AND CL*42 00883 LECM-SYS-DATE <= MQTR-WAIVE-PEN-END-DATE) CL*41 00884 SET FESR-CHRG-PENALTY-NO-88 TO TRUE CL123 00885 END-IF. CL*41 00886 CL*41 00887 IF MQTR-1ST-MTH-NO-ENTRY-88 CL152 00888 NEXT SENTENCE CL152 00889 ELSE CL152 00890 IF MQTR-1ST-MTH-EMPL-CNT > WRK-WORKERS-CNT CL152 00891 MOVE MQTR-1ST-MTH-EMPL-CNT TO WRK-WORKERS-CNT. CL152 00892 CL152 00893 IF MQTR-2ND-MTH-NO-ENTRY-88 CL152 00894 NEXT SENTENCE CL152 00895 ELSE CL152 00896 IF MQTR-2ND-MTH-EMPL-CNT > WRK-WORKERS-CNT CL152 00897 MOVE MQTR-2ND-MTH-EMPL-CNT TO WRK-WORKERS-CNT. CL152 00898 CL152 00899 IF MQTR-3RD-MTH-NO-ENTRY-88 CL152 00900 NEXT SENTENCE CL152 00901 ELSE CL152 00902 IF MQTR-3RD-MTH-EMPL-CNT > WRK-WORKERS-CNT CL152 00903 MOVE MQTR-3RD-MTH-EMPL-CNT TO WRK-WORKERS-CNT. CL152 00904 CL152 00905 P4000-EXIT. CL*60 00906 EXIT. CL*41 00907 CL*48 00908 P5000-ADDRESS. CL*60 00909 MOVE LOW-VALUES TO MTAD-KEY-AREA. CL*48 00910 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. CL*48 00911 SET MTAD-TAD-88 TO TRUE. CL*48 00912 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. CL*48 00913 CL*48 00914 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. CL*48 00915 CL*48 00916 PERFORM S910-READ THRU S910-EXIT. CL*48 00917 CL*48 00918 IF L910-NO-REC-88 CL*48 00919 IF MPRF-EFT-ENROLLED-NO-88 CL178 00920 MOVE 'N' TO WRK-EMP-SELECTED-IND CL178 00921 END-IF CL178 00922 ELSE CL*48 00923 MOVE MSKL-REC TO MTAD-REC CL112 00924 IF MTAD-UC223-NO-88 CL112 00925 IF MPRF-EFT-ENROLLED-NO-88 CL178 00926 MOVE 'N' TO WRK-EMP-SELECTED-IND. CL178 00927 CL*48 00928 P5000-EXIT. CL*60 00929 EXIT. CL*49 00930 CL205 00931 P5500-CONTACT. CL205 00932 MOVE SPACES TO FESR-CONTACT-FIRST-NAME CL214 00933 FESR-CONTACT-MI CL214 00934 FESR-CONTACT-LAST-NAME CL214 00935 FESR-CONTACT-PHONE. CL221 00936 CL214 00937 MOVE LOW-VALUES TO MOPO-KEY-AREA. CL206 00938 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. CL206 00939 SET MOPO-OPO-88 TO TRUE. CL206 00940 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. CL206 00941 CL206 00942 SET WRK-MOPO-FOUND-NO-88 TO TRUE. CL217 00943 PERFORM S910-START-BROWSE THRU S910-EXIT. CL206 00944 IF L910-NO-REC-88 CL206 00945 NEXT SENTENCE CL206 00946 ELSE CL206 00947 PERFORM CL206 00948 UNTIL L910-NO-REC-88 CL206 00949 OR WRK-MOPO-FOUND-YES-88 CL206 00950 MOVE MSKL-REC TO MOPO-REC CL206 00951 IF MOPO-TYPE-STATUS-88 CL206 00952 * DISPLAY 'CONTACT - MOPO NAME FOUND ' MOPO-NAME CL227 00953 SET WRK-MOPO-FOUND-YES-88 TO TRUE CL206 00954 ELSE CL206 00955 PERFORM S910-READ-NEXT THRU S910-EXIT CL206 00956 END-IF CL206 00957 END-PERFORM CL206 00958 END-IF. CL206 00959 CL206 00960 IF WRK-MOPO-FOUND-YES-88 CL206 00961 MOVE MOPO-VOICE-1 TO FESR-CONTACT-PHONE CL221 00962 MOVE MOPO-NAME TO SLASH-NAME CL221 00963 PERFORM P5600-PARSE-NAME THRU P5600-EXIT. CL220 00964 CL206 00965 P5500-EXIT. CL205 00966 EXIT. CL205 00967 CL205 00968 P5600-PARSE-NAME. CL208 00969 *& CL239 00970 * DISPLAY 'P5600 NAME ' SLASH-NAME ' ' MOPO-EMP-NO. CL245 00971 *& CL239 00972 MOVE +0 TO FSUB CL239 00973 LSUB. CL239 00974 MOVE SPACES TO FIRST-NAME CL239 00975 MIDDLE-INIT CL239 00976 LAST-NAME. CL239 00977 SET FIRST-NAME-COMPLETE-NO-88 TO TRUE. CL239 00978 SET LAST-NAME-COMPLETE-NO-88 TO TRUE. CL239 00979 SET MID-INIT-COMPLETE-NO-88 TO TRUE. CL241 00980 CL239 00981 IF SLASH-NAME = SPACES CL243 00982 MOVE SPACES TO FESR-CONTACT-LAST-NAME CL243 00983 FESR-CONTACT-FIRST-NAME CL243 00984 FESR-CONTACT-MI CL243 00985 GO TO P5600-EXIT. CL243 00986 CL243 00987 PERFORM CL239 00988 VARYING NSUB FROM +1 BY +1 CL239 00989 UNTIL NSUB > +34 CL239 00990 OR MID-INIT-COMPLETE-YES-88 CL241 00991 IF FIRST-NAME-COMPLETE-YES-88 CL239 00992 PERFORM P5630-MID-INIT THRU P5630-EXIT CL239 00993 ELSE CL239 00994 IF LAST-NAME-COMPLETE-YES-88 CL239 00995 PERFORM P5620-FIRST-NAME THRU P5620-EXIT CL239 00996 ELSE CL239 00997 PERFORM P5610-LAST-NAME THRU P5610-EXIT CL239 00998 END-IF CL239 00999 END-IF CL239 01000 END-PERFORM. CL239 01001 CL239 01002 MOVE LAST-NAME TO FESR-CONTACT-LAST-NAME. CL243 01003 MOVE FIRST-NAME TO FESR-CONTACT-FIRST-NAME. CL243 01004 MOVE MIDDLE-INIT TO FESR-CONTACT-MI. CL243 01005 *& CL241 01006 * DISPLAY ' P5600 ' FIRST-NAME ' ' MIDDLE-INIT CL245 01007 * ' ' LAST-NAME. CL245 01008 *& CL241 01009 * INSPECT SLASH-NAME TALLYING CL239 01010 * SLASH-TALLY FOR ALL '/'. CL239 01011 * INSPECT SLASH-NAME TALLYING CL239 01012 * LAST-NAME-LEN FOR CHARACTERS BEFORE INITIAL '/'. CL239 01013 * INSPECT SLASH-NAME TALLYING CL239 01014 * TOTAL-LEN FOR CHARACTERS BEFORE INITIAL D-S. CL239 01015 CL209 01016 ** CHECK FOR A VALID CONTACT NAME STRUCTURE ** CL211 01017 * IF SLASH-TALLY NOT = +1 CL239 01018 * GO TO P5600-EXIT. CL239 01019 CL213 01020 *----------------------------------------------------------------- CL212 01021 * REFORMAT. CL212 01022 *----------------------------------------------------------------- CL212 01023 CL213 01024 * IF SLASH-NAME-CHAR (TOTAL-LEN - 1) NOT GREATER SPACE CL239 01025 * MOVE SLASH-NAME-CHAR (TOTAL-LEN) TO FESR-CONTACT-MI CL239 01026 * COMPUTE FIRST-NAME-LEN = CL239 01027 * (TOTAL-LEN - ((LAST-NAME-LEN + 1) + 2)) CL239 01028 * ELSE CL239 01029 * COMPUTE FIRST-NAME-LEN = CL239 01030 * (TOTAL-LEN - (LAST-NAME-LEN - 1)). CL239 01031 * CL239 01032 * MOVE SLASH-NAME (1 : LAST-NAME-LEN) TO CL239 01033 * FESR-CONTACT-LAST-NAME. CL239 01034 * MOVE SLASH-NAME (LAST-NAME-LEN + 2 : FIRST-NAME-LEN) TO CL239 01035 * FESR-CONTACT-FIRST-NAME. CL239 01036 CL211 01037 P5600-EXIT. CL208 01038 EXIT. CL208 01039 CL208 01040 P5610-LAST-NAME. CL239 01041 IF SLASH-NAME-CHAR (NSUB) = '/' CL239 01042 SET LAST-NAME-COMPLETE-YES-88 TO TRUE CL239 01043 GO TO P5610-EXIT CL239 01044 ELSE CL239 01045 IF LSUB < +20 CL239 01046 ADD +1 TO LSUB CL239 01047 MOVE SLASH-NAME-CHAR (NSUB) TO LAST-NAME (LSUB:1) CL239 01048 *& CL239 01049 * DISPLAY ' P5610 LAST ' LAST-NAME CL245 01050 *& CL239 01051 END-IF CL239 01052 END-IF. CL239 01053 CL239 01054 P5610-EXIT. CL239 01055 EXIT. CL239 01056 CL239 01057 P5620-FIRST-NAME. CL239 01058 IF SLASH-NAME-CHAR (NSUB) = SPACE CL239 01059 SET FIRST-NAME-COMPLETE-YES-88 TO TRUE CL239 01060 GO TO P5620-EXIT CL239 01061 ELSE CL239 01062 IF FSUB < +15 CL239 01063 ADD +1 TO FSUB CL239 01064 MOVE SLASH-NAME-CHAR (NSUB) TO FIRST-NAME (FSUB:1) CL239 01065 *& CL239 01066 * DISPLAY ' P5620 FIRST ' FIRST-NAME CL245 01067 *& CL239 01068 END-IF CL239 01069 END-IF. CL239 01070 CL239 01071 P5620-EXIT. CL239 01072 EXIT. CL239 01073 CL239 01074 P5630-MID-INIT. CL239 01075 IF MID-INIT-COMPLETE-NO-88 CL241 01076 MOVE SLASH-NAME-CHAR (NSUB) TO MIDDLE-INIT (1:1) CL241 01077 SET MID-INIT-COMPLETE-YES-88 TO TRUE CL241 01078 *& CL243 01079 * DISPLAY ' P5630 MID ' MIDDLE-INIT CL245 01080 *& CL243 01081 END-IF. CL241 01082 CL239 01083 P5630-EXIT. CL239 01084 EXIT. CL239 01085 CL239 01086 P6000-BUILD-FESR-REC. CL123 01087 * MOVE ZERO TO WRK-EMP-BALANCE. CL*61 01088 * CL*61 01089 * IF MPRF-TOT-BALANCE-AMT > ZERO CL*61 01090 ***** PERFORM P1010-SUCCESSOR THRU P1010-EXIT CL*61 01091 * PERFORM P1100-BALANCE-DUE THRU P1100-EXIT CL*67 01092 * ADD +1 TO WRK-BAL-DUE-CNT CL*67 01093 * ADD WRK-EMP-BALANCE TO WRK-TOT-BAL-DUE. CL*67 01094 CL*61 01095 MOVE ZEROS TO FESR-CREDIT-AVAILABLE. CL123 01096 SET FESR-CALC-TAX-WAGE-YES-88 TO TRUE. CL123 01097 SET FESR-CHRG-INTEREST-YES-88 TO TRUE. CL123 01098 SET FESR-CHRG-PENALTY-YES-88 TO TRUE. CL123 01099 CL*61 01100 SET FESR-TYPE-EMP-STATUS-88 TO TRUE. CL123 01101 SET FESR-SUB-TYPE-DATA-88 TO TRUE. CL123 01102 CL*61 01103 MOVE MPRF-EMP-NO TO FESR-EMP-NO. CL123 01104 MOVE MPRF-FEIN TO FESR-FEIN. CL123 01105 CL*61 01106 IF MPRF-PRIMARY-IS-ENTITY-88 CL*61 01107 MOVE MPRF-PRIMARY-NAME TO FESR-ENTITY-NAME CL123 01108 MOVE SPACES TO FESR-TRADE-NAME CL123 01109 ELSE CL*61 01110 MOVE MPRF-ENTITY-NAME TO FESR-ENTITY-NAME CL123 01111 MOVE MPRF-PRIMARY-NAME TO FESR-TRADE-NAME. CL123 01112 CL*61 01113 MOVE MTAD-VOICE-1-AREA-CD TO FESR-BUSINESS-AREA-CD. CL123 01114 MOVE MTAD-VOICE-1-PREFIX TO FESR-BUSINESS-PREFIX. CL123 01115 MOVE MTAD-VOICE-1-SUFFIX TO FESR-BUSINESS-SUFFIX. CL123 01116 MOVE MTAD-VOICE-1-EXT TO FESR-BUSINESS-EXT. CL123 01117 CL*61 01118 MOVE MTAD-FAX-AREA-CD TO FESR-FAX-AREA-CD. CL123 01119 MOVE MTAD-FAX-PREFIX TO FESR-FAX-PREFIX. CL123 01120 MOVE MTAD-FAX-SUFFIX TO FESR-FAX-SUFFIX. CL123 01121 CL*61 01122 IF MTAD-EMAIL-ADDRESS = SPACES OR LOW-VALUES CL*61 01123 MOVE SPACES TO FESR-EMAIL-ADDRESS CL123 01124 ELSE CL*61 01125 MOVE MTAD-EMAIL-ADDRESS TO FESR-EMAIL-ADDRESS. CL123 01126 CL*61 01127 MOVE MTAD-ATTN-LINE TO FESR-ATTN-LINE. CL123 01128 *************************************************************** CL134 01129 * GOVONE REQUESTED THAT LINE 1 AND LINE 2 BE REVERSED CL134 01130 * 5/13/2003 - GD CL134 01131 *************************************************************** CL134 01132 MOVE MTAD-DELIV-LINE-1 TO FESR-STREET-ADDRESS-2. CL134 01133 MOVE MTAD-DELIV-LINE-2 TO FESR-STREET-ADDRESS-1. CL134 01134 MOVE MTAD-CITY TO FESR-CITY. CL123 01135 MOVE MTAD-ST TO FESR-STATE. CL123 01136 MOVE MTAD-ZIP TO FESR-ZIP. CL123 01137 CL*61 01138 MOVE WRK-EMP-BALANCE TO FESR-PRIOR-BALANCE-DUE. CL123 01139 CL*61 01140 P6000-EXIT. CL206 01141 EXIT. CL*61 01142 CL*88 01143 P7000-GET-WAGE-DATA. CL110 01144 *& CL194 01145 * IF MPRF-EMP-NO = 010169 CL201 01146 * DISPLAY 'ENTER P7000 ' CL201 01147 * WWGH-EMP-NO. CL248 01148 *& CL194 01149 PERFORM P7010-INIT-TABLE THRU P7010-EXIT. CL*92 01150 CL*85 01151 MOVE ZERO TO TBL-SUB CL*85 01152 TBL-CNT CL*76 01153 WRK-MAX-SSN CL137 01154 WRK-WGH-YTD-WAGE. CL248 01155 SET WRK-SSN-ERROR-NO-88 TO TRUE. CL*76 01156 CL*76 01157 MOVE LOW-VALUES TO WWGH-KEY-AREA. CL248 01158 MOVE MPRF-EMP-NO TO WWGH-EMP-NO. CL248 01159 MOVE WRK-FIRST-QTR-5-9 TO WWGH-YRQ. CL248 01160 CL*76 01161 PERFORM S981D-START-BROWSE THRU S981D-EXIT. CL248 01162 IF L981-NO-REC-88 CL248 01163 GO TO P7000-EXIT CL*78 01164 ELSE CL*76 01165 PERFORM P7100-SCAN-WAGES THRU P7100-EXIT CL*78 01166 UNTIL L981-NO-REC-88 CL248 01167 OR WRK-SSN-ERROR-YES-88. CL115 01168 CL*76 01169 IF WRK-MQTR-YTD-WAGE NOT = ZERO CL139 01170 IF WRK-WGH-YTD-WAGE = ZERO CL248 01171 ADD +1 TO WRK-NO-WAGE-CNT CL148 01172 ELSE CL148 01173 ADD +1 TO WRK-WAGES-FOUND-CNT CL149 01174 COMPUTE WRK-PCT = CL148 01175 (WRK-WGH-YTD-WAGE / WRK-MQTR-YTD-WAGE) CL248 01176 IF WRK-PCT <= 1.05 CL148 01177 AND WRK-PCT >= 0.95 CL148 01178 ADD +1 TO WRK-WAGES-OK-CNT CL150 01179 ELSE CL148 01180 PERFORM P7001-DISPLAY THRU P7001-EXIT CL150 01181 END-IF CL150 01182 END-IF CL150 01183 ELSE CL150 01184 IF WRK-WGH-YTD-WAGE NOT = ZERO CL248 01185 PERFORM P7002-DISPLAY THRU P7002-EXIT CL150 01186 END-IF CL150 01187 END-IF. CL150 01188 CL135 01189 P7000-EXIT. CL*78 01190 EXIT. CL*76 01191 CL*76 01192 P7001-DISPLAY. CL150 01193 MOVE WRK-PCT TO WRK-PCT-DISP. CL183 01194 SET FESR-CALC-TAX-WAGE-NO-88 TO TRUE. CL183 01195 ADD +1 TO WRK-MISSING-WAGE-CNT. CL183 01196 * DISPLAY 'MISSING WAGES ' MPRF-EMP-NO CL183 01197 * ' MQTR ' WRK-MQTR-YTD-WAGE CL183 01198 * ' WGH ' WRK-WGH-YTD-WAGE CL248 01199 * ' PCT ' WRK-PCT-DISP CL183 01200 * DISPLAY ' MQTR CNT ' WRK-WORKERS-CNT CL183 01201 * ' WGH CNT ' TBL-CNT. CL248 01202 CL152 01203 P7001-EXIT. CL150 01204 EXIT. CL150 01205 CL150 01206 P7002-DISPLAY. CL150 01207 ADD +1 TO WRK-MQTR-MISSING-CNT. CL183 01208 * DISPLAY 'MQTR MISSING ' MPRF-EMP-NO CL183 01209 * ' MQTR ' WRK-MQTR-YTD-WAGE CL183 01210 * ' WGH ' WRK-WGH-YTD-WAGE. CL183 01211 P7002-EXIT. CL151 01212 EXIT. CL150 01213 CL150 01214 P7010-INIT-TABLE. CL*92 01215 PERFORM CL*92 01216 VARYING TBL-SUB FROM +1 BY +1 CL*92 01217 UNTIL TBL-SUB > TBL-MAX CL*92 01218 MOVE ZEROS TO WAGE-SSN (TBL-SUB) CL*93 01219 MOVE SPACES TO WAGE-FIRST-NAME (TBL-SUB) CL*93 01220 WAGE-MI (TBL-SUB) CL*93 01221 WAGE-LAST-NAME (TBL-SUB) CL*93 01222 MOVE ZEROS TO WAGE-YTD-SUM (TBL-SUB) CL*93 01223 END-PERFORM. CL*92 01224 CL*92 01225 P7010-EXIT. CL*92 01226 EXIT. CL*92 01227 CL*92 01228 P7100-SCAN-WAGES. CL*79 01229 *& CL194 01230 * IF MPRF-EMP-NO = 010021 CL201 01231 * DISPLAY 'ENTER P7100-SCAN-WAGES ' TBL-SUB ' ' TBL-CNT CL201 01232 * ' ' WWGH-SSN ' ' WWGH-EMP-NO ' ' WWGH-YRQ. CL248 01233 *& CL194 01234 CL*90 01235 IF (WWGH-EMP-NO NOT = MPRF-EMP-NO) OR CL248 01236 (WWGH-YRQ > WRK-FOURTH-QTR-5-9) CL248 01237 SET L981-NO-REC-88 TO TRUE CL248 01238 GO TO P7100-EXIT CL*78 01239 ELSE CL*76 01240 IF WWGH-SSN < +1000000 CL248 01241 NEXT SENTENCE CL*76 01242 END-IF CL*76 01243 PERFORM P7110-FIND-INDEX THRU P7110-EXIT CL*78 01244 IF WRK-SSN-ERROR-NO-88 CL*76 01245 IF WRK-INDEX-SSN-FOUND-88 CL*76 01246 PERFORM P7300-ADD-WAGES THRU P7300-EXIT CL159 01247 ELSE CL*76 01248 MOVE WWGH-SSN TO WAGE-SSN (TBL-SUB) CL248 01249 PERFORM P7300-ADD-WAGES THRU P7300-EXIT CL159 01250 PERFORM P7200-GET-NAME THRU P7200-EXIT CL185 01251 END-IF CL*76 01252 ELSE CL*76 01253 ** DISPLAY 'SSN ERROR ' TBL-SUB ' ' TBL-CNT ' ' WWGH-SSN CL248 01254 ** ' ' WWGH-EMP-NO CL248 01255 ADD 1 TO WRK-SSN-ERROR CL107 01256 END-IF CL*99 01257 END-IF. CL*99 01258 CL*76 01259 PERFORM S981E-READ-NEXT THRU S981E-EXIT. CL248 01260 CL*76 01261 ** DISPLAY 'EXIT P7100-EXIT. '. CL*98 01262 P7100-EXIT. CL*78 01263 EXIT. CL*76 01264 CL*76 01265 P7110-FIND-INDEX. CL*78 01266 * DISPLAY 'P71-1 CNT ' TBL-CNT ' LAST SSN ' WRK-MAX-SSN CL101 01267 * ' TBL-SUB ' TBL-SUB. CL101 01268 SET WRK-INDEX-NULL-88 TO TRUE. CL*76 01269 CL*76 01270 IF WWGH-SSN > WRK-MAX-SSN CL248 01271 IF TBL-CNT < TBL-MAX CL*76 01272 ADD +1 TO TBL-CNT CL*76 01273 MOVE TBL-CNT TO TBL-SUB CL*76 01274 SET WRK-INDEX-POSITION-FOUND-88 TO TRUE CL*76 01275 MOVE WWGH-SSN TO WRK-MAX-SSN CL248 01276 ELSE CL*76 01277 SET WRK-SSN-ERROR-YES-88 TO TRUE CL*76 01278 END-IF CL*76 01279 ELSE CL*76 01280 PERFORM P7111-SEARCH-TABLE THRU P7111-EXIT CL*78 01281 IF WRK-INDEX-POSITION-FOUND-88 CL*76 01282 IF TBL-CNT < TBL-MAX CL*76 01283 PERFORM P7112-INSERT-SSN THRU P7112-EXIT CL*78 01284 ELSE CL*76 01285 SET WRK-SSN-ERROR-YES-88 TO TRUE CL*76 01286 END-IF CL*76 01287 END-IF CL*76 01288 END-IF. CL*76 01289 * DISPLAY 'P71-2 CNT ' TBL-CNT ' LAST SSN ' WRK-MAX-SSN CL101 01290 * ' IDX IND ' WRK-INDEX-IND ' TBL-SUB 'TBL-SUB. CL101 01291 P7110-EXIT. CL*78 01292 EXIT. CL*76 01293 CL*76 01294 P7111-SEARCH-TABLE. CL*78 01295 PERFORM CL*76 01296 VARYING SSN-SUB FROM +1 BY +1 CL*76 01297 UNTIL WRK-INDEX-FOUND-88 CL*76 01298 OR SSN-SUB > TBL-CNT CL*76 01299 IF WAGE-SSN (SSN-SUB) = WWGH-SSN CL248 01300 SET WRK-INDEX-SSN-FOUND-88 TO TRUE CL*76 01301 MOVE SSN-SUB TO TBL-SUB CL*76 01302 ELSE CL*76 01303 IF WWGH-SSN < WAGE-SSN (SSN-SUB) CL248 01304 MOVE SSN-SUB TO TBL-SUB CL*76 01305 SET WRK-INDEX-POSITION-FOUND-88 TO TRUE CL*76 01306 END-IF CL*76 01307 END-IF CL*76 01308 END-PERFORM. CL*76 01309 CL*76 01310 P7111-EXIT. CL*78 01311 EXIT. CL*76 01312 P7112-INSERT-SSN. CL*78 01313 CL*76 01314 PERFORM CL*76 01315 VARYING SSN-SUB FROM TBL-CNT BY -1 CL*76 01316 UNTIL SSN-SUB < TBL-SUB CL*76 01317 COMPUTE NXT-SUB = SSN-SUB + 1 CL*76 01318 MOVE WAGE-SSN (SSN-SUB) TO WAGE-SSN (NXT-SUB) CL*76 01319 MOVE WAGE-NAME-AREA (SSN-SUB) TO WAGE-NAME-AREA (NXT-SUB) CL*76 01320 MOVE WAGE-YTD-SUM (SSN-SUB) TO WAGE-YTD-SUM (NXT-SUB) CL*76 01321 PERFORM P7112A-INIT-TBL-ENTRY THRU P7112A-EXIT CL184 01322 END-PERFORM. CL*76 01323 CL*76 01324 ADD +1 TO TBL-CNT. CL*76 01325 CL*76 01326 P7112-EXIT. CL*78 01327 EXIT. CL*76 01328 CL*76 01329 P7112A-INIT-TBL-ENTRY. CL184 01330 MOVE ZERO TO WAGE-SSN (SSN-SUB) CL184 01331 WAGE-YTD-SUM (SSN-SUB). CL184 01332 MOVE SPACES TO WAGE-NAME-AREA (SSN-SUB). CL184 01333 CL184 01334 P7112A-EXIT. CL184 01335 EXIT. CL184 01336 CL184 01337 P7200-GET-NAME. CL185 01338 IF WWGH-SSN = WAGE-SSN (TBL-SUB) CL248 01339 AND WAGE-NAME-AREA (TBL-SUB) > SPACES CL191 01340 GO TO P7200-EXIT. CL189 01341 CL185 01342 MOVE LOW-VALUES TO WNAM-REC. CL185 01343 MOVE WWGH-SSN TO WNAM-SSN. CL248 01344 CL185 01345 PERFORM S982A-START-BROWSE THRU S982A-EXIT. CL185 01346 IF L982-OK-88 CL186 01347 IF WNAM-SSN = WWGH-SSN CL248 01348 IF WNAM-TYPE-FULL-88 CL204 01349 *& CL188 01350 * IF WWGH-EMP-NO = 010021 CL248 01351 * DISPLAY 'NAME ' WNAM-SSN ' ' WNAM-NAME CL204 01352 * END-IF CL204 01353 *& CL193 01354 MOVE WNAM-NAME TO WAGE-NAME-AREA (TBL-SUB) CL204 01355 END-IF CL204 01356 END-IF CL193 01357 END-IF. CL193 01358 CL185 01359 P7200-EXIT. CL185 01360 EXIT. CL185 01361 CL*77 01362 P7300-ADD-WAGES. CL159 01363 IF WRK-CURR-QTR-5-Q = 1 CL159 01364 NEXT SENTENCE CL159 01365 ELSE CL159 01366 ADD WWGH-EARNINGS TO WAGE-YTD-SUM (TBL-SUB) CL248 01367 WRK-WGH-YTD-WAGE CL248 01368 END-IF. CL159 01369 CL159 01370 P7300-EXIT. CL159 01371 EXIT. CL159 01372 CL159 01373 P8000-WRITE-WAGES. CL115 01374 IF TBL-CNT > TBL-HIGHEST CL110 01375 MOVE TBL-CNT TO TBL-HIGHEST. CL110 01376 CL110 01377 PERFORM P8100-WRITE-FEWR THRU P8100-EXIT CL123 01378 VARYING TBL-SUB FROM +1 BY +1 CL115 01379 UNTIL TBL-SUB > TBL-CNT. CL117 01380 CL115 01381 P8000-EXIT. CL*77 01382 EXIT. CL*77 01383 CL115 01384 P8100-WRITE-FEWR. CL123 01385 SET FEWR-TYPE-WAGE-EXP-88 TO TRUE. CL123 01386 SET FEWR-SUB-TYPE-DATA-88 TO TRUE. CL123 01387 CL115 01388 MOVE MPRF-EMP-NO TO FEWR-EMP-NO. CL123 01389 MOVE WAGE-SSN (TBL-SUB) TO FEWR-EMPL-SSN. CL123 01390 MOVE WAGE-FIRST-NAME (TBL-SUB) TO FEWR-FIRST-NAME. CL192 01391 MOVE WAGE-MI (TBL-SUB) TO FEWR-MIDDLE-INITIAL. CL192 01392 MOVE WAGE-LAST-NAME (TBL-SUB) TO FEWR-LAST-NAME. CL192 01393 MOVE WAGE-YTD-SUM (TBL-SUB) TO FEWR-YR-TO-DATE-WAGES. CL123 01394 *** MOVE SPACES TO FEWR-FILLER. CL131 01395 CL115 01396 CL121 01397 PERFORM S946-WRITE-FEWR THRU S946-EXIT. CL123 01398 CL115 01399 ADD +1 TO WRK-EFT-WRITTEN-CNTFEWR. CL123 01400 CL115 01401 P8100-EXIT. CL115 01402 EXIT. CL115 01403 CL115 01404 CL*77 01405 T0000-TERMINATE. EFTBX100 01406 CL*53 01407 PERFORM T1000-WRITE-TRAILER THRU T1000-EXIT. CL*19 01408 CL*19 01409 PERFORM T2000-WRITE-TRAILER THRU T2000-EXIT. CL*74 01410 CL*74 01411 DISPLAY '*********************************************'. CL**7 01412 DISPLAY '* EFTBX100 TERMINATION STATISTICS'. CL125 01413 DISPLAY '* '. CL**3 01414 DISPLAY '* 5% TOLERANCE '. CL147 01415 DISPLAY '* '. CL147 01416 DISPLAY '* MPRF RECORDS READ : ' CL*75 01417 WRK-MPRF-CNT. CL**3 01418 DISPLAY '* FESR EFT RECORDS WRITTEN : ' CL123 01419 WRK-EFT-WRITTEN-CNTFESR. CL123 01420 DISPLAY '* FESR EMPLOYERS WITH BALANCE: ' CL123 01421 WRK-BAL-DUE-CNT. CL**6 01422 MOVE WRK-TOT-BAL-DUE TO WRK-AMT-DISP. CL**6 01423 DISPLAY '* FESR TOTAL BALANCE DUE: : ' CL123 01424 WRK-AMT-DISP. CL**6 01425 DISPLAY '* INT COMP DATE : ' CL*75 01426 LECM-CURR-RUN-DATE. CL**9 01427 * DISPLAY '* SUCCESSORS : ' CL110 01428 * WRK-SUCC-CNT. CL110 01429 DISPLAY ' '. CL*75 01430 DISPLAY '* FEWR EFT RECORDS WRITTEN : ' CL123 01431 WRK-EFT-WRITTEN-CNTFEWR. CL123 01432 CL107 01433 DISPLAY ' '. CL107 01434 DISPLAY 'MAX EMPLOYEES ' TBL-HIGHEST. CL110 01435 MOVE WRK-SSN-ERROR TO WRK-SSN-ERROR-DISP. CL107 01436 DISPLAY '* SSN ERRORS COUNT = : ' CL107 01437 WRK-SSN-ERROR-DISP. CL107 01438 DISPLAY ' '. CL149 01439 DISPLAY 'WAGES FOUND ' CL149 01440 WRK-WAGES-FOUND-CNT. CL149 01441 DISPLAY ' '. CL152 01442 DISPLAY 'WAGES MATCH ' CL152 01443 WRK-WAGES-OK-CNT. CL152 01444 DISPLAY ' '. CL139 01445 DISPLAY 'WAGE DIFFERENCES ' CL139 01446 WRK-MISSING-WAGE-CNT. CL139 01447 DISPLAY ' '. CL183 01448 DISPLAY 'MISSING QUARTER ' CL183 01449 WRK-MQTR-MISSING-CNT. CL183 01450 DISPLAY ' '. CL148 01451 DISPLAY 'NO WAGES ON FILE ' CL148 01452 WRK-NO-WAGE-CNT. CL148 01453 DISPLAY '*********************************************'. CL**7 01454 CL**3 01455 CL*58 01456 PERFORM S981C-CLOSE THRU S981C-EXIT. CL248 01457 PERFORM S982D-CLOSE THRU S982D-EXIT. CL186 01458 CL*73 01459 T0000-EXIT. EFTBX100 01460 EXIT. EFTBX100 01461 CL*19 01462 T1000-WRITE-TRAILER. CL*19 01463 CL*23 01464 SET FTRL-TYPE-EMP-STATUS-88 TO TRUE. CL123 01465 SET FTRL-SUB-TYPE-TRAILER-88 TO TRUE. CL123 01466 CL*26 01467 MOVE WRK-EFT-WRITTEN-CNTFESR TO FTRL-RECORD-CNT. CL123 01468 MOVE ZERO TO FTRL-TOT-AMOUNT. CL123 01469 *NO MOVE WRK-TOT-BAL-DUE TO FTRL-TOT-AMOUNT. CL123 01470 *** MOVE SPACES TO FTRL-FILLER. CL131 01471 CL*19 01472 PERFORM S946-WRITE-TRAILER THRU S946-EXIT. CL121 01473 CL121 01474 CL*19 01475 T1000-EXIT. CL*19 01476 EXIT. CL*19 01477 T2000-WRITE-TRAILER. CL*74 01478 CL*74 01479 SET FTRL-TYPE-WAGE-EXP-88 TO TRUE. CL123 01480 SET FTRL-SUB-TYPE-TRAILER-88 TO TRUE. CL123 01481 CL*74 01482 ** INCREMENT RECORD COUNT BY 2 TO INCLUDE HEADER CL*74 01483 ** AND TRAILER RECORDS. CL*74 01484 ** CL*74 01485 ADD +2 TO WRK-EFT-WRITTEN-CNTFEWR. CL123 01486 MOVE WRK-EFT-WRITTEN-CNTFEWR TO FTRL-RECORD-CNT. CL123 01487 MOVE ZERO TO FTRL-TOT-AMOUNT. CL123 01488 *NO MOVE WRK-TOT-BAL-DUE TO FTRL-TOT-AMOUNT. CL123 01489 *** MOVE SPACES TO FTRL-FILLER. CL131 01490 CL*74 01491 PERFORM S946-WRITE-TRAILER THRU S946-EXIT. CL121 01492 CL*74 01493 T2000-EXIT. CL*74 01494 EXIT. CL*74 01495 CL*74 01496 S001-FROM-FED-8. CL234 01497 SET L001-FROM-FED-8 TO TRUE. CL234 01498 GO TO S001-DATE. CL234 01499 CL234 01500 S001-FROM-ABS-DAY. CL234 01501 SET L001-FROM-ABS-DAY TO TRUE. CL234 01502 GO TO S001-DATE. CL234 01503 CL234 01504 S001-DATE. CL234 01505 CALL 'DTSBU001' USING L001-LINK-AREA. CL234 01506 S001-EXIT. CL234 01507 EXIT. CL234 01508 CL234 01509 S003-AGENCY-DAY. CL234 01510 SET L003-AGENCY-DAY TO TRUE. CL234 01511 GO TO S003-WORK-DAY. CL234 01512 CL234 01513 S003-WORK-DAY. CL234 01514 CALL 'DTSBU003' USING L003-LINK-AREA. CL234 01515 S003-EXIT. CL234 01516 EXIT. CL234 01517 CL234 01518 S004-FROM-DATE. CL*33 01519 SET L004-FROM-DATE TO TRUE. CL*33 01520 GO TO S004-QTR. CL*33 01521 CL*33 01522 S004-FROM-5. CL*33 01523 SET L004-FROM-5 TO TRUE. CL*33 01524 GO TO S004-QTR. CL*33 01525 CL*33 01526 S004-FROM-ABS. CL*33 01527 SET L004-FROM-ABS TO TRUE. CL*33 01528 GO TO S004-QTR. CL*33 01529 CL*33 01530 S004-FROM-3. CL*33 01531 SET L004-FROM-3 TO TRUE. CL*33 01532 GO TO S004-QTR. CL*33 01533 CL*33 01534 S004-QTR. CL*33 01535 CALL 'DTSBU004' USING L004-LINK-AREA. CL*33 01536 S004-EXIT. CL*33 01537 EXIT. CL*33 01538 CL*33 01539 S101-PER-MONTH-NO. CL**8 01540 SET L101-PER-MONTH-NO-88 TO TRUE. CL**8 01541 GO TO S101-INT-CHARGE. CL**8 01542 CL**8 01543 S101-INT-CHARGE. CL**8 01544 CALL 'DTSBU101' USING L101-LINK-AREA. CL**8 01545 S101-EXIT. CL**8 01546 EXIT. CL**8 01547 CL**8 01548 S516-LIABILITY. CL*33 01549 CALL 'DTSBU516' USING L516-LINK-AREA CL*33 01550 MPRF-LINK-REC. CL*33 01551 S516-EXIT. CL*33 01552 EXIT. CL*33 01553 CL*33 01554 S910-OPEN-READ. CL*30 01555 SET L910-OPEN-READ-88 TO TRUE. CL*30 01556 GO TO S910-MSTR-IO. CL*30 01557 CL*30 01558 S910-OPEN-UPDATE-NO-AIX. CL*30 01559 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. CL*30 01560 GO TO S910-MSTR-IO. CL*30 01561 CL*30 01562 S910-READ. CL*30 01563 SET L910-READ-88 TO TRUE. CL*30 01564 GO TO S910-MSTR-IO. CL*30 01565 CL*30 01566 S910-START-BROWSE. CL**9 01567 SET L910-START-BROWSE-88 TO TRUE. CL**9 01568 GO TO S910-MSTR-IO. CL**9 01569 CL*30 01570 S910-READ-NEXT. CL**9 01571 SET L910-READ-NEXT-88 TO TRUE. CL**9 01572 GO TO S910-MSTR-IO. CL**9 01573 CL*30 01574 S910-MSTR-IO. CL**9 01575 CALL 'DTSBU910' USING L910-LINK-AREA CL**9 01576 MSKL-REC. CL**9 01577 S910-EXIT. CL**9 01578 EXIT. CL**9 01579 CL*74 01580 S931-READ. CL179 01581 SET L931-READ-88 TO TRUE. CL179 01582 GO TO S931-REF-IO. CL179 01583 SKIP1 CL179 01584 S931-REF-IO. CL179 01585 CALL 'DTSBU931' USING L931-LINK-AREA CL179 01586 FSKL-REC. CL179 01587 S931-EXIT. EXIT. CL179 01588 CL121 01589 S946-WRITE-HEADER. CL121 01590 CL121 01591 CALL 'DTSBU946' USING FHDR-REC. CL124 01592 GO TO S946-EXIT. CL121 01593 CL121 01594 S946-WRITE-GLOBAL. CL179 01595 CL179 01596 CALL 'DTSBU946' USING FGRD-REC. CL179 01597 GO TO S946-EXIT. CL179 01598 CL179 01599 S946-WRITE-FESR. CL123 01600 CL121 01601 CALL 'DTSBU946' USING FESR-REC. CL123 01602 GO TO S946-EXIT. CL121 01603 S946-WRITE-FEWR. CL123 01604 CL121 01605 CALL 'DTSBU946' USING FEWR-REC. CL123 01606 GO TO S946-EXIT. CL121 01607 S946-WRITE-TRAILER. CL121 01608 CL121 01609 CALL 'DTSBU946' USING FTRL-REC. CL124 01610 GO TO S946-EXIT. CL121 01611 S946-EXIT. CL121 01612 EXIT. CL121 01613 CL121 01614 S981A-OPEN-READ. CL248 01615 SET L981-OPEN-READ-88 TO TRUE. CL248 01616 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. CL248 01617 CL*74 01618 S981A-EXIT. CL248 01619 EXIT. CL*74 01620 CL*74 01621 S981C-CLOSE. CL248 01622 SET L981-CLOSE-88 TO TRUE. CL248 01623 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. CL248 01624 CL*74 01625 S981C-EXIT. CL248 01626 EXIT. CL*74 01627 CL*74 01628 S981D-START-BROWSE. CL248 01629 SET L981-START-BROWSE-88 TO TRUE. CL248 01630 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. CL248 01631 CL*74 01632 S981D-EXIT. CL248 01633 EXIT. CL*74 01634 CL*74 01635 S981E-READ-NEXT. CL248 01636 SET L981-READ-NEXT-88 TO TRUE. CL248 01637 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. CL248 01638 CL*74 01639 S981E-EXIT. CL248 01640 EXIT. CL*74 01641 CL*74 01642 S981Z-WAGE-I. CL248 01643 CALL 'DTSBU981' USING L981-LINK-AREA CL248 01644 WWGH-REC. CL248 01645 S981Z-EXIT. CL248 01646 EXIT. CL*74 01647 CL*74 01648 S982A-START-BROWSE. CL185 01649 SET L982-START-BROWSE-88 TO TRUE. CL185 01650 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL185 01651 CL185 01652 S982A-EXIT. CL185 01653 EXIT. CL185 01654 CL185 01655 S982C-OPEN-READ. CL185 01656 SET L982-OPEN-READ-88 TO TRUE. CL185 01657 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL185 01658 CL185 01659 S982C-EXIT. CL185 01660 EXIT. CL185 01661 CL185 01662 S982D-CLOSE. CL185 01663 SET L982-CLOSE-88 TO TRUE. CL185 01664 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL185 01665 CL185 01666 S982D-EXIT. CL185 01667 EXIT. CL185 01668 CL185 01669 S982Z-WNAM-IO. CL186 01670 CALL 'DTSBU982' USING L982-LINK-AREA CL185 01671 WNAM-REC. CL185 01672 S982Z-EXIT. CL185 01673 EXIT. CL185 01674 CL*74 01675 S999-ABEND. EFTBX100 01676 DISPLAY '*** DTSBE800 ABENDING. ' CL*25 01677 ABEND-MSG. EFTBX100 01678 EFTBX100 01679 CALL 'DTSBU999' USING WRK-ABEND-CD. EFTBX100 01680 S999-EXIT. EFTBX100 01681 EXIT. EFTBX100