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