00001  IDENTIFICATION DIVISION.                                         02/02/99
00002  PROGRAM-ID.             DTSBD390.                                DTSBD390
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV010
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBD390
00005  DATE-COMPILED.                                                   DTSBD390
00006      SKIP3                                                        DTSBD390
00007 *****                                                             DTSBD390
00008 *                                                                 DTSBD390
00009 *    FUNCTION:  LMI UPDATE PROCESSING.                               CL**2
00010 *                                                                 DTSBD390
00011 *                                                                 DTSBD390
00012 *    MODIFICATION LOG:                                            DTSBD390
00013 *                                                                 DTSBD390
00014 *    09/01/94  INITIAL DEVELOPMENT.                               DTSBD390
00015 *              WORK ORDER:                      PROGRAMMER: RHC   DTSBD390
00016 *                                                                 DTSBD390
00017 *    11/13/95  JOINT REGISTRATION PROCESSING.  DURING MODIFY      DTSBD390
00018 *              PROCESSING, IF (EMPLOYER IS "CONNECTED" TO A       DTSBD390
00019 *              WH/OFLT EMPLOYER), AND (AREA CD IS MODIFIED OR     DTSBD390
00020 *              SIC CD IS MODIFIED) THEN WRITE A R122 RECORD       DTSBD390
00021 *              REPORTING THE MODIFICATIONS TO THE WH/OFLT SYSTEM. DTSBD390
00022 *              WORK ORDER: JR                   PROGRAMMER: RPA   DTSBD390
00023 *                                                                 DTSBD390
00024 *    01/30/1999  REVIEWED AND MODIFIED FOR DC.                       CL**2
00025 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00026 *                                                                    CL**2
00027 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00028 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00029 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00030 *                                                                 DTSBD390
00031 *                                                                 DTSBD390
00032 *  DESCRIPTION:                                                   DTSBD390
00033 *                                                                 DTSBD390
00034 *     PROCESS DTSIT016 RECORDS, UPDATING THE MPRF RECORD.            CL**2
00035 *                                                                 DTSBD390
00036 *     REMEMBER TO MAINTAIN MPRF-OLD-SIC-CD, MPRF-SIC-CHNG-DATE,      CL**2
00037 *     MPRF-OLD-NAICS-CD, MPRF-NAICS-CHNG-DATE, MPRF-OLD-OWN-CD,      CL**2
00038 *     AND MPRF-OWN-CHNG-DATE.                                        CL**2
00039 *                                                                 DTSBD390
00040 *     CALL DTSBU331 AS APPROPRIATE.                                  CL**2
00041 *                                                                 DTSBD390
00042 *                                                                 DTSBD390
00043 *      MASTER FILE RECORDS READ:                                  DTSBD390
00044 *                                                                 DTSBD390
00045 *        NONE.                                                       CL**2
00046 *                                                                 DTSBD390
00047 *      MASTER FILE RECORDS UPDATED:                               DTSBD390
00048 *                                                                 DTSBD390
00049 *        NONE.                                                    DTSBD390
00050 *                                                                 DTSBD390
00051 *                                                                 DTSBD390
00052 *      REPORT RECORDS WRITTEN:                                    DTSBD390
00053 *                                                                 DTSBD390
00054 *        NONE.                                                       CL**2
00055 *                                                                 DTSBD390
00056 *                                                                 DTSBD390
00057 *      MODULES CALLED:                                            DTSBD390
00058 *                                                                 DTSBD390
00059 *        DTSBU004  QUARTER CONVERSION.                               CL**2
00060 *        DTSBU038  LMI CODES EDIT/DESCRIPTION.                       CL**3
00061 *        DTSBU039  SIC CODE EDIT/DESCRIPTION.                        CL**2
00062 *        DTSBU040  NAICS CODE EDIT/DESCRIPTION.                      CL**3
00063 *        DTSBU331  WRITE ON-LINE MODIFICATION LOG RECORD.            CL**3
00064 *                                                                 DTSBD390
00065 *****                                                             DTSBD390
00066      SKIP3                                                        DTSBD390
00067  ENVIRONMENT DIVISION.                                            DTSBD390
00068      SKIP3                                                        DTSBD390
00069  DATA DIVISION.                                                   DTSBD390
00070      SKIP3                                                        DTSBD390
00071  WORKING-STORAGE SECTION.                                         DTSBD390
000715 77  PAN-VALET PICTURE X(24) VALUE '010DTSBD390  02/02/99'.       DTSBD390
00072      SKIP3                                                        DTSBD390
00073  01  WRK-AREA.                                                    DTSBD390
00074      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +390.DTSBD390
00075                                                                      CL**2
00076      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD390'.   CL**2
00077                                                                      CL**2
00078      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBD390
00079      SKIP3                                                        DTSBD390
00080  01  MSG-TABLE.                                                   DTSBD390
00081      05  MSG1-INVALID-TRN-CD.                                     DTSBD390
00082          10  MSG1-ID         PIC  X(11)  VALUE 'DTSBD390905'.        CL**2
00083          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE 'INVALID TRN CD'.  DTSBD390
00084          10  MSG1-LONG-TEXT.                                      DTSBD390
00085              15  FILLER      PIC  X(30)                           DTSBD390
00086                    VALUE 'TRANSACTION FAILED - TRANSACTI'.        DTSBD390
00087              15  FILLER      PIC  X(30)                           DTSBD390
00088                    VALUE 'ON CODE NOT VALID             '.        DTSBD390
00089                                                                      CL**2
00090      05  MSG2-INVALID-SIC-CD.                                        CL**2
00091          10  MSG2-ID         PIC  X(11)  VALUE 'DTSBD390702'.        CL**2
00092          10  MSG2-SHORT-TEXT PIC  X(20)  VALUE '              '.     CL**2
00093          10  MSG2-LONG-TEXT.                                         CL**2
00094              15  FILLER      PIC  X(30)                           DTSBD390
00095                    VALUE 'TRANSACTION FAILED - SIC CODE '.        DTSBD390
00096              15  FILLER      PIC  X(30)                           DTSBD390
00097                    VALUE 'IS NOT VALID                  '.           CL**2
00098                                                                      CL**2
00099      05  MSG3-INVALID-SIC-AUX-CD.                                    CL**2
00100          10  MSG3-ID         PIC  X(11)  VALUE 'DTSBD390703'.        CL**2
00101          10  MSG3-SHORT-TEXT PIC  X(20)  VALUE '              '.     CL**2
00102          10  MSG3-LONG-TEXT.                                         CL**2
00103              15  FILLER      PIC  X(30)                           DTSBD390
00104                    VALUE 'TRANSACTION FAILED - SIC AUXIL'.           CL**2
00105              15  FILLER      PIC  X(30)                           DTSBD390
00106                    VALUE 'IARY CODE NOT VALID           '.           CL**2
00107                                                                      CL**2
00108      05  MSG4-INVALID-NAICS-CD.                                      CL**2
00109          10  MSG4-ID         PIC  X(11)  VALUE 'DTSBD390704'.        CL**2
00110          10  MSG4-SHORT-TEXT PIC  X(20)  VALUE '              '.     CL**2
00111          10  MSG4-LONG-TEXT.                                         CL**2
00112              15  FILLER      PIC  X(30)                              CL**2
00113                    VALUE 'TRANSACTION FAILED - NAICS COD'.           CL**2
00114              15  FILLER      PIC  X(30)                              CL**2
00115                    VALUE 'E IS NOT VALID                '.           CL**2
00116                                                                      CL**2
00117      05  MSG5-INVALID-NAICS-AUX-CD.                                  CL**2
00118          10  MSG5-ID         PIC  X(11)  VALUE 'DTSBD390705'.        CL**2
00119          10  MSG5-SHORT-TEXT PIC  X(20)  VALUE '              '.     CL**2
00120          10  MSG5-LONG-TEXT.                                         CL**2
00121              15  FILLER      PIC  X(30)                              CL**2
00122                    VALUE 'TRANSACTION FAILED - NAICS AUX'.           CL**2
00123              15  FILLER      PIC  X(30)                              CL**2
00124                    VALUE 'ILIARY CODE IS NOT VALID      '.           CL**2
00125                                                                      CL**2
00126      05  MSG6-INVALID-OWN-CD.                                        CL**2
00127          10  MSG6-ID         PIC  X(11)  VALUE 'DTSBD390706'.        CL**2
00128          10  MSG6-SHORT-TEXT PIC  X(20)  VALUE '              '.     CL**2
00129          10  MSG6-LONG-TEXT.                                         CL**2
00130              15  FILLER      PIC  X(30)                              CL**2
00131                    VALUE 'TRANSACTION FAILED - OWNERSHIP'.           CL**2
00132              15  FILLER      PIC  X(30)                              CL**2
00133                    VALUE ' CODE IS NOT VALID            '.           CL**2
00134                                                                      CL**2
00135      05  MSG7-INVALID-MULTI-IND.                                     CL**2
00136          10  MSG7-ID         PIC  X(11)  VALUE 'DTSBD390707'.        CL**2
00137          10  MSG7-SHORT-TEXT PIC  X(20)  VALUE '              '.     CL**2
00138          10  MSG7-LONG-TEXT.                                         CL**2
00139              15  FILLER      PIC  X(30)                           DTSBD390
00140                    VALUE 'TRANSACTION FAILED - MULTI SIT'.        DTSBD390
00141              15  FILLER      PIC  X(30)                           DTSBD390
00142                    VALUE 'E INDICATOR IS NOT VALID.     '.        DTSBD390
00143                                                                      CL**2
00144      05  MSG8-INVALID-WARD-CD.                                       CL**2
00145          10  MSG8-ID         PIC  X(11)  VALUE 'DTSBD390708'.        CL**2
00146          10  MSG8-SHORT-TEXT PIC  X(20)  VALUE '              '.     CL**2
00147          10  MSG8-LONG-TEXT.                                         CL**2
00148              15  FILLER      PIC  X(30)                              CL**2
00149                    VALUE 'TRANSACTION FAILED - WARD CODE'.           CL**2
00150              15  FILLER      PIC  X(30)                              CL**2
00151                    VALUE ' IS NOT VALID.                '.           CL*10
00152  EJECT                                                            DTSBD390
00153 *01  L910-LINK-AREA.                                                 CL**2
00154 ***INCLUDE DTSIL910                                                  CL**2
00155      SKIP3                                                           CL**2
00156 *01  MSKL-REC.                                                       CL**2
00157 ***INCLUDE DTSIMSKL                                                  CL**2
00158      SKIP3                                                           CL**2
00159 *01  MRTE-REC.                                                       CL**2
00160 ***INCLUDE DTSIMRTE                                                  CL**2
00161      EJECT                                                        DTSBD390
00162 *01  L004-LINK-AREA.                                                 CL**3
00163 ***INCLUDE DTSIL004                                                  CL**3
00164      SKIP3                                                        DTSBD390
00165  01  L038-LINK-AREA.                                              DTSBD390
00166  ++INCLUDE DTSIL038                                                  CL**2
00167      SKIP3                                                        DTSBD390
00168  01  L039-LINK-AREA.                                              DTSBD390
00169  ++INCLUDE DTSIL039                                                  CL**2
00170      SKIP3                                                        DTSBD390
00171  01  L040-LINK-AREA.                                                 CL**2
00172  ++INCLUDE DTSIL040                                                  CL**2
00173      SKIP3                                                        DTSBD390
00174  01  L331-LINK-AREA.                                                 CL**2
00175  ++INCLUDE DTSIL331                                                  CL**2
00176      EJECT                                                        DTSBD390
00177  LINKAGE SECTION.                                                 DTSBD390
00178      SKIP3                                                        DTSBD390
00179  01  LBCM-LINK-AREA.                                              DTSBD390
00180  ++INCLUDE DTSILBCM                                                  CL**2
00181      EJECT                                                        DTSBD390
00182  01  MPRF-REC.                                                    DTSBD390
00183  ++INCLUDE DTSIMPRF                                                  CL**2
00184      EJECT                                                        DTSBD390
00185  01  T016-REC.                                                    DTSBD390
00186  ++INCLUDE DTSIT016                                                  CL**2
00187      EJECT                                                        DTSBD390
00188  PROCEDURE DIVISION USING LBCM-LINK-AREA                          DTSBD390
00189                           MPRF-REC                                DTSBD390
00190                           T016-REC.                               DTSBD390
00191                                                                      CL**2
00192                                                                      CL**2
00193      IF FIRST-TIME-IND = 'Y'                                      DTSBD390
00194          PERFORM I0000-INITIATE THRU I0000-EXIT                   DTSBD390
00195          MOVE 'N' TO FIRST-TIME-IND.                              DTSBD390
00196                                                                      CL**2
00197                                                                      CL**2
00198      IF NOT T016-EMP-LVL                                          DTSBD390
00199          MOVE MSG1-INVALID-TRN-CD TO LBCM-TRN-MSG-AREA            DTSBD390
00200          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD390
00201      ELSE                                                         DTSBD390
00202          PERFORM P1000-EMP-LVL-CHECKS THRU P1000-EXIT             DTSBD390
00203          IF LBCM-TRN-OK-88                                        DTSBD390
00204              PERFORM P2000-EMP-LVL-UPDATE  THRU P2000-EXIT.          CL**2
00205                                                                      CL**2
00206                                                                      CL**2
00207      GOBACK.                                                      DTSBD390
00208      EJECT                                                           CL**2
00209  I0000-INITIATE.                                                  DTSBD390
00210 *****MOVE LBCM-TRACE-IND TO L910-TRACE-IND.                          CL**3
00211                                                                      CL**2
00212 *****MOVE WRK-MOD-NAME TO L910-MOD-NAME.                             CL**3
00213                                                                      CL**5
00214                                                                      CL**5
00215      MOVE LBCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE.                  CL**5
00216                                                                      CL**5
00217      MOVE 'BATCH' TO L331-OP-ID.                                     CL**5
00218                                                                      CL**5
00219      MOVE SPACES TO L331-FIELD-NAME.                                 CL**5
00220  I0000-EXIT.                                                         CL**2
00221      EXIT.                                                           CL**2
00222      EJECT                                                        DTSBD390
00223  P1000-EMP-LVL-CHECKS.                                            DTSBD390
00224      IF T016-SIC-CD NOT = SPACE                                      CL**3
00225          MOVE T016-SIC-CD TO L039-SIC-CD                             CL**3
00226          PERFORM S039-SIC-EDIT THRU S039-EXIT                        CL**3
00227          IF L039-SIC-NOT-VALID                                    DTSBD390
00228              SET LBCM-TRN-NOT-OK-88 TO TRUE                       DTSBD390
00229              MOVE MSG2-INVALID-SIC-CD TO LBCM-TRN-MSG-AREA           CL**6
00230              GO TO P1000-EXIT.                                    DTSBD390
00231                                                                      CL**3
00232      IF T016-SIC-AUXILIARY-CD NOT =  SPACE                           CL**6
00233          MOVE T016-SIC-AUXILIARY-CD TO L038-CD-1                     CL**3
00234          PERFORM S038-MPRF-SIC-AUXILIARY-CD THRU S038-EXIT           CL**6
00235          IF L038-NOT-VALID                                           CL**3
00236              SET LBCM-TRN-NOT-OK-88 TO TRUE                          CL**3
00237              MOVE MSG3-INVALID-SIC-AUX-CD TO LBCM-TRN-MSG-AREA       CL**6
00238              GO TO P1000-EXIT.                                       CL**3
00239                                                                      CL**3
00240      IF T016-NAICS-CD NOT = SPACE                                    CL**6
00241          MOVE T016-NAICS-CD TO L040-NAICS-CD                         CL**6
00242          PERFORM S040-NAICS-EDIT THRU S040-EXIT                      CL**6
00243          IF L040-NAICS-NOT-VALID                                     CL**6
00244              SET LBCM-TRN-NOT-OK-88 TO TRUE                          CL**6
00245              MOVE MSG4-INVALID-NAICS-CD TO LBCM-TRN-MSG-AREA         CL**6
00246              GO TO P1000-EXIT.                                       CL**6
00247                                                                      CL**6
00248      IF T016-NAICS-AUXILIARY-CD NOT = SPACE                          CL**6
00249          MOVE T016-NAICS-AUXILIARY-CD TO L038-CD-1                   CL**6
00250          PERFORM S038-MPRF-NAICS-AUXILIARY-CD THRU S038-EXIT         CL**6
00251          IF L038-NOT-VALID                                           CL**6
00252              SET LBCM-TRN-NOT-OK-88 TO TRUE                          CL**6
00253              MOVE MSG5-INVALID-NAICS-AUX-CD TO LBCM-TRN-MSG-AREA     CL**6
00254              GO TO P1000-EXIT.                                       CL**6
00255                                                                      CL**6
00256      IF T016-OWN-CD NOT =  SPACE                                     CL**6
00257          MOVE T016-OWN-CD TO L038-CD-2                               CL**6
00258          PERFORM S038-MPRF-OWN-CD THRU S038-EXIT                     CL**6
00259          IF L038-NOT-VALID                                        DTSBD390
00260              SET LBCM-TRN-NOT-OK-88 TO TRUE                       DTSBD390
00261              MOVE MSG6-INVALID-OWN-CD TO LBCM-TRN-MSG-AREA           CL**6
00262              GO TO P1000-EXIT.                                    DTSBD390
00263                                                                      CL**6
00264      IF T016-MULTI-IND  NOT = SPACE                                  CL**6
00265          MOVE T016-MULTI-IND TO L038-CD-1                            CL**6
00266          PERFORM S038-MPRF-MULTI-IND THRU S038-EXIT                  CL**6
00267          IF L038-NOT-VALID                                           CL**6
00268              SET LBCM-TRN-NOT-OK-88 TO TRUE                          CL**6
00269              MOVE MSG7-INVALID-MULTI-IND TO LBCM-TRN-MSG-AREA        CL**6
00270              GO TO P1000-EXIT.                                       CL**6
00271                                                                      CL**6
00272      IF T016-WARD-CD NOT = SPACE                                     CL**6
00273          MOVE T016-WARD-CD TO L038-CD-2                              CL**6
00274          PERFORM S038-MPRF-WARD-CD THRU S038-EXIT                    CL**6
00275          IF L038-NOT-VALID                                           CL**6
00276              SET LBCM-TRN-NOT-OK-88 TO TRUE                          CL**6
00277              MOVE MSG8-INVALID-WARD-CD TO LBCM-TRN-MSG-AREA          CL**6
00278              GO TO P1000-EXIT.                                       CL**6
00279  P1000-EXIT.                                                         CL**6
00280      EXIT.                                                           CL**6
00281      EJECT                                                        DTSBD390
00282  P2000-EMP-LVL-UPDATE.                                               CL**2
00283      MOVE MPRF-EMP-NO TO L331-EMP-NO.                                CL**5
00284                                                                      CL**5
00285      MOVE LBCM-EMP-ABSTIME TO L331-UPDATE-ABSTIME.                   CL**5
00286                                                                      CL**5
00287                                                                      CL**5
00288      IF (T016-SIC-CD = SPACE)                                     DTSBD390
00289                OR                                                    CL**7
00290         (T016-SIC-CD = MPRF-SIC-CD)                                  CL**7
00291          NEXT SENTENCE                                            DTSBD390
00292      ELSE                                                         DTSBD390
00293          MOVE 'MPRF-SIC-CD' TO L331-FIELD-NAME                       CL**7
00294          MOVE MPRF-SIC-CD TO L331-FROM-VALUE                         CL**7
00295          MOVE T016-SIC-CD TO L331-TO-VALUE                           CL**7
00296          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL**7
00297          SET LBCM-EMP-UPDATE-YES-88 TO TRUE                       DTSBD390
00298          MOVE LBCM-CURR-RUN-DATE TO MPRF-CHNG-DATE                   CL**7
00299                                     MPRF-SIC-CHNG-DATE               CL**7
00300          MOVE MPRF-SIC-CD TO MPRF-OLD-SIC-CD                         CL**7
00301          MOVE T016-SIC-CD TO MPRF-SIC-CD.                            CL**7
00302                                                                      CL**7
00303                                                                      CL**7
00304      IF (T016-SIC-AUXILIARY-CD = SPACE)                              CL**7
00305                OR                                                    CL**7
00306         (T016-SIC-AUXILIARY-CD = MPRF-SIC-AUXILIARY-CD)              CL**7
00307          NEXT SENTENCE                                               CL**7
00308      ELSE                                                            CL**7
00309          MOVE 'MPRF-SIC-AUXILIARY-CD' TO L331-FIELD-NAME             CL**7
00310          MOVE MPRF-SIC-AUXILIARY-CD TO L331-FROM-VALUE               CL**7
00311          MOVE T016-SIC-AUXILIARY-CD TO L331-TO-VALUE                 CL**7
00312          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL**7
00313          SET LBCM-EMP-UPDATE-YES-88 TO TRUE                          CL**7
00314          MOVE LBCM-CURR-RUN-DATE TO MPRF-CHNG-DATE                   CL**7
00315          MOVE T016-SIC-AUXILIARY-CD TO MPRF-SIC-AUXILIARY-CD.        CL**7
00316                                                                      CL**7
00317                                                                      CL**7
00318      IF (T016-NAICS-CD = SPACE)                                      CL**7
00319                OR                                                    CL**7
00320         (T016-NAICS-CD = MPRF-NAICS-CD)                              CL**7
00321          NEXT SENTENCE                                               CL**7
00322      ELSE                                                            CL**7
00323          MOVE 'MPRF-NAICS-CD' TO L331-FIELD-NAME                     CL**7
00324          MOVE MPRF-NAICS-CD TO L331-FROM-VALUE                       CL**7
00325          MOVE T016-NAICS-CD TO L331-TO-VALUE                         CL**7
00326          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL**7
00327          SET LBCM-EMP-UPDATE-YES-88 TO TRUE                          CL**7
00328          MOVE LBCM-CURR-RUN-DATE TO MPRF-CHNG-DATE                   CL**7
00329                                     MPRF-NAICS-CHNG-DATE             CL**7
00330          MOVE MPRF-NAICS-CD TO MPRF-OLD-NAICS-CD                     CL**7
00331          MOVE T016-NAICS-CD TO MPRF-NAICS-CD.                        CL**7
00332                                                                      CL**7
00333                                                                      CL**7
00334      IF (T016-NAICS-AUXILIARY-CD = SPACE)                            CL**7
00335                OR                                                    CL**7
00336         (T016-NAICS-AUXILIARY-CD = MPRF-NAICS-AUXILIARY-CD)          CL**7
00337          NEXT SENTENCE                                               CL**7
00338      ELSE                                                            CL**7
00339          MOVE 'MPRF-NAICS-AUXILIARY-CD' TO L331-FIELD-NAME           CL**7
00340          MOVE MPRF-NAICS-AUXILIARY-CD TO L331-FROM-VALUE             CL**7
00341          MOVE T016-NAICS-AUXILIARY-CD TO L331-TO-VALUE               CL**7
00342          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL**7
00343          SET LBCM-EMP-UPDATE-YES-88 TO TRUE                          CL**7
00344          MOVE LBCM-CURR-RUN-DATE TO MPRF-CHNG-DATE                   CL**7
00345          MOVE T016-NAICS-AUXILIARY-CD TO MPRF-NAICS-AUXILIARY-CD.    CL**7
00346                                                                      CL**2
00347                                                                      CL**7
00348      IF (T016-OWN-CD = SPACE)                                     DTSBD390
00349              OR                                                      CL**7
00350         (T016-OWN-CD = MPRF-OWN-CD)                                  CL**7
00351          NEXT SENTENCE                                            DTSBD390
00352      ELSE                                                         DTSBD390
00353          MOVE 'MPRF-OWN-CD' TO L331-FIELD-NAME                       CL**7
00354          MOVE MPRF-OWN-CD TO L331-FROM-VALUE                         CL**7
00355          MOVE T016-OWN-CD TO L331-TO-VALUE                           CL**7
00356          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL**7
00357          SET LBCM-EMP-UPDATE-YES-88 TO TRUE                       DTSBD390
00358          MOVE LBCM-CURR-RUN-DATE TO MPRF-CHNG-DATE                   CL**7
00359                                     MPRF-OWN-CHNG-DATE               CL**7
00360          MOVE MPRF-OWN-CD TO MPRF-OLD-OWN-CD                         CL**7
00361          MOVE T016-OWN-CD TO MPRF-OWN-CD.                            CL**7
00362                                                                      CL**2
00363                                                                      CL**7
00364      IF (T016-MULTI-IND = SPACE)                                     CL**7
00365              OR                                                      CL**7
00366         (T016-MULTI-IND = MPRF-MULTI-IND)                            CL**7
00367          NEXT SENTENCE                                            DTSBD390
00368      ELSE                                                         DTSBD390
00369          MOVE 'MPRF-MULTI-IND' TO L331-FIELD-NAME                    CL**7
00370          MOVE MPRF-MULTI-IND TO L331-FROM-VALUE                      CL**7
00371          MOVE T016-MULTI-IND TO L331-TO-VALUE                        CL**7
00372          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL**7
00373          SET LBCM-EMP-UPDATE-YES-88 TO TRUE                       DTSBD390
00374          MOVE LBCM-CURR-RUN-DATE TO MPRF-CHNG-DATE                   CL**7
00375          MOVE T016-MULTI-IND TO MPRF-MULTI-IND.                      CL**7
00376                                                                      CL**2
00377                                                                      CL**8
00378      IF (T016-WARD-CD = SPACE)                                       CL**7
00379               OR                                                     CL**7
00380         (T016-WARD-CD = MPRF-WARD-CD)                                CL**7
00381          NEXT SENTENCE                                            DTSBD390
00382      ELSE                                                         DTSBD390
00383          MOVE 'MPRF-WARD-CD' TO L331-FIELD-NAME                      CL**7
00384          MOVE MPRF-WARD-CD TO L331-FROM-VALUE                        CL**7
00385          MOVE T016-WARD-CD TO L331-TO-VALUE                          CL**7
00386          PERFORM S331-WRITE-MLOG THRU S331-EXIT                      CL**9
00387          SET LBCM-EMP-UPDATE-YES-88 TO TRUE                       DTSBD390
00388          MOVE LBCM-CURR-RUN-DATE TO MPRF-CHNG-DATE                   CL**7
00389          MOVE T016-WARD-CD TO MPRF-WARD-CD.                          CL**7
00390  P2000-EXIT.                                                         CL**2
00391      EXIT.                                                           CL**2
00392      EJECT                                                        DTSBD390
00393 *S004-FROM-5.                                                        CL**3
00394 *****SET L004-FROM-5 TO TRUE.                                        CL**3
00395 *****GO TO S004-QTR.                                                 CL**3
00396                                                                      CL**2
00397 *S004-FROM-ABS.                                                      CL**3
00398 *****SET L004-FROM-ABS TO TRUE.                                      CL**3
00399 *****GO TO S004-QTR.                                                 CL**3
00400                                                                      CL**2
00401 *S004-QTR.                                                           CL**3
00402 *****CALL 'DTSBU004' USING L004-LINK-AREA.                           CL**3
00403 *S004-EXIT.                                                          CL**3
00404      EXIT.                                                           CL**3
00405      SKIP3                                                        DTSBD390
00406  S038-MPRF-SIC-AUXILIARY-CD.                                         CL**3
00407      SET L038-MPRF-SIC-AUXILIARY-CD TO TRUE.                         CL**3
00408      GO TO S038-LMI-CODES-EDIT.                                      CL**3
00409                                                                      CL**2
00410  S038-MPRF-NAICS-AUXILIARY-CD.                                       CL**3
00411      SET L038-MPRF-NAICS-AUXILIARY-CD TO TRUE.                       CL**3
00412      GO TO S038-LMI-CODES-EDIT.                                      CL**3
00413                                                                      CL**3
00414  S038-MPRF-OWN-CD.                                                   CL**3
00415      SET L038-MPRF-OWN-CD TO TRUE.                                   CL**3
00416      GO TO S038-LMI-CODES-EDIT.                                      CL**3
00417                                                                      CL**3
00418  S038-MPRF-MULTI-IND.                                                CL**3
00419      SET L038-MPRF-MULTI-IND TO TRUE.                                CL**3
00420      GO TO S038-LMI-CODES-EDIT.                                      CL**3
00421                                                                      CL**3
00422  S038-MPRF-WARD-CD.                                                  CL**3
00423      SET L038-MPRF-WARD-CD TO TRUE.                                  CL**3
00424      GO TO S038-LMI-CODES-EDIT.                                      CL**3
00425                                                                      CL**3
00426  S038-LMI-CODES-EDIT.                                                CL**3
00427      CALL 'DTSBU038' USING L038-LINK-AREA.                           CL**2
00428  S038-EXIT.                                                          CL**3
00429      EXIT.                                                           CL**3
00430      SKIP3                                                        DTSBD390
00431  S039-SIC-EDIT.                                                      CL**3
00432      CALL 'DTSBU039' USING L039-LINK-AREA.                           CL**2
00433  S039-EXIT.                                                          CL**3
00434      EXIT.                                                           CL**3
00435      SKIP3                                                           CL**3
00436  S040-NAICS-EDIT.                                                    CL**3
00437      CALL 'DTSBU040' USING L040-LINK-AREA.                           CL**3
00438  S040-EXIT.                                                          CL**3
00439      EXIT.                                                           CL**3
00440      SKIP3                                                           CL**3
00441  S331-WRITE-MLOG.                                                    CL**4
00442      CALL 'DTSBU331' USING L331-LINK-AREA.                           CL**4
00443  S331-EXIT.                                                          CL**4
00444      EXIT.                                                           CL**4
00445      SKIP3                                                           CL**4
00446 *S910-READ.                                                       DTSBD390
00447 *****SET L910-READ-88 TO TRUE.                                       CL**3
00448 *****GO TO S910-MSTR-IO.                                             CL**3
00449                                                                      CL**2
00450 *S910-START-BROWSE.                                                  CL**3
00451 *****SET L910-START-BROWSE-88 TO TRUE.                               CL**3
00452 *****GO TO S910-MSTR-IO.                                             CL**3
00453                                                                      CL**2
00454 *S910-READ-NEXT.                                                     CL**3
00455 *****SET L910-READ-NEXT-88 TO TRUE.                                  CL**3
00456 *****GO TO S910-MSTR-IO.                                             CL**3
00457                                                                      CL**2
00458 *S910-COUNT.                                                      DTSBD390
00459 *****SET L910-COUNT-88 TO TRUE.                                      CL**3
00460 *****GO TO S910-MSTR-IO.                                             CL**3
00461                                                                      CL**3
00462 *S910-WRITE.                                                      DTSBD390
00463 *****SET L910-WRITE-88 TO TRUE.                                      CL**3
00464 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                             CL**3
00465 *****GO TO S910-MSTR-IO.                                             CL**3
00466                                                                      CL**3
00467 *S910-REWRITE.                                                    DTSBD390
00468 *****SET L910-REWRITE-88 TO TRUE.                                    CL**3
00469 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                             CL**3
00470 *****GO TO S910-MSTR-IO.                                             CL**3
00471                                                                      CL**3
00472 *S910-DELETE.                                                     DTSBD390
00473 *****SET L910-DELETE-88 TO TRUE.                                     CL**3
00474 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                             CL**3
00475 *****GO TO S910-MSTR-IO.                                             CL**3
00476                                                                      CL**2
00477 *S910-MSTR-IO.                                                       CL**3
00478 *****CALL 'DTSBU910' USING L910-LINK-AREA                            CL**3
00479 ***************************MSKL-REC.                                 CL**3
00480 *S910-EXIT.                                                          CL**3
00481 *****EXIT.                                                           CL**3
00482      SKIP3                                                        DTSBD390
00483 *S946-WRITE-R101.                                                    CL**3
00484 *****CALL 'DTSBU946' USING R101-REC.                                 CL**3
00485 *****GO TO S946-EXIT.                                                CL**3
00486                                                                      CL**2
00487 *S946-WRITE-R725.                                                    CL**3
00488 *****CALL 'DTSBU946' USING R725-REC.                                 CL**3
00489 *****GO TO S946-EXIT.                                                CL**3
00490                                                                      CL**2
00491 *S946-EXIT.                                                          CL**4
00492 *****EXIT.                                                           CL**4
