00001  IDENTIFICATION DIVISION.                                         07/10/00
00002  PROGRAM-ID.             DTSBE761.                                DTSBE761
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV160
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBE761
00005  DATE-COMPILED.                                                   DTSBE761
00006                                                                   DTSBE761
00007 *****                                                             DTSBE761
00008 *                                                                 DTSBE761
00009 *    CALLING SEQUENCE:  DTSBD400 CALLS                            DTSBE761
00010 *                       DTSBE761 WHICH UPDATES DTSIR901           DTSBE761
00011 *                       DTSBR901 PRODUCES THE REQUESTED           DTSBE761
00012 *                                LABELS.                          DTSBE761
00013 *                                                                 DTSBE761
00014 *    FUNCTION:  JOB SERVICE LABELS EXTRACT.                       DTSBE761
00015 *                                                                 DTSBE761
00016 *                                                                 DTSBE761
00017 *    MODIFICATION LOG:                                            DTSBE761
00018 *                                                                 DTSBE761
00019 *    06/13/96  RECOMPILED TO INCORPORATE CHANGES TO DTSIR901.     DTSBE761
00020 *              REFERENCE RFP: #WARP II          PROGRAMMER: MJA   DTSBE761
00021 *                                                                 DTSBE761
00022 *    03/02/99  MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS  DTSBE761
00023 *              REFERENCE RFP: #XXX              PROGRAMMER:  DVS  DTSBE761
00024 *                                                                 DTSBE761
00025 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE761
00026 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBE761
00027 *              REFERENCE RFP: #XXX              PROGRAMMER: XXX   DTSBE761
00028 *                                                                 DTSBE761
00029 *                                                                 DTSBE761
00030 *  DESCRIPTION:                                                   DTSBE761
00031 *                                                                 DTSBE761
00032 *                                                                 DTSBE761
00033 *    INITIATION:                                                  DTSBE761
00034 *                                                                 DTSBE761
00035 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE761
00036 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE761
00037 *                                                                 DTSBE761
00038 *      EDIT PARAMTERS (SEE 901R1).                                DTSBE761
00039 *                                                                 DTSBE761
00040 *                                                                 DTSBE761
00041 *    PROCESSING:                                                  DTSBE761
00042 *                                                                 DTSBE761
00043 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (901R1).       DTSBE761
00044 *                                                                 DTSBE761
00045 *                                                                 DTSBE761
00046 *    TERMINATION:                                                 DTSBE761
00047 *                                                                 DTSBE761
00048 *      NONE.                                                      DTSBE761
00049 *                                                                 DTSBE761
00050 *                                                                 DTSBE761
00051 *    RECORDS READ:                                                DTSBE761
00052 *                                                                 DTSBE761
00053 *      MASTER:                                                    DTSBE761
00054 *                                                                 DTSBE761
00055 *        NONE.                                                    DTSBE761
00056 *                                                                 DTSBE761
00057 *                                                                 DTSBE761
00058 *      ALTERNATE INDEX:                                           DTSBE761
00059 *                                                                 DTSBE761
00060 *        NONE.                                                    DTSBE761
00061 *                                                                 DTSBE761
00062 *                                                                 DTSBE761
00063 *      REFERENCE:                                                 DTSBE761
00064 *                                                                 DTSBE761
00065 *        NONE.                                                    DTSBE761
00066 *                                                                 DTSBE761
00067 *                                                                 DTSBE761
00068 *    RECORDS UPDATED:                                             DTSBE761
00069 *                                                                 DTSBE761
00070 *        NONE.                                                    DTSBE761
00071 *                                                                 DTSBE761
00072 *                                                                 DTSBE761
00073 *    REPORT RECORDS WRITTEN:                                      DTSBE761
00074 *                                                                 DTSBE761
00075 *        R901  LABELS.                                            DTSBE761
00076 *                                                                 DTSBE761
00077 *                                                                 DTSBE761
00078 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE761
00079 *                                                                 DTSBE761
00080 *        NONE.                                                    DTSBE761
00081 *                                                                 DTSBE761
00082 *                                                                 DTSBE761
00083 *    MODULES CALLED:                                              DTSBE761
00084 *                                                                 DTSBE761
00085 *        DTSBU001  DATE CONVERSION/EDIT.                          DTSBE761
00086 *        DTSBU111  ADDRESS LOOKUP.                                DTSBE761
00087 *        DTSBU112  ADDRESS FORMATTING.                            DTSBE761
00088 *        DTSBU910  MASTER FILE I/O.                               DTSBE761
00089 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBE761
00090 *                                                                 DTSBE761
00091 *                                                                 DTSBE761
00092 *    VERMONT REFERENCE:                                           DTSBE761
00093 *                                                                 DTSBE761
00094 *        NONE.                                                    DTSBE761
00095 *                                                                 DTSBE761
00096 *****                                                             DTSBE761
00097                                                                   DTSBE761
00098  ENVIRONMENT DIVISION.                                            DTSBE761
00099                                                                   DTSBE761
00100  DATA DIVISION.                                                   DTSBE761
00101                                                                   DTSBE761
00102  WORKING-STORAGE SECTION.                                         DTSBE761
001025 77  PAN-VALET PICTURE X(24) VALUE '160DTSBE761  07/10/00'.       DTSBE761
00103                                                                   DTSBE761
00104  01  WRK-AREA.                                                    DTSBE761
00105      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +761.DTSBE761
00106                                                                   DTSBE761
00107      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE761'.DTSBE761
00108                                                                   DTSBE761
00109      05  ABEND-MSG                   PIC  X(60).                  DTSBE761
00110      05  WRK-MQTR-CNT                PIC  9(03)   VALUE ZERO.     DTSBE761
00111                                                                   DTSBE761
00112      05  WRK-EMP-NO                  PIC  S9(07) COMP-3.          DTSBE761
00113      05  WRK-EMP-NO1                 PIC   9(07) VALUE ZEROES.    DTSBE761
00114      05  WRK-EMPL-CNT                PIC  S9(04) COMP  VALUE ZERO.DTSBE761
00115      05  WRK-MIN-EMP-CNT             PIC  S9(04) COMP  VALUE +40. DTSBE761
00116      05  WRK-YRQ                     PIC  X(04)   VALUE ZERO.     DTSBE761
00117                                                                   DTSBE761
00118      05  WRK-PARM-OCC-CNT                PIC S9(04)  COMP.        DTSBE761
00119      05  WRK-EMPLOYER-CLASS              PIC  X(01)  VALUE SPACES.DTSBE761
00120          88  WRK-CLASS-CHG-ONLY-88       VALUE 'C'.               DTSBE761
00121          88  WRK-CLASS-RATED-88          VALUE 'R'.               DTSBE761
00122          88  WRK-CLASS-SELF-INS-88       VALUE 'S'.               DTSBE761
00123          88  WRK-CLASS-UNK-88            VALUE 'U'.               DTSBE761
00124          88  WRK-CLASS-SUB-88            VALUE 'R' 'S'.           DTSBE761
00125      05  WRK-GRP-REPORT-IND              PIC X.                   DTSBE761
00126          88  WRK-ON-REQUEST-88           VALUE '1'.               DTSBE761
00127 *        88  WRK-EMP-REG-A-88            VALUE '2'.               DTSBE761
00128 *        88  WRK-LIAB-DETER-88           VALUE '3'.               DTSBE761
00129          88  WRK-JOB-SERVICE-88          VALUE '4'.               DTSBE761
00130      05  WRK-GRP-IND-CODE-IND            PIC X.                   DTSBE761
00131          88  WRK-GRP-IND-CODE-OFF        VALUE '0'.               DTSBE761
00132          88  WRK-GRP-IND-CODE-NAICS-88   VALUE '1'.               DTSBE761
00133          88  WRK-GRP-IND-CODE-SIC-88     VALUE '2'.               DTSBE761
00134          88  WRK-GRP-IND-CODE-BOTH-88    VALUE '3'.               DTSBE761
00135      05  WRK-VALID-IND-CODE-VALUE        PIC X.                   DTSBE761
00136          88  WRK-PROCESS-DEFAULT-88      VALUE '0'.               DTSBE761
00137          88  WRK-NAICS-ALL-NINES-88      VALUE '1'.               DTSBE761
00138          88  WRK-SIC-ALL-NINES-88        VALUE '2'.               DTSBE761
00139      05  WRK-JS-MIN-EMPL-IND             PIC X.                   DTSBE761
00140          88  WRK-JS-EMPLOYER-MIN-88      VALUE 'Y'.               DTSBE761
00141      05  WRK-PARM-NAICS-CODE.                                     DTSBE761
00142          10  WRK-NAICS-CODE-S             PIC X(06).              DTSBE761
00143          10  WRK-NAICS-CODE-E             PIC X(06).              DTSBE761
00144      05  WRK-PARM-SIC-CODE.                                       DTSBE761
00145          10  WRK-SIC-CODE-S               PIC X(04).              DTSBE761
00146          10  WRK-SIC-CODE-E               PIC X(04).              DTSBE761
00147      05  WRK-NAICS-JOB-CODE             PIC X(06) VALUE SPACES.   DTSBE761
00148      05  WRK-SIC-JOB-CODE.                                        DTSBE761
00149          10  WRK-SIC-JOB-CODE-H           PIC X(02) VALUE '00'.   DTSBE761
00150          10  WRK-SIC-JOB-CODE-L           PIC X(04) VALUE SPACES. DTSBE761
00151      05  WRK-R901-ADDRESS.                                        DTSBE761
00152          10  WRK-ATTN-LINE       PIC  X(40).                      DTSBE761
00153          10  WRK-DELIV-LINE-1    PIC  X(40).                      DTSBE761
00154          10  WRK-DELIV-LINE-2    PIC  X(40).                      DTSBE761
00155          10  WRK-CITY            PIC  X(25).                      DTSBE761
00156          10  WRK-ST              PIC  X(02).                      DTSBE761
00157          10  WRK-ZIP             PIC  X(10).                      DTSBE761
00158          10  WRK-ADVANCED-BARCODE                                 DTSBE761
00159                                  PIC  X(14).                      DTSBE761
00160                                                                   DTSBE761
00161      05  WRK-LABEL-IND                   PIC  X(01).              DTSBE761
00162      EJECT                                                        DTSBE761
00163  01  L001-LINK-AREA.                                              DTSBE761
00164  ++INCLUDE DTSIL001                                               DTSBE761
00165      EJECT                                                        DTSBE761
00166  01  L111-LINK-AREA.                                              DTSBE761
00167  ++INCLUDE DTSIL111                                               DTSBE761
00168      EJECT                                                        DTSBE761
00169  01  L112-LINK-AREA.                                              DTSBE761
00170  ++INCLUDE DTSIL112                                               DTSBE761
00171      EJECT                                                        DTSBE761
00172  01  L910-LINK-AREA.                                              DTSBE761
00173  ++INCLUDE DTSIL910                                               DTSBE761
00174                                                                   DTSBE761
00175  01  MSKL-REC.                                                    DTSBE761
00176  ++INCLUDE DTSIMSKL                                               DTSBE761
00177      EJECT                                                        DTSBE761
00178  01  MQTR-REC.                                                    DTSBE761
00179  ++INCLUDE DTSIMQTR                                               DTSBE761
00180      EJECT                                                        DTSBE761
00181  01  MTAA-REC.                                                    DTSBE761
00182  ++INCLUDE DTSIMTAA                                               DTSBE761
00183      EJECT                                                        DTSBE761
00184  01  MTAD-REC.                                                    DTSBE761
00185  ++INCLUDE DTSIMTAD                                               DTSBE761
00186      EJECT                                                        DTSBE761
00187  01  R901-REC.                                                    DTSBE761
00188  ++INCLUDE DTSIR901                                               DTSBE761
00189      EJECT                                                        DTSBE761
00190  LINKAGE SECTION.                                                 DTSBE761
00191                                                                   DTSBE761
00192  01  LECM-LINK-AREA.                                              DTSBE761
00193  ++INCLUDE DTSILECM                                               DTSBE761
00194                                                                   DTSBE761
00195          10  FILLER REDEFINES LECM-EXTRACT-PARMS.                 DTSBE761
00196              15  LECM-PARM-JS-EXTRACT-TYPE       PIC X.           DTSBE761
00197              15  FILLER                          PIC X.           DTSBE761
00198              15  LECM-PARM-EMPLR-CLASS           PIC X.           DTSBE761
00199              15  FILLER                          PIC X.           DTSBE761
00200              15  LECM-PARM-INDUSTRY-SIC-CODE     PIC X(08).       DTSBE761
00201              15  FILLER                          PIC X.           DTSBE761
00202              15  LECM-PARM-INDUSTRY-NAICS-CODE   PIC X(12).       DTSBE761
00203              15  FILLER                          PIC X.           DTSBE761
00204              15  LECM-PARM-EMPLOYEE-MINIMUM      PIC X(02).       DTSBE761
00205              15  LECM-PARM-EMPLOYEE-MIN-N REDEFINES               DTSBE761
00206                  LECM-PARM-EMPLOYEE-MINIMUM       PIC 9(02).      DTSBE761
00207              15  FILLER                           PIC X(40).      DTSBE761
00208      EJECT                                                        DTSBE761
00209  01  MPRF-LINK-REC.                                               DTSBE761
00210  ++INCLUDE DTSIMPRF                                               DTSBE761
00211      EJECT                                                        DTSBE761
00212 **************************************************************    DTSBE761
00213 *  PROCEDURE DIVISION FOR DTSBE761 - JOB SERVICE LABELS           DTSBE761
00214 *  EXTRACT STARTS HERE.                                           DTSBE761
00215 **************************************************************    DTSBE761
00216                                                                   DTSBE761
00217  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE761
00218                           MPRF-LINK-REC.                          DTSBE761
00219                                                                   DTSBE761
00220      EVALUATE LECM-CALL-TYPE-IND                                  DTSBE761
00221        WHEN 'P'                                                   DTSBE761
00222          PERFORM P0000-PROCESS                                    DTSBE761
00223             THRU P0000-EXIT                                       DTSBE761
00224        WHEN 'I'                                                   DTSBE761
00225          PERFORM I0000-INITIALIZE                                 DTSBE761
00226             THRU I0000-EXIT                                       DTSBE761
00227        WHEN 'T'                                                   DTSBE761
00228          PERFORM T0000-TERMINATE                                  DTSBE761
00229             THRU T0000-EXIT                                       DTSBE761
00230        WHEN OTHER                                                 DTSBE761
00231          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE761
00232            TO ABEND-MSG                                           DTSBE761
00233          PERFORM S999-ABEND                                       DTSBE761
00234             THRU S999-EXIT                                        DTSBE761
00235      END-EVALUATE.                                                DTSBE761
00236                                                                   DTSBE761
00237      GOBACK.                                                      DTSBE761
00238      EJECT                                                        DTSBE761
00239 **************************************************************    DTSBE761
00240 *  THIS IS THE INITIALIZATION PARAGRAPH FOR DTSBE761.             DTSBE761
00241 **************************************************************    DTSBE761
00242                                                                   DTSBE761
00243  I0000-INITIALIZE.                                                DTSBE761
00244                                                                   DTSBE761
00245      MOVE LENGTH OF R901-REC   TO R901-LENGTH.                    DTSBE761
00246      MOVE '901'                TO R901-REC-TYPE.                  DTSBE761
00247      MOVE +0                   TO R901-LABEL-CNT.                 DTSBE761
00248      PERFORM I1000-EDIT-AND-DEFAULT-PARMS                         DTSBE761
00249         THRU I1000-EXIT.                                          DTSBE761
00250      MOVE LECM-TRACE-IND       TO L910-TRACE-IND.                 DTSBE761
00251      MOVE WRK-MOD-NAME         TO L910-MOD-NAME.                  DTSBE761
00252      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE761
00253      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE761
00254                                                                   DTSBE761
00255  I0000-EXIT.                                                      DTSBE761
00256      EXIT.                                                        DTSBE761
00257                                                                   DTSBE761
00258                                                                   DTSBE761
00259  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE761
00260                                                                   DTSBE761
00261      PERFORM I1100-EXTRACT-TYPE                                   DTSBE761
00262         THRU I1100-EXIT.                                          DTSBE761
00263                                                                   DTSBE761
00264      PERFORM I1400-EMPLOYER-CLS                                   DTSBE761
00265         THRU I1400-EXIT.                                          DTSBE761
00266                                                                   DTSBE761
00267  I1000-EXIT.                                                      DTSBE761
00268      EXIT.                                                        DTSBE761
00269                                                                   DTSBE761
00270                                                                   DTSBE761
00271  I1100-EXTRACT-TYPE.                                              DTSBE761
00272      IF LECM-PARM-JS-EXTRACT-TYPE = SPACES                        DTSBE761
00273          MOVE 'LECM-PARM-JS-EXTRACT-TYPE IS MISSING'              DTSBE761
00274            TO ABEND-MSG                                           DTSBE761
00275          PERFORM S999-ABEND                                       DTSBE761
00276             THRU S999-EXIT                                        DTSBE761
00277      ELSE                                                         DTSBE761
00278          IF LECM-PARM-JS-EXTRACT-TYPE NOT = '1' AND '4'           DTSBE761
00279              MOVE 'LECM-PARM-JS-EXTRACT-TYPE IS NOT VALID '       DTSBE761
00280                TO ABEND-MSG                                       DTSBE761
00281              PERFORM S999-ABEND                                   DTSBE761
00282                 THRU S999-EXIT.                                   DTSBE761
00283                                                                   DTSBE761
00284      IF LECM-PARM-JS-EXTRACT-TYPE = '4'                           DTSBE761
00285          SET WRK-JOB-SERVICE-88 TO TRUE                           DTSBE761
00286          PERFORM I1200-INDUSTRY-CDE                               DTSBE761
00287             THRU I1200-EXIT                                       DTSBE761
00288          PERFORM I1300-EMPLOYEE-MIN                               DTSBE761
00289             THRU I1300-EXIT                                       DTSBE761
00290      ELSE                                                         DTSBE761
00291          SET WRK-ON-REQUEST-88  TO TRUE.                          DTSBE761
00292                                                                   DTSBE761
00293      DISPLAY 'J IND  ' WRK-GRP-REPORT-IND.                        DTSBE761
00294  I1100-EXIT.                                                      DTSBE761
00295      EXIT.                                                        DTSBE761
00296                                                                   DTSBE761
00297                                                                   DTSBE761
00298  I1200-INDUSTRY-CDE.                                              DTSBE761
00299      SET WRK-GRP-IND-CODE-OFF TO TRUE.                            DTSBE761
00300                                                                   DTSBE761
00301      IF  LECM-PARM-INDUSTRY-NAICS-CODE > SPACES                   DTSBE761
00302      AND LECM-PARM-INDUSTRY-SIC-CODE   > SPACES                   DTSBE761
00303          MOVE LECM-PARM-INDUSTRY-NAICS-CODE TO WRK-PARM-NAICS-CODEDTSBE761
00304          MOVE LECM-PARM-INDUSTRY-SIC-CODE   TO WRK-PARM-SIC-CODE  DTSBE761
00305          SET WRK-GRP-IND-CODE-BOTH-88       TO TRUE               DTSBE761
00306      ELSE                                                         DTSBE761
00307          IF LECM-PARM-INDUSTRY-NAICS-CODE > SPACES                DTSBE761
00308              MOVE LECM-PARM-INDUSTRY-NAICS-CODE                   DTSBE761
00309                TO WRK-PARM-NAICS-CODE                             DTSBE761
00310              SET WRK-GRP-IND-CODE-NAICS-88 TO TRUE                DTSBE761
00311          ELSE                                                     DTSBE761
00312              IF LECM-PARM-INDUSTRY-SIC-CODE > SPACES              DTSBE761
00313                  MOVE LECM-PARM-INDUSTRY-SIC-CODE                 DTSBE761
00314                    TO WRK-PARM-SIC-CODE                           DTSBE761
00315                  SET WRK-GRP-IND-CODE-SIC-88 TO TRUE.             DTSBE761
00316                                                                   DTSBE761
00317       PERFORM I1210-VALIDATE-CDE                                  DTSBE761
00318          THRU I1210-EXIT.                                         DTSBE761
00319                                                                   DTSBE761
00320       DISPLAY ' GROUP CODE ' WRK-GRP-IND-CODE-IND.                DTSBE761
00321  I1200-EXIT.                                                      DTSBE761
00322      EXIT.                                                        DTSBE761
00323                                                                   DTSBE761
00324  I1210-VALIDATE-CDE.                                              DTSBE761
00325                                                                   DTSBE761
00326       IF  WRK-NAICS-CODE-S > SPACES                               DTSBE761
00327       AND WRK-NAICS-CODE-E > SPACES                               DTSBE761
00328           IF WRK-NAICS-CODE-S > WRK-NAICS-CODE-E                  DTSBE761
00329               MOVE 'LECM-PARM-INDUSTRY-NAICS-CODE RANGE INVALID ' DTSBE761
00330                   TO ABEND-MSG                                    DTSBE761
00331               PERFORM S999-ABEND                                  DTSBE761
00332                  THRU S999-EXIT                                   DTSBE761
00333           ELSE                                                    DTSBE761
00334               NEXT SENTENCE                                       DTSBE761
00335       ELSE                                                        DTSBE761
00336           MOVE WRK-NAICS-CODE-S TO WRK-NAICS-CODE-E.              DTSBE761
00337                                                                   DTSBE761
00338       IF  WRK-SIC-CODE-S > SPACES                                 DTSBE761
00339       AND WRK-SIC-CODE-E > SPACES                                 DTSBE761
00340           IF WRK-SIC-CODE-S > WRK-SIC-CODE-E                      DTSBE761
00341               MOVE 'LECM-PARM-INDUSTRY-SIC-CODE RANGE INVALID '   DTSBE761
00342                   TO ABEND-MSG                                    DTSBE761
00343               PERFORM S999-ABEND                                  DTSBE761
00344                  THRU S999-EXIT                                   DTSBE761
00345           ELSE                                                    DTSBE761
00346               NEXT SENTENCE                                       DTSBE761
00347       ELSE                                                        DTSBE761
00348           MOVE WRK-SIC-CODE-S TO WRK-SIC-CODE-E.                  DTSBE761
00349                                                                   DTSBE761
00350  I1210-EXIT.                                                      DTSBE761
00351      EXIT.                                                        DTSBE761
00352                                                                   DTSBE761
00353                                                                   DTSBE761
00354  I1300-EMPLOYEE-MIN.                                              DTSBE761
00355      IF LECM-PARM-EMPLOYEE-MIN-N NOT NUMERIC                      DTSBE761
00356          MOVE 40 TO LECM-PARM-EMPLOYEE-MINIMUM.                   DTSBE761
00357                                                                   DTSBE761
00358      MOVE LECM-PARM-EMPLOYEE-MIN-N TO WRK-MIN-EMP-CNT.            DTSBE761
00359                                                                   DTSBE761
00360  I1300-EXIT.                                                      DTSBE761
00361      EXIT.                                                        DTSBE761
00362                                                                   DTSBE761
00363                                                                   DTSBE761
00364  I1400-EMPLOYER-CLS.                                              DTSBE761
00365      IF LECM-PARM-EMPLR-CLASS > SPACES                            DTSBE761
00366          EVALUATE LECM-PARM-EMPLR-CLASS                           DTSBE761
00367            WHEN 'C'                                               DTSBE761
00368              SET WRK-CLASS-CHG-ONLY-88 TO TRUE                    DTSBE761
00369            WHEN 'R'                                               DTSBE761
00370              SET WRK-CLASS-RATED-88    TO TRUE                    DTSBE761
00371            WHEN 'S'                                               DTSBE761
00372              SET WRK-CLASS-SELF-INS-88 TO TRUE                    DTSBE761
00373            WHEN 'U'                                               DTSBE761
00374              SET WRK-CLASS-UNK-88      TO TRUE                    DTSBE761
00375            WHEN OTHER                                             DTSBE761
00376              SET WRK-CLASS-SUB-88      TO TRUE                    DTSBE761
00377              DISPLAY                                              DTSBE761
00378                'LECM-PARM-EMPLR-CLASS INVALID - DEFAULT VALUE SET'DTSBE761
00379          END-EVALUATE                                             DTSBE761
00380      ELSE                                                         DTSBE761
00381          SET WRK-CLASS-SUB-88          TO TRUE.                   DTSBE761
00382                                                                   DTSBE761
00383  I1400-EXIT.                                                      DTSBE761
00384      EXIT.                                                        DTSBE761
00385      EJECT                                                        DTSBE761
00386 **************************************************************    DTSBE761
00387 *  THIS IS THE PROCESS PARAGRAPH FOR DTSBE761.                    DTSBE761
00388 **************************************************************    DTSBE761
00389                                                                   DTSBE761
00390  P0000-PROCESS.                                                   DTSBE761
00391                                                                   DTSBE761
00392      IF MPRF-STATUS-ACT-88                                        DTSBE761
00393          NEXT SENTENCE                                            DTSBE761
00394      ELSE                                                         DTSBE761
00395          GO TO P0000-EXIT.                                        DTSBE761
00396                                                                   DTSBE761
00397      IF MPRF-EMP-CLASS = WRK-EMPLOYER-CLASS                       DTSBE761
00398          NEXT SENTENCE                                            DTSBE761
00399      ELSE                                                         DTSBE761
00400          GO TO P0000-EXIT.                                        DTSBE761
00401                                                                   DTSBE761
00402                                                                   DTSBE761
00403      IF WRK-JOB-SERVICE-88                                        DTSBE761
00404          PERFORM P1000-JOB-SERVICE-PROCESSING                     DTSBE761
00405             THRU P1000-EXIT                                       DTSBE761
00406      ELSE                                                         DTSBE761
00407          PERFORM P1100-DEFAULT-LABEL-PROCESS                      DTSBE761
00408             THRU P1100-EXIT.                                      DTSBE761
00409                                                                   DTSBE761
00410  P0000-EXIT.                                                      DTSBE761
00411      EXIT.                                                        DTSBE761
00412      EJECT                                                        DTSBE761
00413 **************************************************************    DTSBE761
00414 *  THIS PARAGRAPH SETS UP THE KEY FOR THE R901 EXTRACT RECORD.    DTSBE761
00415 **************************************************************    DTSBE761
00416  P1000-JOB-SERVICE-PROCESSING.                                    DTSBE761
00417                                                                   DTSBE761
00418      IF MPRF-NAICS-PRIV-HOUSEHOLDS-88                             DTSBE761
00419      OR MPRF-SIC-PRIV-HOUSEHOLDS-88                               DTSBE761
00420          GO TO P1000-EXIT.                                        DTSBE761
00421                                                                   DTSBE761
00422      MOVE LOW-VALUES  TO MSKL-KEY-AREA.                           DTSBE761
00423                                                                   DTSBE761
00424      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBE761
00425                                                                   DTSBE761
00426      SET MSKL-QTR-88  TO TRUE.                                    DTSBE761
00427                                                                   DTSBE761
00428      PERFORM S910-START-BROWSE                                    DTSBE761
00429         THRU S910-EXIT.                                           DTSBE761
00430                                                                   DTSBE761
00431      IF L910-NO-REC-88                                            DTSBE761
00432          GO TO P1000-EXIT                                         DTSBE761
00433      ELSE                                                         DTSBE761
00434          ADD +1 TO WRK-MQTR-CNT                                   DTSBE761
00435          MOVE ZERO TO WRK-EMPL-CNT                                DTSBE761
00436          PERFORM P1400-SCAN-MQTR                                  DTSBE761
00437             THRU P1400-EXIT                                       DTSBE761
00438               UNTIL L910-NO-REC-88.                               DTSBE761
00439                                                                   DTSBE761
00440      IF WRK-EMPL-CNT > WRK-MIN-EMP-CNT                            DTSBE761
00441          PERFORM P1010-VALIDATE-INDUSTRY-CDS                      DTSBE761
00442             THRU P1010-EXIT.                                      DTSBE761
00443  P1000-EXIT.                                                      DTSBE761
00444      EXIT.                                                        DTSBE761
00445 **************************************************************    DTSBE761
00446 *  THIS PARAGRAPH SETS UP THE NAICS OR SIC CODE VALUES            DTSBE761
00447 **************************************************************    DTSBE761
00448                                                                   DTSBE761
00449  P1010-VALIDATE-INDUSTRY-CDS.                                     DTSBE761
00450        MOVE SPACES TO WRK-VALID-IND-CODE-VALUE.                   DTSBE761
00451                                                                   DTSBE761
00452        IF WRK-GRP-IND-CODE-OFF                                    DTSBE761
00453            PERFORM P1040-DEFAULT-CHECK                            DTSBE761
00454               THRU P1040-EXIT,                                    DTSBE761
00455                                                                   DTSBE761
00456        IF WRK-GRP-IND-CODE-BOTH-88                                DTSBE761
00457        OR WRK-GRP-IND-CODE-NAICS-88                               DTSBE761
00458            PERFORM P1020-VALIDATE-NAICS-VALUE                     DTSBE761
00459               THRU P1020-EXIT.                                    DTSBE761
00460                                                                   DTSBE761
00461        IF WRK-GRP-IND-CODE-SIC-88                                 DTSBE761
00462            PERFORM P1030-VALIDATE-SIC-VALUE                       DTSBE761
00463               THRU P1030-EXIT.                                    DTSBE761
00464                                                                   DTSBE761
00465        IF WRK-PROCESS-DEFAULT-88                                  DTSBE761
00466            PERFORM P1100-DEFAULT-LABEL-PROCESS                    DTSBE761
00467               THRU P1100-EXIT.                                    DTSBE761
00468  P1010-EXIT.                                                      DTSBE761
00469      EXIT.                                                        DTSBE761
00470                                                                   DTSBE761
00471                                                                   DTSBE761
00472  P1020-VALIDATE-NAICS-VALUE.                                      DTSBE761
00473                                                                   DTSBE761
00474       IF MPRF-NAICS-CD-NONCLASSIF-88                              DTSBE761
00475           SET WRK-NAICS-ALL-NINES-88 TO TRUE                      DTSBE761
00476           IF WRK-GRP-IND-CODE-BOTH-88                             DTSBE761
00477               PERFORM P1030-VALIDATE-SIC-VALUE                    DTSBE761
00478                  THRU P1030-EXIT                                  DTSBE761
00479           ELSE                                                    DTSBE761
00480               GO TO P1020-EXIT.                                   DTSBE761
00481                                                                   DTSBE761
00482       IF  MPRF-NAICS-CD >= WRK-NAICS-CODE-S                       DTSBE761
00483       AND MPRF-NAICS-CD <= WRK-NAICS-CODE-E                       DTSBE761
00484           MOVE MPRF-NAICS-CD TO WRK-NAICS-JOB-CODE                DTSBE761
00485           SET R901-GRP4-NAICS-88     TO  TRUE                     DTSBE761
00486           SET WRK-PROCESS-DEFAULT-88 TO TRUE                      DTSBE761
00487       ELSE                                                        DTSBE761
00488           IF WRK-GRP-IND-CODE-BOTH-88                             DTSBE761
00489               PERFORM P1030-VALIDATE-SIC-VALUE                    DTSBE761
00490                  THRU P1030-EXIT.                                 DTSBE761
00491  P1020-EXIT.                                                      DTSBE761
00492      EXIT.                                                        DTSBE761
00493                                                                   DTSBE761
00494                                                                   DTSBE761
00495  P1030-VALIDATE-SIC-VALUE.                                        DTSBE761
00496                                                                   DTSBE761
00497       IF MPRF-SIC-CD-NONCLASSIF-88                                DTSBE761
00498           SET WRK-SIC-ALL-NINES-88 TO TRUE                        DTSBE761
00499           GO TO P1030-EXIT.                                       DTSBE761
00500                                                                   DTSBE761
00501 *     DISPLAY  'EMP SIC ' MPRF-SIC-CD                             DTSBE761
00502 *     DISPLAY  'WRK SIC ' WRK-SIC-CODE-S  '  ' WRK-SIC-CODE-E     DTSBE761
00503 *     DISPLAY SPACE                                               DTSBE761
00504                                                                   DTSBE761
00505       IF  MPRF-SIC-CD >= WRK-SIC-CODE-S                           DTSBE761
00506       AND MPRF-SIC-CD <= WRK-SIC-CODE-E                           DTSBE761
00507           MOVE MPRF-SIC-CD TO WRK-SIC-JOB-CODE-L                  DTSBE761
00508           SET R901-GRP4-SIC-88       TO TRUE                      DTSBE761
00509           SET WRK-PROCESS-DEFAULT-88 TO TRUE.                     DTSBE761
00510                                                                   DTSBE761
00511  P1030-EXIT.                                                      DTSBE761
00512      EXIT.                                                        DTSBE761
00513 **************************************************************    DTSBE761
00514 *  THIS PARAGRAPH WILL DEFAULT TO A NAICS CODE OR SIC CODE        DTSBE761
00515 **************************************************************    DTSBE761
00516  P1040-DEFAULT-CHECK.                                             DTSBE761
00517                                                                   DTSBE761
00518      SET WRK-PROCESS-DEFAULT-88 TO TRUE.                          DTSBE761
00519                                                                   DTSBE761
00520      IF MPRF-NAICS-CD-NONCLASSIF-88                               DTSBE761
00521          NEXT SENTENCE                                            DTSBE761
00522      ELSE                                                         DTSBE761
00523          MOVE MPRF-NAICS-CD TO WRK-NAICS-JOB-CODE                 DTSBE761
00524          SET R901-GRP4-NAICS-88 TO TRUE                           DTSBE761
00525          GO TO P1040-EXIT.                                        DTSBE761
00526                                                                   DTSBE761
00527      MOVE MPRF-SIC-CD      TO WRK-SIC-JOB-CODE-L.                 DTSBE761
00528      SET  R901-GRP4-SIC-88 TO TRUE.                               DTSBE761
00529                                                                   DTSBE761
00530  P1040-EXIT.                                                      DTSBE761
00531      EXIT.                                                        DTSBE761
00532      EJECT                                                        DTSBE761
00533  P1100-DEFAULT-LABEL-PROCESS.                                     DTSBE761
00534                                                                   DTSBE761
00535      PERFORM P2000-SETUP-R901-KEY                                 DTSBE761
00536         THRU P2000-EXIT.                                          DTSBE761
00537      PERFORM P3000-LOOKUP-ADDR                                    DTSBE761
00538         THRU P3000-EXIT.                                          DTSBE761
00539                                                                   DTSBE761
00540      IF WRK-ON-REQUEST-88                                         DTSBE761
00541          PERFORM S946-WRITE-R901                                  DTSBE761
00542             THRU S946-EXIT                                        DTSBE761
00543          MOVE LOW-VALUES TO R901-SORT-VAR-AREA                    DTSBE761
00544          GO TO P1100-EXIT.                                        DTSBE761
00545                                                                   DTSBE761
00546      IF L111-ADDR-FOUND-88                                        DTSBE761
00547          PERFORM P1200-VALIDATE-MAIL-CRITERIA                     DTSBE761
00548             THRU P1200-EXIT.                                      DTSBE761
00549                                                                   DTSBE761
00550  P1100-EXIT.                                                      DTSBE761
00551      EXIT.                                                        DTSBE761
00552 ******************************************************************DTSBE761
00553 *  THIS PARAGRAPH CHECKS THE MTAD RECD FOR A DISTRICT OF COLUMBIA DTSBE761
00554 *  ADDRESS. IF ONE EXIST, WRITE THE MTAD LABEL OTHERWISE USE THE  DTSBE761
00555 *  TAX MAILING ADDRESS.                                           DTSBE761
00556 ******************************************************************DTSBE761
00557                                                                   DTSBE761
00558  P1200-VALIDATE-MAIL-CRITERIA.                                    DTSBE761
00559                                                                   DTSBE761
00560      SET R901-JOB-SERVICE-88 TO TRUE.                             DTSBE761
00561                                                                   DTSBE761
00562      IF L112-ST EQUAL 'DC'                                        DTSBE761
00563          PERFORM S946-WRITE-R901                                  DTSBE761
00564             THRU S946-EXIT                                        DTSBE761
00565      ELSE                                                         DTSBE761
00566          PERFORM P3110-LOOKUP-PHYS-ADDR                           DTSBE761
00567             THRU P3110-EXIT                                       DTSBE761
00568          IF L111-ADDR-FOUND-88                                    DTSBE761
00569              PERFORM S946-WRITE-R901                              DTSBE761
00570                 THRU S946-EXIT.                                   DTSBE761
00571                                                                   DTSBE761
00572      MOVE LOW-VALUES TO R901-SORT-VAR-AREA.                       DTSBE761
00573                                                                   DTSBE761
00574  P1200-EXIT.                                                      DTSBE761
00575      EXIT.                                                        DTSBE761
00576 **************************************************************    DTSBE761
00577 *  THIS PARAGRAPH SETS UP THE KEY FOR THE MQTR EXTRACT            DTSBE761
00578 *  TO DETERMINE IF THE EMPLOYER HAS A MINIMUN NUMBER OF           DTSBE761
00579 *  EMPLOYEES WITHIN THE MOST RECENT QUARTER.                      DTSBE761
00580 **************************************************************    DTSBE761
00581  P1400-SCAN-MQTR.                                                 DTSBE761
00582      MOVE MSKL-REC TO MQTR-REC.                                   DTSBE761
00583                                                                   DTSBE761
00584      IF MQTR-CURR-RCVD-88                                         DTSBE761
00585          MOVE MQTR-YRQ TO WRK-YRQ                                 DTSBE761
00586          PERFORM P1500-EMPL-CNT                                   DTSBE761
00587             THRU P1500-EXIT.                                      DTSBE761
00588                                                                   DTSBE761
00589      PERFORM S910-READ-NEXT                                       DTSBE761
00590         THRU S910-EXIT.                                           DTSBE761
00591                                                                   DTSBE761
00592  P1400-EXIT.                                                      DTSBE761
00593      EXIT.                                                        DTSBE761
00594  P1500-EMPL-CNT.                                                  DTSBE761
00595 ***  DISPLAY MQTR-YRQ '  ' MQTR-CURR-RPT-TYPE.                    DTSBE761
00596 ***  DISPLAY MQTR-1ST-MTH-EMPL-CNT '  '                           DTSBE761
00597 ***          MQTR-2ND-MTH-EMPL-CNT '  '                           DTSBE761
00598 ***          MQTR-3RD-MTH-EMPL-CNT.                               DTSBE761
00599                                                                   DTSBE761
00600      IF MQTR-1ST-MTH-NO-ENTRY-88                                  DTSBE761
00601          NEXT SENTENCE                                            DTSBE761
00602      ELSE                                                         DTSBE761
00603          MOVE MQTR-1ST-MTH-EMPL-CNT TO WRK-EMPL-CNT.              DTSBE761
00604                                                                   DTSBE761
00605      IF MQTR-2ND-MTH-NO-ENTRY-88                                  DTSBE761
00606          NEXT SENTENCE                                            DTSBE761
00607      ELSE                                                         DTSBE761
00608          IF MQTR-2ND-MTH-EMPL-CNT > WRK-EMPL-CNT                  DTSBE761
00609              MOVE MQTR-2ND-MTH-EMPL-CNT TO WRK-EMPL-CNT.          DTSBE761
00610                                                                   DTSBE761
00611      IF MQTR-3RD-MTH-NO-ENTRY-88                                  DTSBE761
00612          NEXT SENTENCE                                            DTSBE761
00613      ELSE                                                         DTSBE761
00614          IF MQTR-3RD-MTH-EMPL-CNT > WRK-EMPL-CNT                  DTSBE761
00615              MOVE MQTR-3RD-MTH-EMPL-CNT TO WRK-EMPL-CNT.          DTSBE761
00616  P1500-EXIT.                                                      DTSBE761
00617      EXIT.                                                        DTSBE761
00618                                                                   DTSBE761
00619 **************************************************************    DTSBE761
00620 *  THIS PARAGRAPH SETS UP THE KEY FOR THE R901 EXTRACT RECORD.    DTSBE761
00621 **************************************************************    DTSBE761
00622                                                                   DTSBE761
00623  P2000-SETUP-R901-KEY.                                            DTSBE761
00624      ADD +1                     TO R901-LABEL-CNT.                DTSBE761
00625                                                                   DTSBE761
00626      IF WRK-JOB-SERVICE-88                                        DTSBE761
00627          MOVE MPRF-PRIMARY-NAME TO R901-GRP4-PRIMARY-NAME         DTSBE761
00628          MOVE MPRF-EMP-NO       TO R901-GRP4-EMP-NO               DTSBE761
00629          PERFORM P2100-SETUP-IND-CD                               DTSBE761
00630             THRU P2100-EXIT                                       DTSBE761
00631      ELSE                                                         DTSBE761
00632          SET R901-ON-REQUEST-88 TO TRUE                           DTSBE761
00633          MOVE MPRF-EMP-NO       TO R901-GRP1-EMP-NO.              DTSBE761
00634                                                                   DTSBE761
00635  P2000-EXIT.                                                      DTSBE761
00636      EXIT.                                                        DTSBE761
00637 **************************************************************    DTSBE761
00638 *  THIS PARAGRAPH SETS UP THE INDUSTRY CODE VALUE. IF BOTH        DTSBE761
00639 *  SIC AND NAICS CODE APPEAR THEN USE ONLY NAICS CODE VALUE.      DTSBE761
00640 **************************************************************    DTSBE761
00641                                                                   DTSBE761
00642  P2100-SETUP-IND-CD.                                              DTSBE761
00643      IF R901-GRP4-NAICS-88                                        DTSBE761
00644          MOVE WRK-NAICS-JOB-CODE TO R901-GRP4-IND-CODE.           DTSBE761
00645                                                                   DTSBE761
00646      IF R901-GRP4-SIC-88                                          DTSBE761
00647          MOVE WRK-SIC-JOB-CODE   TO R901-GRP4-IND-CODE.           DTSBE761
00648                                                                   DTSBE761
00649  P2100-EXIT.                                                      DTSBE761
00650      EXIT.                                                        DTSBE761
00651      EJECT                                                        DTSBE761
00652 **************************************************************    DTSBE761
00653 *  THIS PARAGRAPH LOOKS UP THE ADDRESS (MTAD).                    DTSBE761
00654 **************************************************************    DTSBE761
00655                                                                   DTSBE761
00656  P3000-LOOKUP-ADDR.                                               DTSBE761
00657                                                                   DTSBE761
00658      SET L111-LOOKUP-TAD-88     TO TRUE.                          DTSBE761
00659      SET L111-ID-NO-TAD-MAIL-88 TO TRUE.                          DTSBE761
00660                                                                   DTSBE761
00661      MOVE MPRF-EMP-NO TO L111-EMP-NO.                             DTSBE761
00662      MOVE MPRF-EMP-NO TO R901-EMP-NO.                             DTSBE761
00663                                                                   DTSBE761
00664      PERFORM S111-LOOKUP-ADDR                                     DTSBE761
00665         THRU S111-EXIT.                                           DTSBE761
00666                                                                   DTSBE761
00667      IF L111-ADDR-FOUND-88                                        DTSBE761
00668          SET L112-TAD-ADDR-88 TO TRUE                             DTSBE761
00669          PERFORM P3100-FORMAT-ADDR                                DTSBE761
00670             THRU P3100-EXIT                                       DTSBE761
00671      ELSE                                                         DTSBE761
00672          MOVE +1      TO R901-LABEL-CNT                           DTSBE761
00673          MOVE ALL '?' TO R901-FMT-ADDR                            DTSBE761
00674                          R901-ZIP                                 DTSBE761
00675                          R901-ADVANCED-BARCODE.                   DTSBE761
00676                                                                   DTSBE761
00677  P3000-EXIT.                                                      DTSBE761
00678      EXIT.                                                        DTSBE761
00679                                                                   DTSBE761
00680  P3110-LOOKUP-PHYS-ADDR.                                          DTSBE761
00681                                                                   DTSBE761
00682 **   DISPLAY 'LOOK UP TAX ADDR '                                  DTSBE761
00683 **   DISPLAY 'EMP NO ' WRK-EMP-NO1                                DTSBE761
00684 **   DISPLAY SPACE.                                               DTSBE761
00685                                                                   DTSBE761
00686      SET L111-LOOKUP-TAD-88     TO TRUE.                          DTSBE761
00687      SET L111-ID-NO-TAD-PHYS-88 TO TRUE.                          DTSBE761
00688                                                                   DTSBE761
00689      MOVE MPRF-EMP-NO TO L111-EMP-NO.                             DTSBE761
00690      MOVE MPRF-EMP-NO TO R901-EMP-NO.                             DTSBE761
00691                                                                   DTSBE761
00692      PERFORM S111-LOOKUP-ADDR                                     DTSBE761
00693         THRU S111-EXIT.                                           DTSBE761
00694                                                                   DTSBE761
00695      IF L111-ADDR-FOUND-88                                        DTSBE761
00696          SET L112-TAD-ADDR-88 TO TRUE                             DTSBE761
00697          PERFORM P3100-FORMAT-ADDR                                DTSBE761
00698             THRU P3100-EXIT                                       DTSBE761
00699      ELSE                                                         DTSBE761
00700          MOVE +1      TO R901-LABEL-CNT                           DTSBE761
00701          MOVE ALL '?' TO R901-FMT-ADDR                            DTSBE761
00702                          R901-ZIP                                 DTSBE761
00703                          R901-ADVANCED-BARCODE.                   DTSBE761
00704                                                                   DTSBE761
00705  P3110-EXIT.                                                      DTSBE761
00706      EXIT.                                                        DTSBE761
00707                                                                   DTSBE761
00708                                                                   DTSBE761
00709 **************************************************************    DTSBE761
00710 *  THIS PARAGRAPH FORMATS THE ADDRESS (MTAD).                     DTSBE761
00711 **************************************************************    DTSBE761
00712  P3100-FORMAT-ADDR.                                               DTSBE761
00713                                                                   DTSBE761
00714      SET L112-ANCHOR-LAST-88    TO TRUE.                          DTSBE761
00715      MOVE MPRF-PRIMARY-NAME     TO L112-PRIMARY-NAME.             DTSBE761
00716      MOVE L111-RETURN-AREA      TO L112-NAME-ADDRESS-AREA.        DTSBE761
00717                                                                   DTSBE761
00718      PERFORM S112-FORMAT-ADDR                                     DTSBE761
00719         THRU S112-EXIT.                                           DTSBE761
00720                                                                   DTSBE761
00721      MOVE L112-MAILING-ADDRESS  TO R901-FMT-ADDR.                 DTSBE761
00722      MOVE L112-ZIP              TO R901-ZIP.                      DTSBE761
00723      MOVE L112-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE.         DTSBE761
00724      MOVE +1                    TO R901-LABEL-CNT.                DTSBE761
00725                                                                   DTSBE761
00726  P3100-EXIT.                                                      DTSBE761
00727      EXIT.                                                        DTSBE761
00728      EJECT                                                        DTSBE761
00729  T0000-TERMINATE.                                                 DTSBE761
00730                                                                   DTSBE761
00731                                                                   DTSBE761
00732  T0000-EXIT.                                                      DTSBE761
00733      EXIT.                                                        DTSBE761
00734      EJECT                                                        DTSBE761
00735  S001-FROM-FED-8.                                                 DTSBE761
00736      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE761
00737      GO TO S001-DATE.                                             DTSBE761
00738                                                                   DTSBE761
00739  S001-FROM-CAL-6.                                                 DTSBE761
00740      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE761
00741      GO TO S001-DATE.                                             DTSBE761
00742                                                                   DTSBE761
00743  S001-FROM-ABS-DAY.                                               DTSBE761
00744      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE761
00745      GO TO S001-DATE.                                             DTSBE761
00746                                                                   DTSBE761
00747  S001-DATE.                                                       DTSBE761
00748      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE761
00749  S001-EXIT.                                                       DTSBE761
00750      EXIT.                                                        DTSBE761
00751                                                                   DTSBE761
00752  S111-LOOKUP-ADDR.                                                DTSBE761
00753                                                                   DTSBE761
00754      CALL 'DTSBU111' USING L111-LINK-AREA.                        DTSBE761
00755  S111-EXIT.                                                       DTSBE761
00756      EXIT.                                                        DTSBE761
00757                                                                   DTSBE761
00758  S112-FORMAT-ADDR.                                                DTSBE761
00759      CALL 'DTSBU112' USING L112-LINK-AREA.                        DTSBE761
00760  S112-EXIT.                                                       DTSBE761
00761      EXIT.                                                        DTSBE761
00762                                                                   DTSBE761
00763  S910-READ.                                                       DTSBE761
00764      SET L910-READ-88 TO TRUE.                                    DTSBE761
00765      GO TO S910-MSTR-IO.                                          DTSBE761
00766                                                                   DTSBE761
00767  S910-START-BROWSE.                                               DTSBE761
00768      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE761
00769      GO TO S910-MSTR-IO.                                          DTSBE761
00770                                                                   DTSBE761
00771  S910-READ-NEXT.                                                  DTSBE761
00772      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE761
00773      GO TO S910-MSTR-IO.                                          DTSBE761
00774                                                                   DTSBE761
00775  S910-COUNT.                                                      DTSBE761
00776      SET L910-COUNT-88 TO TRUE.                                   DTSBE761
00777      GO TO S910-MSTR-IO.                                          DTSBE761
00778                                                                   DTSBE761
00779  S910-MSTR-IO.                                                    DTSBE761
00780      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE761
00781                            MSKL-REC.                              DTSBE761
00782  S910-EXIT.                                                       DTSBE761
00783      EXIT.                                                        DTSBE761
00784                                                                   DTSBE761
00785  S946-WRITE-R901.                                                 DTSBE761
00786      CALL 'DTSBU946' USING R901-REC.                              DTSBE761
00787      GO TO S946-EXIT.                                             DTSBE761
00788                                                                   DTSBE761
00789  S946-EXIT.                                                       DTSBE761
00790      EXIT.                                                        DTSBE761
00791                                                                   DTSBE761
00792  S999-ABEND.                                                      DTSBE761
00793      DISPLAY '*** DTSBE761 ABENDING.  '                           DTSBE761
00794              ABEND-MSG.                                           DTSBE761
00795                                                                   DTSBE761
00796      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE761
00797  S999-EXIT.                                                       DTSBE761
00798      EXIT.                                                        DTSBE761
