DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
493
Batch/DTSBD390.cob
Normal file
493
Batch/DTSBD390.cob
Normal file
@ -0,0 +1,493 @@
|
||||
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
|
||||
Reference in New Issue
Block a user