00001  IDENTIFICATION DIVISION.                                         07/13/99
00002  PROGRAM-ID.             DTSBE792.                                DTSBE792
00003  AUTHOR.                 TRW.                                        LV029
00004  DATE-WRITTEN.           JULY 1999.                                  CL*12
00005  DATE-COMPILED.                                                   DTSBE792
00006      SKIP3                                                        DTSBE792
00007 *****                                                             DTSBE792
00008 *                                                                 DTSBE792
00009 *    CALLING SEQUENCE:  DTSBD400 CALLS                               CL**4
00010 *                       DTSBE792 WHICH UPDATES DTSIR792              CL*12
00011 *                       DTSBR792 READS DTSIR792 RECORDS              CL*12
00012 *                       TO PRODUCE THE LIST OF EMPLOYERS             CL*12
00013 *                       WITHE NAICS AND SIC CODES.                   CL*12
00014 *                                                                    CL*12
00015 *    FUNCTION:  EMPLOYERS WITH MISSING INDUSTRY CODE.                CL*18
00016 *                                                                 DTSBE792
00017 *                                                                 DTSBE792
00018 *    MODIFICATION LOG:                                            DTSBE792
00019 *                                                                 DTSBE792
00020 *    07/12/1999  THIS PROGRAM WAS CLONED AND MODIFIED TO MEET        CL*18
00021 *                DUTAS PROGRAM MODIFICATION SPECIFICATIONS.          CL*18
00022 *                REFERENCE RFP: XXXXXXX         PROGRAMMER: DVS      CL*19
00023 *                                                                    CL**3
00024 *                                                                 DTSBE792
00025 *  DESCRIPTION:                                                   DTSBE792
00026 *                                                                 DTSBE792
00027 *                                                                 DTSBE792
00028 *    INITIATION:                                                  DTSBE792
00029 *                                                                 DTSBE792
00030 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE792
00031 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE792
00032 *                                                                 DTSBE792
00033 *      EDIT PARAMTERS (SEE 792R1).                                   CL*12
00034 *                                                                 DTSBE792
00035 *                                                                 DTSBE792
00036 *    PROCESSING:                                                  DTSBE792
00037 *                                                                 DTSBE792
00038 *      SEE EXTRACT DESCRIPTION 792R1.                                CL*12
00039 *                                                                 DTSBE792
00040 *                                                                 DTSBE792
00041 *    TERMINATION:                                                 DTSBE792
00042 *                                                                 DTSBE792
00043 *      NONE.                                                      DTSBE792
00044 *                                                                 DTSBE792
00045 *                                                                 DTSBE792
00046 *    RECORDS READ:                                                DTSBE792
00047 *                                                                 DTSBE792
00048 *      MASTER:                                                    DTSBE792
00049 *                                                                 DTSBE792
00050 *        NONE.                                                    DTSBE792
00051 *                                                                 DTSBE792
00052 *                                                                 DTSBE792
00053 *      ALTERNATE INDEX:                                           DTSBE792
00054 *                                                                 DTSBE792
00055 *        NONE.                                                    DTSBE792
00056 *                                                                 DTSBE792
00057 *                                                                 DTSBE792
00058 *      REFERENCE:                                                 DTSBE792
00059 *                                                                 DTSBE792
00060 *        NONE.                                                    DTSBE792
00061 *                                                                 DTSBE792
00062 *                                                                 DTSBE792
00063 *    RECORDS UPDATED:                                             DTSBE792
00064 *                                                                 DTSBE792
00065 *        NONE.                                                    DTSBE792
00066 *                                                                 DTSBE792
00067 *                                                                 DTSBE792
00068 *    REPORT RECORDS WRITTEN:                                      DTSBE792
00069 *                                                                 DTSBE792
00070 *        R792  EMPLOYERS WITH MISSING INDUSTRY CODE.                 CL*20
00071 *                                                                 DTSBE792
00072 *                                                                 DTSBE792
00073 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE792
00074 *                                                                 DTSBE792
00075 *        NONE.                                                    DTSBE792
00076 *                                                                 DTSBE792
00077 *                                                                 DTSBE792
00078 *    MODULES CALLED:                                              DTSBE792
00079 *                                                                 DTSBE792
00080 *        DTSBU001  DATE CONVERSION/EDIT.                             CL**3
00081 *        DTSBU112  ADDRESS FORMATTING.                               CL**3
00082 *        DTSBU910  MASTER FILE I/O.                                  CL**3
00083 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.      CL**3
00084 *                                                                 DTSBE792
00085 *                                                                 DTSBE792
00086 *    VERMONT REFERENCE:                                           DTSBE792
00087 *                                                                 DTSBE792
00088 *        NONE.                                                    DTSBE792
00089 *                                                                 DTSBE792
00090 *****                                                             DTSBE792
00091      SKIP3                                                        DTSBE792
00092  ENVIRONMENT DIVISION.                                            DTSBE792
00093      SKIP3                                                        DTSBE792
00094  DATA DIVISION.                                                   DTSBE792
00095      SKIP3                                                        DTSBE792
00096  WORKING-STORAGE SECTION.                                         DTSBE792
000965 77  PAN-VALET PICTURE X(24) VALUE '029DTSBE792  07/13/99'.       DTSBE792
00097      SKIP3                                                        DTSBE792
00098  01  WRK-AREA.                                                    DTSBE792
00099      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +792.   CL*12
00100                                                                   DTSBE792
00101      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE792'.   CL*12
00102      SKIP3                                                        DTSBE792
00103      05  ABEND-MSG                       PIC  X(60).              DTSBE792
00104      SKIP3                                                        DTSBE792
00105      EJECT                                                        DTSBE792
00106  01  L001-LINK-AREA.                                              DTSBE792
00107  ++INCLUDE DTSIL001                                                  CL**5
00108      EJECT                                                        DTSBE792
00109  01  L111-LINK-AREA.                                              DTSBE792
00110  ++INCLUDE DTSIL111                                                  CL**5
00111      EJECT                                                        DTSBE792
00112  01  L112-LINK-AREA.                                              DTSBE792
00113  ++INCLUDE DTSIL112                                                  CL**5
00114      EJECT                                                        DTSBE792
00115  01  L910-LINK-AREA.                                              DTSBE792
00116  ++INCLUDE DTSIL910                                                  CL**5
00117      SKIP3                                                        DTSBE792
00118  01  MSKL-REC.                                                    DTSBE792
00119  ++INCLUDE DTSIMSKL                                                  CL**5
00120      EJECT                                                        DTSBE792
00121  01  MTAD-REC.                                                       CL*14
00122  ++INCLUDE DTSIMTAD                                                  CL*14
00123      EJECT                                                           CL*14
00124  01  R792-REC.                                                       CL*12
00125  ++INCLUDE DTSIR792                                                  CL*12
00126      EJECT                                                        DTSBE792
00127  LINKAGE SECTION.                                                 DTSBE792
00128      SKIP3                                                        DTSBE792
00129  01  LECM-LINK-AREA.                                              DTSBE792
00130  ++INCLUDE DTSILECM                                                  CL**5
00131      EJECT                                                        DTSBE792
00132  01  MPRF-LINK-REC.                                               DTSBE792
00133  ++INCLUDE DTSIMPRF                                                  CL**5
00134      EJECT                                                        DTSBE792
00135  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE792
00136                           MPRF-LINK-REC.                          DTSBE792
00137      SKIP2                                                        DTSBE792
00138      IF LECM-PROCESS-88                                           DTSBE792
00139          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE792
00140      ELSE                                                         DTSBE792
00141      IF LECM-INITIALIZE-88                                        DTSBE792
00142          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE792
00143      ELSE                                                         DTSBE792
00144      IF LECM-TERMINATE-88                                         DTSBE792
00145          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE792
00146      ELSE                                                         DTSBE792
00147          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE792
00148            TO ABEND-MSG                                           DTSBE792
00149          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE792
00150      SKIP2                                                        DTSBE792
00151      GOBACK.                                                      DTSBE792
00152      EJECT                                                        DTSBE792
00153  I0000-INITIALIZE.                                                DTSBE792
00154      MOVE LENGTH OF R792-REC TO R792-LENGTH.                         CL*12
00155      MOVE '792'              TO R792-REC-TYPE.                       CL*12
00156      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE792
00157                                                                   DTSBE792
00158      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE792
00159                                                                   DTSBE792
00160      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE792
00161                                                                   DTSBE792
00162      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE792
00163  I0000-EXIT.                                                      DTSBE792
00164      EXIT.                                                        DTSBE792
00165      EJECT                                                        DTSBE792
00166  P0000-PROCESS.                                                   DTSBE792
00167                                                                      CL*21
00168       IF  MPRF-NAICS-CD-NONCLASSIF-88  AND                           CL*13
00169           MPRF-SIC-CD-NONCLASSIF-88                                  CL*13
00170           PERFORM P1000-CONSTRUCT-R792 THRU P1000-EXIT               CL*13
00171      END-IF.                                                         CL*21
00172                                                                      CL*13
00173  P0000-EXIT.                                                      DTSBE792
00174      EXIT.                                                        DTSBE792
00175      EJECT                                                        DTSBE792
00176  P1000-CONSTRUCT-R792.                                               CL*12
00177      MOVE LOW-VALUE         TO MTAD-KEY-AREA.                        CL*15
00178      MOVE MPRF-EMP-NO       TO MTAD-EMP-NO.                          CL*15
00179      SET MTAD-TAD-88 TO TRUE.                                        CL*15
00180      SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                        CL*15
00181      MOVE MTAD-KEY-AREA     TO MSKL-KEY-AREA.                        CL*15
00182      PERFORM S910-READ THRU S910-EXIT.                               CL*15
00183      IF L910-NO-REC-88                                               CL*15
00184          NEXT SENTENCE                                               CL*15
00185      ELSE                                                            CL*15
00186          MOVE MSKL-REC TO MTAD-REC                                   CL*25
00187          MOVE MTAD-ADDRESS TO L112-ADDRESS                           CL*25
00188          MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME                 CL*26
00189          SET L112-TAD-ADDR-88 TO TRUE                                CL*26
00190          SET L112-ANCHOR-FIRST-88 TO TRUE                            CL*26
00191          PERFORM S112-FORMAT-ADDR THRU S112-EXIT                     CL*25
00192 *        MOVE L112-MAILING-ADDRESS TO R792-FMT-ADDR                  CL*25
00193          MOVE MPRF-EMP-NO          TO R792-EMP-NO                    CL*29
00194          PERFORM P1100-ADDRESS THRU P1100-EXIT                       CL*22
00195          PERFORM S946-WRITE-R792  THRU  S946-EXIT                    CL*23
00196      END-IF.                                                         CL*24
00197      SKIP3                                                           CL*16
00198  P1000-EXIT.                                                         CL*15
00199      EXIT.                                                           CL*15
00200      EJECT                                                           CL*15
00201                                                                      CL*15
00202  P1100-ADDRESS.                                                      CL*22
00203      MOVE L112-PRIMARY-NAME TO R792-PRIMARY-NAME.                    CL*25
00204                                                                      CL*25
00205      MOVE MTAD-VOICE-1 TO R792-VOICE-1                               CL*27
00206                                                                      CL*27
00207      IF L112-ATTN-LINE = 'C/O'                                       CL*25
00208         MOVE SPACES TO R792-ATTN-LINE                                CL*16
00209      ELSE                                                            CL*16
00210         MOVE L112-ATTN-LINE  TO R792-ATTN-LINE                       CL*25
00211      END-IF.                                                         CL*16
00212                                                                      CL*16
00213  P1100-EXIT.                                                         CL*22
00214      EXIT.                                                        DTSBE792
00215      EJECT                                                        DTSBE792
00216  T0000-TERMINATE.                                                 DTSBE792
00217      SKIP2                                                        DTSBE792
00218      SKIP2                                                        DTSBE792
00219  T0000-EXIT.                                                      DTSBE792
00220      EXIT.                                                        DTSBE792
00221      EJECT                                                        DTSBE792
00222  S001-FROM-FED-8.                                                 DTSBE792
00223      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE792
00224      GO TO S001-DATE.                                             DTSBE792
00225                                                                   DTSBE792
00226  S001-FROM-CAL-6.                                                 DTSBE792
00227      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE792
00228      GO TO S001-DATE.                                             DTSBE792
00229                                                                   DTSBE792
00230  S001-FROM-ABS-DAY.                                               DTSBE792
00231      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE792
00232      GO TO S001-DATE.                                             DTSBE792
00233                                                                   DTSBE792
00234  S001-DATE.                                                       DTSBE792
00235      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL**3
00236  S001-EXIT.                                                       DTSBE792
00237      EXIT.                                                        DTSBE792
00238      SKIP3                                                        DTSBE792
00239  S111-LOOKUP-ADDR.                                                DTSBE792
00240      CALL 'DTSBU111' USING L111-LINK-AREA.                           CL**3
00241  S111-EXIT.                                                       DTSBE792
00242      EXIT.                                                        DTSBE792
00243      SKIP3                                                        DTSBE792
00244  S112-FORMAT-ADDR.                                                DTSBE792
00245      CALL 'DTSBU112' USING L112-LINK-AREA.                           CL**3
00246  S112-EXIT.                                                       DTSBE792
00247      EXIT.                                                        DTSBE792
00248      SKIP3                                                        DTSBE792
00249  S910-READ.                                                       DTSBE792
00250      SET L910-READ-88 TO TRUE.                                    DTSBE792
00251      GO TO S910-MSTR-IO.                                          DTSBE792
00252                                                                   DTSBE792
00253  S910-START-BROWSE.                                               DTSBE792
00254      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE792
00255      GO TO S910-MSTR-IO.                                          DTSBE792
00256                                                                   DTSBE792
00257  S910-READ-NEXT.                                                  DTSBE792
00258      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE792
00259      GO TO S910-MSTR-IO.                                          DTSBE792
00260                                                                   DTSBE792
00261  S910-COUNT.                                                      DTSBE792
00262      SET L910-COUNT-88 TO TRUE.                                   DTSBE792
00263      GO TO S910-MSTR-IO.                                          DTSBE792
00264                                                                   DTSBE792
00265  S910-MSTR-IO.                                                    DTSBE792
00266      CALL 'DTSBU910' USING L910-LINK-AREA                            CL**3
00267                            MSKL-REC.                              DTSBE792
00268  S910-EXIT.                                                       DTSBE792
00269      EXIT.                                                        DTSBE792
00270      SKIP3                                                        DTSBE792
00271  S946-WRITE-R792.                                                    CL*12
00272 *    MOVE LENGTH OF R792-REC TO R792-LENGTH.                         CL*28
00273      CALL 'DTSBU946' USING R792-REC.                                 CL*12
00274      GO TO S946-EXIT.                                             DTSBE792
00275                                                                   DTSBE792
00276  S946-EXIT.                                                       DTSBE792
00277      EXIT.                                                        DTSBE792
00278      SKIP3                                                        DTSBE792
00279  S999-ABEND.                                                      DTSBE792
00280      DISPLAY '*** DTSBE761 ABENDING.  '                              CL**3
00281              ABEND-MSG.                                           DTSBE792
00282                                                                   DTSBE792
00283      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**3
00284  S999-EXIT.                                                       DTSBE792
00285      EXIT.                                                        DTSBE792
