1683 lines
133 KiB
COBOL
1683 lines
133 KiB
COBOL
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
|