00001 IDENTIFICATION DIVISION. 05/17/01 00002 PROGRAM-ID. DTSBR901. DTSBR901 00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV052 00004 DATE-WRITTEN. JULY 1994. DTSBR901 00005 DATE-COMPILED. DTSBR901 00006 DTSBR901 00007 ***** DTSBR901 00008 * CALLING SEQUENCE: DTSBD311, DTSBD314, DTSBD315, DTSBR901 00009 * DTSBD317 AND DTSBE761 CAN DTSBR901 00010 * UPDATE DTSIR901 RECORD AND THE DTSBR901 00011 * DTSBR901 READS DTSIR901 RECORDS DTSBR901 00012 * DTSBR901 00013 * TO PRINT THE EXTRACTED LABELS. DTSBR901 00014 * FUNCTION: LABEL PRINTING. DTSBR901 00015 * DTSBR901 00016 * DTSBR901 00017 * MODIFICATION HISTORY: DTSBR901 00018 * DTSBR901 00019 * 07-31-94 INITIAL DEVELOPMENT DTSBR901 00020 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR901 00021 * DTSBR901 00022 * 03-15-95 DROP OP-ID FROM UI-272 LABELS. DTSBR901 00023 * REFERENCE RFP #CR053 AUTHOR OF CHANGE - RHC DTSBR901 00024 * DTSBR901 00025 * 05-16-95 WORDS "UI ACCOUNT #" REMOVED PER C.R. 080 DTSBR901 00026 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR901 00027 * DTSBR901 00028 * 06-13-96 RECOMPILED TO INCORPORATE CHANGES TO DTSIR901 FOR DTSBR901 00029 * ELECTRONIC FILER LABELS FROM SCREEN 76. DTSBR901 00030 * REFERENCE RFP #WARP II PROGRAMMER: MJA DTSBR901 00031 * DTSBR901 00032 * 10-29-98 DROP REFERENCE TO R901-UI-272-88 DTSBR901 00033 * R901-GRP6-JS-OFFICE-ID FROM PROGRAM TO MEET DC DTSBR901 00034 * EXTERNAL DESIGN EXPORT REQUIREMENTS. DTSBR901 00035 * REFERENCE RFP #**** PROGRAMMER: DVS DTSBR901 00036 * DTSBR901 00037 * 10-13-99 ADDED S083-UPPERCSE-CHG ROUTINE TO CHANGE ALL LOWER DTSBR901 00038 * CASE LETTERS TO UPPER CASE ON OPR NAME AND UNIT DTSBR901 00039 * NAME LABEL. PROGRAMMER: FB DTSBR901 00040 * DTSBR901 00041 * 02-20-01 FIXED A BUG FOUND WHEN PRINTING SIC/NAIC EXTRACTS DTSBR901 00042 * FOR JOB-SERVICE LABELS PROGRAMMER: JHP DTSBR901 00043 * DTSBR901 00044 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR901 00045 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR901 00046 * REFERENCE RFP #**** PROGRAMMER: XXX DTSBR901 00047 * DTSBR901 00048 * DTSBR901 00049 * DESCRIPTION: DTSBR901 00050 * DTSBR901 00051 * THIS MODULE GENERATES LABELS FOR VARIOUS PROCESSES DTSBR901 00052 * IN THE TAX SYSTEM. DTSBR901 00053 * DTSBR901 00054 * DTSBR901 00055 * RECORDS READ: DTSBR901 00056 * DTSBR901 00057 * NONE. DTSBR901 00058 * DTSBR901 00059 * DTSBR901 00060 * PRINTED OUTPUTS: DTSBR901 00061 * DTSBR901 00062 * 901R1 LABELS DTSBR901 00063 * DTSBR901 00064 * DTSBR901 00065 * RECORDS WRITTEN: DTSBR901 00066 * DTSBR901 00067 * NONE. DTSBR901 00068 * DTSBR901 00069 * DTSBR901 00070 * MODULES CALLED: DTSBR901 00071 * DTSBR901 00072 * DTSBU071 NAME EDIT/CONVERSION MODULE DTSBR901 00073 * DTSBU082 OPERATOR ID EDIT/LOOKUP MODULE DTSBR901 00074 * DTSBU132 JOB SERVICE OFFICE DESC. MODULE DTSBR901 00075 * DTSBR901 00076 ***** DTSBR901 00077 EJECT DTSBR901 00078 ENVIRONMENT DIVISION. DTSBR901 00079 DTSBR901 00080 CONFIGURATION SECTION. DTSBR901 00081 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR901 00082 DTSBR901 00083 INPUT-OUTPUT SECTION. DTSBR901 00084 DTSBR901 00085 FILE-CONTROL. DTSBR901 00086 SELECT PRT-FILE1 ASSIGN TO RPT901R1. DTSBR901 00087 SELECT PRT-FILE2 ASSIGN TO RPT901R2. DTSBR901 00088 DTSBR901 00089 DATA DIVISION. DTSBR901 00090 DTSBR901 00091 FILE SECTION. DTSBR901 00092 DTSBR901 00093 FD PRT-FILE1 DTSBR901 00094 RECORDING MODE IS F. DTSBR901 00095 01 REPORT-LISTING1 PIC X(80). DTSBR901 00096 DTSBR901 00097 FD PRT-FILE2 DTSBR901 00098 RECORDING MODE IS F. DTSBR901 00099 01 REPORT-LISTING2 PIC X(80). DTSBR901 00100 DTSBR901 00101 EJECT DTSBR901 00102 WORKING-STORAGE SECTION. DTSBR901 001025 77 PAN-VALET PICTURE X(24) VALUE '052DTSBR901 05/17/01'. DTSBR901 00103 DTSBR901 00104 01 WRK-AREA. DTSBR901 00105 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +901.DTSBR901 00106 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR901 00107 DTSBR901 00108 05 RPT1-OPEN-SW PIC X(01) VALUE 'N'. DTSBR901 00109 DTSBR901 00110 05 WRK-BREAK-GROUP. DTSBR901 00111 10 WRK-LABEL-TYPE PIC X(27) VALUE SPACES. DTSBR901 00112 10 WRK-OPR-NAME PIC X(32) VALUE SPACES. DTSBR901 00113 05 WRK-OPR-UNIT-NAME PIC X(30) VALUE SPACES. DTSBR901 00114 DTSBR901 00115 05 WRK-HOLD-GROUP PIC X(01) VALUE SPACE. DTSBR901 00116 05 WRK-HOLD-GROUP-9 REDEFINES WRK-HOLD-GROUP DTSBR901 00117 PIC 9(01). DTSBR901 00118 05 WRK-HOLD-OP-ID PIC X(08) VALUE SPACES. DTSBR901 00119 DTSBR901 00120 05 WRK-LOCAL-OFFICE-DESC. DTSBR901 00121 10 WRK-FILLER PIC X(13) DTSBR901 00122 VALUE 'LOCAL OFFICE '. DTSBR901 00123 10 WRK-JS-OFFICE-ID PIC 9(02) VALUE ZEROS. DTSBR901 00124 DTSBR901 00125 05 WRK-LABEL-TYPE-TEXT. DTSBR901 00126 10 FILLER PIC X(27) VALUE DTSBR901 00127 ' ON REQUEST LABELS '. DTSBR901 00128 10 FILLER PIC X(27) VALUE DTSBR901 00129 'REGISTRATION CYCLE A LABELS'. DTSBR901 00130 10 FILLER PIC X(27) VALUE DTSBR901 00131 'LIAB DETERMINATION LABELS'. DTSBR901 00132 10 FILLER PIC X(27) VALUE DTSBR901 00133 ' JOB SERVICE LABELS '. DTSBR901 00134 05 FILLER REDEFINES WRK-LABEL-TYPE-TEXT. DTSBR901 00135 10 WRK-TEXT-LINE OCCURS 4 TIMES DTSBR901 00136 INDEXED BY WRK-TEXT-LINE-IDX DTSBR901 00137 PIC X(27). DTSBR901 00138 05 WRK-GRP4-CD-1 PIC X(06) VALUE 'NAIC: '. DTSBR901 00139 05 WRK-GRP4-CD-2 PIC X(06) VALUE ' SIC: '. DTSBR901 00140 DTSBR901 00141 01 LINEUP-LABEL1. DTSBR901 00142 05 LLD1-LINE-1 PIC X(80) VALUE SPACES. DTSBR901 00143 05 LLD1-LINE-2. DTSBR901 00144 10 FILLER PIC X(03) VALUE SPACES. DTSBR901 00145 10 FILLER PIC X(07) DTSBR901 00146 VALUE '999 999'. DTSBR901 00147 05 LLD1-LINE-3 PIC X(80) VALUE SPACES. DTSBR901 00148 05 LLD1-LINE-4. DTSBR901 00149 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00150 10 FILLER PIC X(40) DTSBR901 00151 VALUE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'. DTSBR901 00152 05 LLD1-LINE-5. DTSBR901 00153 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00154 10 ILLER PIC X(40) DTSBR901 00155 VALUE 'XXXXXXXXXXXXXXX DTSP901 XXXXXXXXXXXXXXX'. DTSBR901 00156 05 LLD1-LINE-6. DTSBR901 00157 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00158 10 FILLER PIC X(16) DTSBR901 00159 VALUE 'XXXXXXXXXXXXXXX '. DTSBR901 00160 10 LLD1-SYS-DATE PIC X(08) VALUE SPACES. DTSBR901 00161 10 FILLER PIC X(16) DTSBR901 00162 VALUE ' XXXXXXXXXXXXXXX'. DTSBR901 00163 05 LLD1-LINE-7. DTSBR901 00164 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00165 10 FILLER PIC X(40) DTSBR901 00166 VALUE 'XXXXXXXXXXXXXXX DTSP901 XXXXXXXXXXXXXXX'. DTSBR901 00167 05 LLD1-LINE-8. DTSBR901 00168 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00169 10 FILLER PIC X(40) DTSBR901 00170 VALUE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'. DTSBR901 00171 EJECT DTSBR901 00172 01 BREAK-LABEL1. DTSBR901 00173 05 BLD1-LINE-1 PIC X(80) VALUE SPACES. DTSBR901 00174 05 BLD1-LINE-3. DTSBR901 00175 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00176 10 FILLER PIC X(40) DTSBR901 00177 VALUE IS ALL '*'. DTSBR901 00178 05 BLD1-LINE-4. DTSBR901 00179 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00180 10 FILLER PIC X(01) DTSBR901 00181 VALUE IS '*'. DTSBR901 00182 10 FILLER PIC X(05) VALUE SPACE. DTSBR901 00183 10 BLD1-LABEL-TYPE PIC X(27) VALUE SPACE. DTSBR901 00184 10 FILLER PIC X(06) VALUE SPACE. DTSBR901 00185 10 FILLER PIC X(01) DTSBR901 00186 VALUE IS '*'. DTSBR901 00187 05 BLD1-LINE-5. DTSBR901 00188 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00189 10 FILLER PIC X(01) DTSBR901 00190 VALUE IS '*'. DTSBR901 00191 10 FILLER PIC X(05) VALUE SPACE. DTSBR901 00192 10 BLD1-OPR-NAME PIC X(32) VALUE SPACE. DTSBR901 00193 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00194 10 FILLER PIC X(01) DTSBR901 00195 VALUE IS '*'. DTSBR901 00196 05 BLD1-LINE-6. DTSBR901 00197 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00198 10 FILLER PIC X(01) DTSBR901 00199 VALUE IS '*'. DTSBR901 00200 10 FILLER PIC X(05) VALUE SPACE. DTSBR901 00201 10 BLD1-OPR-UNIT-NAME PIC X(30) VALUE SPACE. DTSBR901 00202 10 FILLER PIC X(03) VALUE SPACE. DTSBR901 00203 10 FILLER PIC X(01) DTSBR901 00204 VALUE IS '*'. DTSBR901 00205 05 BLD1-LINE-7. DTSBR901 00206 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00207 10 FILLER PIC X(40) DTSBR901 00208 VALUE IS ALL '*'. DTSBR901 00209 DTSBR901 00210 01 MAILING-LABEL1. DTSBR901 00211 05 MLD1-LINE-1 PIC X(80) VALUE SPACES. DTSBR901 00212 05 MLD1-LINE-2. DTSBR901 00213 10 FILLER PIC X(03) VALUE SPACE. DTSBR901 00214 10 MLD1-EMP-NO PIC 999B999. DTSBR901 00215 05 MLD1-LINE-3 PIC X(80) VALUE SPACES. DTSBR901 00216 05 MLD1-LINE-4. DTSBR901 00217 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00218 10 MLD1-FMT-LINE-1 PIC X(40) VALUE SPACE. DTSBR901 00219 05 MLD1-LINE-5. DTSBR901 00220 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00221 10 MLD1-FMT-LINE-2 PIC X(40) VALUE SPACE. DTSBR901 00222 05 MLD1-LINE-6. DTSBR901 00223 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00224 10 MLD1-FMT-LINE-3 PIC X(40) VALUE SPACE. DTSBR901 00225 05 MLD1-LINE-7. DTSBR901 00226 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00227 10 MLD1-FMT-LINE-4 PIC X(40) VALUE SPACE. DTSBR901 00228 05 MLD1-LINE-8. DTSBR901 00229 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00230 10 MLD1-FMT-LINE-5 PIC X(40) VALUE SPACE. DTSBR901 00231 DTSBR901 00232 01 LINEUP-LABEL2. DTSBR901 00233 05 LLD2-LINE-1 PIC X(80) VALUE SPACES. DTSBR901 00234 05 LLD2-LINE-2. DTSBR901 00235 10 FILLER PIC X(03) VALUE SPACES. DTSBR901 00236 10 FILLER PIC X(07) DTSBR901 00237 VALUE '999 999'. DTSBR901 00238 05 LLD2-LINE-3 PIC X(80) VALUE SPACES. DTSBR901 00239 05 LLD2-LINE-4. DTSBR901 00240 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00241 10 FILLER PIC X(40) DTSBR901 00242 VALUE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'. DTSBR901 00243 05 LLD2-LINE-5. DTSBR901 00244 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00245 10 FILLER PIC X(40) DTSBR901 00246 VALUE 'XXXXXXXXXXXXXXX DTSP901 (OTHER) XXXXXXX'. DTSBR901 00247 05 LLD2-LINE-6. DTSBR901 00248 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00249 10 FILLER PIC X(16) DTSBR901 00250 VALUE 'XXXXXXXXXXXXXXX '. DTSBR901 00251 10 LLD2-SYS-DATE PIC X(08) VALUE SPACES. DTSBR901 00252 10 FILLER PIC X(16) DTSBR901 00253 VALUE ' (OTHER) XXXXXXX'. DTSBR901 00254 05 LLD2-LINE-7. DTSBR901 00255 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00256 10 FILLER PIC X(40) DTSBR901 00257 VALUE 'XXXXXXXXXXXXXXX DTSP901 (OTHER) XXXXXXX'. DTSBR901 00258 05 LLD2-LINE-8. DTSBR901 00259 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00260 10 FILLER PIC X(40) DTSBR901 00261 VALUE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'. DTSBR901 00262 DTSBR901 00263 01 BREAK-LABEL2. DTSBR901 00264 05 BLD2-LINE-1 PIC X(80) VALUE SPACES. DTSBR901 00265 05 BLD2-LINE-3. DTSBR901 00266 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00267 10 FILLER PIC X(40) DTSBR901 00268 VALUE IS ALL '*'. DTSBR901 00269 05 BLD2-LINE-4. DTSBR901 00270 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00271 10 FILLER PIC X(01) DTSBR901 00272 VALUE IS '*'. DTSBR901 00273 10 FILLER PIC X(05) VALUE SPACE. DTSBR901 00274 10 BLD2-LABEL-TYPE PIC X(27) VALUE SPACE. DTSBR901 00275 10 FILLER PIC X(06) VALUE SPACE. DTSBR901 00276 10 FILLER PIC X(01) DTSBR901 00277 VALUE IS '*'. DTSBR901 00278 05 BLD2-LINE-5. DTSBR901 00279 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00280 10 FILLER PIC X(01) DTSBR901 00281 VALUE IS '*'. DTSBR901 00282 10 FILLER PIC X(05) VALUE SPACE. DTSBR901 00283 10 BLD2-OPR-NAME PIC X(32) VALUE SPACE. DTSBR901 00284 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00285 10 FILLER PIC X(01) DTSBR901 00286 VALUE IS '*'. DTSBR901 00287 05 BLD2-LINE-6. DTSBR901 00288 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00289 10 FILLER PIC X(01) DTSBR901 00290 VALUE IS '*'. DTSBR901 00291 10 FILLER PIC X(05) VALUE SPACE. DTSBR901 00292 10 BLD2-OPR-UNIT-NAME PIC X(30) VALUE SPACE. DTSBR901 00293 10 FILLER PIC X(03) VALUE SPACE. DTSBR901 00294 10 FILLER PIC X(01) DTSBR901 00295 VALUE IS '*'. DTSBR901 00296 05 BLD2-LINE-7. DTSBR901 00297 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00298 10 FILLER PIC X(40) DTSBR901 00299 VALUE IS ALL '*'. DTSBR901 00300 DTSBR901 00301 01 MAILING-LABEL2. DTSBR901 00302 05 MLD2-LINE-1 PIC X(80) VALUE SPACES. DTSBR901 00303 05 MLD2-LINE-2. DTSBR901 00304 10 FILLER PIC X(03) VALUE SPACES. DTSBR901 00305 10 MLD2-EMP-NO PIC 999B999. DTSBR901 00306 10 FILLER PIC X(15) VALUE SPACES. DTSBR901 00307 10 WRK-GRP4-LBL-ID PIC X(06) VALUE SPACE. DTSBR901 00308 10 WRK-GRP4-LBL-NBR PIC X(06) VALUE SPACE. DTSBR901 00309 05 MLD2-LINE-3 PIC X(80) VALUE SPACES. DTSBR901 00310 05 MLD2-LINE-4. DTSBR901 00311 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00312 10 MLD2-FMT-LINE-1 PIC X(40) VALUE SPACE. DTSBR901 00313 05 MLD2-LINE-5. DTSBR901 00314 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00315 10 MLD2-FMT-LINE-2 PIC X(40) VALUE SPACE. DTSBR901 00316 05 MLD2-LINE-6. DTSBR901 00317 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00318 10 MLD2-FMT-LINE-3 PIC X(40) VALUE SPACE. DTSBR901 00319 05 MLD2-LINE-7. DTSBR901 00320 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00321 10 MLD2-FMT-LINE-4 PIC X(40) VALUE SPACE. DTSBR901 00322 05 MLD2-LINE-8. DTSBR901 00323 10 FILLER PIC X(01) VALUE SPACE. DTSBR901 00324 10 MLD2-FMT-LINE-5 PIC X(40) VALUE SPACE. DTSBR901 00325 EJECT DTSBR901 00326 01 ILBL-LINK-AREA. DTSBR901 00327 ++INCLUDE DOESILBL DTSBR901 00328 DTSBR901 00329 01 L071-LINK-AREA. DTSBR901 00330 ++INCLUDE DTSIL071 DTSBR901 00331 DTSBR901 00332 01 L082-LINK-AREA. DTSBR901 00333 ++INCLUDE DTSIL082 DTSBR901 00334 DTSBR901 00335 01 LINK-AREA. DTSBR901 00336 ++INCLUDE DTSIL009 DTSBR901 00337 EJECT DTSBR901 00338 LINKAGE SECTION. DTSBR901 00339 DTSBR901 00340 01 LRCM-LINK-AREA. DTSBR901 00341 ++INCLUDE DTSILRCM DTSBR901 00342 EJECT DTSBR901 00343 01 R901-REC. DTSBR901 00344 ++INCLUDE DTSIR901 DTSBR901 00345 EJECT DTSBR901 00346 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR901 00347 R901-REC. DTSBR901 00348 DTSBR901 00349 IF FIRST-TIME-IND = 'Y' DTSBR901 00350 PERFORM I1000-INITIATE DTSBR901 00351 THRU I1000-EXIT DTSBR901 00352 MOVE 'N' TO FIRST-TIME-IND. DTSBR901 00353 DTSBR901 00354 IF LRCM-EOR-88 DTSBR901 00355 PERFORM T1000-TERMINATE DTSBR901 00356 THRU T1000-EXIT DTSBR901 00357 ELSE DTSBR901 00358 PERFORM P1000-PROCESS DTSBR901 00359 THRU P1000-EXIT. DTSBR901 00360 DTSBR901 00361 GOBACK. DTSBR901 00362 EJECT DTSBR901 00363 I1000-INITIATE. DTSBR901 00364 MOVE LENGTH OF ILBL-LINK-AREA TO ILBL-LENGTH. DTSBR901 00365 IF R901-JOB-SERVICE-88 DTSBR901 00366 * OPEN OUTPUT PRT-FILE2 DTSBR901 00367 * MOVE SPACES TO REPORT-LISTING2 DTSBR901 00368 MOVE LRCM-SYS-DATE TO LLD2-SYS-DATE DTSBR901 00369 PERFORM P3000-LINEUP-LABEL2 THRU P3000-EXIT 2 TIMES DTSBR901 00370 MOVE 'N' TO RPT1-OPEN-SW DTSBR901 00371 ELSE DTSBR901 00372 * OPEN OUTPUT PRT-FILE1 DTSBR901 00373 * MOVE SPACES TO REPORT-LISTING1 DTSBR901 00374 MOVE LRCM-SYS-DATE TO LLD1-SYS-DATE DTSBR901 00375 PERFORM P4000-LINEUP-LABEL1 THRU P4000-EXIT 2 TIMES DTSBR901 00376 MOVE 'Y' TO RPT1-OPEN-SW. DTSBR901 00377 DTSBR901 00378 PERFORM P2000-SET-GROUP THRU P2000-EXIT. DTSBR901 00379 DTSBR901 00380 DTSBR901 00381 I1000-EXIT. DTSBR901 00382 EXIT. DTSBR901 00383 EJECT DTSBR901 00384 P1000-PROCESS. DTSBR901 00385 DTSBR901 00386 IF R901-GROUP = WRK-HOLD-GROUP DTSBR901 00387 IF R901-EMP-REG-A-88 DTSBR901 00388 OR R901-LIAB-DETER-88 DTSBR901 00389 OR R901-ON-REQUEST-88 DTSBR901 00390 PERFORM P1100-CHECK-FOR-NEW-OP-ID DTSBR901 00391 THRU P1100-EXIT DTSBR901 00392 ELSE DTSBR901 00393 NEXT SENTENCE DTSBR901 00394 END-IF DTSBR901 00395 ELSE DTSBR901 00396 **** DTSBR901 00397 **** THE THREE TYPES OF LABELS ABOVE ARE *ABSOLUTELY* DTSBR901 00398 **** MUTUALLY EXCLUSIVE WITH LABEL TYPE FOUR!!! DTSBR901 00399 **** THE FIRST THREE ARE RELATED AND ARE ALL PRINTED DTSBR901 00400 **** IN RPT901R1. THE FOURTH LABEL TYPE IS THE *ONLY* DTSBR901 00401 **** ONE PRINTED IN RPT901R2. DTSBR901 00402 **** THERE CAN NEVER BE A TYPE 4 IN THE SAME 'PER.RPT' DTSBR901 00403 **** FILE WITH ANY OF THE OTHERS FROM THE *SAME* JOB. DTSBR901 00404 **** DTSBR901 00405 **** IF R901-JOB-SERVICE-88 DTSBR901 00406 **** AND RPT1-OPEN-SW = 'Y' DTSBR901 00407 **** PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR901 00408 **** PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR901 00409 **** END-IF DTSBR901 00410 DTSBR901 00411 PERFORM P2000-SET-GROUP THRU P2000-EXIT DTSBR901 00412 END-IF. DTSBR901 00413 DTSBR901 00414 IF RPT1-OPEN-SW = 'Y' DTSBR901 00415 PERFORM R901-LABEL-CNT TIMES DTSBR901 00416 PERFORM P5000-MAILING-LABEL1 THRU P5000-EXIT DTSBR901 00417 END-PERFORM DTSBR901 00418 ELSE DTSBR901 00419 PERFORM R901-LABEL-CNT TIMES DTSBR901 00420 PERFORM P1010-CHECK-JOB-SRVC THRU P1010-EXIT DTSBR901 00421 PERFORM P6000-MAILING-LABEL2 THRU P6000-EXIT DTSBR901 00422 MOVE SPACE TO WRK-GRP4-LBL-ID, DTSBR901 00423 WRK-GRP4-LBL-NBR DTSBR901 00424 END-PERFORM DTSBR901 00425 END-IF. DTSBR901 00426 DTSBR901 00427 P1000-EXIT. DTSBR901 00428 EXIT. DTSBR901 00429 P1010-CHECK-JOB-SRVC. DTSBR901 00430 IF R901-JOB-SERVICE-88 DTSBR901 00431 IF R901-GRP4-NAICS-88 DTSBR901 00432 MOVE WRK-GRP4-CD-1 TO WRK-GRP4-LBL-ID DTSBR901 00433 ELSE DTSBR901 00434 IF R901-GRP4-SIC-88 DTSBR901 00435 MOVE WRK-GRP4-CD-2 TO WRK-GRP4-LBL-ID DTSBR901 00436 END-IF DTSBR901 00437 END-IF DTSBR901 00438 DTSBR901 00439 IF WRK-GRP4-LBL-ID NOT = SPACE DTSBR901 00440 MOVE R901-GRP4-IND-CODE TO WRK-GRP4-LBL-NBR DTSBR901 00441 END-IF DTSBR901 00442 END-IF. DTSBR901 00443 P1010-EXIT. DTSBR901 00444 EXIT. DTSBR901 00445 EJECT DTSBR901 00446 P1100-CHECK-FOR-NEW-OP-ID. DTSBR901 00447 DTSBR901 00448 IF R901-GRP1-OP-ID NOT = WRK-HOLD-OP-ID DTSBR901 00449 PERFORM P2100-SET-OPR-FIELDS DTSBR901 00450 THRU P2100-EXIT. DTSBR901 00451 DTSBR901 00452 P1100-EXIT. DTSBR901 00453 EXIT. DTSBR901 00454 DTSBR901 00455 EJECT DTSBR901 00456 P2000-SET-GROUP. DTSBR901 00457 DTSBR901 00458 MOVE R901-GROUP TO WRK-HOLD-GROUP. DTSBR901 00459 SET WRK-TEXT-LINE-IDX TO WRK-HOLD-GROUP-9. DTSBR901 00460 MOVE WRK-TEXT-LINE (WRK-TEXT-LINE-IDX) TO WRK-LABEL-TYPE DTSBR901 00461 BLD1-LABEL-TYPE DTSBR901 00462 BLD2-LABEL-TYPE. DTSBR901 00463 IF R901-JOB-SERVICE-88 DTSBR901 00464 NEXT SENTENCE DTSBR901 00465 ELSE DTSBR901 00466 PERFORM P2100-SET-OPR-FIELDS DTSBR901 00467 THRU P2100-EXIT. DTSBR901 00468 DTSBR901 00469 P2000-EXIT. DTSBR901 00470 EXIT. DTSBR901 00471 DTSBR901 00472 P2100-SET-OPR-FIELDS. DTSBR901 00473 DTSBR901 00474 MOVE R901-GRP1-OP-ID TO WRK-HOLD-OP-ID DTSBR901 00475 L082-OP-ID. DTSBR901 00476 DTSBR901 00477 PERFORM S082-OP-ID-NAME DTSBR901 00478 THRU S082-EXIT. DTSBR901 00479 DTSBR901 00480 MOVE L082-NAME TO L071-NAM. DTSBR901 00481 MOVE 2 TO L071-NAME-FORMAT. DTSBR901 00482 DTSBR901 00483 PERFORM S071-DESLASH-NAME DTSBR901 00484 THRU S071-EXIT. DTSBR901 00485 DTSBR901 00486 ********** CONVERTING LOWER CASE TO UPPER CASE ***************** DTSBR901 00487 ** MOVE L071-NAM TO WRK-OPR-NAME DTSBR901 00488 MOVE L071-NAM TO L009-DATA. DTSBR901 00489 PERFORM S083-UPPERCASE-CHG DTSBR901 00490 THRU S083-EXIT. DTSBR901 00491 MOVE L009-DATA TO WRK-OPR-NAME DTSBR901 00492 BLD1-OPR-NAME DTSBR901 00493 BLD2-OPR-NAME. DTSBR901 00494 DTSBR901 00495 ** MOVE L082-UNIT-NAME TO WRK-OPR-UNIT-NAME DTSBR901 00496 MOVE L082-UNIT-NAME TO L009-DATA. DTSBR901 00497 PERFORM S083-UPPERCASE-CHG DTSBR901 00498 THRU S083-EXIT. DTSBR901 00499 MOVE L009-DATA TO WRK-OPR-UNIT-NAME DTSBR901 00500 BLD1-OPR-UNIT-NAME DTSBR901 00501 BLD2-OPR-UNIT-NAME. DTSBR901 00502 ************* ***********************DTSBR901 00503 IF RPT1-OPEN-SW = 'Y' DTSBR901 00504 IF R901-GRP1-OP-ID NOT = SPACES DTSBR901 00505 PERFORM P7000-BREAK-LABEL1 THRU P7000-EXIT DTSBR901 00506 END-IF DTSBR901 00507 ELSE DTSBR901 00508 PERFORM P8000-BREAK-LABEL2 THRU P8000-EXIT. DTSBR901 00509 DTSBR901 00510 P2100-EXIT. DTSBR901 00511 EXIT. DTSBR901 00512 DTSBR901 00513 P3000-LINEUP-LABEL2. DTSBR901 00514 MOVE LLD2-LINE-1 TO ILBL-FMT-LINE(1) DTSBR901 00515 MOVE LLD2-LINE-2 TO ILBL-FMT-LINE(2) DTSBR901 00516 MOVE LLD2-LINE-3 TO ILBL-FMT-LINE(3) DTSBR901 00517 MOVE LLD2-LINE-4 TO ILBL-FMT-LINE(4) DTSBR901 00518 MOVE LLD2-LINE-5 TO ILBL-FMT-LINE(5) DTSBR901 00519 MOVE LLD2-LINE-6 TO ILBL-FMT-LINE(6) DTSBR901 00520 MOVE LLD2-LINE-7 TO ILBL-FMT-LINE(7) DTSBR901 00521 MOVE LLD2-LINE-8 TO ILBL-FMT-LINE(8) DTSBR901 00522 PERFORM S946-WRITE THRU S946-EXIT. DTSBR901 00523 P3000-EXIT. DTSBR901 00524 EXIT. DTSBR901 00525 DTSBR901 00526 P4000-LINEUP-LABEL1. DTSBR901 00527 DTSBR901 00528 MOVE LLD1-LINE-1 TO ILBL-FMT-LINE(1) DTSBR901 00529 MOVE LLD1-LINE-2 TO ILBL-FMT-LINE(2) DTSBR901 00530 MOVE LLD1-LINE-3 TO ILBL-FMT-LINE(3) DTSBR901 00531 MOVE LLD1-LINE-4 TO ILBL-FMT-LINE(4) DTSBR901 00532 MOVE LLD1-LINE-5 TO ILBL-FMT-LINE(5) DTSBR901 00533 MOVE LLD1-LINE-6 TO ILBL-FMT-LINE(6) DTSBR901 00534 MOVE LLD1-LINE-7 TO ILBL-FMT-LINE(7) DTSBR901 00535 MOVE LLD1-LINE-8 TO ILBL-FMT-LINE(8) DTSBR901 00536 PERFORM S946-WRITE THRU S946-EXIT. DTSBR901 00537 P4000-EXIT. DTSBR901 00538 EXIT. DTSBR901 00539 DTSBR901 00540 P5000-MAILING-LABEL1. DTSBR901 00541 DTSBR901 00542 MOVE R901-EMP-NO TO MLD1-EMP-NO DTSBR901 00543 MOVE R901-FMT-LINE (1) TO MLD1-FMT-LINE-1 DTSBR901 00544 MOVE R901-FMT-LINE (2) TO MLD1-FMT-LINE-2 DTSBR901 00545 MOVE R901-FMT-LINE (3) TO MLD1-FMT-LINE-3 DTSBR901 00546 MOVE R901-FMT-LINE (4) TO MLD1-FMT-LINE-4 DTSBR901 00547 MOVE R901-FMT-LINE (5) TO MLD1-FMT-LINE-5. DTSBR901 00548 DTSBR901 00549 MOVE MLD1-LINE-1 TO ILBL-FMT-LINE(1) DTSBR901 00550 MOVE MLD1-LINE-2 TO ILBL-FMT-LINE(2) DTSBR901 00551 MOVE MLD1-LINE-3 TO ILBL-FMT-LINE(3) DTSBR901 00552 MOVE MLD1-LINE-4 TO ILBL-FMT-LINE(4) DTSBR901 00553 MOVE MLD1-LINE-5 TO ILBL-FMT-LINE(5) DTSBR901 00554 MOVE MLD1-LINE-6 TO ILBL-FMT-LINE(6) DTSBR901 00555 MOVE MLD1-LINE-7 TO ILBL-FMT-LINE(7) DTSBR901 00556 MOVE MLD1-LINE-8 TO ILBL-FMT-LINE(8) DTSBR901 00557 PERFORM S946-WRITE THRU S946-EXIT. DTSBR901 00558 P5000-EXIT. DTSBR901 00559 EXIT. DTSBR901 00560 DTSBR901 00561 P6000-MAILING-LABEL2. DTSBR901 00562 DTSBR901 00563 MOVE R901-EMP-NO TO MLD2-EMP-NO DTSBR901 00564 MOVE R901-FMT-LINE (1) TO MLD2-FMT-LINE-1 DTSBR901 00565 MOVE R901-FMT-LINE (2) TO MLD2-FMT-LINE-2 DTSBR901 00566 MOVE R901-FMT-LINE (3) TO MLD2-FMT-LINE-3 DTSBR901 00567 MOVE R901-FMT-LINE (4) TO MLD2-FMT-LINE-4 DTSBR901 00568 MOVE R901-FMT-LINE (5) TO MLD2-FMT-LINE-5. DTSBR901 00569 DTSBR901 00570 MOVE MLD2-LINE-1 TO ILBL-FMT-LINE(1) DTSBR901 00571 MOVE MLD2-LINE-2 TO ILBL-FMT-LINE(2) DTSBR901 00572 MOVE MLD2-LINE-3 TO ILBL-FMT-LINE(3) DTSBR901 00573 MOVE MLD2-LINE-4 TO ILBL-FMT-LINE(4) DTSBR901 00574 MOVE MLD2-LINE-5 TO ILBL-FMT-LINE(5) DTSBR901 00575 MOVE MLD2-LINE-6 TO ILBL-FMT-LINE(6) DTSBR901 00576 MOVE MLD2-LINE-7 TO ILBL-FMT-LINE(7) DTSBR901 00577 MOVE MLD2-LINE-8 TO ILBL-FMT-LINE(8) DTSBR901 00578 PERFORM S946-WRITE THRU S946-EXIT. DTSBR901 00579 P6000-EXIT. DTSBR901 00580 EXIT. DTSBR901 00581 DTSBR901 00582 P7000-BREAK-LABEL1. DTSBR901 00583 DTSBR901 00584 MOVE BLD1-LINE-1 TO ILBL-FMT-LINE(1) DTSBR901 00585 MOVE SPACES TO ILBL-FMT-LINE(2) DTSBR901 00586 MOVE BLD1-LINE-3 TO ILBL-FMT-LINE(3) DTSBR901 00587 MOVE BLD1-LINE-4 TO ILBL-FMT-LINE(4) DTSBR901 00588 MOVE BLD1-LINE-5 TO ILBL-FMT-LINE(5) DTSBR901 00589 MOVE BLD1-LINE-6 TO ILBL-FMT-LINE(6) DTSBR901 00590 MOVE BLD1-LINE-7 TO ILBL-FMT-LINE(7) DTSBR901 00591 MOVE SPACES TO ILBL-FMT-LINE(8) DTSBR901 00592 PERFORM S946-WRITE THRU S946-EXIT. DTSBR901 00593 P7000-EXIT. DTSBR901 00594 EXIT. DTSBR901 00595 DTSBR901 00596 P8000-BREAK-LABEL2. DTSBR901 00597 DTSBR901 00598 MOVE BLD2-LINE-1 TO ILBL-FMT-LINE(1) DTSBR901 00599 MOVE SPACES TO ILBL-FMT-LINE(2) DTSBR901 00600 MOVE BLD2-LINE-3 TO ILBL-FMT-LINE(3) DTSBR901 00601 MOVE BLD2-LINE-4 TO ILBL-FMT-LINE(4) DTSBR901 00602 MOVE BLD2-LINE-5 TO ILBL-FMT-LINE(5) DTSBR901 00603 MOVE BLD2-LINE-6 TO ILBL-FMT-LINE(6) DTSBR901 00604 MOVE BLD2-LINE-7 TO ILBL-FMT-LINE(7) DTSBR901 00605 MOVE SPACES TO ILBL-FMT-LINE(8) DTSBR901 00606 PERFORM S946-WRITE THRU S946-EXIT. DTSBR901 00607 P8000-EXIT. DTSBR901 00608 EXIT. DTSBR901 00609 DTSBR901 00610 T1000-TERMINATE. DTSBR901 00611 DTSBR901 00612 MOVE -1 TO ILBL-LENGTH. DTSBR901 00613 PERFORM S946-WRITE THRU S946-EXIT. DTSBR901 00614 * IF RPT1-OPEN-SW = 'Y' DTSBR901 00615 * CLOSE PRT-FILE1 DTSBR901 00616 * ELSE DTSBR901 00617 * CLOSE PRT-FILE2. DTSBR901 00618 DTSBR901 00619 T1000-EXIT. DTSBR901 00620 EXIT. DTSBR901 00621 EJECT DTSBR901 00622 S071-DESLASH-NAME. DTSBR901 00623 DTSBR901 00624 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR901 00625 DTSBR901 00626 S071-EXIT. DTSBR901 00627 EXIT. DTSBR901 00628 DTSBR901 00629 S082-OP-ID-NAME. DTSBR901 00630 DTSBR901 00631 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR901 00632 DTSBR901 00633 S082-EXIT. DTSBR901 00634 EXIT. DTSBR901 00635 DTSBR901 00636 S083-UPPERCASE-CHG. DTSBR901 00637 DTSBR901 00638 CALL 'DTSBU009' USING L009-DATA. DTSBR901 00639 DTSBR901 00640 S083-EXIT. DTSBR901 00641 EXIT. DTSBR901 00642 DTSBR901 00643 DTSBR901 00644 S946-WRITE. DTSBR901 00645 DTSBR901 00646 CALL 'DOESU946' USING ILBL-LINK-AREA. DTSBR901 00647 DTSBR901 00648 S946-EXIT. DTSBR901 00649 EXIT. DTSBR901 00650 DTSBR901 00651 S999-ABEND. DTSBR901 00652 DTSBR901 00653 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR901 00654 DTSBR901 00655 S999-EXIT. DTSBR901 00656 EXIT. DTSBR901