708 lines
56 KiB
COBOL
708 lines
56 KiB
COBOL
00001 IDENTIFICATION DIVISION. 01/24/01
|
|
00002 PROGRAM-ID. DTSBR603. DTSBR603
|
|
00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV128
|
|
00004 DATE-WRITTEN. OCTOBER 1994. DTSBR603
|
|
00005 DATE-COMPILED. DTSBR603
|
|
00006 * DTSBR603
|
|
00007 * DTSBR603
|
|
00008 ***** DTSBR603
|
|
00009 * CALLING SEQUENCE: DTSBD300 CALLS DTSBR603
|
|
00010 * DTSBD331 WHICH CREATES DTSIR603 DTSBR603
|
|
00011 * DTSBR603 READS DTSIR603 RECORDS. DTSBR603
|
|
00012 * DTSBR603
|
|
00013 * FUNCTION: FIELD ASSIGNMENT REPORT TAX DATA. DTSBR603
|
|
00014 * DTSBR603
|
|
00015 * MODIFICATION HISTORY: DTSBR603
|
|
00016 * DTSBR603
|
|
00017 * 10-26-94 INITIAL DEVELOPMENT DTSBR603
|
|
00018 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR603
|
|
00019 * DTSBR603
|
|
00020 * 12-14-94 ADD FIELD REP OPID. DTSBR603
|
|
00021 * REFERENCE RFP #CR024 AUTHOR OF CHANGE - RHC DTSBR603
|
|
00022 * DTSBR603
|
|
00023 * 03-16-95 ADD REPORT 603R2 - FIELD ASSIGNMENT EXPORT REPORT. DTSBR603
|
|
00024 * REFERENCE RFP #CR054 AUTHOR OF CHANGE - RHC DTSBR603
|
|
00025 * DTSBR603
|
|
00026 * 04-07-95 RECOMPILED FOR R991-UNIT-DSCR PER CHANGE REQUEST 064 DTSBR603
|
|
00027 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR603
|
|
00028 * DTSBR603
|
|
00029 * 10-22-99 HEADER AND DETAIL LINE CORRECTIONS DTSBR603
|
|
00030 * CHANGED ZZZ,ZZZ.99 TO ZZZ,ZZ9.99 IN DETAIL-LINE DTSBR603
|
|
00031 * AND ADDED W-EMP-NO-RE AUTHOR OF CHANGE -**FB DTSBR603
|
|
00032 * DTSBR603
|
|
00033 * 10-30-00 FIXED MISHANDLING OF MAIL/PHYS ADDRS & T B D DTSBR603
|
|
00034 * DTSBR603
|
|
00035 * AUTHOR OF CHANGE - JHP DTSBR603
|
|
00036 * DTSBR603
|
|
00037 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR603
|
|
00038 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR603
|
|
00039 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR603
|
|
00040 * DTSBR603
|
|
00041 * DTSBR603
|
|
00042 * DESCRIPTION: DTSBR603
|
|
00043 * DTSBR603
|
|
00044 * THIS MODULE BUILDS VARIABLE LENGTH RECORDS FOR DOWNLOAD DTSBR603
|
|
00045 * TO A PC SPREADSHEET IN AID OF A FIELD ASSIGNMENT. DTSBR603
|
|
00046 * DTSBR603
|
|
00047 * THIS IS AN "AT LEAST ONCE" MODULE. DTSBR603
|
|
00048 * DTSBR603
|
|
00049 * DTSBR603
|
|
00050 * RECORDS READ: DTSBR603
|
|
00051 * DTSBR603
|
|
00052 * NONE. DTSBR603
|
|
00053 * DTSBR603
|
|
00054 * PRINTED OUTPUTS: DTSBR603
|
|
00055 * DTSBR603
|
|
00056 * NONE. DTSBR603
|
|
00057 * DTSBR603
|
|
00058 * RECORDS WRITTEN: DTSBR603
|
|
00059 * DTSBR603
|
|
00060 * 603R1 FIELD ASSIGNMENT REPORT DTSBR603
|
|
00061 * DTSBR603
|
|
00062 * MODULES CALLED: DTSBR603
|
|
00063 * DTSBR603
|
|
00064 * DTSBU001 DATE EDIT/CONVERSION MODULE DTSBR603
|
|
00065 * DTSBU056 RATE DISPLAY MODULE DTSBR603
|
|
00066 * DTSBU062 FIELD REP ID EDIT/DESCRIPTION MODULE DTSBR603
|
|
00067 * DTSBU143 VARIABLE LENGTH RECORD CONSTRUCTION MODULE DTSBR603
|
|
00068 * DTSBR603
|
|
00069 * DTSBR603
|
|
00070 ***** DTSBR603
|
|
00071 * DTSBR603
|
|
00072 * DTSBR603
|
|
00073 ENVIRONMENT DIVISION. DTSBR603
|
|
00074 CONFIGURATION SECTION. DTSBR603
|
|
00075 SPECIAL-NAMES. DTSBR603
|
|
00076 C01 IS TOP-OF-PAGE. DTSBR603
|
|
00077 SKIP2 DTSBR603
|
|
00078 INPUT-OUTPUT SECTION. DTSBR603
|
|
00079 DTSBR603
|
|
00080 FILE-CONTROL. DTSBR603
|
|
00081 SELECT PRT-FILE ASSIGN TO RPT603R1. DTSBR603
|
|
00082 SKIP2 DTSBR603
|
|
00083 DATA DIVISION. DTSBR603
|
|
00084 SKIP2 DTSBR603
|
|
00085 FILE SECTION. DTSBR603
|
|
00086 SKIP2 DTSBR603
|
|
00087 FD PRT-FILE DTSBR603
|
|
00088 RECORDING MODE IS F DTSBR603
|
|
00089 DATA RECORD IS REPORT-REC. DTSBR603
|
|
00090 01 REPORT-REC PIC X(133). DTSBR603
|
|
00091 EJECT DTSBR603
|
|
00092 WORKING-STORAGE SECTION. DTSBR603
|
|
000925 77 PAN-VALET PICTURE X(24) VALUE '128DTSBR603 01/24/01'. DTSBR603
|
|
00093 * DTSBR603
|
|
00094 01 WRK-AREA. DTSBR603
|
|
00095 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +603.DTSBR603
|
|
00096 05 SUB PIC 9(04) VALUE ZERO. DTSBR603
|
|
00097 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR603
|
|
00098 DTSBR603
|
|
00099 05 WS-MISC-DATA PIC X(35) VALUE SPACES. DTSBR603
|
|
00100 DTSBR603
|
|
00101 05 WS-FIELD-REP-INFO. DTSBR603
|
|
00102 10 WS-FIELD-REP-ID-LAST PIC X(02) VALUE SPACE. DTSBR603
|
|
00103 10 FILLER PIC X(02) VALUE SPACE. DTSBR603
|
|
00104 10 WS-FIELD-REP-NAME PIC X(32) VALUE SPACE. DTSBR603
|
|
00105 DTSBR603
|
|
00106 05 WS-PAGE-COUNT PIC 9(04) VALUE ZERO. DTSBR603
|
|
00107 05 WS-LINE-COUNT PIC 9(04) VALUE ZERO. DTSBR603
|
|
00108 05 WS-ASSIGN-NO-OUTPUT PIC 9(07) VALUE ZERO. DTSBR603
|
|
00109 DTSBR603
|
|
00110 05 WS-YR-QTR PIC 9(05) VALUE ZERO. DTSBR603
|
|
00111 05 WS-YR-QTR-R REDEFINES WS-YR-QTR. DTSBR603
|
|
00112 10 WS-YQTR-CC PIC 99. DTSBR603
|
|
00113 10 WS-YQTR-YR PIC 99. DTSBR603
|
|
00114 10 WS-YQTR-MM PIC 9. DTSBR603
|
|
00115 05 WS-DISPLAY-YQTR. DTSBR603
|
|
00116 10 WS-DISPLAY-YR PIC X(02) VALUE SPACE. DTSBR603
|
|
00117 10 FILLER PIC X(01) VALUE '/'. DTSBR603
|
|
00118 10 WS-DISPLAY-MM PIC X(01) VALUE SPACE. DTSBR603
|
|
00119 05 WS-VOICE-OUTPUT PIC X(09) VALUE SPACE. DTSBR603
|
|
00120 05 WS-VOICE-OUTPUT-R. DTSBR603
|
|
00121 10 WS-VOICE-OUTPUT-EDIT1 PIC X(03) VALUE SPACE. DTSBR603
|
|
00122 10 FILLER PIC X(01) VALUE '-'. DTSBR603
|
|
00123 10 WS-VOICE-OUTPUT-EDIT2 PIC X(03) VALUE SPACE. DTSBR603
|
|
00124 10 FILLER PIC X(01) VALUE '-'. DTSBR603
|
|
00125 10 WS-VOICE-OUTPUT-EDIT3 PIC X(04) VALUE SPACE. DTSBR603
|
|
00126 05 WS-START-DATE-OUTPUT PIC X(08) VALUE SPACE. DTSBR603
|
|
00127 05 WS-AUDIT-START-YRQ-OUTPUT. DTSBR603
|
|
00128 10 WS-AUDIT-START-YRQ-OUTPUT-R DTSBR603
|
|
00129 PIC 99/9. DTSBR603
|
|
00130 05 WS-AUDIT-END-YRQ-OUTPUT. DTSBR603
|
|
00131 10 WS-AUDIT-END-YRQ-OUTPUT-R DTSBR603
|
|
00132 PIC 99/9. DTSBR603
|
|
00133 DTSBR603
|
|
00134 05 WS-OPO-SSN-UNPACK PIC 9(09) VALUE ZERO. DTSBR603
|
|
00135 05 WS-OPO-SSN-OUTPUT. DTSBR603
|
|
00136 10 WS-OPO-SSN-OUTPUT-EDIT1 PIC 9(03) VALUE ZERO. DTSBR603
|
|
00137 10 FILLER PIC X(01) VALUE '-'. DTSBR603
|
|
00138 10 WS-OPO-SSN-OUTPUT-EDIT2 PIC 9(02) VALUE ZERO. DTSBR603
|
|
00139 10 FILLER PIC X(01) VALUE '-'. DTSBR603
|
|
00140 10 WS-OPO-SSN-OUTPUT-EDIT3 PIC 9(04) VALUE ZERO. DTSBR603
|
|
00141 DTSBR603
|
|
00142 EJECT DTSBR603
|
|
00143 05 WS-HEADER-1. DTSBR603
|
|
00144 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00145 10 WS-REPORT-TYPE PIC X(05) VALUE DTSBR603
|
|
00146 '603R1'. DTSBR603
|
|
00147 10 FILLER PIC X(35) VALUE SPACE. DTSBR603
|
|
00148 10 WS-LRCM-AGY-NAME-LINE1 PIC X(50) VALUE SPACE. DTSBR603
|
|
00149 10 FILLER PIC X(28) VALUE SPACE. DTSBR603
|
|
00150 10 FILLER PIC X(05) DTSBR603
|
|
00151 VALUE 'DATE:'. DTSBR603
|
|
00152 10 WS-LRCM-SYS-DATE PIC X(08) VALUE SPACE. DTSBR603
|
|
00153 05 WS-HEADER-2. DTSBR603
|
|
00154 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00155 10 FILLER PIC X(40) VALUE SPACE. DTSBR603
|
|
00156 10 WS-LRCM-AGY-NAME-LINE2 PIC X(50) VALUE SPACE. DTSBR603
|
|
00157 10 FILLER PIC X(28) VALUE SPACE. DTSBR603
|
|
00158 10 FILLER PIC X(05) DTSBR603
|
|
00159 VALUE 'TIME:'. DTSBR603
|
|
00160 10 WS-LRCM-SYS-TIME PIC X(08) VALUE SPACE. DTSBR603
|
|
00161 05 WS-HEADER-3. DTSBR603
|
|
00162 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00163 10 FILLER PIC X(10) VALUE DTSBR603
|
|
00164 'ROUTE TO: '. DTSBR603
|
|
00165 10 WS-HEADER-3-UNIT PIC X(20) VALUE SPACE. DTSBR603
|
|
00166 10 FILLER PIC X(10) VALUE SPACE. DTSBR603
|
|
00167 10 WS-HEADER-3-TITLE PIC X(50) VALUE SPACE. DTSBR603
|
|
00168 10 FILLER PIC X(28) VALUE SPACE. DTSBR603
|
|
00169 10 FILLER PIC X(05) DTSBR603
|
|
00170 VALUE 'PAGE:'. DTSBR603
|
|
00171 10 FILLER PIC X(02) VALUE SPACE. DTSBR603
|
|
00172 10 W-PAGE-CNTR PIC ZZ,ZZ9. DTSBR603
|
|
00173 DTSBR603
|
|
00174 05 WS-LINE-01. DTSBR603
|
|
00175 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00176 10 FILLER PIC X(10) VALUE DTSBR603
|
|
00177 'ASSIGN NO:'. DTSBR603
|
|
00178 10 FILLER PIC X(06) VALUE SPACE. DTSBR603
|
|
00179 10 W-ASSIGN-NO PIC 999B99999. DTSBR603
|
|
00180 10 FILLER PIC X(45) VALUE SPACE. DTSBR603
|
|
00181 10 FILLER PIC X(20) VALUE DTSBR603
|
|
00182 '--------------------'. DTSBR603
|
|
00183 10 FILLER PIC X(24) VALUE DTSBR603
|
|
00184 ' OWNER/PARTNER/OFFICERS '. DTSBR603
|
|
00185 10 FILLER PIC X(20) VALUE DTSBR603
|
|
00186 '--------------------'. DTSBR603
|
|
00187 05 WS-LINE-02. DTSBR603
|
|
00188 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00189 10 FILLER PIC X(10) VALUE DTSBR603
|
|
00190 'FIELD REP:'. DTSBR603
|
|
00191 10 FILLER PIC X(06) VALUE SPACE. DTSBR603
|
|
00192 10 W-FLD-ID PIC X(02) VALUE SPACE. DTSBR603
|
|
00193 10 FILLER PIC X(02) VALUE SPACE. DTSBR603
|
|
00194 10 W-FLD-REP-NAME PIC X(35) VALUE SPACE. DTSBR603
|
|
00195 10 FILLER PIC X(45) VALUE SPACE. DTSBR603
|
|
00196 10 FILLER PIC X(45) VALUE SPACE. DTSBR603
|
|
00197 10 FILLER PIC X(20) VALUE DTSBR603
|
|
00198 ' NAME '. DTSBR603
|
|
00199 10 FILLER PIC X(24) VALUE DTSBR603
|
|
00200 ' TITLE '. DTSBR603
|
|
00201 10 FILLER PIC X(20) VALUE DTSBR603
|
|
00202 ' SSN '. DTSBR603
|
|
00203 05 WS-LINE-03. DTSBR603
|
|
00204 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00205 10 FILLER PIC X(10) VALUE DTSBR603
|
|
00206 'OPERATOR :'. DTSBR603
|
|
00207 10 FILLER PIC X(06) VALUE SPACE. DTSBR603
|
|
00208 10 W-OPER-ID PIC X(08) VALUE SPACE. DTSBR603
|
|
00209 DTSBR603
|
|
00210 05 WS-LINE-04. DTSBR603
|
|
00211 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00212 10 W-LINE-04-TAG PIC X(10) VALUE DTSBR603
|
|
00213 ' EMP NO:'. DTSBR603
|
|
00214 10 FILLER PIC X(06) VALUE SPACE. DTSBR603
|
|
00215 10 W-EMP-NO PIC 999B999. DTSBR603
|
|
00216 10 W-EMP-NO-RE REDEFINES W-EMP-NO DTSBR603
|
|
00217 PIC XXXBXXX. DTSBR603
|
|
00218 10 W-LINE-04-VARIABLE-DATA PIC X(107) VALUE SPACE. DTSBR603
|
|
00219 05 W-LINE-DATA OCCURS 5 TIMES. DTSBR603
|
|
00220 15 W-LABEL PIC X(08) VALUE SPACE. DTSBR603
|
|
00221 15 W-VARIABLE-DATA PIC X(35) VALUE SPACE. DTSBR603
|
|
00222 15 W-FILLER1 PIC X(04) VALUE SPACE. DTSBR603
|
|
00223 15 W-OPER-NAME PIC X(20) VALUE SPACE. DTSBR603
|
|
00224 15 W-FILLER2 PIC X(04) VALUE SPACE. DTSBR603
|
|
00225 15 W-OPER-TITLE PIC X(15) VALUE SPACE. DTSBR603
|
|
00226 15 W-FILLER2 PIC X(04) VALUE SPACE. DTSBR603
|
|
00227 15 W-OPER-SSN PIC X(11) VALUE SPACE. DTSBR603
|
|
00228 05 WS-LINE-05. DTSBR603
|
|
00229 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00230 10 FILLER PIC X(31) VALUE SPACES. DTSBR603
|
|
00231 10 W-PHONE-OUTPUT PIC X(15) VALUE SPACE. DTSBR603
|
|
00232 05 WS-LINE-06. DTSBR603
|
|
00233 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00234 10 FILLER PIC X(11) VALUE DTSBR603
|
|
00235 ' ORG TYPE:'. DTSBR603
|
|
00236 10 FILLER PIC X(06) VALUE SPACE. DTSBR603
|
|
00237 10 W-ORG-TYPE PIC X(03) VALUE SPACE. DTSBR603
|
|
00238 10 FILLER PIC X(10) VALUE SPACE. DTSBR603
|
|
00239 10 W-ORG-NAME PIC X(35) VALUE SPACE. DTSBR603
|
|
00240 05 WS-LINE-07. DTSBR603
|
|
00241 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00242 10 FILLER PIC X(11) VALUE DTSBR603
|
|
00243 ' FEIN NO:'. DTSBR603
|
|
00244 10 FILLER PIC X(06) VALUE SPACE. DTSBR603
|
|
00245 10 W-FEIN-NO PIC 99B9999999. DTSBR603
|
|
00246 10 FILLER PIC X(09) VALUE SPACE. DTSBR603
|
|
00247 10 FILLER PIC X(10) VALUE DTSBR603
|
|
00248 'SIC CODE :'. DTSBR603
|
|
00249 10 FILLER PIC X(04) VALUE SPACE. DTSBR603
|
|
00250 10 W-SIC-CD PIC X(04) VALUE SPACE. DTSBR603
|
|
00251 10 FILLER PIC X(10) VALUE SPACES. DTSBR603
|
|
00252 10 FILLER PIC X(11) VALUE DTSBR603
|
|
00253 'NAICS CODE:'. DTSBR603
|
|
00254 10 FILLER PIC X(06) VALUE SPACES. DTSBR603
|
|
00255 10 W-NAICS-CD PIC X(06) VALUE SPACE. DTSBR603
|
|
00256 05 WS-LINE-08. DTSBR603
|
|
00257 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00258 10 FILLER PIC X(11) VALUE DTSBR603
|
|
00259 'CREDIT IND:'. DTSBR603
|
|
00260 10 FILLER PIC X(06) VALUE SPACE. DTSBR603
|
|
00261 10 W-CREDIT-IND PIC X(01) VALUE SPACE. DTSBR603
|
|
00262 10 FILLER PIC X(18) VALUE SPACE. DTSBR603
|
|
00263 10 FILLER PIC X(12) VALUE DTSBR603
|
|
00264 'START DATE:'. DTSBR603
|
|
00265 10 FILLER PIC X(03) VALUE SPACES. DTSBR603
|
|
00266 10 W-START-DATE PIC X(08) VALUE SPACE. DTSBR603
|
|
00267 05 WS-LINE-09. DTSBR603
|
|
00268 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00269 10 FILLER PIC X(11) VALUE DTSBR603
|
|
00270 ' DEBIT IND:'. DTSBR603
|
|
00271 10 FILLER PIC X(06) VALUE SPACE. DTSBR603
|
|
00272 10 W-DEBIT-IND PIC X(01) VALUE SPACE. DTSBR603
|
|
00273 10 FILLER PIC X(18) VALUE SPACE. DTSBR603
|
|
00274 10 FILLER PIC X(12) VALUE DTSBR603
|
|
00275 'START QTR :' . DTSBR603
|
|
00276 10 FILLER PIC X(03) VALUE SPACES. DTSBR603
|
|
00277 10 W-START-QTR PIC X(04) VALUE SPACE. DTSBR603
|
|
00278 10 FILLER PIC X(10) VALUE SPACES. DTSBR603
|
|
00279 10 FILLER PIC X(11) VALUE DTSBR603
|
|
00280 ' END QTR :'. DTSBR603
|
|
00281 10 FILLER PIC X(06) VALUE SPACES. DTSBR603
|
|
00282 10 W-END-QTR PIC X(04) VALUE SPACE. DTSBR603
|
|
00283 05 WS-LINE-11. DTSBR603
|
|
00284 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00285 10 FILLER PIC X(132) VALUE ALL '-'. DTSBR603
|
|
00286 05 WS-LINE-11-HDR. DTSBR603
|
|
00287 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00288 10 FILLER PIC X(10) VALUE SPACES. DTSBR603
|
|
00289 10 FILLER PIC X(20) VALUE SPACE. DTSBR603
|
|
00290 10 FILLER PIC X(10) VALUE SPACE. DTSBR603
|
|
00291 10 WS-LINE-11-TITLE PIC X(50) VALUE SPACE. DTSBR603
|
|
00292 10 FILLER PIC X(28) VALUE SPACE. DTSBR603
|
|
00293 05 WS-LINE-12-HDR. DTSBR603
|
|
00294 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00295 10 FILLER PIC X(31) VALUE DTSBR603
|
|
00296 'YEAR REPORT TAX WGE CHG '. DTSBR603
|
|
00297 10 FILLER PIC X(34) VALUE DTSBR603
|
|
00298 '------------ WAGES ------------ '. DTSBR603
|
|
00299 10 FILLER PIC X(32) VALUE DTSBR603
|
|
00300 '-------- TAXES -------- ------ '. DTSBR603
|
|
00301 10 FILLER PIC X(35) VALUE DTSBR603
|
|
00302 'PENALTY ------ ----- INTEREST -----'. DTSBR603
|
|
00303 05 WS-LINE-13-HDR. DTSBR603
|
|
00304 10 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00305 10 FILLER PIC X(31) VALUE DTSBR603
|
|
00306 ' QTR TYPE RATE DATE '. DTSBR603
|
|
00307 10 FILLER PIC X(34) VALUE DTSBR603
|
|
00308 ' TOTAL EXCESS TAXABLE '. DTSBR603
|
|
00309 10 FILLER PIC X(32) VALUE DTSBR603
|
|
00310 'CHARGED PAID CHARGED'. DTSBR603
|
|
00311 10 FILLER PIC X(35) VALUE DTSBR603
|
|
00312 ' PAID CHARGED PAID'. DTSBR603
|
|
00313 DTSBR603
|
|
00314 01 WS-QUARTER-AREA. DTSBR603
|
|
00315 05 WS-QUARTER-DATA. DTSBR603
|
|
00316 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00317 15 W-YR-QTR PIC X(04) VALUE SPACE. DTSBR603
|
|
00318 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00319 15 W-RPT-TYPE PIC X(10) VALUE SPACE. DTSBR603
|
|
00320 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00321 15 W-UI-RATE PIC X(05) VALUE SPACE. DTSBR603
|
|
00322 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00323 15 W-WAGE-CHNG-DATE PIC X(08) VALUE SPACE. DTSBR603
|
|
00324 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00325 15 W-TOTAL-WAGE PIC ZZZZ,ZZ9.99. DTSBR603
|
|
00326 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00327 15 W-EXCESS-WAGE PIC ZZZZ,ZZ9.99. DTSBR603
|
|
00328 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00329 15 W-TAXABLE-WAGE PIC ZZZ,ZZ9.99. DTSBR603
|
|
00330 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00331 15 W-TAXES-CHARGED PIC ZZZ,ZZ9.99. DTSBR603
|
|
00332 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00333 15 W-TAXES-PAID PIC ZZZ,ZZ9.99. DTSBR603
|
|
00334 15 W-TAX-ADJ-IND PIC X. DTSBR603
|
|
00335 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00336 15 W-PENALTY-CHARGED PIC ZZZ,ZZ9.99. DTSBR603
|
|
00337 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00338 15 W-PENALTY-PAID PIC ZZZ,ZZ9.99. DTSBR603
|
|
00339 15 W-PEN-ADJ-IND PIC X. DTSBR603
|
|
00340 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00341 15 W-INTEREST-CHG PIC ZZ,ZZ9.99. DTSBR603
|
|
00342 15 FILLER PIC X(01) VALUE SPACE. DTSBR603
|
|
00343 15 W-INTEREST-PAID PIC ZZ,ZZ9.99. DTSBR603
|
|
00344 15 W-INT-ADJ-IND PIC X. DTSBR603
|
|
00345 EJECT DTSBR603
|
|
00346 01 L001-LINK-AREA. DTSBR603
|
|
00347 ++INCLUDE DTSIL001 DTSBR603
|
|
00348 EJECT DTSBR603
|
|
00349 01 L032-LINK-AREA. DTSBR603
|
|
00350 ++INCLUDE DTSIL032 DTSBR603
|
|
00351 EJECT DTSBR603
|
|
00352 01 L056-LINK-AREA. DTSBR603
|
|
00353 ++INCLUDE DTSIL056 DTSBR603
|
|
00354 EJECT DTSBR603
|
|
00355 01 L062-LINK-AREA. DTSBR603
|
|
00356 ++INCLUDE DTSIL062 DTSBR603
|
|
00357 EJECT DTSBR603
|
|
00358 LINKAGE SECTION. DTSBR603
|
|
00359 SKIP2 DTSBR603
|
|
00360 01 LRCM-LINK-AREA. DTSBR603
|
|
00361 ++INCLUDE DTSILRCM DTSBR603
|
|
00362 EJECT DTSBR603
|
|
00363 01 R603-REC. DTSBR603
|
|
00364 ++INCLUDE DTSIR603 DTSBR603
|
|
00365 EJECT DTSBR603
|
|
00366 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR603
|
|
00367 R603-REC. DTSBR603
|
|
00368 DTSBR603
|
|
00369 IF FIRST-TIME-IND = 'Y' DTSBR603
|
|
00370 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR603
|
|
00371 MOVE 'N' TO FIRST-TIME-IND. DTSBR603
|
|
00372 DTSBR603
|
|
00373 IF LRCM-EOR-88 DTSBR603
|
|
00374 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR603
|
|
00375 ELSE DTSBR603
|
|
00376 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR603
|
|
00377 DTSBR603
|
|
00378 GOBACK. DTSBR603
|
|
00379 DTSBR603
|
|
00380 I1000-INITIATE. DTSBR603
|
|
00381 DTSBR603
|
|
00382 MOVE SPACES TO WS-FIELD-REP-INFO. DTSBR603
|
|
00383 OPEN OUTPUT PRT-FILE. DTSBR603
|
|
00384 DTSBR603
|
|
00385 I1000-EXIT. DTSBR603
|
|
00386 EXIT. DTSBR603
|
|
00387 DTSBR603
|
|
00388 T1000-TERMINATE. DTSBR603
|
|
00389 DTSBR603
|
|
00390 CLOSE PRT-FILE. DTSBR603
|
|
00391 DTSBR603
|
|
00392 T1000-EXIT. DTSBR603
|
|
00393 EXIT. DTSBR603
|
|
00394 EJECT DTSBR603
|
|
00395 P1000-PROCESS. DTSBR603
|
|
00396 DTSBR603
|
|
00397 IF R603-ASSIGN-NO = WS-ASSIGN-NO-OUTPUT DTSBR603
|
|
00398 NEXT SENTENCE DTSBR603
|
|
00399 ELSE DTSBR603
|
|
00400 PERFORM P1010-HEADER THRU P1010-EXIT. DTSBR603
|
|
00401 DTSBR603
|
|
00402 PERFORM P2000-OUTPUT-EMPLOYER-RECS THRU P2000-EXIT. DTSBR603
|
|
00403 DTSBR603
|
|
00404 MOVE WS-LINE-11 TO REPORT-REC. DTSBR603
|
|
00405 WRITE REPORT-REC AFTER 2 LINES. DTSBR603
|
|
00406 DTSBR603
|
|
00407 MOVE 'PRE-AUDIT INFORMATION BY QUARTER' TO WS-LINE-11-TITLE. DTSBR603
|
|
00408 MOVE WS-LINE-11-HDR TO REPORT-REC. DTSBR603
|
|
00409 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00410 MOVE WS-LINE-12-HDR TO REPORT-REC. DTSBR603
|
|
00411 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00412 MOVE WS-LINE-13-HDR TO REPORT-REC. DTSBR603
|
|
00413 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00414 DTSBR603
|
|
00415 IF R603-QTR-CNT > +0 DTSBR603
|
|
00416 PERFORM P3000-OUTPUT-QUARTER-RECS THRU P3000-EXIT DTSBR603
|
|
00417 VARYING R603-QTR-IDX FROM +1 BY +1 DTSBR603
|
|
00418 UNTIL R603-QTR-IDX > R603-QTR-CNT DTSBR603
|
|
00419 ELSE DTSBR603
|
|
00420 MOVE ' NO QUARTER DATA FOUND ' DTSBR603
|
|
00421 TO WS-MISC-DATA DTSBR603
|
|
00422 WRITE REPORT-REC FROM WS-MISC-DATA AFTER 3 DTSBR603
|
|
00423 END-IF. DTSBR603
|
|
00424 P1000-EXIT. DTSBR603
|
|
00425 EXIT. DTSBR603
|
|
00426 DTSBR603
|
|
00427 P1010-HEADER. DTSBR603
|
|
00428 MOVE LRCM-AGY-NAME-LINE1 TO WS-LRCM-AGY-NAME-LINE1 DTSBR603
|
|
00429 MOVE LRCM-SYS-DATE TO WS-LRCM-SYS-DATE DTSBR603
|
|
00430 MOVE WS-HEADER-1 TO REPORT-REC DTSBR603
|
|
00431 WRITE REPORT-REC AFTER TOP-OF-PAGE. DTSBR603
|
|
00432 DTSBR603
|
|
00433 MOVE LRCM-AGY-NAME-LINE2 TO WS-LRCM-AGY-NAME-LINE2 DTSBR603
|
|
00434 MOVE LRCM-SYS-TIME TO WS-LRCM-SYS-TIME DTSBR603
|
|
00435 MOVE WS-HEADER-2 TO REPORT-REC DTSBR603
|
|
00436 WRITE REPORT-REC AFTER 1 LINE. DTSBR603
|
|
00437 DTSBR603
|
|
00438 MOVE ' FIELD ASSIGNMENT REPORT TAX-DATA ' DTSBR603
|
|
00439 TO WS-HEADER-3-TITLE DTSBR603
|
|
00440 MOVE 'ENFORCEMENT UNIT' TO WS-HEADER-3-UNIT DTSBR603
|
|
00441 ADD 1 TO WS-PAGE-COUNT DTSBR603
|
|
00442 MOVE WS-PAGE-COUNT TO W-PAGE-CNTR DTSBR603
|
|
00443 MOVE WS-HEADER-3 TO REPORT-REC DTSBR603
|
|
00444 WRITE REPORT-REC AFTER 1 LINE. DTSBR603
|
|
00445 DTSBR603
|
|
00446 MOVE R603-FIELD-REP-ID TO WS-FIELD-REP-ID-LAST DTSBR603
|
|
00447 L062-FLD-REP-ID DTSBR603
|
|
00448 PERFORM S062-FLD-REP-INFO THRU S062-EXIT DTSBR603
|
|
00449 MOVE L062-NAME TO W-FLD-REP-NAME DTSBR603
|
|
00450 MOVE R603-ASSIGN-NO TO WS-ASSIGN-NO-OUTPUT. DTSBR603
|
|
00451 P1010-EXIT. DTSBR603
|
|
00452 EXIT. DTSBR603
|
|
00453 EJECT DTSBR603
|
|
00454 P2000-OUTPUT-EMPLOYER-RECS. DTSBR603
|
|
00455 MOVE WS-ASSIGN-NO-OUTPUT TO W-ASSIGN-NO. DTSBR603
|
|
00456 MOVE WS-LINE-01 TO REPORT-REC. DTSBR603
|
|
00457 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00458 DTSBR603
|
|
00459 MOVE R603-FIELD-REP-ID TO W-FLD-ID. DTSBR603
|
|
00460 MOVE WS-LINE-02 TO REPORT-REC. DTSBR603
|
|
00461 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00462 DTSBR603
|
|
00463 MOVE R603-FIELD-REP-OPID TO W-OPER-ID. DTSBR603
|
|
00464 MOVE WS-LINE-03 TO REPORT-REC. DTSBR603
|
|
00465 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00466 DTSBR603
|
|
00467 PERFORM P3500-OUTPUT-OPO-RECS THRU P3500-EXIT DTSBR603
|
|
00468 VARYING R603-OPO-IDX FROM 1 BY 1 DTSBR603
|
|
00469 UNTIL R603-OPO-IDX > 5. DTSBR603
|
|
00470 DTSBR603
|
|
00471 MOVE R603-MAIL-VOICE-1(1:10) TO WS-VOICE-OUTPUT DTSBR603
|
|
00472 MOVE SPACES TO W-PHONE-OUTPUT. DTSBR603
|
|
00473 DTSBR603
|
|
00474 IF WS-VOICE-OUTPUT > SPACES DTSBR603
|
|
00475 MOVE R603-MAIL-VOICE-1(1:3) TO WS-VOICE-OUTPUT-EDIT1 DTSBR603
|
|
00476 MOVE R603-MAIL-VOICE-1(4:3) TO WS-VOICE-OUTPUT-EDIT2 DTSBR603
|
|
00477 MOVE R603-MAIL-VOICE-1(7:4) TO WS-VOICE-OUTPUT-EDIT3 DTSBR603
|
|
00478 MOVE WS-VOICE-OUTPUT-R TO W-PHONE-OUTPUT DTSBR603
|
|
00479 MOVE WS-LINE-05 TO REPORT-REC DTSBR603
|
|
00480 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00481 DTSBR603
|
|
00482 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00483 DTSBR603
|
|
00484 PERFORM P3750-PHYS-ADDR-RTN THRU P3750-EXIT DTSBR603
|
|
00485 VARYING R603-PHYS-IDX FROM 1 BY 1 DTSBR603
|
|
00486 UNTIL R603-PHYS-IDX > 5. DTSBR603
|
|
00487 DTSBR603
|
|
00488 MOVE R603-PHYS-VOICE-1(1:10) TO WS-VOICE-OUTPUT DTSBR603
|
|
00489 MOVE SPACES TO W-PHONE-OUTPUT. DTSBR603
|
|
00490 DTSBR603
|
|
00491 IF WS-VOICE-OUTPUT > SPACES DTSBR603
|
|
00492 MOVE R603-PHYS-VOICE-1(1:3) TO WS-VOICE-OUTPUT-EDIT1 DTSBR603
|
|
00493 MOVE R603-PHYS-VOICE-1(4:3) TO WS-VOICE-OUTPUT-EDIT2 DTSBR603
|
|
00494 MOVE R603-PHYS-VOICE-1(7:4) TO WS-VOICE-OUTPUT-EDIT3 DTSBR603
|
|
00495 MOVE WS-VOICE-OUTPUT-R TO W-PHONE-OUTPUT DTSBR603
|
|
00496 MOVE WS-LINE-05 TO REPORT-REC DTSBR603
|
|
00497 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00498 DTSBR603
|
|
00499 MOVE R603-ORG-TYPE TO W-ORG-TYPE. DTSBR603
|
|
00500 MOVE WS-LINE-06 TO REPORT-REC. DTSBR603
|
|
00501 WRITE REPORT-REC AFTER 2 LINES. DTSBR603
|
|
00502 DTSBR603
|
|
00503 MOVE R603-FEIN TO W-FEIN-NO. DTSBR603
|
|
00504 DTSBR603
|
|
00505 MOVE R603-SIC-CD TO W-SIC-CD. DTSBR603
|
|
00506 MOVE R603-NAICS-CD TO W-NAICS-CD. DTSBR603
|
|
00507 MOVE WS-LINE-07 TO REPORT-REC. DTSBR603
|
|
00508 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00509 DTSBR603
|
|
00510 MOVE R603-CREDIT-IND TO W-CREDIT-IND. DTSBR603
|
|
00511 DTSBR603
|
|
00512 MOVE R603-START-DATE TO L001-FED-8-DATE-9. DTSBR603
|
|
00513 SET L001-FROM-FED-8 TO TRUE. DTSBR603
|
|
00514 PERFORM S001-DATE THRU S001-EXIT. DTSBR603
|
|
00515 MOVE L001-SLASH-DATE TO WS-START-DATE-OUTPUT. DTSBR603
|
|
00516 MOVE WS-START-DATE-OUTPUT TO W-START-DATE. DTSBR603
|
|
00517 DTSBR603
|
|
00518 MOVE WS-LINE-08 TO REPORT-REC. DTSBR603
|
|
00519 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00520 DTSBR603
|
|
00521 MOVE R603-DEBIT-IND TO W-DEBIT-IND. DTSBR603
|
|
00522 MOVE R603-AUDIT-START-YRQ DTSBR603
|
|
00523 TO WS-AUDIT-START-YRQ-OUTPUT-R. DTSBR603
|
|
00524 MOVE WS-AUDIT-START-YRQ-OUTPUT TO W-START-QTR DTSBR603
|
|
00525 MOVE R603-AUDIT-END-YRQ DTSBR603
|
|
00526 TO WS-AUDIT-END-YRQ-OUTPUT-R. DTSBR603
|
|
00527 MOVE WS-AUDIT-END-YRQ-OUTPUT TO W-END-QTR DTSBR603
|
|
00528 DTSBR603
|
|
00529 MOVE WS-LINE-09 TO REPORT-REC. DTSBR603
|
|
00530 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00531 DTSBR603
|
|
00532 P2000-EXIT. DTSBR603
|
|
00533 EXIT. DTSBR603
|
|
00534 EJECT DTSBR603
|
|
00535 P3000-OUTPUT-QUARTER-RECS. DTSBR603
|
|
00536 DTSBR603
|
|
00537 MOVE R603-QTR-YRQ (R603-QTR-IDX) DTSBR603
|
|
00538 TO WS-YR-QTR. DTSBR603
|
|
00539 MOVE WS-YQTR-YR TO WS-DISPLAY-YR DTSBR603
|
|
00540 MOVE WS-YQTR-MM TO WS-DISPLAY-MM DTSBR603
|
|
00541 MOVE WS-DISPLAY-YQTR TO W-YR-QTR. DTSBR603
|
|
00542 DTSBR603
|
|
00543 MOVE R603-QTR-CURR-RPT-TYPE (R603-QTR-IDX) TO L032-CD. DTSBR603
|
|
00544 SET L032-MQTR-CURR-RPT-TYPE TO TRUE. DTSBR603
|
|
00545 PERFORM S032-ACCT-DESCRIPTION THRU S032-EXIT DTSBR603
|
|
00546 MOVE L032-SHORT-DSCR TO W-RPT-TYPE. DTSBR603
|
|
00547 DTSBR603
|
|
00548 MOVE R603-QTR-UI-RATE (R603-QTR-IDX) TO L056-RATE. DTSBR603
|
|
00549 SET L056-DISP3-LEFT-88 TO TRUE. DTSBR603
|
|
00550 PERFORM S056-RATE-DISPLAY THRU S056-EXIT. DTSBR603
|
|
00551 MOVE L056-DISP-RATE TO W-UI-RATE. DTSBR603
|
|
00552 DTSBR603
|
|
00553 MOVE R603-QTR-WAGE-CHNG-DATE (R603-QTR-IDX) DTSBR603
|
|
00554 TO L001-FED-8-DATE-9. DTSBR603
|
|
00555 SET L001-FROM-FED-8 TO TRUE. DTSBR603
|
|
00556 PERFORM S001-DATE THRU S001-EXIT. DTSBR603
|
|
00557 MOVE L001-SLASH-DATE TO W-WAGE-CHNG-DATE. DTSBR603
|
|
00558 DTSBR603
|
|
00559 MOVE R603-QTR-TOT-WAGE (R603-QTR-IDX) TO W-TOTAL-WAGE. DTSBR603
|
|
00560 DTSBR603
|
|
00561 MOVE R603-QTR-EXCESS-WAGE (R603-QTR-IDX) TO W-EXCESS-WAGE. DTSBR603
|
|
00562 DTSBR603
|
|
00563 MOVE R603-QTR-TAX-WAGE (R603-QTR-IDX) TO W-TAXABLE-WAGE. DTSBR603
|
|
00564 DTSBR603
|
|
00565 MOVE R603-QTR-TAX-CHARGED-AMT (R603-QTR-IDX) DTSBR603
|
|
00566 TO W-TAXES-CHARGED. DTSBR603
|
|
00567 DTSBR603
|
|
00568 MOVE R603-QTR-TAX-PAID-AMT (R603-QTR-IDX) DTSBR603
|
|
00569 TO W-TAXES-PAID. DTSBR603
|
|
00570 DTSBR603
|
|
00571 MOVE R603-QTR-TAX-TOLERATED-IND (R603-QTR-IDX) DTSBR603
|
|
00572 TO W-TAX-ADJ-IND. DTSBR603
|
|
00573 DTSBR603
|
|
00574 MOVE R603-QTR-PEN-CHARGED-AMT (R603-QTR-IDX) DTSBR603
|
|
00575 TO W-PENALTY-CHARGED. DTSBR603
|
|
00576 DTSBR603
|
|
00577 MOVE R603-QTR-PEN-PAID-AMT (R603-QTR-IDX) DTSBR603
|
|
00578 TO W-PENALTY-PAID. DTSBR603
|
|
00579 DTSBR603
|
|
00580 MOVE R603-QTR-PEN-TOLERATED-IND (R603-QTR-IDX) DTSBR603
|
|
00581 TO W-PEN-ADJ-IND. DTSBR603
|
|
00582 DTSBR603
|
|
00583 MOVE R603-QTR-INT-CHARGED-AMT (R603-QTR-IDX) DTSBR603
|
|
00584 TO W-INTEREST-CHG. DTSBR603
|
|
00585 DTSBR603
|
|
00586 MOVE R603-QTR-INT-PAID-AMT (R603-QTR-IDX) DTSBR603
|
|
00587 TO W-INTEREST-PAID. DTSBR603
|
|
00588 DTSBR603
|
|
00589 MOVE R603-QTR-TAX-TOLERATED-IND (R603-QTR-IDX) DTSBR603
|
|
00590 TO W-INT-ADJ-IND. DTSBR603
|
|
00591 DTSBR603
|
|
00592 INITIALIZE REPORT-REC. DTSBR603
|
|
00593 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT. DTSBR603
|
|
00594 DTSBR603
|
|
00595 WRITE REPORT-REC FROM WS-QUARTER-DATA AFTER 1. DTSBR603
|
|
00596 DTSBR603
|
|
00597 P3000-EXIT. DTSBR603
|
|
00598 EXIT. DTSBR603
|
|
00599 EJECT DTSBR603
|
|
00600 P3500-OUTPUT-OPO-RECS. DTSBR603
|
|
00601 SET SUB TO R603-OPO-IDX DTSBR603
|
|
00602 DTSBR603
|
|
00603 MOVE R603-OPO-NAME (R603-OPO-IDX) TO DTSBR603
|
|
00604 W-OPER-NAME (SUB). DTSBR603
|
|
00605 DTSBR603
|
|
00606 MOVE R603-OPO-TITLE (R603-OPO-IDX) TO DTSBR603
|
|
00607 W-OPER-TITLE (SUB). DTSBR603
|
|
00608 DTSBR603
|
|
00609 IF R603-OPO-SSN (R603-OPO-IDX) > 0 DTSBR603
|
|
00610 MOVE R603-OPO-SSN (R603-OPO-IDX) TO WS-OPO-SSN-UNPACK DTSBR603
|
|
00611 MOVE WS-OPO-SSN-UNPACK (1:3) TO WS-OPO-SSN-OUTPUT-EDIT1 DTSBR603
|
|
00612 MOVE WS-OPO-SSN-UNPACK (4:2) TO WS-OPO-SSN-OUTPUT-EDIT2 DTSBR603
|
|
00613 MOVE WS-OPO-SSN-UNPACK (6:4) TO WS-OPO-SSN-OUTPUT-EDIT3 DTSBR603
|
|
00614 MOVE WS-OPO-SSN-OUTPUT TO W-OPER-SSN (SUB) DTSBR603
|
|
00615 ELSE DTSBR603
|
|
00616 MOVE SPACES TO W-OPER-SSN (SUB) DTSBR603
|
|
00617 END-IF. DTSBR603
|
|
00618 DTSBR603
|
|
00619 IF SUB = 1 DTSBR603
|
|
00620 MOVE R603-EMP-NO TO W-EMP-NO DTSBR603
|
|
00621 MOVE ' EMP NO:' TO W-LINE-04-TAG DTSBR603
|
|
00622 MOVE SPACES TO W-LABEL (SUB) DTSBR603
|
|
00623 MOVE R603-PRIMARY-NAME TO W-VARIABLE-DATA (SUB) DTSBR603
|
|
00624 ELSE DTSBR603
|
|
00625 IF SUB = 2 DTSBR603
|
|
00626 MOVE SPACES TO W-EMP-NO-RE DTSBR603
|
|
00627 MOVE ' ' TO W-LINE-04-TAG DTSBR603
|
|
00628 MOVE 'MAIL:' TO W-LABEL (SUB) DTSBR603
|
|
00629 MOVE R603-MAIL-LINE (SUB - 1) DTSBR603
|
|
00630 TO W-VARIABLE-DATA (SUB) DTSBR603
|
|
00631 ELSE DTSBR603
|
|
00632 MOVE SPACES TO W-LABEL (SUB) DTSBR603
|
|
00633 MOVE R603-MAIL-LINE (SUB - 1) DTSBR603
|
|
00634 TO W-VARIABLE-DATA (SUB) DTSBR603
|
|
00635 END-IF DTSBR603
|
|
00636 END-IF. DTSBR603
|
|
00637 DTSBR603
|
|
00638 IF W-VARIABLE-DATA (SUB) > SPACES OR DTSBR603
|
|
00639 W-OPER-NAME (SUB) > SPACES DTSBR603
|
|
00640 MOVE W-LINE-DATA (SUB) TO W-LINE-04-VARIABLE-DATA DTSBR603
|
|
00641 MOVE WS-LINE-04 TO REPORT-REC DTSBR603
|
|
00642 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT DTSBR603
|
|
00643 END-IF. DTSBR603
|
|
00644 DTSBR603
|
|
00645 MOVE SPACES TO W-LINE-04-VARIABLE-DATA. DTSBR603
|
|
00646 DTSBR603
|
|
00647 P3500-EXIT. DTSBR603
|
|
00648 EXIT. DTSBR603
|
|
00649 DTSBR603
|
|
00650 P3750-PHYS-ADDR-RTN. DTSBR603
|
|
00651 SET SUB TO R603-PHYS-IDX. DTSBR603
|
|
00652 INITIALIZE W-LINE-DATA (SUB). DTSBR603
|
|
00653 MOVE R603-PHYS-LINE (R603-PHYS-IDX) TO DTSBR603
|
|
00654 W-VARIABLE-DATA (SUB). DTSBR603
|
|
00655 DISPLAY 'W-PHYSICAL-DATA ' W-VARIABLE-DATA (SUB). DTSBR603
|
|
00656 DISPLAY ' SUBSCRIPT ' SUB. DTSBR603
|
|
00657 DTSBR603
|
|
00658 IF SUB = 1 DTSBR603
|
|
00659 MOVE 'PHYS:' TO W-LABEL(SUB) DTSBR603
|
|
00660 ELSE DTSBR603
|
|
00661 MOVE ' ' TO W-LABEL(SUB) DTSBR603
|
|
00662 END-IF. DTSBR603
|
|
00663 DTSBR603
|
|
00664 IF W-VARIABLE-DATA (SUB) > SPACES DTSBR603
|
|
00665 MOVE W-LINE-DATA (SUB) TO W-LINE-04-VARIABLE-DATA DTSBR603
|
|
00666 MOVE WS-LINE-04 TO REPORT-REC DTSBR603
|
|
00667 PERFORM S2000-WRITE-RECORD THRU S2000-EXIT DTSBR603
|
|
00668 END-IF. DTSBR603
|
|
00669 P3750-EXIT. DTSBR603
|
|
00670 EXIT. DTSBR603
|
|
00671 EJECT DTSBR603
|
|
00672 S001-DATE. DTSBR603
|
|
00673 DTSBR603
|
|
00674 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR603
|
|
00675 DTSBR603
|
|
00676 S001-EXIT. DTSBR603
|
|
00677 EXIT. DTSBR603
|
|
00678 DTSBR603
|
|
00679 S032-ACCT-DESCRIPTION. DTSBR603
|
|
00680 DTSBR603
|
|
00681 CALL 'DTSBU032' USING L032-LINK-AREA. DTSBR603
|
|
00682 DTSBR603
|
|
00683 S032-EXIT. DTSBR603
|
|
00684 EXIT. DTSBR603
|
|
00685 DTSBR603
|
|
00686 S056-RATE-DISPLAY. DTSBR603
|
|
00687 DTSBR603
|
|
00688 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR603
|
|
00689 DTSBR603
|
|
00690 S056-EXIT. DTSBR603
|
|
00691 EXIT. DTSBR603
|
|
00692 DTSBR603
|
|
00693 S062-FLD-REP-INFO. DTSBR603
|
|
00694 DTSBR603
|
|
00695 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBR603
|
|
00696 DTSBR603
|
|
00697 S062-EXIT. DTSBR603
|
|
00698 EXIT. DTSBR603
|
|
00699 DTSBR603
|
|
00700 S2000-WRITE-RECORD. DTSBR603
|
|
00701 WRITE REPORT-REC AFTER 1 LINE. DTSBR603
|
|
00702 ADD 1 TO WS-LINE-COUNT. DTSBR603
|
|
00703 INITIALIZE REPORT-REC. DTSBR603
|
|
00704 S2000-EXIT. DTSBR603
|
|
00705 EXIT. DTSBR603
|
|
00706 **** DTSBR603
|