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