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