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