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
