750 lines
59 KiB
COBOL
750 lines
59 KiB
COBOL
00001 IDENTIFICATION DIVISION. 07/16/04
|
|
00002 PROGRAM-ID. DTSBD331. DTSBD331
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV034
|
|
00004 DATE-WRITTEN. NOVEMBER 1998. DTSBD331
|
|
00005 DATE-COMPILED. DTSBD331
|
|
00006 SKIP2 DTSBD331
|
|
00007 ***** DTSBD331
|
|
00008 * DTSBD331
|
|
00009 * FUNCTION: TAX DOWNLOAD AND WAGE DOWNLOAD PROCESSING. DTSBD331
|
|
00010 * DTSBD331
|
|
00011 * DTSBD331
|
|
00012 * MODIFICATION LOG: DTSBD331
|
|
00013 * DTSBD331
|
|
00014 * 10/23/2000 CORRECTED A PROBLEM WITH 'LEFT-OVER' DATA IN SOMEDTSBD331
|
|
00015 * R603- & R604- FIELDS. PROGRAMMER: JHP DTSBD331
|
|
00016 * DTSBD331
|
|
00017 * 11/18/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACBD331. DTSBD331
|
|
00018 * WORK ORDER: PROGRAMMER: GD DTSBD331
|
|
00019 * DTSBD331
|
|
00020 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD331
|
|
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD331
|
|
00022 * WORK ORDER: PROGRAMMER: XXX DTSBD331
|
|
00023 * DTSBD331
|
|
00024 * DTSBD331
|
|
00025 * DESCRIPTION: DTSBD331
|
|
00026 * DTSBD331
|
|
00027 * IF T021-DOWNLOAD-TAX: DTSBD331
|
|
00028 * DTSBD331
|
|
00029 * READ THE INDICATED FIELD ASSIGNMENT. DTSBD331
|
|
00030 * DTSBD331
|
|
00031 * IF THE FIELD ASSIGNMENT IS FOUND DTSBD331
|
|
00032 * DTSBD331
|
|
00033 * CONSTRUCT AND WRITE ONE R603 RECORD (SEE THE DTSBD331
|
|
00034 * EXTERNAL DESIGN FOR DETAILS) DTSBD331
|
|
00035 * DTSBD331
|
|
00036 * ELSE DTSBD331
|
|
00037 * DTSBD331
|
|
00038 * FAIL THE TRANSACTION. DTSBD331
|
|
00039 * DTSBD331
|
|
00040 * DTSBD331
|
|
00041 * DO ONLY ONE TAX DOWNLOAD FOR ANY GIVEN ASSIGNMENT. DTSBD331
|
|
00042 * YOU CAN DEPEND ON THE T021 TRANSACTIONS TO ARRIVE DTSBD331
|
|
00043 * IN ASSIGN-NO (WITHIN EMP-NO) SEQUENCE. IGNORE TAX DTSBD331
|
|
00044 * DOWNLOAD REQUESTS TWO THRU N FOR A GIVEN DTSBD331
|
|
00045 * EMP-NO+ASSIGN-NO. DTSBD331
|
|
00046 * DTSBD331
|
|
00047 * DTSBD331
|
|
00048 * DTSBD331
|
|
00049 * IF T021-DOWNLOAD-WAGE: DTSBD331
|
|
00050 * DTSBD331
|
|
00051 * READ THE INDICATED FIELD ASSIGNMENT. DTSBD331
|
|
00052 * DTSBD331
|
|
00053 * IF THE FIELD ASSIGNMENT IS FOUND DTSBD331
|
|
00054 * DTSBD331
|
|
00055 * CONSTRUCT AND WRITE ONE R604 RECORD (SEE THE DTSBD331
|
|
00056 * EXTERNAL DESIGN FOR DETAILS) DTSBD331
|
|
00057 * DTSBD331
|
|
00058 * ELSE DTSBD331
|
|
00059 * DTSBD331
|
|
00060 * FAIL THE TRANSACTION. DTSBD331
|
|
00061 * DTSBD331
|
|
00062 * DTSBD331
|
|
00063 * DO ONLY ONE WAGE DOWNLOAD FOR ANY GIVEN ASSIGNMENT. DTSBD331
|
|
00064 * YOU CAN DEPEND ON THE T021 TRANSACTIONS TO ARRIVE DTSBD331
|
|
00065 * IN ASSIGN-NO (WITHIN EMP-NO) SEQUENCE. IGNORE WAGE DTSBD331
|
|
00066 * DOWNLOAD REQUESTS TWO THRU N FOR A GIVEN DTSBD331
|
|
00067 * EMP-NO+ASSIGN-NO. DTSBD331
|
|
00068 * DTSBD331
|
|
00069 * DTSBD331
|
|
00070 * MASTER FILE RECORDS READ: DTSBD331
|
|
00071 * DTSBD331
|
|
00072 * MFAS DTSBD331
|
|
00073 * MOPO DTSBD331
|
|
00074 * MTAD DTSBD331
|
|
00075 * MQTR DTSBD331
|
|
00076 * DTSBD331
|
|
00077 * DTSBD331
|
|
00078 * MASTER FILE RECORDS UPDATED: DTSBD331
|
|
00079 * DTSBD331
|
|
00080 * NONE. DTSBD331
|
|
00081 * DTSBD331
|
|
00082 * DTSBD331
|
|
00083 * REPORT RECORDS WRITTEN: DTSBD331
|
|
00084 * DTSBD331
|
|
00085 * R603 FIELD ASSIGNMENT EXPORT (TAX). DTSBD331
|
|
00086 * R604 FIELD ASSIGNMENT EXPORT (WAGE). DTSBD331
|
|
00087 * DTSBD331
|
|
00088 * DTSBD331
|
|
00089 * MODULES CALLED: DTSBD331
|
|
00090 * DTSBD331
|
|
00091 * DTSBU004 ABSOLUTE QUARTER. DTSBD331
|
|
00092 * DTSBU062 FIELD REP ID EDIT/DESCRIPTION. DTSBD331
|
|
00093 * DTSBU112 FORMAT ADDRESS. DTSBD331
|
|
00094 * DTSBU910 MASTER FILE I/O. DTSBD331
|
|
00095 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD331
|
|
00096 * DTSBD331
|
|
00097 * DTSBD331
|
|
00098 ***** DTSBD331
|
|
00099 SKIP2 DTSBD331
|
|
00100 ENVIRONMENT DIVISION. DTSBD331
|
|
00101 EJECT DTSBD331
|
|
00102 DATA DIVISION. DTSBD331
|
|
00103 WORKING-STORAGE SECTION. DTSBD331
|
|
001035 77 PAN-VALET PICTURE X(24) VALUE '034DTSBD331 07/16/04'. DTSBD331
|
|
00104 DTSBD331
|
|
00105 01 WRK-AREA. DTSBD331
|
|
00106 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +331.DTSBD331
|
|
00107 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD331'.DTSBD331
|
|
00108 DTSBD331
|
|
00109 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD331
|
|
00110 DTSBD331
|
|
00111 05 LAST-R603-EMP-NO PIC S9(07) COMP-3. DTSBD331
|
|
00112 05 LAST-R604-EMP-NO PIC S9(07) COMP-3. DTSBD331
|
|
00113 05 LAST-R603-ASSIGN-NO PIC S9(09) COMP-3. DTSBD331
|
|
00114 05 LAST-R604-ASSIGN-NO PIC S9(09) COMP-3. DTSBD331
|
|
00115 DTSBD331
|
|
00116 05 WRK-QTR-SUB PIC S9(04) COMP. DTSBD331
|
|
00117 05 WRK-ACCT-SUB PIC S9(04) COMP. DTSBD331
|
|
00118 05 WRK-CNT PIC S9(04) COMP. DTSBD331
|
|
00119 05 WRK-YRQ PIC 9(05). DTSBD331
|
|
00120 05 FILLER REDEFINES WRK-YRQ. DTSBD331
|
|
00121 10 WRK-YR PIC 9(04). DTSBD331
|
|
00122 10 WRK-Q PIC 9(01). DTSBD331
|
|
00123 05 WRK-ABS-START-QTR PIC S9(04) COMP. DTSBD331
|
|
00124 05 WRK-ABS-END-QTR PIC S9(04) COMP. DTSBD331
|
|
00125 05 WRK-START-QTR PIC S9(05) COMP-3. DTSBD331
|
|
00126 05 WRK-END-QTR PIC S9(05) COMP-3. DTSBD331
|
|
00127 05 WRK-MAIL-ADDR PIC X(200). DTSBD331
|
|
00128 05 WRK-MAIL-PHONE PIC X(15). DTSBD331
|
|
00129 05 WRK-PHYS-ADDR PIC X(200). DTSBD331
|
|
00130 05 WRK-PHYS-PHONE PIC X(15). DTSBD331
|
|
00131 SKIP2 DTSBD331
|
|
00132 01 MSG-TABLE. DTSBD331
|
|
00133 DTSBD331
|
|
00134 05 MSG1-ASSIGN-NO-NOT-FOUND. DTSBD331
|
|
00135 10 MSG1-ID PIC X(11) VALUE 'DTSBD331601'. DTSBD331
|
|
00136 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'ASSIGN NO ERR '. DTSBD331
|
|
00137 10 MSG1-LONG-TEXT. DTSBD331
|
|
00138 15 FILLER PIC X(31) DTSBD331
|
|
00139 VALUE 'TRANSACTION FAILED - ASSIGN NO '. DTSBD331
|
|
00140 15 MSG1-ASSIGN-NO DTSBD331
|
|
00141 PIC 99B99999. DTSBD331
|
|
00142 15 FILLER PIC X(15) DTSBD331
|
|
00143 VALUE ' DOES NOT EXIST'. DTSBD331
|
|
00144 DTSBD331
|
|
00145 05 MSG2-FIELD-REP-OPID-INVALID. DTSBD331
|
|
00146 10 MSG2-ID PIC X(11) VALUE 'DTSBD331611'. DTSBD331
|
|
00147 10 MSG2-SHORT-TEXT PIC X(20) DTSBD331
|
|
00148 VALUE 'INVALID FLD REP OPID'. DTSBD331
|
|
00149 10 MSG2-LONG-TEXT. DTSBD331
|
|
00150 15 FILLER PIC X(30) DTSBD331
|
|
00151 VALUE 'TRANSACTION FAILED - FIELD REP'. DTSBD331
|
|
00152 15 FILLER PIC X(22) DTSBD331
|
|
00153 VALUE ' OPID ERR - ASSIGN NO '. DTSBD331
|
|
00154 15 MSG2-ASSIGN-NO DTSBD331
|
|
00155 PIC 99B99999. DTSBD331
|
|
00156 DTSBD331
|
|
00157 05 MSG3-INVALID-TRN-CD. DTSBD331
|
|
00158 10 MSG3-ID PIC X(11) VALUE 'DTSBD331905'. DTSBD331
|
|
00159 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'INVALID TRN CD'. DTSBD331
|
|
00160 10 MSG3-LONG-TEXT. DTSBD331
|
|
00161 15 FILLER PIC X(30) DTSBD331
|
|
00162 VALUE 'TRANSACTION FAILED - TRANSACTI'. DTSBD331
|
|
00163 15 FILLER PIC X(30) DTSBD331
|
|
00164 VALUE 'ON CODE NOT VALID '. DTSBD331
|
|
00165 EJECT DTSBD331
|
|
00166 01 L004-LINK-AREA. DTSBD331
|
|
00167 ++INCLUDE DTSIL004 DTSBD331
|
|
00168 EJECT DTSBD331
|
|
00169 01 L062-LINK-AREA. DTSBD331
|
|
00170 ++INCLUDE DTSIL062 DTSBD331
|
|
00171 EJECT DTSBD331
|
|
00172 01 L112-LINK-AREA. DTSBD331
|
|
00173 ++INCLUDE DTSIL112 DTSBD331
|
|
00174 EJECT DTSBD331
|
|
00175 01 L910-LINK-AREA. DTSBD331
|
|
00176 ++INCLUDE DTSIL910 DTSBD331
|
|
00177 EJECT DTSBD331
|
|
00178 01 MSKL-REC. DTSBD331
|
|
00179 ++INCLUDE DTSIMSKL DTSBD331
|
|
00180 EJECT DTSBD331
|
|
00181 01 MFAS-REC. DTSBD331
|
|
00182 ++INCLUDE DTSIMFAS DTSBD331
|
|
00183 EJECT DTSBD331
|
|
00184 01 MTAD-REC. DTSBD331
|
|
00185 ++INCLUDE DTSIMTAD DTSBD331
|
|
00186 EJECT DTSBD331
|
|
00187 01 MOPO-REC. DTSBD331
|
|
00188 ++INCLUDE DTSIMOPO DTSBD331
|
|
00189 EJECT DTSBD331
|
|
00190 01 MQTR-REC. DTSBD331
|
|
00191 ++INCLUDE DTSIMQTR DTSBD331
|
|
00192 EJECT DTSBD331
|
|
00193 01 L931-LINK-AREA. DTSBD331
|
|
00194 ++INCLUDE DTSIL931 DTSBD331
|
|
00195 EJECT DTSBD331
|
|
00196 01 FSKL-REC. DTSBD331
|
|
00197 ++INCLUDE DTSIFSKL DTSBD331
|
|
00198 EJECT DTSBD331
|
|
00199 01 FCYR-REC. DTSBD331
|
|
00200 ++INCLUDE DTSIFCYR DTSBD331
|
|
00201 EJECT DTSBD331
|
|
00202 01 RSKL-REC. DTSBD331
|
|
00203 ++INCLUDE DTSIRSK3 DTSBD331
|
|
00204 EJECT DTSBD331
|
|
00205 01 R603-REC. DTSBD331
|
|
00206 ++INCLUDE DTSIR603 DTSBD331
|
|
00207 EJECT DTSBD331
|
|
00208 01 R604-REC. DTSBD331
|
|
00209 ++INCLUDE DTSIR604 DTSBD331
|
|
00210 EJECT DTSBD331
|
|
00211 LINKAGE SECTION. DTSBD331
|
|
00212 SKIP2 DTSBD331
|
|
00213 01 LBCM-LINK-AREA. DTSBD331
|
|
00214 ++INCLUDE DTSILBCM DTSBD331
|
|
00215 EJECT DTSBD331
|
|
00216 01 MPRF-REC. DTSBD331
|
|
00217 ++INCLUDE DTSIMPRF DTSBD331
|
|
00218 EJECT DTSBD331
|
|
00219 01 T021-REC. DTSBD331
|
|
00220 ++INCLUDE DTSIT021 DTSBD331
|
|
00221 EJECT DTSBD331
|
|
00222 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD331
|
|
00223 MPRF-REC DTSBD331
|
|
00224 T021-REC. DTSBD331
|
|
00225 DTSBD331
|
|
00226 IF FIRST-TIME-IND = 'Y' DTSBD331
|
|
00227 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBD331
|
|
00228 MOVE 'N' TO FIRST-TIME-IND. DTSBD331
|
|
00229 SKIP2 DTSBD331
|
|
00230 IF T021-DOWNLOAD-TAX DTSBD331
|
|
00231 PERFORM P1000-DL-TAX THRU P1000-EXIT DTSBD331
|
|
00232 ELSE DTSBD331
|
|
00233 IF T021-DOWNLOAD-WAGE DTSBD331
|
|
00234 PERFORM P2000-DL-WAGE THRU P2000-EXIT DTSBD331
|
|
00235 ELSE DTSBD331
|
|
00236 MOVE MSG3-INVALID-TRN-CD TO LBCM-TRN-MSG-AREA DTSBD331
|
|
00237 SET LBCM-TRN-NOT-OK-88 TO TRUE. DTSBD331
|
|
00238 SKIP2 DTSBD331
|
|
00239 GOBACK. DTSBD331
|
|
00240 SKIP2 DTSBD331
|
|
00241 SKIP2 DTSBD331
|
|
00242 I0000-INITIATE. DTSBD331
|
|
00243 MOVE LBCM-TRACE-IND TO L910-TRACE-IND DTSBD331
|
|
00244 L931-TRACE-IND. DTSBD331
|
|
00245 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD331
|
|
00246 L931-MOD-NAME. DTSBD331
|
|
00247 DTSBD331
|
|
00248 MOVE LENGTH OF R603-REC TO R603-LENGTH. DTSBD331
|
|
00249 MOVE LENGTH OF R604-REC TO R604-LENGTH. DTSBD331
|
|
00250 MOVE '603' TO R603-REC-TYPE. DTSBD331
|
|
00251 MOVE '604' TO R604-REC-TYPE. DTSBD331
|
|
00252 DTSBD331
|
|
00253 MOVE +0 TO LAST-R603-EMP-NO DTSBD331
|
|
00254 LAST-R604-EMP-NO DTSBD331
|
|
00255 LAST-R603-ASSIGN-NO DTSBD331
|
|
00256 LAST-R604-ASSIGN-NO. DTSBD331
|
|
00257 I0000-EXIT. EXIT. DTSBD331
|
|
00258 EJECT DTSBD331
|
|
00259 P1000-DL-TAX. DTSBD331
|
|
00260 DTSBD331
|
|
00261 IF MPRF-EMP-NO = LAST-R603-EMP-NO DTSBD331
|
|
00262 AND T021-ASSIGN-NO = LAST-R603-ASSIGN-NO DTSBD331
|
|
00263 GO TO P1000-EXIT DTSBD331
|
|
00264 ELSE DTSBD331
|
|
00265 MOVE MPRF-EMP-NO TO LAST-R603-EMP-NO DTSBD331
|
|
00266 MOVE T021-ASSIGN-NO TO LAST-R603-ASSIGN-NO. DTSBD331
|
|
00267 DTSBD331
|
|
00268 MOVE LOW-VALUE TO MFAS-KEY-AREA. DTSBD331
|
|
00269 MOVE MPRF-EMP-NO TO MFAS-EMP-NO. DTSBD331
|
|
00270 SET MFAS-FAS-88 TO TRUE. DTSBD331
|
|
00271 MOVE T021-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSBD331
|
|
00272 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBD331
|
|
00273 PERFORM S910-READ THRU S910-EXIT. DTSBD331
|
|
00274 IF L910-NO-REC-88 DTSBD331
|
|
00275 MOVE T021-ASSIGN-NO TO MSG1-ASSIGN-NO DTSBD331
|
|
00276 MOVE MSG1-ASSIGN-NO-NOT-FOUND TO LBCM-TRN-MSG-AREA DTSBD331
|
|
00277 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD331
|
|
00278 GO TO P1000-EXIT. DTSBD331
|
|
00279 MOVE MSKL-REC TO MFAS-REC. DTSBD331
|
|
00280 SKIP2 DTSBD331
|
|
00281 MOVE MFAS-FLD-REP-ID TO R603-FIELD-REP-ID. DTSBD331
|
|
00282 MOVE MFAS-ASSIGN-NO TO R603-ASSIGN-NO. DTSBD331
|
|
00283 INITIALIZE R603-DATA-AREA. DTSBD331
|
|
00284 *------------------------------------------- DTSBD331
|
|
00285 * E - EMPLOYER INFO DTSBD331
|
|
00286 *------------------------------------------- DTSBD331
|
|
00287 MOVE MPRF-EMP-NO TO R603-EMP-NO. DTSBD331
|
|
00288 MOVE MPRF-PRIMARY-NAME TO R603-PRIMARY-NAME. DTSBD331
|
|
00289 MOVE MPRF-FEIN TO R603-FEIN. DTSBD331
|
|
00290 MOVE MPRF-ORG-TYPE TO R603-ORG-TYPE. DTSBD331
|
|
00291 MOVE MPRF-SIC-CD TO R603-SIC-CD. DTSBD331
|
|
00292 MOVE MPRF-NAICS-CD TO R603-NAICS-CD. DTSBD331
|
|
00293 DTSBD331
|
|
00294 PERFORM P3000-RETRIEVE-TAX-ADDRESSES THRU P3000-EXIT. DTSBD331
|
|
00295 MOVE WRK-MAIL-ADDR TO R603-MAIL-ADDR. DTSBD331
|
|
00296 MOVE WRK-MAIL-PHONE TO R603-MAIL-VOICE-1. DTSBD331
|
|
00297 MOVE WRK-PHYS-ADDR TO R603-PHYS-ADDR. DTSBD331
|
|
00298 MOVE WRK-PHYS-PHONE TO R603-PHYS-VOICE-1. DTSBD331
|
|
00299 *& IF LBCM-TRN-NOT-OK-88 DTSBD331
|
|
00300 *& GO TO P1000-EXIT. DTSBD331
|
|
00301 DTSBD331
|
|
00302 IF MPRF-TOT-CREDIT-AMT > 0 DTSBD331
|
|
00303 MOVE 'Y' TO R603-CREDIT-IND DTSBD331
|
|
00304 ELSE DTSBD331
|
|
00305 MOVE 'N' TO R603-CREDIT-IND. DTSBD331
|
|
00306 IF MPRF-TOT-BALANCE-AMT > 0 DTSBD331
|
|
00307 OR MPRF-PURSUED-RPT-CNT > 0 DTSBD331
|
|
00308 MOVE 'Y' TO R603-DEBIT-IND DTSBD331
|
|
00309 ELSE DTSBD331
|
|
00310 MOVE 'N' TO R603-DEBIT-IND. DTSBD331
|
|
00311 MOVE MFAS-START-DATE TO R603-START-DATE. DTSBD331
|
|
00312 MOVE MFAS-START-YRQ TO R603-AUDIT-START-YRQ. DTSBD331
|
|
00313 MOVE MFAS-END-YRQ TO R603-AUDIT-END-YRQ. DTSBD331
|
|
00314 MOVE MFAS-AUDIT-IND TO R603-AUDIT-IND. DTSBD331
|
|
00315 DTSBD331
|
|
00316 MOVE MFAS-FLD-REP-ID TO L062-FLD-REP-ID. DTSBD331
|
|
00317 PERFORM S062-OPID THRU S062-EXIT. DTSBD331
|
|
00318 IF L062-VALID DTSBD331
|
|
00319 MOVE L062-OP-ID TO R603-FIELD-REP-OPID DTSBD331
|
|
00320 ELSE DTSBD331
|
|
00321 MOVE T021-ASSIGN-NO TO MSG2-ASSIGN-NO DTSBD331
|
|
00322 MOVE MSG2-FIELD-REP-OPID-INVALID TO LBCM-TRN-MSG-AREA DTSBD331
|
|
00323 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD331
|
|
00324 GO TO P1000-EXIT. DTSBD331
|
|
00325 *------------------------------------------- DTSBD331
|
|
00326 * Q - QUARTER INFO DTSBD331
|
|
00327 *------------------------------------------- DTSBD331
|
|
00328 IF MFAS-START-YRQ = +0 DTSBD331
|
|
00329 NEXT SENTENCE DTSBD331
|
|
00330 ELSE DTSBD331
|
|
00331 MOVE MFAS-START-YRQ TO L004-QTR-5-9 DTSBD331
|
|
00332 PERFORM S004-FROM-5 THRU S004-EXIT DTSBD331
|
|
00333 DTSBD331
|
|
00334 MOVE LOW-VALUE TO MQTR-KEY-AREA DTSBD331
|
|
00335 MOVE MPRF-EMP-NO TO MQTR-EMP-NO DTSBD331
|
|
00336 SET MQTR-QTR-88 TO TRUE DTSBD331
|
|
00337 PERFORM P1200-LOAD-QUARTER-INFO THRU P1200-EXIT DTSBD331
|
|
00338 VARYING WRK-QTR-SUB FROM +1 BY +1 DTSBD331
|
|
00339 UNTIL WRK-QTR-SUB > +12 DTSBD331
|
|
00340 OR L004-QTR-5-9 > MFAS-END-YRQ. DTSBD331
|
|
00341 *------------------------------------------- DTSBD331
|
|
00342 * O - OWNER/PARTNER/OFFICER INFO DTSBD331
|
|
00343 *------------------------------------------- DTSBD331
|
|
00344 MOVE +0 TO R603-OPO-CNT. DTSBD331
|
|
00345 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD331
|
|
00346 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD331
|
|
00347 SET MSKL-OPO-88 TO TRUE. DTSBD331
|
|
00348 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD331
|
|
00349 PERFORM UNTIL L910-NO-REC-88 DTSBD331
|
|
00350 OR R603-OPO-CNT = +5 DTSBD331
|
|
00351 MOVE MSKL-REC TO MOPO-REC DTSBD331
|
|
00352 ADD +1 TO R603-OPO-CNT DTSBD331
|
|
00353 MOVE MOPO-NAME TO R603-OPO-NAME (R603-OPO-CNT) DTSBD331
|
|
00354 MOVE MOPO-TITLE TO R603-OPO-TITLE (R603-OPO-CNT) DTSBD331
|
|
00355 MOVE MOPO-SSN TO R603-OPO-SSN (R603-OPO-CNT) DTSBD331
|
|
00356 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD331
|
|
00357 END-PERFORM. DTSBD331
|
|
00358 SKIP2 DTSBD331
|
|
00359 MOVE R603-REC TO RSKL-REC. DTSBD331
|
|
00360 PERFORM S946-RPT-REC THRU S946-EXIT. DTSBD331
|
|
00361 DTSBD331
|
|
00362 P1000-EXIT. EXIT. DTSBD331
|
|
00363 EJECT DTSBD331
|
|
00364 P1200-LOAD-QUARTER-INFO. DTSBD331
|
|
00365 DTSBD331
|
|
00366 MOVE L004-QTR-5-9 TO R603-QTR-YRQ (WRK-QTR-SUB) DTSBD331
|
|
00367 MQTR-YRQ. DTSBD331
|
|
00368 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD331
|
|
00369 PERFORM S910-READ THRU S910-EXIT. DTSBD331
|
|
00370 IF L910-OK-88 DTSBD331
|
|
00371 ADD +1 TO R603-QTR-CNT DTSBD331
|
|
00372 MOVE MSKL-REC TO MQTR-REC DTSBD331
|
|
00373 MOVE MQTR-CURR-RPT-TYPE TO R603-QTR-CURR-RPT-TYPE DTSBD331
|
|
00374 (WRK-QTR-SUB)DTSBD331
|
|
00375 MOVE MQTR-UI-RATE TO R603-QTR-UI-RATE DTSBD331
|
|
00376 (WRK-QTR-SUB)DTSBD331
|
|
00377 MOVE MQTR-WAGE-CHNG-DATE TO R603-QTR-WAGE-CHNG-DATE DTSBD331
|
|
00378 (WRK-QTR-SUB)DTSBD331
|
|
00379 MOVE MQTR-TOT-WAGE TO R603-QTR-TOT-WAGE DTSBD331
|
|
00380 (WRK-QTR-SUB)DTSBD331
|
|
00381 MOVE MQTR-EXCESS-WAGE TO R603-QTR-EXCESS-WAGE DTSBD331
|
|
00382 (WRK-QTR-SUB)DTSBD331
|
|
00383 MOVE MQTR-TAX-WAGE TO R603-QTR-TAX-WAGE DTSBD331
|
|
00384 (WRK-QTR-SUB)DTSBD331
|
|
00385 PERFORM P1205-INIT-INDS THRU P1205-EXIT DTSBD331
|
|
00386 VARYING WRK-CNT FROM 1 BY 1 DTSBD331
|
|
00387 UNTIL WRK-CNT > +12 DTSBD331
|
|
00388 PERFORM P1210-ACCOUNT-DATA THRU P1210-EXIT DTSBD331
|
|
00389 VARYING WRK-ACCT-SUB FROM 1 BY 1 DTSBD331
|
|
00390 UNTIL WRK-ACCT-SUB > MQTR-ACCT-CNT. DTSBD331
|
|
00391 SKIP2 DTSBD331
|
|
00392 ADD +1 TO L004-ABS-QTR. DTSBD331
|
|
00393 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD331
|
|
00394 DTSBD331
|
|
00395 P1200-EXIT. EXIT. DTSBD331
|
|
00396 DTSBD331
|
|
00397 P1205-INIT-INDS. DTSBD331
|
|
00398 SET R603-QTR-TAX-TOLERATED-NO-88 (WRK-CNT) TO TRUE. DTSBD331
|
|
00399 SET R603-QTR-PEN-TOLERATED-NO-88 (WRK-CNT) TO TRUE. DTSBD331
|
|
00400 SET R603-QTR-PEN-WAIVED-NO-88 (WRK-CNT) TO TRUE. DTSBD331
|
|
00401 SET R603-QTR-INT-TOLERATED-NO-88 (WRK-CNT) TO TRUE. DTSBD331
|
|
00402 SET R603-QTR-INT-WAIVED-NO-88 (WRK-CNT) TO TRUE. DTSBD331
|
|
00403 P1205-EXIT. EXIT. DTSBD331
|
|
00404 DTSBD331
|
|
00405 P1210-ACCOUNT-DATA. DTSBD331
|
|
00406 IF MQTR-ACCT-TAX-88 (WRK-ACCT-SUB) DTSBD331
|
|
00407 PERFORM P1211-TAX THRU P1211-EXIT. DTSBD331
|
|
00408 DTSBD331
|
|
00409 IF MQTR-ACCT-LATE-PEN-88 (WRK-ACCT-SUB) DTSBD331
|
|
00410 OR MQTR-ACCT-NSF-PEN-88 (WRK-ACCT-SUB) DTSBD331
|
|
00411 OR MQTR-ACCT-MISC-PEN-88 (WRK-ACCT-SUB) DTSBD331
|
|
00412 PERFORM P1212-PENALTY THRU P1212-EXIT. DTSBD331
|
|
00413 DTSBD331
|
|
00414 IF MQTR-ACCT-INT-88 (WRK-ACCT-SUB) DTSBD331
|
|
00415 PERFORM P1213-INTEREST THRU P1213-EXIT. DTSBD331
|
|
00416 P1210-EXIT. EXIT. DTSBD331
|
|
00417 DTSBD331
|
|
00418 P1211-TAX. DTSBD331
|
|
00419 ADD MQTR-CHARGED-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00420 TO R603-QTR-TAX-CHARGED-AMT (WRK-QTR-SUB). DTSBD331
|
|
00421 ADD MQTR-PAID-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00422 TO R603-QTR-TAX-PAID-AMT (WRK-QTR-SUB). DTSBD331
|
|
00423 IF MQTR-TOLER-AMT (WRK-ACCT-SUB) > 0 DTSBD331
|
|
00424 SUBTRACT MQTR-TOLER-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00425 FROM R603-QTR-TAX-CHARGED-AMT (WRK-QTR-SUB) DTSBD331
|
|
00426 SET R603-QTR-TAX-TOLERATED-YES-88 (WRK-QTR-SUB) TO TRUE. DTSBD331
|
|
00427 DTSBD331
|
|
00428 P1211-EXIT. EXIT. DTSBD331
|
|
00429 DTSBD331
|
|
00430 P1212-PENALTY. DTSBD331
|
|
00431 ADD MQTR-CHARGED-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00432 TO R603-QTR-PEN-CHARGED-AMT (WRK-QTR-SUB). DTSBD331
|
|
00433 ADD MQTR-PAID-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00434 TO R603-QTR-PEN-PAID-AMT (WRK-QTR-SUB). DTSBD331
|
|
00435 DTSBD331
|
|
00436 IF MQTR-TOLER-AMT (WRK-ACCT-SUB) > 0 DTSBD331
|
|
00437 SUBTRACT MQTR-TOLER-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00438 FROM R603-QTR-PEN-CHARGED-AMT (WRK-QTR-SUB) DTSBD331
|
|
00439 SET R603-QTR-PEN-TOLERATED-YES-88 (WRK-QTR-SUB) TO TRUE. DTSBD331
|
|
00440 IF MQTR-WAIVED-AMT (WRK-ACCT-SUB) > 0 DTSBD331
|
|
00441 SUBTRACT MQTR-WAIVED-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00442 FROM R603-QTR-PEN-CHARGED-AMT (WRK-QTR-SUB) DTSBD331
|
|
00443 SET R603-QTR-PEN-WAIVED-YES-88 (WRK-QTR-SUB) TO TRUE. DTSBD331
|
|
00444 P1212-EXIT. EXIT. DTSBD331
|
|
00445 DTSBD331
|
|
00446 P1213-INTEREST. DTSBD331
|
|
00447 MOVE MQTR-CHARGED-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00448 TO R603-QTR-INT-CHARGED-AMT (WRK-QTR-SUB). DTSBD331
|
|
00449 MOVE MQTR-PAID-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00450 TO R603-QTR-INT-PAID-AMT (WRK-QTR-SUB). DTSBD331
|
|
00451 DTSBD331
|
|
00452 IF MQTR-TOLER-AMT (WRK-ACCT-SUB) > 0 DTSBD331
|
|
00453 SUBTRACT MQTR-TOLER-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00454 FROM R603-QTR-INT-CHARGED-AMT (WRK-QTR-SUB) DTSBD331
|
|
00455 SET R603-QTR-INT-TOLERATED-YES-88 (WRK-QTR-SUB) TO TRUE. DTSBD331
|
|
00456 IF MQTR-WAIVED-AMT (WRK-ACCT-SUB) > 0 DTSBD331
|
|
00457 SUBTRACT MQTR-WAIVED-AMT (WRK-ACCT-SUB) DTSBD331
|
|
00458 FROM R603-QTR-INT-CHARGED-AMT (WRK-QTR-SUB) DTSBD331
|
|
00459 SET R603-QTR-INT-WAIVED-YES-88 (WRK-QTR-SUB)TO TRUE. DTSBD331
|
|
00460 P1213-EXIT. EXIT. DTSBD331
|
|
00461 DTSBD331
|
|
00462 EJECT DTSBD331
|
|
00463 P2000-DL-WAGE. DTSBD331
|
|
00464 DTSBD331
|
|
00465 IF MPRF-EMP-NO = LAST-R604-EMP-NO DTSBD331
|
|
00466 AND T021-ASSIGN-NO = LAST-R604-ASSIGN-NO DTSBD331
|
|
00467 GO TO P2000-EXIT DTSBD331
|
|
00468 ELSE DTSBD331
|
|
00469 MOVE MPRF-EMP-NO TO LAST-R604-EMP-NO DTSBD331
|
|
00470 MOVE T021-ASSIGN-NO TO LAST-R604-ASSIGN-NO. DTSBD331
|
|
00471 DTSBD331
|
|
00472 MOVE LOW-VALUE TO MFAS-KEY-AREA. DTSBD331
|
|
00473 MOVE MPRF-EMP-NO TO MFAS-EMP-NO. DTSBD331
|
|
00474 SET MFAS-FAS-88 TO TRUE. DTSBD331
|
|
00475 MOVE T021-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSBD331
|
|
00476 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBD331
|
|
00477 PERFORM S910-READ THRU S910-EXIT. DTSBD331
|
|
00478 IF L910-NO-REC-88 DTSBD331
|
|
00479 MOVE T021-ASSIGN-NO TO MSG1-ASSIGN-NO DTSBD331
|
|
00480 MOVE MSG1-ASSIGN-NO-NOT-FOUND TO LBCM-TRN-MSG-AREA DTSBD331
|
|
00481 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD331
|
|
00482 GO TO P2000-EXIT. DTSBD331
|
|
00483 MOVE MSKL-REC TO MFAS-REC. DTSBD331
|
|
00484 INITIALIZE R604-DATA-AREA. DTSBD331
|
|
00485 DTSBD331
|
|
00486 MOVE MPRF-EMP-NO TO R604-EMP-NO. DTSBD331
|
|
00487 MOVE MPRF-PRIMARY-NAME TO R604-PRIMARY-NAME. DTSBD331
|
|
00488 MOVE MFAS-ASSIGN-NO TO R604-ASSIGN-NO. DTSBD331
|
|
00489 MOVE MFAS-FLD-REP-ID TO R604-FIELD-REP-ID DTSBD331
|
|
00490 L062-FLD-REP-ID. DTSBD331
|
|
00491 PERFORM S062-OPID THRU S062-EXIT. DTSBD331
|
|
00492 IF L062-VALID DTSBD331
|
|
00493 MOVE L062-OP-ID TO R604-FIELD-REP-OPID DTSBD331
|
|
00494 ELSE DTSBD331
|
|
00495 MOVE T021-ASSIGN-NO TO MSG2-ASSIGN-NO DTSBD331
|
|
00496 MOVE MSG2-FIELD-REP-OPID-INVALID TO LBCM-TRN-MSG-AREA DTSBD331
|
|
00497 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD331
|
|
00498 GO TO P2000-EXIT. DTSBD331
|
|
00499 SKIP2 DTSBD331
|
|
00500 PERFORM P2010-EDIT-QTRS THRU P2010-EXIT. DTSBD331
|
|
00501 SKIP2 DTSBD331
|
|
00502 *------------------------------------------- DTSBD331
|
|
00503 * Q - QUARTER INFO DTSBD331
|
|
00504 *------------------------------------------- DTSBD331
|
|
00505 IF MFAS-START-YRQ = +0 DTSBD331
|
|
00506 NEXT SENTENCE DTSBD331
|
|
00507 ELSE DTSBD331
|
|
00508 MOVE WRK-START-QTR TO L004-QTR-5-9 DTSBD331
|
|
00509 PERFORM S004-FROM-5 THRU S004-EXIT DTSBD331
|
|
00510 DTSBD331
|
|
00511 MOVE LOW-VALUE TO MQTR-KEY-AREA DTSBD331
|
|
00512 MOVE MPRF-EMP-NO TO MQTR-EMP-NO DTSBD331
|
|
00513 SET MQTR-QTR-88 TO TRUE DTSBD331
|
|
00514 PERFORM P2100-LOAD-QUARTER-INFO THRU P2100-EXIT DTSBD331
|
|
00515 VARYING WRK-QTR-SUB FROM +1 BY +1 DTSBD331
|
|
00516 UNTIL WRK-QTR-SUB > +4 DTSBD331
|
|
00517 OR L004-QTR-5-9 > WRK-END-QTR. DTSBD331
|
|
00518 SKIP2 DTSBD331
|
|
00519 * MOVE MPRF-FEIN TO R604-FEIN. DTSBD331
|
|
00520 * MOVE MPRF-ORG-TYPE TO R604-ORG-TYPE. DTSBD331
|
|
00521 * MOVE MPRF-SIC-CD TO R604-SIC-CD. DTSBD331
|
|
00522 * MOVE MPRF-NAICS-CD TO R604-NAICS-CD. DTSBD331
|
|
00523 DTSBD331
|
|
00524 PERFORM P3000-RETRIEVE-TAX-ADDRESSES THRU P3000-EXIT. DTSBD331
|
|
00525 MOVE WRK-MAIL-ADDR TO R604-MAIL-ADDR. DTSBD331
|
|
00526 MOVE WRK-MAIL-PHONE TO R604-MAIL-VOICE-1. DTSBD331
|
|
00527 MOVE WRK-PHYS-ADDR TO R604-PHYS-ADDR. DTSBD331
|
|
00528 MOVE WRK-PHYS-PHONE TO R604-PHYS-VOICE-1. DTSBD331
|
|
00529 DTSBD331
|
|
00530 *------------------------------------------- DTSBD331
|
|
00531 * O - OWNER/PARTNER/OFFICER INFO DTSBD331
|
|
00532 *------------------------------------------- DTSBD331
|
|
00533 MOVE +0 TO R604-OPO-CNT. DTSBD331
|
|
00534 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD331
|
|
00535 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD331
|
|
00536 SET MSKL-OPO-88 TO TRUE. DTSBD331
|
|
00537 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD331
|
|
00538 PERFORM UNTIL L910-NO-REC-88 DTSBD331
|
|
00539 OR R604-OPO-CNT = +5 DTSBD331
|
|
00540 MOVE MSKL-REC TO MOPO-REC DTSBD331
|
|
00541 ADD +1 TO R604-OPO-CNT DTSBD331
|
|
00542 MOVE MOPO-NAME TO R604-OPO-NAME (R604-OPO-CNT) DTSBD331
|
|
00543 MOVE MOPO-TITLE TO R604-OPO-TITLE (R604-OPO-CNT) DTSBD331
|
|
00544 MOVE MOPO-SSN TO R604-OPO-SSN (R604-OPO-CNT) DTSBD331
|
|
00545 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD331
|
|
00546 END-PERFORM. DTSBD331
|
|
00547 DTSBD331
|
|
00548 PERFORM P2200-TAX-WAGE-BASE THRU P2200-EXIT. DTSBD331
|
|
00549 MOVE R604-REC TO RSKL-REC. DTSBD331
|
|
00550 PERFORM S946-RPT-REC THRU S946-EXIT. DTSBD331
|
|
00551 DTSBD331
|
|
00552 P2000-EXIT. EXIT. DTSBD331
|
|
00553 DTSBD331
|
|
00554 *********************************************************** DTSBD331
|
|
00555 * THE WAGE EXTRACT WILL PROVIDE NO MORE THAN 4 QUARTERS, DTSBD331
|
|
00556 * ALTHOUGH THE USER MAY ENTER A RANGE OF UP TO 20. DTSBD331
|
|
00557 * THIS PARAGRAPH LIMITS THE RANGE ON THE R604 REQUEST DTSBD331
|
|
00558 * RECORD TO 4 QUARTERS BEGINNING WITH MFAS-START-YRQ. DTSBD331
|
|
00559 *********************************************************** DTSBD331
|
|
00560 P2010-EDIT-QTRS. DTSBD331
|
|
00561 IF MFAS-START-YRQ = +0 DTSBD331
|
|
00562 MOVE ZERO TO R604-START-YRQ DTSBD331
|
|
00563 R604-LAST-YRQ DTSBD331
|
|
00564 WRK-START-QTR DTSBD331
|
|
00565 WRK-END-QTR DTSBD331
|
|
00566 GO TO P2010-EXIT. DTSBD331
|
|
00567 DTSBD331
|
|
00568 MOVE MFAS-START-YRQ TO L004-QTR-5-9. DTSBD331
|
|
00569 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD331
|
|
00570 MOVE L004-ABS-QTR TO WRK-ABS-START-QTR. DTSBD331
|
|
00571 DTSBD331
|
|
00572 MOVE MFAS-END-YRQ TO L004-QTR-5-9. DTSBD331
|
|
00573 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD331
|
|
00574 MOVE L004-ABS-QTR TO WRK-ABS-END-QTR. DTSBD331
|
|
00575 DTSBD331
|
|
00576 MOVE MFAS-START-YRQ TO R604-START-YRQ DTSBD331
|
|
00577 WRK-START-QTR. DTSBD331
|
|
00578 DTSBD331
|
|
00579 IF (WRK-ABS-END-QTR - WRK-ABS-START-QTR) > +3 DTSBD331
|
|
00580 ADD +3 TO WRK-ABS-START-QTR DTSBD331
|
|
00581 MOVE WRK-ABS-START-QTR TO L004-ABS-QTR DTSBD331
|
|
00582 PERFORM S004-FROM-ABS THRU S004-EXIT DTSBD331
|
|
00583 MOVE L004-QTR-5-9 TO R604-LAST-YRQ DTSBD331
|
|
00584 WRK-END-QTR DTSBD331
|
|
00585 ELSE DTSBD331
|
|
00586 MOVE MFAS-END-YRQ TO R604-LAST-YRQ DTSBD331
|
|
00587 WRK-END-QTR. DTSBD331
|
|
00588 P2010-EXIT. EXIT. DTSBD331
|
|
00589 DTSBD331
|
|
00590 P2100-LOAD-QUARTER-INFO. DTSBD331
|
|
00591 DTSBD331
|
|
00592 MOVE L004-QTR-5-9 TO R604-QTR-YRQ (WRK-QTR-SUB) DTSBD331
|
|
00593 MQTR-YRQ. DTSBD331
|
|
00594 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD331
|
|
00595 PERFORM S910-READ THRU S910-EXIT. DTSBD331
|
|
00596 IF L910-OK-88 DTSBD331
|
|
00597 MOVE MSKL-REC TO MQTR-REC DTSBD331
|
|
00598 MOVE MQTR-CURR-RPT-TYPE TO R604-QTR-CURR-RPT-TYPE DTSBD331
|
|
00599 (WRK-QTR-SUB)DTSBD331
|
|
00600 MOVE MQTR-UI-RATE TO R604-QTR-UI-RATE DTSBD331
|
|
00601 (WRK-QTR-SUB)DTSBD331
|
|
00602 MOVE MQTR-WAGE-CHNG-DATE TO R604-QTR-WAGE-CHNG-DATE DTSBD331
|
|
00603 (WRK-QTR-SUB)DTSBD331
|
|
00604 MOVE MQTR-TOT-WAGE TO R604-QTR-TOT-WAGE DTSBD331
|
|
00605 (WRK-QTR-SUB)DTSBD331
|
|
00606 MOVE MQTR-EXCESS-WAGE TO R604-QTR-EXCESS-WAGE DTSBD331
|
|
00607 (WRK-QTR-SUB)DTSBD331
|
|
00608 MOVE MQTR-TAX-WAGE TO R604-QTR-TAX-WAGE DTSBD331
|
|
00609 (WRK-QTR-SUB)DTSBD331
|
|
00610 SKIP2 DTSBD331
|
|
00611 ADD +1 TO L004-ABS-QTR. DTSBD331
|
|
00612 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD331
|
|
00613 DTSBD331
|
|
00614 P2100-EXIT. EXIT. DTSBD331
|
|
00615 DTSBD331
|
|
00616 P2200-TAX-WAGE-BASE. DTSBD331
|
|
00617 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSBD331
|
|
00618 SET FCYR-CYR-88 TO TRUE. DTSBD331
|
|
00619 MOVE MFAS-START-YRQ TO L004-QTR-5-9. DTSBD331
|
|
00620 MOVE L004-QTR-5-YR TO FCYR-YR. DTSBD331
|
|
00621 MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. DTSBD331
|
|
00622 DTSBD331
|
|
00623 PERFORM S931-READ THRU S931-EXIT. DTSBD331
|
|
00624 IF L931-NO-REC-88 DTSBD331
|
|
00625 NEXT SENTENCE DTSBD331
|
|
00626 ELSE DTSBD331
|
|
00627 MOVE FSKL-REC TO FCYR-REC DTSBD331
|
|
00628 MOVE FCYR-TAXABLE-WAGE-BASE TO R604-TAXABLE-WAGE-BASE. DTSBD331
|
|
00629 DTSBD331
|
|
00630 P2200-EXIT. EXIT. DTSBD331
|
|
00631 EJECT DTSBD331
|
|
00632 P3000-RETRIEVE-TAX-ADDRESSES. DTSBD331
|
|
00633 DTSBD331
|
|
00634 SET L112-TAD-ADDR-88 TO TRUE. DTSBD331
|
|
00635 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSBD331
|
|
00636 MOVE SPACE TO L112-PRIMARY-NAME DTSBD331
|
|
00637 L112-NAME DTSBD331
|
|
00638 L112-TITLE. DTSBD331
|
|
00639 ** MAKE SURE PRIOR MAIL/PHYS DATA ARE CLEARED DTSBD331
|
|
00640 MOVE SPACE TO WRK-MAIL-ADDR DTSBD331
|
|
00641 WRK-MAIL-PHONE DTSBD331
|
|
00642 WRK-PHYS-ADDR DTSBD331
|
|
00643 WRK-PHYS-PHONE. DTSBD331
|
|
00644 DTSBD331
|
|
00645 MOVE LOW-VALUE TO MTAD-KEY-AREA. DTSBD331
|
|
00646 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBD331
|
|
00647 SET MTAD-TAD-88 TO TRUE. DTSBD331
|
|
00648 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBD331
|
|
00649 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD331
|
|
00650 PERFORM S910-READ THRU S910-EXIT. DTSBD331
|
|
00651 DTSBD331
|
|
00652 IF L910-NO-REC-88 DTSBD331
|
|
00653 NEXT SENTENCE DTSBD331
|
|
00654 ELSE DTSBD331
|
|
00655 MOVE MSKL-REC TO MTAD-REC DTSBD331
|
|
00656 MOVE MTAD-ADDRESS TO L112-ADDRESS DTSBD331
|
|
00657 PERFORM S112-ADDRESS THRU S112-EXIT DTSBD331
|
|
00658 MOVE L112-MAILING-ADDRESS TO WRK-MAIL-ADDR DTSBD331
|
|
00659 MOVE MTAD-VOICE-1 TO WRK-MAIL-PHONE. DTSBD331
|
|
00660 DTSBD331
|
|
00661 DTSBD331
|
|
00662 IF MPRF-TAX-REC-ADDR-NO-88 DTSBD331
|
|
00663 GO TO P3000-EXIT. DTSBD331
|
|
00664 DTSBD331
|
|
00665 MOVE LOW-VALUE TO MTAD-KEY-AREA. DTSBD331
|
|
00666 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBD331
|
|
00667 SET MTAD-TAD-88 TO TRUE. DTSBD331
|
|
00668 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSBD331
|
|
00669 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD331
|
|
00670 PERFORM S910-READ THRU S910-EXIT. DTSBD331
|
|
00671 DTSBD331
|
|
00672 IF L910-NO-REC-88 DTSBD331
|
|
00673 NEXT SENTENCE DTSBD331
|
|
00674 ELSE DTSBD331
|
|
00675 MOVE MSKL-REC TO MTAD-REC DTSBD331
|
|
00676 MOVE MTAD-ADDRESS TO L112-ADDRESS DTSBD331
|
|
00677 PERFORM S112-ADDRESS THRU S112-EXIT DTSBD331
|
|
00678 MOVE L112-MAILING-ADDRESS TO WRK-PHYS-ADDR DTSBD331
|
|
00679 MOVE MTAD-VOICE-1 TO WRK-PHYS-PHONE. DTSBD331
|
|
00680 DTSBD331
|
|
00681 P3000-EXIT. EXIT. DTSBD331
|
|
00682 EJECT DTSBD331
|
|
00683 S004-FROM-5. DTSBD331
|
|
00684 SET L004-FROM-5 TO TRUE. DTSBD331
|
|
00685 GO TO S004-QTR. DTSBD331
|
|
00686 DTSBD331
|
|
00687 S004-FROM-ABS. DTSBD331
|
|
00688 SET L004-FROM-ABS TO TRUE. DTSBD331
|
|
00689 GO TO S004-QTR. DTSBD331
|
|
00690 DTSBD331
|
|
00691 S004-QTR. DTSBD331
|
|
00692 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD331
|
|
00693 S004-EXIT. EXIT. DTSBD331
|
|
00694 SKIP2 DTSBD331
|
|
00695 S062-OPID. DTSBD331
|
|
00696 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBD331
|
|
00697 S062-EXIT. EXIT. DTSBD331
|
|
00698 SKIP2 DTSBD331
|
|
00699 S112-ADDRESS. DTSBD331
|
|
00700 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBD331
|
|
00701 S112-EXIT. EXIT. DTSBD331
|
|
00702 SKIP2 DTSBD331
|
|
00703 S910-READ. DTSBD331
|
|
00704 SET L910-READ-88 TO TRUE. DTSBD331
|
|
00705 GO TO S910-MSTR-IO. DTSBD331
|
|
00706 DTSBD331
|
|
00707 S910-START-BROWSE. DTSBD331
|
|
00708 SET L910-START-BROWSE-88 TO TRUE. DTSBD331
|
|
00709 GO TO S910-MSTR-IO. DTSBD331
|
|
00710 DTSBD331
|
|
00711 S910-READ-NEXT. DTSBD331
|
|
00712 SET L910-READ-NEXT-88 TO TRUE. DTSBD331
|
|
00713 GO TO S910-MSTR-IO. DTSBD331
|
|
00714 DTSBD331
|
|
00715 *S910-COUNT. DTSBD331
|
|
00716 * SET L910-COUNT-88 TO TRUE. DTSBD331
|
|
00717 * GO TO S910-MSTR-IO. DTSBD331
|
|
00718 * DTSBD331
|
|
00719 *S910-WRITE. DTSBD331
|
|
00720 * SET L910-WRITE-88 TO TRUE. DTSBD331
|
|
00721 * GO TO S910-MSTR-IO. DTSBD331
|
|
00722 * DTSBD331
|
|
00723 *S910-REWRITE. DTSBD331
|
|
00724 * SET L910-REWRITE-88 TO TRUE. DTSBD331
|
|
00725 * GO TO S910-MSTR-IO. DTSBD331
|
|
00726 * DTSBD331
|
|
00727 *S910-DELETE. DTSBD331
|
|
00728 * SET L910-DELETE-88 TO TRUE. DTSBD331
|
|
00729 * GO TO S910-MSTR-IO. DTSBD331
|
|
00730 DTSBD331
|
|
00731 S910-MSTR-IO. DTSBD331
|
|
00732 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD331
|
|
00733 MSKL-REC. DTSBD331
|
|
00734 S910-EXIT. EXIT. DTSBD331
|
|
00735 SKIP2 DTSBD331
|
|
00736 S931-READ. DTSBD331
|
|
00737 SET L931-READ-88 TO TRUE. DTSBD331
|
|
00738 GO TO S931-REF-IO. DTSBD331
|
|
00739 DTSBD331
|
|
00740 S931-REF-IO. DTSBD331
|
|
00741 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD331
|
|
00742 FSKL-REC. DTSBD331
|
|
00743 S931-EXIT. EXIT. DTSBD331
|
|
00744 SKIP2 DTSBD331
|
|
00745 S946-RPT-REC. DTSBD331
|
|
00746 CALL 'DTSBU946' USING RSKL-REC. DTSBD331
|
|
00747 S946-EXIT. EXIT. DTSBD331
|
|
00748 * DTSBD331
|