00001 IDENTIFICATION DIVISION. 02/26/08 00002 PROGRAM-ID. DTSBD387. DTSBD387 00003 AUTHOR. NORTHROP GRUMMAN. LV001 00004 DATE-WRITTEN. JUNE 2005. DTSBD387 00005 DATE-COMPILED. DTSBD387 00006 DTSBD387 00007 ***** DTSBD387 00008 * FUNCTION: ADD RELATED EMPLOYERS FROM WEB DTSBD387 00009 * REGISTRATIONS DTSBD387 00010 * DTSBD387 00011 * DTSBD387 00012 * MODIFICATION LOG: DTSBD387 00013 * DTSBD387 00014 * 06/01/2005 INITIAL DEVELOPMENT. DTSBD387 00015 * WORK ORDER: PROGRAMMER: GD DTSBD387 00016 * DTSBD387 00017 * MM/DD/CCYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD387 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD387 00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD387 00020 * DTSBD387 00021 * DTSBD387 00022 * DESCRIPTION: DTSBD387 00023 * DTSBD387 00024 * DTSBD387 00025 * DTSBD387 00026 * MASTER FILE RECORDS READ: DTSBD387 00027 * DTSBD387 00028 * MRTE DTSBD387 00029 * DTSBD387 00030 * DTSBD387 00031 * MASTER FILE RECORDS UPDATED: DTSBD387 00032 * DTSBD387 00033 * MREL DTSBD387 00034 * DTSBD387 00035 * DTSBD387 00036 * REPORT RECORDS WRITTEN: DTSBD387 00037 * DTSBD387 00038 * NONE DTSBD387 00039 * DTSBD387 00040 * DTSBD387 00041 * MODULES CALLED: DTSBD387 00042 * DTSBD387 00043 * DTSBU331 FORMAT AND WRITE MLOG RECORD OCCURRENCE. DTSBD387 00044 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD387 00045 * DTSBU927 BTC FILE OUTPUT. DTSBD387 00046 * DTSBU941 VARIABLE LENGTH RECORD INPUT 1. DTSBD387 00047 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD387 00048 * DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2. DTSBD387 00049 * DTSBD387 00050 ***** DTSBD387 00051 SKIP3 DTSBD387 00052 ENVIRONMENT DIVISION. DTSBD387 00053 SKIP3 DTSBD387 00054 DATA DIVISION. DTSBD387 00055 EJECT DTSBD387 00056 WORKING-STORAGE SECTION. DTSBD387 000565 77 PAN-VALET PICTURE X(24) VALUE '001DTSBD387 02/26/08'. DTSBD387 00057 SKIP3 DTSBD387 00058 01 WRK-AREA. DTSBD387 00059 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +387.DTSBD387 00060 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD387'.DTSBD387 00061 05 WRK-ABEND-MSG PIC X(60). DTSBD387 00062 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD387 00063 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD387 00064 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. DTSBD387 00065 05 WRK-PHONE PIC X(15) VALUE SPACES. DTSBD387 00066 05 FILLER REDEFINES WRK-PHONE. DTSBD387 00067 10 WRK-AREA-CD PIC X(03). DTSBD387 00068 10 WRK-PREFIX PIC X(03). DTSBD387 00069 10 WRK-SUFFIX PIC X(04). DTSBD387 00070 10 WRK-EXT PIC X(05). DTSBD387 00071 05 WRK-PHONE-TEXT1 PIC X(72) VALUE SPACES. DTSBD387 00072 05 WRK-PHONE-TEXT2 PIC X(72) VALUE SPACES. DTSBD387 00073 05 WRK-PORTION-EXP-TRNSF PIC S9(03)V99 COMP-3. DTSBD387 00074 05 WRK-PORTION-EXP-TRNSF-X PIC 999.99. DTSBD387 00075 DTSBD387 00076 05 DISP-DATE PIC X(10) VALUE SPACES. DTSBD387 00077 05 DISP-TIME PIC X(08) VALUE SPACES. DTSBD387 00078 05 DISP-ABSTIME PIC X(16) VALUE SPACES. DTSBD387 00079 DTSBD387 00080 05 WRK-MSG-TEXT. DTSBD387 00081 10 WRK-MSG-LINE PIC X(50). DTSBD387 00082 DTSBD387 00083 01 MSG-TABLE. DTSBD387 00084 05 MSG1-AREA. DTSBD387 00085 10 MSG1-ID PIC X(11) VALUE 'DTSBD387001'. DTSBD387 00086 10 MSG1-SHORT-TEXT PIC X(20) VALUE ' '. DTSBD387 00087 10 MSG1-LONG-TEXT. DTSBD387 00088 15 FILLER PIC X(30) DTSBD387 00089 VALUE 'TRANSACTION FAILED - '. DTSBD387 00090 15 FILLER PIC X(30) DTSBD387 00091 VALUE ' '. DTSBD387 00092 EJECT DTSBD387 00093 01 L004-LINK-AREA. DTSBD387 00094 ++INCLUDE DTSIL004 DTSBD387 00095 EJECT DTSBD387 00096 01 L005-LINK-AREA. DTSBD387 00097 ++INCLUDE DTSIL005 DTSBD387 00098 EJECT DTSBD387 00099 01 L006-LINK-AREA. DTSBD387 00100 ++INCLUDE DTSIL006 DTSBD387 00101 EJECT DTSBD387 00102 01 L056-LINK-AREA. DTSBD387 00103 ++INCLUDE DTSIL056 DTSBD387 00104 EJECT DTSBD387 00105 01 L331-LINK-AREA. DTSBD387 00106 ++INCLUDE DTSIL331 DTSBD387 00107 EJECT DTSBD387 00108 01 L910-LINK-AREA. DTSBD387 00109 ++INCLUDE DTSIL910 DTSBD387 00110 EJECT DTSBD387 00111 01 MSKL-REC. DTSBD387 00112 ++INCLUDE DTSIMSKL DTSBD387 00113 EJECT DTSBD387 00114 01 MREL-REC. DTSBD387 00115 ++INCLUDE DTSIMREL DTSBD387 00116 DTSBD387 00117 01 R907-REC. DTSBD387 00118 ++INCLUDE DTSIR907 DTSBD387 00119 EJECT DTSBD387 00120 DTSBD387 00121 01 Y130-REC. DTSBD387 00122 ++INCLUDE DTSIY130 DTSBD387 00123 EJECT DTSBD387 00124 LINKAGE SECTION. DTSBD387 00125 SKIP3 DTSBD387 00126 01 LBCM-LINK-AREA. DTSBD387 00127 ++INCLUDE DTSILBCM DTSBD387 00128 EJECT DTSBD387 00129 01 MPRF-REC. DTSBD387 00130 ++INCLUDE DTSIMPRF DTSBD387 00131 EJECT DTSBD387 00132 01 T002-REC. DTSBD387 00133 ++INCLUDE DTSIT002 DTSBD387 00134 EJECT DTSBD387 00135 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD387 00136 MPRF-REC DTSBD387 00137 T002-REC. DTSBD387 00138 DTSBD387 00139 IF FIRST-TIME-IND = 'Y' DTSBD387 00140 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBD387 00141 MOVE 'N' TO FIRST-TIME-IND. DTSBD387 00142 DTSBD387 00143 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD387 00144 DTSBD387 00145 GOBACK. DTSBD387 00146 DTSBD387 00147 I0000-INITIATE. DTSBD387 00148 DTSBD387 00149 MOVE +0 TO WRK-EMP-NO. DTSBD387 00150 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD387 00151 DTSBD387 00152 I0000-EXIT. DTSBD387 00153 EXIT. DTSBD387 00154 DTSBD387 00155 P0000-PROCESS. DTSBD387 00156 DTSBD387 00157 IF T002-EMP-REL-88 DTSBD387 00158 NEXT SENTENCE DTSBD387 00159 ELSE DTSBD387 00160 GO TO P0000-EXIT DTSBD387 00161 END-IF. DTSBD387 00162 DTSBD387 00163 MOVE T002-DATA-AREA TO Y130-DATA-AREA. DTSBD387 00164 DTSBD387 00165 PERFORM P1000-ADD-RELATED-EMP THRU P1000-EXIT. DTSBD387 00166 DTSBD387 00167 P0000-EXIT. DTSBD387 00168 EXIT. DTSBD387 00169 DTSBD387 00170 P1000-ADD-RELATED-EMP. DTSBD387 00171 *& DTSBD387 00172 DISPLAY 'BD387 P1000 ' MPRF-EMP-NO DTSBD387 00173 ' ' Y130-PRED-EMP-NO. DTSBD387 00174 *& DTSBD387 00175 MOVE LOW-VALUES TO MREL-REC. DTSBD387 00176 DTSBD387 00177 MOVE T002-EMP-NO TO MREL-EMP-NO. DTSBD387 00178 MOVE Y130-PRED-EMP-NO TO MREL-PRED-EMP-NO. DTSBD387 00179 MOVE Y130-REL-EFF-DATE TO MREL-EFF-DATE. DTSBD387 00180 SET MREL-REL-88 TO TRUE. DTSBD387 00181 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSBD387 00182 DTSBD387 00183 PERFORM S910-READ THRU S910-EXIT. DTSBD387 00184 IF L910-OK-88 DTSBD387 00185 PERFORM P1100-UPDATE THRU P1100-EXIT DTSBD387 00186 ELSE DTSBD387 00187 PERFORM P1200-ADD THRU P1200-EXIT DTSBD387 00188 END-IF. DTSBD387 00189 DTSBD387 00190 P1000-EXIT. DTSBD387 00191 EXIT. DTSBD387 00192 DTSBD387 00193 P1100-UPDATE. DTSBD387 00194 DISPLAY 'BD387 - RELATIONSHIP EXISTS ' DTSBD387 00195 DISPLAY ' SUCCESSOR ' T002-EMP-NO DTSBD387 00196 ' PREDECESSOR ' Y130-PRED-EMP-NO. DTSBD387 00197 *** MOVE MREL-REC TO MSKL-REC. DTSBD387 00198 *** PERFORM S910-REWRITE THRU S910-EXIT. DTSBD387 00199 DTSBD387 00200 P1100-EXIT. DTSBD387 00201 EXIT. DTSBD387 00202 DTSBD387 00203 P1200-ADD. DTSBD387 00204 PERFORM S330-INIT-MLOG THRU S330-EXIT. DTSBD387 00205 DTSBD387 00206 MOVE 'MREL-RELATIONSHIP-CD' TO L331-FIELD-NAME. DTSBD387 00207 MOVE SPACES TO L331-FROM-VALUE. DTSBD387 00208 MOVE Y130-RELATIONSHIP-CD TO L331-TO-VALUE. DTSBD387 00209 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD387 00210 MOVE Y130-RELATIONSHIP-CD TO MREL-RELATIONSHIP-CD. DTSBD387 00211 DTSBD387 00212 MOVE 'MREL-SUCCESSOR-DET-IND' TO L331-FIELD-NAME. DTSBD387 00213 MOVE SPACES TO L331-FROM-VALUE. DTSBD387 00214 SET MREL-SUCCESSOR-DET-NO-88 TO TRUE. DTSBD387 00215 MOVE MREL-SUCCESSOR-DET-IND TO L331-TO-VALUE. DTSBD387 00216 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD387 00217 DTSBD387 00218 MOVE 'MREL-EXP-TRNSF-CD' TO L331-FIELD-NAME. DTSBD387 00219 MOVE SPACES TO L331-FROM-VALUE. DTSBD387 00220 IF Y130-PORTION-EXP-TRNSF > 0 DTSBD387 00221 SET MREL-EXP-TRNSF-YES-88 TO TRUE DTSBD387 00222 ELSE DTSBD387 00223 SET MREL-EXP-TRNSF-NO-88 TO TRUE DTSBD387 00224 END-IF. DTSBD387 00225 MOVE MREL-EXP-TRNSF-CD TO L331-TO-VALUE. DTSBD387 00226 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD387 00227 DTSBD387 00228 MOVE 'MREL-PORTION-EXP-TRNSF' TO L331-FIELD-NAME. DTSBD387 00229 MOVE SPACES TO L331-FROM-VALUE. DTSBD387 00230 COMPUTE WRK-PORTION-EXP-TRNSF = DTSBD387 00231 (Y130-PORTION-EXP-TRNSF * 100). DTSBD387 00232 MOVE WRK-PORTION-EXP-TRNSF DTSBD387 00233 TO WRK-PORTION-EXP-TRNSF-X. DTSBD387 00234 MOVE WRK-PORTION-EXP-TRNSF-X TO L331-TO-VALUE. DTSBD387 00235 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD387 00236 MOVE Y130-PORTION-EXP-TRNSF TO MREL-PORTION-EXP-TRNSF. DTSBD387 00237 DTSBD387 00238 SET MREL-NOT-CONVERTED-88 TO TRUE. DTSBD387 00239 MOVE LBCM-CURR-RUN-DATE TO MREL-ESTB-DATE DTSBD387 00240 MREL-CHNG-DATE. DTSBD387 00241 DTSBD387 00242 MOVE +1 TO MREL-TEXT-CNT. DTSBD387 00243 MOVE 'WEB REGISTRATION PREDECESSOR ' DTSBD387 00244 TO MREL-TEXT (MREL-TEXT-CNT). DTSBD387 00245 ADD +1 TO MREL-TEXT-CNT. DTSBD387 00246 MOVE Y130-REL-NAME DTSBD387 00247 TO MREL-TEXT (MREL-TEXT-CNT). DTSBD387 00248 ADD +1 TO MREL-TEXT-CNT. DTSBD387 00249 MOVE Y130-REL-ATTN DTSBD387 00250 TO MREL-TEXT (MREL-TEXT-CNT). DTSBD387 00251 ADD +1 TO MREL-TEXT-CNT. DTSBD387 00252 STRING Y130-REL-DELV2 ' ' DTSBD387 00253 Y130-REL-DELV1 (1:31) DTSBD387 00254 DELIMITED BY SIZE DTSBD387 00255 INTO MREL-TEXT (MREL-TEXT-CNT) DTSBD387 00256 END-STRING. DTSBD387 00257 DTSBD387 00258 ADD +1 TO MREL-TEXT-CNT. DTSBD387 00259 MOVE Y130-REL-DELV2 DTSBD387 00260 TO MREL-TEXT (MREL-TEXT-CNT). DTSBD387 00261 ADD +1 TO MREL-TEXT-CNT. DTSBD387 00262 STRING DTSBD387 00263 Y130-REL-CITY ', ' DTSBD387 00264 Y130-REL-STATE ' ' DTSBD387 00265 Y130-REL-ZIP DTSBD387 00266 DELIMITED BY SIZE DTSBD387 00267 INTO MREL-TEXT (MREL-TEXT-CNT) DTSBD387 00268 END-STRING. DTSBD387 00269 DTSBD387 00270 MOVE SPACES TO WRK-PHONE DTSBD387 00271 WRK-PHONE-TEXT1 DTSBD387 00272 WRK-PHONE-TEXT2. DTSBD387 00273 DTSBD387 00274 IF Y130-REL-VOICE > SPACES DTSBD387 00275 MOVE Y130-REL-VOICE TO WRK-PHONE DTSBD387 00276 STRING DTSBD387 00277 'PHONE ' WRK-AREA-CD '-' DTSBD387 00278 WRK-PREFIX '-' DTSBD387 00279 WRK-SUFFIX ' ' WRK-EXT DTSBD387 00280 DELIMITED BY SIZE DTSBD387 00281 INTO WRK-PHONE-TEXT1 DTSBD387 00282 END-STRING DTSBD387 00283 END-IF. DTSBD387 00284 MOVE SPACES TO WRK-PHONE. DTSBD387 00285 IF Y130-REL-FAX > SPACES DTSBD387 00286 MOVE Y130-REL-FAX TO WRK-PHONE DTSBD387 00287 STRING DTSBD387 00288 ' FAX ' WRK-AREA-CD '-' DTSBD387 00289 WRK-PREFIX '-' DTSBD387 00290 WRK-SUFFIX DTSBD387 00291 DELIMITED BY SIZE DTSBD387 00292 INTO WRK-PHONE-TEXT2 DTSBD387 00293 END-STRING DTSBD387 00294 END-IF. DTSBD387 00295 ADD +1 TO MREL-TEXT-CNT. DTSBD387 00296 STRING WRK-PHONE-TEXT1 ' ' WRK-PHONE-TEXT2 DTSBD387 00297 DELIMITED BY SIZE DTSBD387 00298 INTO MREL-TEXT (MREL-TEXT-CNT) DTSBD387 00299 END-STRING DTSBD387 00300 DTSBD387 00301 ADD +1 TO MREL-TEXT-CNT. DTSBD387 00302 MOVE Y130-REL-EMAIL DTSBD387 00303 TO MREL-TEXT (MREL-TEXT-CNT). DTSBD387 00304 DTSBD387 00305 MOVE MREL-REC TO MSKL-REC. DTSBD387 00306 PERFORM S910-WRITE THRU S910-EXIT. DTSBD387 00307 DTSBD387 00308 P1200-EXIT. DTSBD387 00309 EXIT. DTSBD387 00310 DTSBD387 00311 S005-FROM-ABSTIME. DTSBD387 00312 SET L005-FROM-ABSTIME TO TRUE. DTSBD387 00313 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD387 00314 DTSBD387 00315 S005-EXIT. DTSBD387 00316 EXIT. DTSBD387 00317 DTSBD387 00318 S330-INIT-MLOG. DTSBD387 00319 MOVE T002-EMP-NO TO L331-EMP-NO. DTSBD387 00320 MOVE LBCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSBD387 00321 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD387 00322 MOVE LBCM-EMP-ABSTIME TO L331-UPDATE-ABSTIME. DTSBD387 00323 MOVE 'BATCH' TO L331-OP-ID. DTSBD387 00324 MOVE LBCM-ABSTIME TO L005-ABSTIME. DTSBD387 00325 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD387 00326 MOVE L005-DATE-8-SLASH-TIME TO L331-REC-OCC-ID. DTSBD387 00327 DTSBD387 00328 S330-EXIT. DTSBD387 00329 EXIT. DTSBD387 00330 DTSBD387 00331 S331-WRITE-MLOG. DTSBD387 00332 CALL 'DTSBU331' USING L331-LINK-AREA. DTSBD387 00333 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD387 00334 DTSBD387 00335 S331-EXIT. DTSBD387 00336 EXIT. DTSBD387 00337 DTSBD387 00338 S910-OPEN-READ. DTSBD387 00339 SET L910-OPEN-READ-88 TO TRUE. DTSBD387 00340 GO TO S910-MSTR-IO. DTSBD387 00341 DTSBD387 00342 S910-OPEN-UPDATE. DTSBD387 00343 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD387 00344 GO TO S910-MSTR-IO. DTSBD387 00345 DTSBD387 00346 S910-OPEN-UPDATE-NO-AIX. DTSBD387 00347 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBD387 00348 GO TO S910-MSTR-IO. DTSBD387 00349 DTSBD387 00350 S910-READ. DTSBD387 00351 SET L910-READ-88 TO TRUE. DTSBD387 00352 GO TO S910-MSTR-IO. DTSBD387 00353 DTSBD387 00354 S910-START-BROWSE. DTSBD387 00355 SET L910-START-BROWSE-88 TO TRUE. DTSBD387 00356 GO TO S910-MSTR-IO. DTSBD387 00357 DTSBD387 00358 S910-READ-NEXT. DTSBD387 00359 SET L910-READ-NEXT-88 TO TRUE. DTSBD387 00360 GO TO S910-MSTR-IO. DTSBD387 00361 DTSBD387 00362 S910-COUNT. DTSBD387 00363 SET L910-COUNT-88 TO TRUE. DTSBD387 00364 GO TO S910-MSTR-IO. DTSBD387 00365 DTSBD387 00366 S910-WRITE. DTSBD387 00367 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD387 00368 SET L910-WRITE-88 TO TRUE. DTSBD387 00369 GO TO S910-MSTR-IO. DTSBD387 00370 DTSBD387 00371 S910-REWRITE. DTSBD387 00372 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD387 00373 SET L910-REWRITE-88 TO TRUE. DTSBD387 00374 GO TO S910-MSTR-IO. DTSBD387 00375 DTSBD387 00376 S910-DELETE. DTSBD387 00377 SET L910-DELETE-88 TO TRUE. DTSBD387 00378 GO TO S910-MSTR-IO. DTSBD387 00379 DTSBD387 00380 S910-CLOSE. DTSBD387 00381 SET L910-CLOSE-88 TO TRUE. DTSBD387 00382 GO TO S910-MSTR-IO. DTSBD387 00383 DTSBD387 00384 S910-MSTR-IO. DTSBD387 00385 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD387 00386 MSKL-REC. DTSBD387 00387 S910-EXIT. DTSBD387 00388 EXIT. DTSBD387 00389 DTSBD387 00390 S947-WRITE-R907. DTSBD387 00391 CALL 'DTSBU947' USING R907-REC. DTSBD387 00392 DTSBD387 00393 S947-EXIT. DTSBD387 00394 EXIT. DTSBD387 00395 DTSBD387 00396 S999-ABEND. DTSBD387 00397 DISPLAY '*** DTSBD387 ABENDING : ' DTSBD387 00398 WRK-ABEND-MSG. DTSBD387 00399 DTSBD387 00400 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD387 00401 S999-EXIT. DTSBD387 00402 EXIT. DTSBD387 00403 DTSBD387