00001 IDENTIFICATION DIVISION. 12/26/02 00002 PROGRAM-ID. DTSBD630. DTSBD630 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV013 00004 DATE-WRITTEN. DECEMBER 1991. DTSBD630 00005 DATE-COMPILED. DTSBD630 00006 SKIP3 DTSBD630 00007 ***** DTSBD630 00008 * DTSBD630 00009 * FUNCTION: FUTA POTENTIAL NON-FEDERAL FILER DRIVER. DTSBD630 00010 * DTSBD630 00011 * DTSBD630 00012 * MODIFICATION LOG: DTSBD630 00013 * DTSBD630 00014 * 01/28/92 INITIAL DEVELOPMENT. DTSBD630 00015 * WORK ORDER: PROGRAMMER: TCL DTSBD630 00016 * DTSBD630 00017 * 12/05/94 CONVERT TO 1994/MONTANA. DTSBD630 00018 * WORK ORDER: PROGRAMMER: RHC DTSBD630 00019 * DTSBD630 00020 * 01/07/97 ZIP CODE LENGTH ON PNFF OUTPUT CHANGED TO 12 FROM DTSBD630 00021 * 9 (OVERALL LRECL CHANGED TO 373) DTSBD630 00022 * WORK ORDER: PROGRAMMER: SFW DTSBD630 00023 * DTSBD630 00024 * 11/13/97 TAX YEAR 1996 MODIFICATIONS. INCREASED RECORD DTSBD630 00025 * LENGTH: FOUR DIGIT YEAR. DTSBD630 00026 * WORK ORDER: TCL 222 PROGRAMMER: EHH DTSBD630 00027 * DTSBD630 00028 * 10/19/1998 ADD TWO NEW "PAYMENT" DATA ELEMENTS ('THRU 4/15' DTSBD630 00029 * & 'AFTER 4/15'). DTSBD630 00030 * WORK ORDER: TCL 237 PROGRAMMER: KDN DTSBD630 00031 * DTSBD630 00032 * 02/17/1999 REVIEWED AND MODIFIED FOR DC. DTSBD630 00033 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD630 00034 * DTSBD630 00035 * 02/27/1999 MODIFIED TO OPEN/CLOSE REFERENCE FILE. DTSBU516 DTSBD630 00036 * WAS MODIFIED TO READ THE REFERENCE FILE. DTSBD630 00037 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD630 00038 * DTSBD630 00039 * 08/14/2002 RECOMPILED FOR NEW VERSION OF DTSIL516. DTSBD630 00040 * NO CHANGES NEEDED FOR ESTIMATED RATES. DTSBD630 00041 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD630 00042 * DTSBD630 00043 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD630 00044 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD630 00045 * DTSBD630 00046 * DTSBD630 00047 * DESCRIPTION: DTSBD630 00048 * DTSBD630 00049 * DTSBD630 DETERMINES FUTA POTENTIAL NON-FEDERAL FILERS FOR DTSBD630 00050 * A GIVEN YEAR. A FUTA POTENTIAL NON-FEDERAL FILER IS AN DTSBD630 00051 * EMPLOYER WHO HAS FILED REPORTS FOR ONE OR MORE QUARTERS DTSBD630 00052 * OF THE PARM-YEAR (WITH TAX WAGES GREATER THAN 1500 FOR DTSBD630 00053 * YEAR) (IGNORE ESTIMATED REPORTS) BUT FOR WHOM NO SUCCESSFULDTSBD630 00054 * FUTA CERTIFICATION WAS ACCOMPLISHED (IN DTSBD610). DTSBD630 00055 * DTSBD630 00056 * READ THE EMPLOYER MASTER FILE PRF RECORDS SEQUENTIALLY. DTSBD630 00057 * DTSBD630 00058 * IF THE EMPLOYER HAS TAX WAGES GREATER THAN 1500 IN DTSBD630 00059 * PARM-YEAR AND NO RECORD EXISTS FOR THE EMPLOYER ON THE DTSBD630 00060 * "EMPLOYERS CERTIFIED FOR CURRENT YEAR" FILE, THEN DTSBD630 00061 * WRITE A "IRS FUTA POTENTIAL NON-FEDERAL FILER TAPE" DTSBD630 00062 * RECORD AND WRITE A R708 RECORD. DTSBD630 00063 * DTSBD630 00064 * DTSBD630 00065 * PARAMETERS INPUT: DTSBD630 00066 * DTSBD630 00067 * NONE. DTSBD630 00068 * DTSBD630 00069 * DTSBD630 00070 * TAPES INPUT: DTSBD630 00071 * DTSBD630 00072 * NONE. DTSBD630 00073 * DTSBD630 00074 * DTSBD630 00075 * MASTER FILE RECORDS READ: DTSBD630 00076 * DTSBD630 00077 * MPRF DTSBD630 00078 * MSOL DTSBD630 00079 * MQTR DTSBD630 00080 * MDST DTSBD630 00081 * DTSBD630 00082 * DTSBD630 00083 * ALTERNATE INDEX FILE RECORDS READ: DTSBD630 00084 * DTSBD630 00085 * NONE DTSBD630 00086 * DTSBD630 00087 * DTSBD630 00088 * MASTER FILE RECORDS UPDATED: DTSBD630 00089 * DTSBD630 00090 * NONE. DTSBD630 00091 * DTSBD630 00092 * DTSBD630 00093 * REPORT RECORDS WRITTEN: DTSBD630 00094 * DTSBD630 00095 * R708 FUTA POTENTIAL NON-FEDERAL FILER. DTSBD630 00096 * DTSBD630 00097 * DTSBD630 00098 * TAPES WRITTEN: DTSBD630 00099 * DTSBD630 00100 * IRS FUTA POTENTIAL NON-FEDERAL FILER TAPE (PNFF). DTSBD630 00101 * DTSBD630 00102 * SEE IRS DOCUMENT 6581 "SPECIFICATIONS FOR THE DTSBD630 00103 * NATIONWIDE SYSTEM FOR COMPUTERIZED CERTIFICATION DTSBD630 00104 * OF STATE FUTA CREDITS" FOR FORMAT. DTSBD630 00105 * DTSBD630 00106 * DTSBD630 00107 * DISK DATASETS READ: DTSBD630 00108 * DTSBD630 00109 * EMPLOYERS CERTIFIED FOR CURRENT YEAR DTSBD630 00110 * DTSBD630 00111 * KEY IS EMP-NO. DTSBD630 00112 * DTSBD630 00113 * DTSBD630 00114 * MODULES CALLED: DTSBD630 00115 * DTSBD630 00116 * DTSBU071 NAME FORMAT. DTSBD630 00117 * DTSBU111 ADDRESS LOOKUP. DTSBD630 00118 * DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE FOR DTSBD630 00119 * A GIVEN QUARTER. DTSBD630 00120 * DTSBU910 MASTER FILE I/O. DTSBD630 00121 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD630 00122 * DTSBU971 BATCH CURRENT YEAR FUTA CERTIFICATION I/O. DTSBD630 00123 * DTSBD630 00124 * DTSBD630 00125 ***** DTSBD630 00126 SKIP3 DTSBD630 00127 ENVIRONMENT DIVISION. DTSBD630 00128 SKIP2 DTSBD630 00129 INPUT-OUTPUT SECTION. DTSBD630 00130 DTSBD630 00131 FILE-CONTROL. DTSBD630 00132 SELECT POT-FILE ASSIGN TO DTSFPOT. DTSBD630 00133 SKIP3 DTSBD630 00134 DATA DIVISION. DTSBD630 00135 SKIP3 DTSBD630 00136 FILE SECTION. DTSBD630 00137 SKIP2 DTSBD630 00138 FD POT-FILE DTSBD630 00139 RECORDING MODE IS F DTSBD630 00140 BLOCK CONTAINS 0 RECORDS DTSBD630 00141 LABEL RECORDS ARE STANDARD. DTSBD630 00142 DTSBD630 00143 01 POT-REC. DTSBD630 00144 05 POT-DISPLAY-ZERO-1 PIC 9(04). DTSBD630 00145 05 POT-STATE-CD PIC X(02). DTSBD630 00146 05 POT-FEIN PIC 9(09). DTSBD630 00147 05 POT-FEIN-X REDEFINES POT-FEIN DTSBD630 00148 PIC X(09). DTSBD630 00149 05 POT-EMP-NO-AREA. DTSBD630 00150 10 POT-EMP-NO PIC 9(06). DTSBD630 00151 10 FILLER PIC X(09). DTSBD630 00152 05 POT-TAX-PERIOD PIC 9(06). DTSBD630 00153 05 FILLER REDEFINES POT-TAX-PERIOD. DTSBD630 00154 10 POT-TAX-YEAR PIC 9(04). DTSBD630 00155 10 POT-TAX-MONTH PIC 9(02). DTSBD630 00156 05 POT-RATE-AREA OCCURS 4 TIMES. DTSBD630 00157 10 POT-TAX-WAGE PIC 9(11)V9(02). DTSBD630 00158 10 POT-RATE PIC V9(06). DTSBD630 00159 05 POT-PAID-PRIOR-2-1 PIC 9(11)V9(02). DTSBD630 00160 05 POT-PAID-2-1-THRU-2-10 PIC 9(11)V9(02). DTSBD630 00161 05 POT-PAID-AFTER-2-10 PIC 9(11)V9(02). DTSBD630 00162 05 POT-PAID-THRU-4-15 PIC 9(11)V9(02). DTSBD630 00163 05 POT-PAID-AFTER-4-15 PIC 9(11)V9(02). DTSBD630 00164 05 POT-DISPLAY-ZERO-2 PIC 9(02). DTSBD630 00165 05 POT-ZIP. DTSBD630 00166 10 POT-ZIP-FIRST-9. DTSBD630 00167 15 POT-ZIP-1 PIC X(05). DTSBD630 00168 15 POT-ZIP-2 PIC X(04). DTSBD630 00169 10 FILLER PIC X(03). DTSBD630 00170 05 POT-NAME OCCURS 4 TIMES PIC X(35). DTSBD630 00171 05 POT-STREET PIC X(35). DTSBD630 00172 05 POT-CITY-ST PIC X(35). DTSBD630 00173 EJECT DTSBD630 00174 WORKING-STORAGE SECTION. DTSBD630 001745 77 PAN-VALET PICTURE X(24) VALUE '013DTSBD630 12/26/02'. DTSBD630 00175 SKIP3 DTSBD630 00176 01 WRK-AREA. DTSBD630 00177 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +630.DTSBD630 00178 DTSBD630 00179 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD630'.DTSBD630 00180 DTSBD630 00181 05 WRK-POT-CHAR-CNT PIC S9(04) COMP VALUE +375.DTSBD630 00182 DTSBD630 00183 DTSBD630 00184 05 WRK-CERT-CURRENT-YEAR PIC 9(04). DTSBD630 00185 DTSBD630 00186 DTSBD630 00187 05 PRF-REC-CNT PIC S9(07) COMP-3. DTSBD630 00188 DTSBD630 00189 05 POT-REC-CNT PIC S9(07) COMP-3. DTSBD630 00190 DTSBD630 00191 DTSBD630 00192 05 WRK-DATE-9 PIC 9(08). DTSBD630 00193 05 WRK-DATE-X REDEFINES WRK-DATE-9. DTSBD630 00194 10 WRK-YR PIC 9(04). DTSBD630 00195 10 WRK-MO PIC 9(02). DTSBD630 00196 10 WRK-DA PIC 9(02). DTSBD630 00197 DTSBD630 00198 05 WRK-QTR-9 PIC 9(05). DTSBD630 00199 05 WRK-QTR-X REDEFINES WRK-QTR-9. DTSBD630 00200 10 WRK-QTR-YR PIC 9(04). DTSBD630 00201 10 WRK-QTR-Q PIC 9(01). DTSBD630 00202 DTSBD630 00203 DTSBD630 00204 05 WRK-TAX-PERIOD PIC 9(06). DTSBD630 00205 05 FILLER REDEFINES WRK-TAX-PERIOD. DTSBD630 00206 10 WRK-TAX-YEAR PIC 9(04). DTSBD630 00207 10 WRK-TAX-MONTH PIC 9(02). DTSBD630 00208 DTSBD630 00209 05 WRK-CERT-FEB-1-DATE PIC S9(09) COMP-3. DTSBD630 00210 DTSBD630 00211 05 WRK-CERT-FEB-10-DATE PIC S9(09) COMP-3. DTSBD630 00212 DTSBD630 00213 05 WRK-CERT-APR-15-DATE PIC S9(09) COMP-3. DTSBD630 00214 DTSBD630 00215 DTSBD630 00216 05 NAME-SUB PIC S9(04) COMP. DTSBD630 00217 DTSBD630 00218 DTSBD630 00219 05 RATE-CNT PIC S9(04) COMP. DTSBD630 00220 DTSBD630 00221 05 RATE-SUB PIC S9(04) COMP. DTSBD630 00222 DTSBD630 00223 05 RATE-MATCH PIC X(01). DTSBD630 00224 DTSBD630 00225 DTSBD630 00226 05 WRK-PAID-PRIOR-2-1 PIC S9(09)V9(02) COMP-3.DTSBD630 00227 DTSBD630 00228 05 WRK-PAID-2-1-THRU-2-10 PIC S9(09)V9(02) COMP-3.DTSBD630 00229 DTSBD630 00230 05 WRK-PAID-AFTER-2-10 PIC S9(09)V9(02) COMP-3.DTSBD630 00231 DTSBD630 00232 05 WRK-PAID-THRU-4-15 PIC S9(09)V9(02) COMP-3.DTSBD630 00233 DTSBD630 00234 05 WRK-PAID-AFTER-4-15 PIC S9(09)V9(02) COMP-3.DTSBD630 00235 DTSBD630 00236 DTSBD630 00237 05 WRK-YRQ-SUB PIC S9(04) COMP. DTSBD630 00238 DTSBD630 00239 05 WRK-YRQ-AREA OCCURS 4 TIMES DTSBD630 00240 INDEXED BY WRK-YRQ-IDX. DTSBD630 00241 10 WRK-YRQ PIC S9(05) COMP-3.DTSBD630 00242 10 WRK-YRQ-LIABLE-IND PIC X(01). DTSBD630 00243 10 WRK-RPT-FILED-IND PIC X(01). DTSBD630 00244 10 WRK-RATE PIC S9(01)V9(04) COMP-3.DTSBD630 00245 10 WRK-TAX-WAGE PIC S9(11)V9(02) COMP-3.DTSBD630 00246 DTSBD630 00247 DTSBD630 00248 05 WRK-LIABLE-IND PIC X(01). DTSBD630 00249 DTSBD630 00250 05 WRK-FILED-IND PIC X(01). DTSBD630 00251 DTSBD630 00252 05 WRK-YR-TAX-WAGE PIC S9(11)V9(02) COMP-3.DTSBD630 00253 DTSBD630 00254 DTSBD630 00255 05 WRK-MPRF-ZIP. DTSBD630 00256 10 WRK-MPRF-ZIP-1 PIC X(05). DTSBD630 00257 10 FILLER PIC X(01). DTSBD630 00258 10 WRK-MPRF-ZIP-2 PIC X(04). DTSBD630 00259 DTSBD630 00260 DTSBD630 00261 05 WRK-DOMESTIC-IND PIC X(01). DTSBD630 00262 EJECT DTSBD630 00263 01 L910-LINK-AREA. DTSBD630 00264 ++INCLUDE DTSIL910 DTSBD630 00265 SKIP3 DTSBD630 00266 01 MSKL-REC. DTSBD630 00267 ++INCLUDE DTSIMSKL DTSBD630 00268 SKIP3 DTSBD630 00269 01 MPRF-REC. DTSBD630 00270 ++INCLUDE DTSIMPRF DTSBD630 00271 SKIP3 DTSBD630 00272 01 MSOL-REC. DTSBD630 00273 ++INCLUDE DTSIMSOL DTSBD630 00274 SKIP3 DTSBD630 00275 01 MQTR-REC. DTSBD630 00276 ++INCLUDE DTSIMQTR DTSBD630 00277 SKIP3 DTSBD630 00278 01 MDST-REC. DTSBD630 00279 ++INCLUDE DTSIMDST DTSBD630 00280 EJECT DTSBD630 00281 01 L931-LINK-AREA. DTSBD630 00282 ++INCLUDE DTSIL931 DTSBD630 00283 SKIP3 DTSBD630 00284 01 FSKL-REC. DTSBD630 00285 ++INCLUDE DTSIFSKL DTSBD630 00286 EJECT DTSBD630 00287 01 L971-LINK-AREA. DTSBD630 00288 ++INCLUDE DTSIL971 DTSBD630 00289 SKIP3 DTSBD630 00290 01 X971-REC. DTSBD630 00291 ++INCLUDE DTSIX971 DTSBD630 00292 EJECT DTSBD630 00293 01 RSKL-REC. DTSBD630 00294 ++INCLUDE DTSIRSK1 DTSBD630 00295 SKIP3 DTSBD630 00296 01 R708-REC. DTSBD630 00297 ++INCLUDE DTSIR708 DTSBD630 00298 EJECT DTSBD630 00299 *01 L071-LINK-AREA. DTSBD630 00300 ***INCLUDE DTSIL071 DTSBD630 00301 SKIP3 DTSBD630 00302 01 L111-LINK-AREA. DTSBD630 00303 ++INCLUDE DTSIL111 DTSBD630 00304 SKIP3 DTSBD630 00305 01 L516-LINK-AREA. DTSBD630 00306 ++INCLUDE DTSIL516 DTSBD630 00307 EJECT DTSBD630 00308 PROCEDURE DIVISION. DTSBD630 00309 DTSBD630 00310 DTSBD630 00311 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBD630 00312 DTSBD630 00313 DTSBD630 00314 PERFORM I2000-SET-CERT-CURRENT-YEAR THRU I2000-EXIT. DTSBD630 00315 DTSBD630 00316 DTSBD630 00317 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD630 00318 DTSBD630 00319 MOVE +0 TO MSKL-EMP-NO. DTSBD630 00320 DTSBD630 00321 SET MSKL-PRF-88 TO TRUE. DTSBD630 00322 DTSBD630 00323 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD630 00324 DTSBD630 00325 PERFORM UNTIL L910-NO-REC-88 DTSBD630 00326 MOVE MSKL-REC TO MPRF-REC DTSBD630 00327 ADD +1 TO PRF-REC-CNT DTSBD630 00328 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD630 00329 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSBD630 00330 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD630 00331 END-PERFORM. DTSBD630 00332 DTSBD630 00333 DTSBD630 00334 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD630 00335 DTSBD630 00336 DTSBD630 00337 GOBACK. DTSBD630 00338 EJECT DTSBD630 00339 I1000-OPEN-FILES. DTSBD630 00340 MOVE 'N' TO L910-TRACE-IND DTSBD630 00341 L931-TRACE-IND DTSBD630 00342 L971-TRACE-IND DTSBD630 00343 L516-TRACE-IND. DTSBD630 00344 DTSBD630 00345 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD630 00346 L931-MOD-NAME DTSBD630 00347 L971-MOD-NAME. DTSBD630 00348 DTSBD630 00349 DTSBD630 00350 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD630 00351 DTSBD630 00352 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD630 00353 DTSBD630 00354 PERFORM S971-OPEN-READ THRU S971-EXIT. DTSBD630 00355 DTSBD630 00356 OPEN OUTPUT POT-FILE. DTSBD630 00357 DTSBD630 00358 DTSBD630 00359 MOVE +0 TO PRF-REC-CNT DTSBD630 00360 POT-REC-CNT. DTSBD630 00361 DTSBD630 00362 DTSBD630 00363 MOVE LENGTH OF R708-REC TO R708-LENGTH. DTSBD630 00364 I1000-EXIT. DTSBD630 00365 EXIT. DTSBD630 00366 SKIP3 DTSBD630 00367 I2000-SET-CERT-CURRENT-YEAR. DTSBD630 00368 MOVE +0 TO X971-EMP-NO. DTSBD630 00369 DTSBD630 00370 PERFORM S971-START-BROWSE THRU S971-EXIT. DTSBD630 00371 DTSBD630 00372 IF L910-NO-REC-88 DTSBD630 00373 DISPLAY 'NO CURRENT YEAR CERT RECORDS EXIST' DTSBD630 00374 PERFORM S999-ABEND THRU S999-EXIT. DTSBD630 00375 DTSBD630 00376 MOVE X971-CERT-YEAR TO WRK-CERT-CURRENT-YEAR DTSBD630 00377 WRK-TAX-YEAR DTSBD630 00378 WRK-YR. DTSBD630 00379 DTSBD630 00380 DTSBD630 00381 MOVE 12 TO WRK-TAX-MONTH. DTSBD630 00382 DTSBD630 00383 DTSBD630 00384 ADD +1 TO WRK-YR. DTSBD630 00385 DTSBD630 00386 MOVE 02 TO WRK-MO. DTSBD630 00387 DTSBD630 00388 MOVE 01 TO WRK-DA. DTSBD630 00389 DTSBD630 00390 MOVE WRK-DATE-9 TO WRK-CERT-FEB-1-DATE. DTSBD630 00391 DTSBD630 00392 MOVE 10 TO WRK-DA. DTSBD630 00393 DTSBD630 00394 MOVE WRK-DATE-9 TO WRK-CERT-FEB-10-DATE. DTSBD630 00395 DTSBD630 00396 MOVE 04 TO WRK-MO. DTSBD630 00397 DTSBD630 00398 MOVE 15 TO WRK-DA. DTSBD630 00399 DTSBD630 00400 MOVE WRK-DATE-9 TO WRK-CERT-APR-15-DATE. DTSBD630 00401 I2000-EXIT. DTSBD630 00402 EXIT. DTSBD630 00403 EJECT DTSBD630 00404 P0000-PROCESS. DTSBD630 00405 IF NOT MPRF-CLASS-RATED-88 DTSBD630 00406 GO TO P0000-EXIT. DTSBD630 00407 DTSBD630 00408 DTSBD630 00409 MOVE MPRF-EMP-NO TO X971-EMP-NO. DTSBD630 00410 DTSBD630 00411 PERFORM S971-READ THRU S971-EXIT. DTSBD630 00412 DTSBD630 00413 IF L971-OK-88 DTSBD630 00414 GO TO P0000-EXIT. DTSBD630 00415 DTSBD630 00416 DTSBD630 00417 PERFORM P1000-INIT-WRK THRU P1000-EXIT. DTSBD630 00418 DTSBD630 00419 DTSBD630 00420 PERFORM P4000-PROCESS-EMP-NO THRU P4000-EXIT. DTSBD630 00421 DTSBD630 00422 IF WRK-FILED-IND = 'N' DTSBD630 00423 OR DTSBD630 00424 WRK-YR-TAX-WAGE < 1000.00 DTSBD630 00425 GO TO P0000-EXIT. DTSBD630 00426 DTSBD630 00427 DTSBD630 00428 ***** DTSBD630 00429 * DTSBD630 00430 * MONTANA DETERMINED WHETHER AN EMPLOYER FIT THE "DOMESTIC" DTSBD630 00431 * FUTA CATEGORY BASED ON MSOL-LIAB-CD. DTSBD630 00432 * DTSBD630 00433 * DC DETERMINES WHETHER AN EMPLOYER FITS THE "DOMESTIC" FUTA DTSBD630 00434 * CATEGORY BASED ON MPRF-NAICS-CD AND MPRF-SIC-CD. DTSBD630 00435 * DTSBD630 00436 ***** DTSBD630 00437 DTSBD630 00438 *****IF WRK-YR-TAX-WAGE < 1500.00 DTSBD630 00439 *********MOVE 'N' TO WRK-DOMESTIC-IND DTSBD630 00440 *********MOVE LOW-VALUE TO MSKL-KEY-AREA DTSBD630 00441 *********MOVE MPRF-EMP-NO TO MSKL-EMP-NO DTSBD630 00442 *********SET MSKL-SOL-88 TO TRUE DTSBD630 00443 *********PERFORM S910-START-BROWSE THRU S910-EXIT DTSBD630 00444 *********MOVE MSKL-REC TO MSOL-REC DTSBD630 00445 *********PERFORM UNTIL L910-NO-REC-88 DTSBD630 00446 *****************OR WRK-DOMESTIC-IND = 'Y' DTSBD630 00447 *************IF WRK-YRQ (4) < MSOL-FIRST-LIAB-YRQ DTSBD630 00448 *************OR WRK-YRQ (1) > MSOL-LAST-LIAB-YRQ DTSBD630 00449 *************OR NOT MSOL-LIAB-REG-DOMEST-88 DTSBD630 00450 *****************PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD630 00451 *****************MOVE MSKL-REC TO MSOL-REC DTSBD630 00452 *************ELSE DTSBD630 00453 *****************MOVE 'Y' TO WRK-DOMESTIC-IND DTSBD630 00454 *************END-IF DTSBD630 00455 *********END-PERFORM DTSBD630 00456 *********IF WRK-DOMESTIC-IND = 'N' DTSBD630 00457 *************GO TO P0000-EXIT. DTSBD630 00458 DTSBD630 00459 DTSBD630 00460 IF WRK-YR-TAX-WAGE < 1500.00 DTSBD630 00461 MOVE 'N' TO WRK-DOMESTIC-IND DTSBD630 00462 PERFORM P0100-DETERMINE-DOMESTIC THRU P0100-EXIT DTSBD630 00463 IF WRK-DOMESTIC-IND = 'N' DTSBD630 00464 GO TO P0000-EXIT. DTSBD630 00465 DTSBD630 00466 DTSBD630 00467 PERFORM P5100-WRITE-POT THRU P5100-EXIT. DTSBD630 00468 DTSBD630 00469 DTSBD630 00470 PERFORM P5200-WRITE-R708 THRU P5200-EXIT. DTSBD630 00471 P0000-EXIT. DTSBD630 00472 EXIT. DTSBD630 00473 SKIP3 DTSBD630 00474 P0100-DETERMINE-DOMESTIC. DTSBD630 00475 IF MPRF-NAICS-CD-NONCLASSIF-88 DTSBD630 00476 IF MPRF-SIC-PRIV-HOUSEHOLDS-88 DTSBD630 00477 MOVE 'Y' TO WRK-DOMESTIC-IND DTSBD630 00478 ELSE DTSBD630 00479 NEXT SENTENCE DTSBD630 00480 ELSE DTSBD630 00481 IF MPRF-NAICS-PRIV-HOUSEHOLDS-88 DTSBD630 00482 MOVE 'Y' TO WRK-DOMESTIC-IND DTSBD630 00483 ELSE DTSBD630 00484 NEXT SENTENCE. DTSBD630 00485 P0100-EXIT. DTSBD630 00486 EXIT. DTSBD630 00487 EJECT DTSBD630 00488 P1000-INIT-WRK. DTSBD630 00489 MOVE +0 TO WRK-YR-TAX-WAGE DTSBD630 00490 WRK-PAID-PRIOR-2-1 DTSBD630 00491 WRK-PAID-2-1-THRU-2-10 DTSBD630 00492 WRK-PAID-AFTER-2-10 DTSBD630 00493 WRK-PAID-THRU-4-15 DTSBD630 00494 WRK-PAID-AFTER-4-15. DTSBD630 00495 DTSBD630 00496 DTSBD630 00497 MOVE 'N' TO WRK-LIABLE-IND DTSBD630 00498 WRK-FILED-IND. DTSBD630 00499 DTSBD630 00500 DTSBD630 00501 MOVE WRK-CERT-CURRENT-YEAR TO WRK-QTR-YR. DTSBD630 00502 DTSBD630 00503 DTSBD630 00504 PERFORM P1100-INIT-WRK-YRQ THRU P1100-EXIT DTSBD630 00505 VARYING WRK-YRQ-SUB FROM 1 BY 1 DTSBD630 00506 UNTIL WRK-YRQ-SUB > +4. DTSBD630 00507 DTSBD630 00508 DTSBD630 00509 INITIALIZE R708-DATA-AREA. DTSBD630 00510 P1000-EXIT. DTSBD630 00511 EXIT. DTSBD630 00512 SKIP3 DTSBD630 00513 P1100-INIT-WRK-YRQ. DTSBD630 00514 MOVE WRK-YRQ-SUB TO WRK-QTR-Q. DTSBD630 00515 DTSBD630 00516 MOVE WRK-QTR-9 TO WRK-YRQ (WRK-YRQ-SUB). DTSBD630 00517 DTSBD630 00518 MOVE 'N' TO WRK-YRQ-LIABLE-IND (WRK-YRQ-SUB) DTSBD630 00519 WRK-RPT-FILED-IND (WRK-YRQ-SUB). DTSBD630 00520 DTSBD630 00521 MOVE +0 TO WRK-RATE (WRK-YRQ-SUB) DTSBD630 00522 WRK-TAX-WAGE (WRK-YRQ-SUB). DTSBD630 00523 P1100-EXIT. DTSBD630 00524 EXIT. DTSBD630 00525 EJECT DTSBD630 00526 P4000-PROCESS-EMP-NO. DTSBD630 00527 PERFORM P4100-SET-YRQ-LIABLE THRU P4100-EXIT DTSBD630 00528 VARYING WRK-YRQ-IDX FROM 1 BY 1 DTSBD630 00529 UNTIL WRK-YRQ-IDX > 4. DTSBD630 00530 DTSBD630 00531 IF WRK-LIABLE-IND = 'N' DTSBD630 00532 GO TO P4000-EXIT. DTSBD630 00533 DTSBD630 00534 DTSBD630 00535 PERFORM P4200-MQTR-READ THRU P4200-EXIT DTSBD630 00536 VARYING WRK-YRQ-IDX FROM 1 BY 1 DTSBD630 00537 UNTIL WRK-YRQ-IDX > 4. DTSBD630 00538 DTSBD630 00539 IF WRK-FILED-IND = 'N' DTSBD630 00540 GO TO P4000-EXIT. DTSBD630 00541 DTSBD630 00542 DTSBD630 00543 MOVE LOW-VALUE TO MDST-KEY-AREA. DTSBD630 00544 DTSBD630 00545 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD630 00546 DTSBD630 00547 SET MDST-DST-88 TO TRUE. DTSBD630 00548 DTSBD630 00549 MOVE WRK-YRQ (1) TO MDST-YRQ. DTSBD630 00550 DTSBD630 00551 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD630 00552 DTSBD630 00553 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD630 00554 DTSBD630 00555 MOVE MSKL-REC TO MDST-REC. DTSBD630 00556 DTSBD630 00557 PERFORM P4300-MDST-BROWSE THRU P4300-EXIT DTSBD630 00558 UNTIL L910-NO-REC-88 DTSBD630 00559 OR MDST-YRQ > WRK-YRQ (4). DTSBD630 00560 P4000-EXIT. DTSBD630 00561 EXIT. DTSBD630 00562 EJECT DTSBD630 00563 P4100-SET-YRQ-LIABLE. DTSBD630 00564 MOVE WRK-YRQ (WRK-YRQ-IDX) TO L516-YRQ. DTSBD630 00565 DTSBD630 00566 PERFORM S516-LIABILITY THRU S516-EXIT. DTSBD630 00567 DTSBD630 00568 IF L516-LIABLE-88 DTSBD630 00569 MOVE 'Y' TO WRK-YRQ-LIABLE-IND (WRK-YRQ-IDX) DTSBD630 00570 WRK-LIABLE-IND. DTSBD630 00571 P4100-EXIT. DTSBD630 00572 EXIT. DTSBD630 00573 SKIP3 DTSBD630 00574 P4200-MQTR-READ. DTSBD630 00575 IF WRK-YRQ-LIABLE-IND (WRK-YRQ-IDX) = 'N' DTSBD630 00576 GO TO P4200-EXIT. DTSBD630 00577 DTSBD630 00578 DTSBD630 00579 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD630 00580 DTSBD630 00581 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD630 00582 DTSBD630 00583 SET MQTR-QTR-88 TO TRUE. DTSBD630 00584 DTSBD630 00585 MOVE WRK-YRQ (WRK-YRQ-IDX) TO MQTR-YRQ. DTSBD630 00586 DTSBD630 00587 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD630 00588 DTSBD630 00589 PERFORM S910-READ THRU S910-EXIT. DTSBD630 00590 DTSBD630 00591 IF L910-NO-REC-88 DTSBD630 00592 GO TO P4200-EXIT. DTSBD630 00593 DTSBD630 00594 MOVE MSKL-REC TO MQTR-REC. DTSBD630 00595 DTSBD630 00596 DTSBD630 00597 IF NOT MQTR-CURR-RCVD-88 DTSBD630 00598 GO TO P4200-EXIT. DTSBD630 00599 DTSBD630 00600 DTSBD630 00601 MOVE 'Y' TO WRK-RPT-FILED-IND (WRK-YRQ-IDX) DTSBD630 00602 WRK-FILED-IND. DTSBD630 00603 DTSBD630 00604 MOVE MQTR-UI-RATE TO WRK-RATE (WRK-YRQ-IDX). DTSBD630 00605 DTSBD630 00606 MOVE MQTR-TAX-WAGE TO WRK-TAX-WAGE (WRK-YRQ-IDX). DTSBD630 00607 DTSBD630 00608 ADD MQTR-TAX-WAGE TO WRK-YR-TAX-WAGE. DTSBD630 00609 P4200-EXIT. DTSBD630 00610 EXIT. DTSBD630 00611 EJECT DTSBD630 00612 P4300-MDST-BROWSE. DTSBD630 00613 MOVE MDST-YRQ TO WRK-QTR-9. DTSBD630 00614 DTSBD630 00615 IF WRK-RPT-FILED-IND (WRK-QTR-Q) = 'Y' DTSBD630 00616 PERFORM P4310-DSTRB-DATA-LOOP THRU P4310-EXIT DTSBD630 00617 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD630 00618 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD630 00619 DTSBD630 00620 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD630 00621 DTSBD630 00622 MOVE MSKL-REC TO MDST-REC. DTSBD630 00623 P4300-EXIT. DTSBD630 00624 EXIT. DTSBD630 00625 SKIP3 DTSBD630 00626 P4310-DSTRB-DATA-LOOP. DTSBD630 00627 ***************************************************************** DTSBD630 00628 *** REPORT UI TAX PAYMENTS TWICE - (ONCE IN THE PRIOR 2/1, DTSBD630 00629 *** 2/1-2/10, AFTER 2/10 DATA ELEMENTS) AND (ONCE IN THE 4/15 OR DTSBD630 00630 *** PRIOR, AFTER 4/15 DATA ELEMENTS). DTSBD630 00631 ***************************************************************** DTSBD630 00632 IF NOT MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBD630 00633 GO TO P4310-EXIT. DTSBD630 00634 DTSBD630 00635 DTSBD630 00636 IF MDST-RECEIVED-DATE < WRK-CERT-FEB-1-DATE DTSBD630 00637 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-PRIOR-2-1 DTSBD630 00638 ELSE DTSBD630 00639 IF MDST-RECEIVED-DATE > WRK-CERT-FEB-10-DATE DTSBD630 00640 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-AFTER-2-10 DTSBD630 00641 ELSE DTSBD630 00642 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-2-1-THRU-2-10. DTSBD630 00643 DTSBD630 00644 DTSBD630 00645 IF MDST-RECEIVED-DATE > WRK-CERT-APR-15-DATE DTSBD630 00646 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-AFTER-4-15 DTSBD630 00647 ELSE DTSBD630 00648 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-PAID-THRU-4-15. DTSBD630 00649 P4310-EXIT. DTSBD630 00650 EXIT. DTSBD630 00651 EJECT DTSBD630 00652 P5100-WRITE-POT. DTSBD630 00653 INITIALIZE POT-REC. DTSBD630 00654 DTSBD630 00655 DTSBD630 00656 MOVE 'DC' TO POT-STATE-CD. DTSBD630 00657 DTSBD630 00658 MOVE MPRF-FEIN TO POT-FEIN. DTSBD630 00659 DTSBD630 00660 MOVE SPACE TO POT-EMP-NO-AREA. DTSBD630 00661 DTSBD630 00662 MOVE MPRF-EMP-NO TO POT-EMP-NO. DTSBD630 00663 DTSBD630 00664 MOVE WRK-TAX-PERIOD TO POT-TAX-PERIOD. DTSBD630 00665 DTSBD630 00666 MOVE +0 TO RATE-CNT. DTSBD630 00667 DTSBD630 00668 PERFORM P5110-WRK-YRQ-LOOP THRU P5110-EXIT DTSBD630 00669 VARYING WRK-YRQ-IDX FROM 1 BY 1 DTSBD630 00670 UNTIL WRK-YRQ-IDX > +4. DTSBD630 00671 DTSBD630 00672 MOVE WRK-PAID-PRIOR-2-1 TO POT-PAID-PRIOR-2-1. DTSBD630 00673 DTSBD630 00674 MOVE WRK-PAID-2-1-THRU-2-10 TO POT-PAID-2-1-THRU-2-10. DTSBD630 00675 DTSBD630 00676 MOVE WRK-PAID-AFTER-2-10 TO POT-PAID-AFTER-2-10. DTSBD630 00677 DTSBD630 00678 MOVE WRK-PAID-THRU-4-15 TO POT-PAID-THRU-4-15. DTSBD630 00679 DTSBD630 00680 MOVE WRK-PAID-AFTER-4-15 TO POT-PAID-AFTER-4-15. DTSBD630 00681 DTSBD630 00682 PERFORM P5120-ADDRESS THRU P5120-EXIT. DTSBD630 00683 DTSBD630 00684 WRITE POT-REC. DTSBD630 00685 DTSBD630 00686 ADD +1 TO POT-REC-CNT. DTSBD630 00687 P5100-EXIT. DTSBD630 00688 EXIT. DTSBD630 00689 EJECT DTSBD630 00690 P5110-WRK-YRQ-LOOP. DTSBD630 00691 IF WRK-RATE (WRK-YRQ-IDX) = +0 DTSBD630 00692 AND DTSBD630 00693 WRK-TAX-WAGE (WRK-YRQ-IDX) = +0 DTSBD630 00694 GO TO P5110-EXIT. DTSBD630 00695 DTSBD630 00696 DTSBD630 00697 MOVE 'N' TO RATE-MATCH. DTSBD630 00698 DTSBD630 00699 PERFORM P5111-MATCH-LOOP THRU P5111-EXIT DTSBD630 00700 VARYING RATE-SUB FROM 1 BY 1 DTSBD630 00701 UNTIL (RATE-SUB > RATE-CNT) DTSBD630 00702 OR DTSBD630 00703 (RATE-MATCH = 'Y'). DTSBD630 00704 DTSBD630 00705 DTSBD630 00706 IF RATE-MATCH = 'Y' DTSBD630 00707 SUBTRACT 1 FROM RATE-SUB DTSBD630 00708 ADD WRK-TAX-WAGE (WRK-YRQ-IDX) DTSBD630 00709 TO POT-TAX-WAGE (RATE-SUB) DTSBD630 00710 R708-TAX-WAGE (RATE-SUB) DTSBD630 00711 ELSE DTSBD630 00712 ADD +1 TO RATE-CNT DTSBD630 00713 MOVE WRK-RATE (WRK-YRQ-IDX) DTSBD630 00714 TO POT-RATE (RATE-CNT) DTSBD630 00715 R708-RATE (RATE-CNT) DTSBD630 00716 MOVE WRK-TAX-WAGE (WRK-YRQ-IDX) DTSBD630 00717 TO POT-TAX-WAGE (RATE-CNT) DTSBD630 00718 R708-TAX-WAGE (RATE-CNT). DTSBD630 00719 P5110-EXIT. DTSBD630 00720 EXIT. DTSBD630 00721 SKIP3 DTSBD630 00722 P5111-MATCH-LOOP. DTSBD630 00723 IF WRK-RATE (WRK-YRQ-IDX) = POT-RATE (RATE-SUB) DTSBD630 00724 MOVE 'Y' TO RATE-MATCH. DTSBD630 00725 P5111-EXIT. DTSBD630 00726 EXIT. DTSBD630 00727 EJECT DTSBD630 00728 P5120-ADDRESS. DTSBD630 00729 MOVE MPRF-PRIMARY-NAME TO POT-NAME (1). DTSBD630 00730 DTSBD630 00731 DTSBD630 00732 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBD630 00733 DTSBD630 00734 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBD630 00735 DTSBD630 00736 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBD630 00737 DTSBD630 00738 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBD630 00739 DTSBD630 00740 IF L111-ADDR-NOT-FOUND-88 DTSBD630 00741 GO TO P5120-EXIT. DTSBD630 00742 DTSBD630 00743 DTSBD630 00744 *****IF L111-NAME = SPACE DTSBD630 00745 *********MOVE +2 TO NAME-SUB DTSBD630 00746 *****ELSE DTSBD630 00747 *********MOVE L111-NAME TO L071-NAM DTSBD630 00748 *********PERFORM S071-FROM-LAST-NAME-FIRST THRU S071-EXIT DTSBD630 00749 *********IF L111-TITLE = SPACE DTSBD630 00750 *************MOVE L071-NAM TO POT-NAME (2) DTSBD630 00751 *********ELSE DTSBD630 00752 *************STRING L071-NAM DELIMITED BY ' ' DTSBD630 00753 ********************', ' DELIMITED BY SIZE DTSBD630 00754 ********************L111-TITLE DELIMITED BY SIZE DTSBD630 00755 *****************INTO POT-NAME (2) DTSBD630 00756 *********END-IF DTSBD630 00757 *********MOVE +3 TO NAME-SUB. DTSBD630 00758 DTSBD630 00759 MOVE +1 TO NAME-SUB. DTSBD630 00760 DTSBD630 00761 IF L111-ATTN-LINE = SPACES OR LOW-VALUES DTSBD630 00762 NEXT SENTENCE DTSBD630 00763 ELSE DTSBD630 00764 ADD +1 TO NAME-SUB DTSBD630 00765 MOVE L111-ATTN-LINE TO POT-NAME (NAME-SUB). DTSBD630 00766 DTSBD630 00767 IF L111-DELIV-LINE-1 = SPACES OR LOW-VALUES DTSBD630 00768 NEXT SENTENCE DTSBD630 00769 ELSE DTSBD630 00770 ADD +1 TO NAME-SUB DTSBD630 00771 MOVE L111-DELIV-LINE-1 TO POT-NAME (NAME-SUB). DTSBD630 00772 DTSBD630 00773 MOVE L111-DELIV-LINE-2 TO POT-STREET. DTSBD630 00774 DTSBD630 00775 STRING L111-CITY DELIMITED BY ' ' DTSBD630 00776 ', ' DELIMITED BY SIZE DTSBD630 00777 L111-ST DELIMITED BY SIZE DTSBD630 00778 INTO POT-CITY-ST. DTSBD630 00779 DTSBD630 00780 MOVE SPACES TO POT-ZIP. DTSBD630 00781 DTSBD630 00782 MOVE L111-ZIP TO WRK-MPRF-ZIP DTSBD630 00783 POT-ZIP-FIRST-9. DTSBD630 00784 DTSBD630 00785 IF WRK-MPRF-ZIP-2 NUMERIC DTSBD630 00786 MOVE WRK-MPRF-ZIP-2 TO POT-ZIP-2. DTSBD630 00787 P5120-EXIT. DTSBD630 00788 EXIT. DTSBD630 00789 EJECT DTSBD630 00790 P5200-WRITE-R708. DTSBD630 00791 MOVE MPRF-FEIN TO R708-FEIN. DTSBD630 00792 DTSBD630 00793 MOVE MPRF-EMP-NO TO R708-EMP-NO. DTSBD630 00794 DTSBD630 00795 MOVE WRK-TAX-PERIOD TO R708-TAX-PERIOD. DTSBD630 00796 DTSBD630 00797 MOVE WRK-PAID-PRIOR-2-1 TO R708-ONTIME. DTSBD630 00798 DTSBD630 00799 MOVE WRK-PAID-2-1-THRU-2-10 TO R708-GRACE. DTSBD630 00800 DTSBD630 00801 MOVE WRK-PAID-AFTER-2-10 TO R708-LATE. DTSBD630 00802 DTSBD630 00803 MOVE WRK-PAID-THRU-4-15 TO R708-ONTIME-SCHED-H. DTSBD630 00804 DTSBD630 00805 MOVE WRK-PAID-AFTER-4-15 TO R708-LATE-SCHED-H. DTSBD630 00806 DTSBD630 00807 MOVE RATE-CNT TO R708-WAGE-RATE-CNT. DTSBD630 00808 DTSBD630 00809 PERFORM S946-WRITE-R708 THRU S946-EXIT. DTSBD630 00810 P5200-EXIT. DTSBD630 00811 EXIT. DTSBD630 00812 EJECT DTSBD630 00813 T0000-TERMINATE. DTSBD630 00814 DISPLAY ' '. DTSBD630 00815 DTSBD630 00816 DISPLAY '*** DTSBD630 TERMINATION STATISTICS'. DTSBD630 00817 DTSBD630 00818 DISPLAY ' '. DTSBD630 00819 DTSBD630 00820 DISPLAY '*** ' DTSBD630 00821 PRF-REC-CNT DTSBD630 00822 ' MPRF RECORDS READ'. DTSBD630 00823 DTSBD630 00824 DISPLAY '*** ' DTSBD630 00825 POT-REC-CNT DTSBD630 00826 ' POTENTIAL NON-FEDERAL FILER RECORDS WRITTEN'. DTSBD630 00827 DTSBD630 00828 CLOSE POT-FILE. DTSBD630 00829 DTSBD630 00830 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD630 00831 DTSBD630 00832 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD630 00833 DTSBD630 00834 PERFORM S971-CLOSE THRU S971-EXIT. DTSBD630 00835 DTSBD630 00836 MOVE -1 TO RSK1-LENGTH. DTSBD630 00837 DTSBD630 00838 PERFORM S946-WRITE-RSKL THRU S946-EXIT. DTSBD630 00839 T0000-EXIT. DTSBD630 00840 EXIT. DTSBD630 00841 EJECT DTSBD630 00842 *S071-FROM-LAST-NAME-FIRST. DTSBD630 00843 *****SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSBD630 00844 *****CALL 'DTSBU071' USING L071-LINK-AREA. DTSBD630 00845 *S071-EXIT. DTSBD630 00846 *****EXIT. DTSBD630 00847 SKIP3 DTSBD630 00848 S111-LOOKUP-ADDR. DTSBD630 00849 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBD630 00850 S111-EXIT. DTSBD630 00851 EXIT. DTSBD630 00852 SKIP3 DTSBD630 00853 S516-LIABILITY. DTSBD630 00854 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD630 00855 MPRF-REC. DTSBD630 00856 S516-EXIT. DTSBD630 00857 EXIT. DTSBD630 00858 SKIP3 DTSBD630 00859 S910-OPEN-READ. DTSBD630 00860 SET L910-OPEN-READ-88 TO TRUE. DTSBD630 00861 GO TO S910-MSTR-IO. DTSBD630 00862 DTSBD630 00863 S910-READ. DTSBD630 00864 SET L910-READ-88 TO TRUE. DTSBD630 00865 GO TO S910-MSTR-IO. DTSBD630 00866 DTSBD630 00867 S910-START-BROWSE. DTSBD630 00868 SET L910-START-BROWSE-88 TO TRUE. DTSBD630 00869 GO TO S910-MSTR-IO. DTSBD630 00870 DTSBD630 00871 S910-READ-NEXT. DTSBD630 00872 SET L910-READ-NEXT-88 TO TRUE. DTSBD630 00873 GO TO S910-MSTR-IO. DTSBD630 00874 DTSBD630 00875 *S910-COUNT. DTSBD630 00876 *****SET L910-COUNT-88 TO TRUE. DTSBD630 00877 *****GO TO S910-MSTR-IO. DTSBD630 00878 DTSBD630 00879 S910-CLOSE. DTSBD630 00880 SET L910-CLOSE-88 TO TRUE. DTSBD630 00881 GO TO S910-MSTR-IO. DTSBD630 00882 DTSBD630 00883 S910-MSTR-IO. DTSBD630 00884 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD630 00885 MSKL-REC. DTSBD630 00886 S910-EXIT. DTSBD630 00887 EXIT. DTSBD630 00888 SKIP3 DTSBD630 00889 S931-OPEN-READ. DTSBD630 00890 SET L931-OPEN-READ-88 TO TRUE. DTSBD630 00891 GO TO S931-REF-IO. DTSBD630 00892 DTSBD630 00893 S931-CLOSE. DTSBD630 00894 SET L931-CLOSE-88 TO TRUE. DTSBD630 00895 GO TO S931-REF-IO. DTSBD630 00896 DTSBD630 00897 S931-REF-IO. DTSBD630 00898 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD630 00899 FSKL-REC. DTSBD630 00900 S931-EXIT. DTSBD630 00901 EXIT. DTSBD630 00902 SKIP3 DTSBD630 00903 S971-OPEN-READ. DTSBD630 00904 SET L971-OPEN-READ-88 TO TRUE. DTSBD630 00905 GO TO S971-CURR-CERT-IO. DTSBD630 00906 DTSBD630 00907 S971-READ. DTSBD630 00908 SET L971-READ-88 TO TRUE. DTSBD630 00909 GO TO S971-CURR-CERT-IO. DTSBD630 00910 DTSBD630 00911 S971-START-BROWSE. DTSBD630 00912 SET L971-START-BROWSE-88 TO TRUE. DTSBD630 00913 GO TO S971-CURR-CERT-IO. DTSBD630 00914 DTSBD630 00915 *S971-READ-NEXT. DTSBD630 00916 *****SET L971-READ-NEXT-88 TO TRUE. DTSBD630 00917 *****GO TO S971-CURR-CERT-IO. DTSBD630 00918 DTSBD630 00919 S971-CLOSE. DTSBD630 00920 SET L971-CLOSE-88 TO TRUE. DTSBD630 00921 GO TO S971-CURR-CERT-IO. DTSBD630 00922 DTSBD630 00923 S971-CURR-CERT-IO. DTSBD630 00924 CALL 'DTSBU971' USING L971-LINK-AREA DTSBD630 00925 X971-REC. DTSBD630 00926 S971-EXIT. DTSBD630 00927 EXIT. DTSBD630 00928 SKIP3 DTSBD630 00929 S946-WRITE-RSKL. DTSBD630 00930 CALL 'DTSBU946' USING RSKL-REC. DTSBD630 00931 GO TO S946-EXIT. DTSBD630 00932 DTSBD630 00933 S946-WRITE-R708. DTSBD630 00934 CALL 'DTSBU946' USING R708-REC. DTSBD630 00935 GO TO S946-EXIT. DTSBD630 00936 DTSBD630 00937 S946-EXIT. DTSBD630 00938 EXIT. DTSBD630 00939 SKIP3 DTSBD630 00940 S999-ABEND. DTSBD630 00941 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD630 00942 S999-EXIT. DTSBD630 00943 EXIT. DTSBD630