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