00001 IDENTIFICATION DIVISION. 06/17/09 00002 PROGRAM-ID. DESBD323. DESBD323 00003 AUTHOR. NGC. LV003 00004 DATE-WRITTEN. APRIL 2009 DESBD323 00005 DATE-COMPILED. DESBD323 00006 SKIP3 DESBD323 00007 ***** DESBD323 00008 * DESBD323 00009 * FUNCTION: MATCH NAME RECORDS OUTPUT FROM DESBD322 AGAINST DESBD323 00010 * THE PREVIOUS DAY'S FILE. WRITE AN OUTPUT NAME DESBD323 00011 * RECORD ONLY IF THE NAME DOES NOT EXIST IN THE DESBD323 00012 * PREVIOUS FILE OR IF IT IS DIFFERENT. DESBD323 00013 * DESBD323 00014 * MODIFICATION LOG: DESBD323 00015 * DESBD323 00016 * 04/08/2009 INITIAL DEVELOPMENT DESBD323 00017 * WORK ORDER: PROGRAMMER: GD DESBD323 00018 * DESBD323 00019 * 99/99/9999 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD323 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD323 00021 * WORK ORDER: PROGRAMMER: XXX DESBD323 00022 * DESBD323 00023 * DESCRIPTION: DESBD323 00024 * DESBD323 00025 * INITIATION: DESBD323 00026 * INITIAL READ FROM BOTH INPUT FILES DESBD323 00027 * DESBD323 00028 * PROCESSING: DESBD323 00029 * DESBD323 00030 * TERMINATION: DESBD323 00031 * CLOSE FILES DESBD323 00032 * DESBD323 00033 * RECORDS READ: DESBD323 00034 * MASTER: DESBD323 00035 NONE DESBD323 00036 * DESBD323 00037 * ALTERNATE INDEX: DESBD323 00038 * NONE. DESBD323 00039 * DESBD323 00040 * REFERENCE: DESBD323 00041 * NONE. DESBD323 00042 * DESBD323 00043 * RECORDS UPDATED: DESBD323 00044 * NONE DESBD323 00045 * DESBD323 00046 * REPORT RECORDS WRITTEN: DESBD323 00047 * NONE DESBD323 00048 * DESBD323 00049 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DESBD323 00050 * NONE. DESBD323 00051 * DESBD323 00052 * MODULES CALLED: DESBD323 00053 * DTSBU001 DATE CONVERSION/EDIT. DESBD323 00054 * DTSBU004 QUARERLY SUMMARY REPORT REC. DESBD323 00055 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DESBD323 00056 * DESBD323 00057 * VERMONT REFERENCE: DESBD323 00058 * NONE. DESBD323 00059 * DESBD323 00060 ***** DESBD323 00061 SKIP3 DESBD323 00062 ENVIRONMENT DIVISION. DESBD323 00063 INPUT-OUTPUT SECTION. DESBD323 00064 SKIP3 DESBD323 00065 FILE-CONTROL. DESBD323 00066 SELECT NEW-NAME-FILE ASSIGN TO DESFB32A DESBD323 00067 FILE STATUS IS NEW-NAME-STATUS. DESBD323 00068 DESBD323 00069 SELECT PREV-NAME-FILE ASSIGN TO DESFB32B DESBD323 00070 FILE STATUS IS PREV-NAME-STATUS. DESBD323 00071 DESBD323 00072 SELECT OUT-NAME-FILE ASSIGN TO DESFB323 DESBD323 00073 FILE STATUS IS OUT-NAME-STATUS. DESBD323 00074 DESBD323 00075 SKIP3 DESBD323 00076 DATA DIVISION. DESBD323 00077 FILE SECTION. DESBD323 00078 FD NEW-NAME-FILE DESBD323 00079 RECORDING MODE IS F DESBD323 00080 LABEL RECORDS ARE STANDARD DESBD323 00081 BLOCK CONTAINS 0 CHARACTERS. DESBD323 00082 SKIP1 DESBD323 00083 01 NEW-NAME-REC. DESBD323 00084 ++INCLUDE DTSIX147 DESBD323 00085 DESBD323 00086 FD PREV-NAME-FILE DESBD323 00087 RECORDING MODE IS F DESBD323 00088 LABEL RECORDS ARE STANDARD DESBD323 00089 BLOCK CONTAINS 0 CHARACTERS. DESBD323 00090 SKIP1 DESBD323 00091 01 PREV-NAME-REC. DESBD323 00092 ++INCLUDE DTSIX147 DESBD323 00093 DESBD323 00094 FD OUT-NAME-FILE DESBD323 00095 RECORDING MODE IS F DESBD323 00096 LABEL RECORDS ARE STANDARD DESBD323 00097 BLOCK CONTAINS 0 CHARACTERS. DESBD323 00098 SKIP1 DESBD323 00099 01 OUT-NAME-REC PIC X(76). DESBD323 00100 DESBD323 00101 WORKING-STORAGE SECTION. DESBD323 001015 77 PAN-VALET PICTURE X(24) VALUE '003DESBD323 06/17/09'. DESBD323 00102 DESBD323 00103 01 WRK-AREA. DESBD323 00104 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +322.DESBD323 00105 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD322'.DESBD323 00106 05 WRK-ABEND-MSG PIC X(60). DESBD323 00107 DESBD323 00108 05 NEW-NAME-STATUS PIC X(02). DESBD323 00109 88 NEW-NAME-OK-88 VALUE '00'. DESBD323 00110 88 NEW-NAME-EOF-88 VALUE '10'. DESBD323 00111 DESBD323 00112 05 PREV-NAME-STATUS PIC X(02). DESBD323 00113 88 PREV-NAME-OK-88 VALUE '00'. DESBD323 00114 88 PREV-NAME-EOF-88 VALUE '10'. DESBD323 00115 DESBD323 00116 05 OUT-NAME-STATUS PIC X(02). DESBD323 00117 88 OUT-NAME-OK-88 VALUE '00'. DESBD323 00118 DESBD323 00119 05 WRK-ERROR-IND PIC X(01). DESBD323 00120 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD323 00121 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD323 00122 DESBD323 00123 05 WRK-RUN-TYPE PIC X(01). DESBD323 00124 88 WRK-RUN-TYPE-DAILY-88 VALUE 'D'. DESBD323 00125 88 WRK-RUN-TYPE-CNVRT-88 VALUE 'C'. DESBD323 00126 DESBD323 00127 05 WRK-CURR-SSN PIC S9(09) COMP-3 VALUE +0. DESBD323 00128 DESBD323 00129 05 WRK-NEW-CNT PIC S9(07) COMP-3 VALUE +0. DESBD323 00130 05 WRK-PREV-CNT PIC S9(07) COMP-3 VALUE +0. DESBD323 00131 05 WRK-NEW-OUT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD323 00132 05 WRK-PREV-OUT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD323 00133 DESBD323 00134 05 AMT-DISP1 PIC ---------9.99. DESBD323 00135 05 AMT-DISP2 PIC ---------9.99. DESBD323 00136 DESBD323 00137 01 L001-LINK-AREA. DESBD323 00138 ++INCLUDE DTSIL001 DESBD323 00139 EJECT DESBD323 00140 01 L004-LINK-AREA. DESBD323 00141 ++INCLUDE DTSIL004 DESBD323 00142 EJECT DESBD323 00143 01 L005-LINK-AREA. DESBD323 00144 ++INCLUDE DTSIL005 DESBD323 00145 EJECT DESBD323 00146 01 WRK-X146-REC. DESBD323 00147 ++INCLUDE DTSIX146 DESBD323 00148 EJECT DESBD323 00149 LINKAGE SECTION. DESBD323 00150 SKIP3 DESBD323 00151 01 PARM-AREA. DESBD323 00152 05 PARM-LENGTH PIC S9(04) COMP. DESBD323 00153 05 PARM-DATA. DESBD323 00154 10 PARM-RUN-TYPE PIC X(01). DESBD323 00155 88 PARM-RUN-TYPE-DAILY-88 VALUE 'D'. DESBD323 00156 88 PARM-RUN-TYPE-CNVRT-88 VALUE 'C'. DESBD323 00157 88 PARM-RUN-TYPE-VALID-88 VALUE 'C', 'D'. DESBD323 00158 DESBD323 00159 PROCEDURE DIVISION USING PARM-AREA. DESBD323 00160 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DESBD323 00161 IF WRK-ERROR-NO-88 DESBD323 00162 PERFORM P0000-PROCESS THRU P0000-EXIT DESBD323 00163 PERFORM T0000-TERMINATE THRU T0000-EXIT DESBD323 00164 END-IF. DESBD323 00165 DESBD323 00166 GOBACK. DESBD323 00167 EJECT DESBD323 00168 I0000-INITIALIZE. DESBD323 00169 SET WRK-ERROR-NO-88 TO TRUE. DESBD323 00170 DESBD323 00171 SET L005-FROM-SYS TO TRUE. DESBD323 00172 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD323 00173 DISPLAY 'BD323 ' L005-SLASH-8-DATE. DESBD323 00174 DESBD323 00175 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DESBD323 00176 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DESBD323 00177 DESBD323 00178 I0000-EXIT. DESBD323 00179 EXIT. DESBD323 00180 DESBD323 00181 I1000-PROCESS-PARMS. DESBD323 00182 IF PARM-LENGTH = +1 DESBD323 00183 NEXT SENTENCE DESBD323 00184 ELSE DESBD323 00185 DISPLAY 'PARM-LENGTH NOT EQUAL TO 1 ' PARM-LENGTH DESBD323 00186 PERFORM S999-ABEND THRU S999-EXIT DESBD323 00187 END-IF. DESBD323 00188 DESBD323 00189 DISPLAY '***'. DESBD323 00190 DESBD323 00191 DISPLAY '*** ' DESBD323 00192 WRK-MOD-NAME DESBD323 00193 ' PARAMETERS: ' DESBD323 00194 PARM-DATA. DESBD323 00195 DESBD323 00196 DISPLAY '***'. DESBD323 00197 DESBD323 00198 IF PARM-RUN-TYPE-VALID-88 DESBD323 00199 MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE DESBD323 00200 ELSE DESBD323 00201 DISPLAY 'INVALID PARM: ' PARM-RUN-TYPE DESBD323 00202 PERFORM S999-ABEND THRU S999-EXIT DESBD323 00203 END-IF. DESBD323 00204 DESBD323 00205 I1000-EXIT. DESBD323 00206 EXIT. DESBD323 00207 DESBD323 00208 I2000-OPEN-FILES. DESBD323 00209 OPEN INPUT NEW-NAME-FILE. DESBD323 00210 IF NOT NEW-NAME-OK-88 DESBD323 00211 DISPLAY 'CANNOT OPEN NEW-NAME ' NEW-NAME-STATUS DESBD323 00212 SET WRK-ERROR-YES-88 TO TRUE DESBD323 00213 GO TO I2000-EXIT DESBD323 00214 END-IF. DESBD323 00215 DESBD323 00216 *************************************************** DESBD323 00217 ** USE THE FOLLOWING TO REBUILD THE ENTIRE FILE: DESBD323 00218 ** DESBD323 00219 IF WRK-RUN-TYPE-CNVRT-88 DESBD323 00220 OPEN OUTPUT PREV-NAME-FILE DESBD323 00221 CLOSE PREV-NAME-FILE DESBD323 00222 END-IF. DESBD323 00223 *************************************************** DESBD323 00224 DESBD323 00225 OPEN INPUT PREV-NAME-FILE. DESBD323 00226 IF NOT PREV-NAME-OK-88 DESBD323 00227 DISPLAY 'CANNOT OPEN PREV-NAME ' PREV-NAME-STATUS DESBD323 00228 SET WRK-ERROR-YES-88 TO TRUE DESBD323 00229 GO TO I2000-EXIT DESBD323 00230 END-IF. DESBD323 00231 DESBD323 00232 DESBD323 00233 OPEN OUTPUT OUT-NAME-FILE. DESBD323 00234 IF NOT OUT-NAME-OK-88 DESBD323 00235 DISPLAY 'CANNOT OPEN OUT-NAME ' OUT-NAME-STATUS DESBD323 00236 SET WRK-ERROR-YES-88 TO TRUE DESBD323 00237 GO TO I2000-EXIT DESBD323 00238 END-IF. DESBD323 00239 DESBD323 00240 DESBD323 00241 I2000-EXIT. DESBD323 00242 EXIT. DESBD323 00243 DESBD323 00244 P0000-PROCESS. DESBD323 00245 PERFORM S1100-READ-NEW THRU S1100-EXIT. DESBD323 00246 PERFORM S1200-READ-PREV THRU S1200-EXIT. DESBD323 00247 DESBD323 00248 PERFORM P1000-SCAN-NAMES THRU P1000-EXIT DESBD323 00249 UNTIL NEW-NAME-EOF-88 DESBD323 00250 AND PREV-NAME-EOF-88. DESBD323 00251 DESBD323 00252 PERFORM P2000-REBUILD-PREV-FILE THRU P2000-EXIT. DESBD323 00253 P0000-EXIT. DESBD323 00254 EXIT. DESBD323 00255 DESBD323 00256 P1000-SCAN-NAMES. DESBD323 00257 IF PREV-NAME-EOF-88 DESBD323 00258 SET X146-INSERT-88 TO TRUE DESBD323 00259 PERFORM S1110-WRITE-NEW THRU S1110-EXIT DESBD323 00260 PERFORM S1100-READ-NEW THRU S1100-EXIT DESBD323 00261 GO TO P1000-EXIT DESBD323 00262 END-IF. DESBD323 00263 DESBD323 00264 IF X147-SSN OF NEW-NAME-REC > DESBD323 00265 X147-SSN OF PREV-NAME-REC DESBD323 00266 PERFORM S1200-READ-PREV THRU S1200-EXIT DESBD323 00267 ELSE DESBD323 00268 IF X147-SSN OF NEW-NAME-REC = DESBD323 00269 X147-SSN OF PREV-NAME-REC DESBD323 00270 PERFORM P1100-CHECK-NAME THRU P1100-EXIT DESBD323 00271 PERFORM S1200-READ-PREV THRU S1200-EXIT DESBD323 00272 PERFORM S1100-READ-NEW THRU S1100-EXIT DESBD323 00273 ELSE DESBD323 00274 IF X147-SSN OF NEW-NAME-REC < DESBD323 00275 X147-SSN OF PREV-NAME-REC DESBD323 00276 SET X146-INSERT-88 TO TRUE DESBD323 00277 PERFORM S1110-WRITE-NEW THRU S1110-EXIT DESBD323 00278 PERFORM S1100-READ-NEW THRU S1100-EXIT DESBD323 00279 END-IF DESBD323 00280 END-IF DESBD323 00281 END-IF. DESBD323 00282 DESBD323 00283 DESBD323 00284 P1000-EXIT. DESBD323 00285 EXIT. DESBD323 00286 DESBD323 00287 P1100-CHECK-NAME. DESBD323 00288 IF X147-EFF-DATE OF NEW-NAME-REC > DESBD323 00289 X147-EFF-DATE OF PREV-NAME-REC DESBD323 00290 IF X147-LAST-NAME OF NEW-NAME-REC NOT = DESBD323 00291 X147-LAST-NAME OF PREV-NAME-REC DESBD323 00292 SET X146-UPDATE-88 TO TRUE DESBD323 00293 PERFORM S1110-WRITE-NEW THRU S1110-EXIT DESBD323 00294 END-IF DESBD323 00295 END-IF. DESBD323 00296 DESBD323 00297 P1100-EXIT. DESBD323 00298 EXIT. DESBD323 00299 DESBD323 00300 P2000-REBUILD-PREV-FILE. DESBD323 00301 PERFORM P2100-RESET-FILES THRU P2100-EXIT. DESBD323 00302 PERFORM P2200-COPY-DATA THRU P2200-EXIT. DESBD323 00303 DESBD323 00304 P2000-EXIT. DESBD323 00305 EXIT. DESBD323 00306 DESBD323 00307 P2100-RESET-FILES. DESBD323 00308 CLOSE PREV-NAME-FILE. DESBD323 00309 DESBD323 00310 OPEN OUTPUT PREV-NAME-FILE. DESBD323 00311 IF NOT PREV-NAME-OK-88 DESBD323 00312 DISPLAY 'CANNOT OPEN PREV-NAME FOR OUTPUT ' DESBD323 00313 PREV-NAME-STATUS DESBD323 00314 SET WRK-ERROR-YES-88 TO TRUE DESBD323 00315 GO TO P2100-EXIT DESBD323 00316 END-IF. DESBD323 00317 DESBD323 00318 CLOSE NEW-NAME-FILE. DESBD323 00319 DESBD323 00320 OPEN INPUT NEW-NAME-FILE. DESBD323 00321 IF NOT NEW-NAME-OK-88 DESBD323 00322 DISPLAY 'CANNOT OPEN NEW-NAME - P2100 ' DESBD323 00323 NEW-NAME-STATUS DESBD323 00324 SET WRK-ERROR-YES-88 TO TRUE DESBD323 00325 GO TO P2100-EXIT DESBD323 00326 END-IF. DESBD323 00327 DESBD323 00328 P2100-EXIT. DESBD323 00329 EXIT. DESBD323 00330 DESBD323 00331 P2200-COPY-DATA. DESBD323 00332 PERFORM S1100-READ-NEW THRU S1100-EXIT. DESBD323 00333 DESBD323 00334 PERFORM UNTIL NEW-NAME-EOF-88 DESBD323 00335 WRITE PREV-NAME-REC FROM NEW-NAME-REC DESBD323 00336 PERFORM S1100-READ-NEW THRU S1100-EXIT DESBD323 00337 END-PERFORM. DESBD323 00338 DESBD323 00339 P2200-EXIT. DESBD323 00340 EXIT. DESBD323 00341 DESBD323 00342 T0000-TERMINATE. DESBD323 00343 DESBD323 00344 DISPLAY ' '. DESBD323 00345 DISPLAY ' '. DESBD323 00346 DESBD323 00347 DISPLAY '*** DESBD323 TERMINATION STATISTICS ***'. DESBD323 00348 DESBD323 00349 DISPLAY ' '. DESBD323 00350 DISPLAY 'NEW RECORDS READ :' DESBD323 00351 WRK-NEW-CNT. DESBD323 00352 DISPLAY 'PREVIOUS RECORDS READ :' DESBD323 00353 WRK-PREV-CNT. DESBD323 00354 DISPLAY ' '. DESBD323 00355 DISPLAY 'NEW RECORDS WRITTEN :' DESBD323 00356 WRK-NEW-OUT-CNT. DESBD323 00357 DISPLAY 'PREVIOUS RECORDS WRITTEN :' DESBD323 00358 WRK-PREV-OUT-CNT. DESBD323 00359 DESBD323 00360 IF WRK-NEW-OUT-CNT = ZERO DESBD323 00361 AND WRK-PREV-OUT-CNT = ZERO DESBD323 00362 PERFORM T1000-WRITE-DUMMY THRU T1000-EXIT DESBD323 00363 END-IF. DESBD323 00364 DESBD323 00365 CLOSE NEW-NAME-FILE DESBD323 00366 PREV-NAME-FILE DESBD323 00367 OUT-NAME-FILE. DESBD323 00368 DESBD323 00369 T0000-EXIT. DESBD323 00370 EXIT. DESBD323 00371 DESBD323 00372 T1000-WRITE-DUMMY. DESBD323 00373 MOVE '146' TO X146-REC-TYPE. DESBD323 00374 MOVE ZEROS TO X146-SSN. DESBD323 00375 MOVE SPACES TO X146-EFF-DATE DESBD323 00376 X146-LAST-NAME DESBD323 00377 X146-FIRST-NAME DESBD323 00378 X146-MID-INIT. DESBD323 00379 DESBD323 00380 WRITE OUT-NAME-REC FROM WRK-X146-REC. DESBD323 00381 IF NOT OUT-NAME-OK-88 DESBD323 00382 DISPLAY 'CANNOT WRITE DUMMY REC ' OUT-NAME-STATUS DESBD323 00383 PERFORM S999-ABEND THRU S999-EXIT DESBD323 00384 ELSE DESBD323 00385 DISPLAY 'DUMMY RECORD WRITTEN' DESBD323 00386 END-IF. DESBD323 00387 DESBD323 00388 T1000-EXIT. DESBD323 00389 EXIT. DESBD323 00390 DESBD323 00391 S001-FROM-FED-8. DESBD323 00392 SET L001-FROM-FED-8 TO TRUE. DESBD323 00393 GO TO S001-DATE. DESBD323 00394 DESBD323 00395 S001-FROM-ABS-DAY. DESBD323 00396 SET L001-FROM-ABS-DAY TO TRUE. DESBD323 00397 GO TO S001-DATE. DESBD323 00398 DESBD323 00399 S001-FROM-CAL-6. DESBD323 00400 SET L001-FROM-CAL-6 TO TRUE. DESBD323 00401 GO TO S001-DATE. DESBD323 00402 DESBD323 00403 S001-DATE. DESBD323 00404 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD323 00405 S001-EXIT. DESBD323 00406 EXIT. DESBD323 00407 DESBD323 00408 S004-FROM-3. DESBD323 00409 SET L004-FROM-3 TO TRUE. DESBD323 00410 GO TO S004-YRQ. DESBD323 00411 DESBD323 00412 S004-FROM-5. DESBD323 00413 SET L004-FROM-5 TO TRUE. DESBD323 00414 GO TO S004-YRQ. DESBD323 00415 DESBD323 00416 S004-YRQ. DESBD323 00417 CALL 'DTSBU004' USING L004-LINK-AREA. DESBD323 00418 DESBD323 00419 S004-EXIT. DESBD323 00420 EXIT. DESBD323 00421 DESBD323 00422 S005-FROM-SYS. DESBD323 00423 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD323 00424 S005-EXIT. DESBD323 00425 EXIT. DESBD323 00426 DESBD323 00427 S1100-READ-NEW. DESBD323 00428 READ NEW-NAME-FILE. DESBD323 00429 IF NEW-NAME-EOF-88 DESBD323 00430 DISPLAY 'NEW FILE EOF ' NEW-NAME-STATUS DESBD323 00431 ELSE DESBD323 00432 IF NOT NEW-NAME-OK-88 DESBD323 00433 DISPLAY 'NEW FILE: BAD READ ' NEW-NAME-STATUS DESBD323 00434 SET NEW-NAME-EOF-88 TO TRUE DESBD323 00435 SET PREV-NAME-EOF-88 TO TRUE DESBD323 00436 ELSE DESBD323 00437 ADD +1 TO WRK-NEW-CNT DESBD323 00438 END-IF DESBD323 00439 END-IF. DESBD323 00440 DESBD323 00441 S1100-EXIT. DESBD323 00442 EXIT. DESBD323 00443 DESBD323 00444 S1110-WRITE-NEW. DESBD323 00445 MOVE '146' TO X146-REC-TYPE. DESBD323 00446 MOVE X147-SSN OF NEW-NAME-REC TO X146-SSN. DESBD323 00447 MOVE X147-EFF-DATE OF NEW-NAME-REC TO L001-FED-8-DATE-9. DESBD323 00448 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DESBD323 00449 MOVE L001-SLASH-8-DATE TO X146-EFF-DATE. DESBD323 00450 MOVE X147-LAST-NAME OF NEW-NAME-REC TO X146-LAST-NAME. DESBD323 00451 MOVE X147-FIRST-NAME OF NEW-NAME-REC TO X146-FIRST-NAME. DESBD323 00452 MOVE X147-MID-INIT OF NEW-NAME-REC TO X146-MID-INIT. DESBD323 00453 MOVE L005-SLASH-8-DATE TO X146-PROCESS-DATE. DESBD323 00454 DESBD323 00455 WRITE OUT-NAME-REC FROM WRK-X146-REC. DESBD323 00456 IF NOT OUT-NAME-OK-88 DESBD323 00457 DISPLAY 'CANNOT WRITE OUTPUT REC ' OUT-NAME-STATUS DESBD323 00458 PERFORM S999-ABEND THRU S999-EXIT DESBD323 00459 ELSE DESBD323 00460 ADD +1 TO WRK-NEW-OUT-CNT DESBD323 00461 END-IF. DESBD323 00462 DESBD323 00463 S1110-EXIT. DESBD323 00464 EXIT. DESBD323 00465 DESBD323 00466 S1200-READ-PREV. DESBD323 00467 READ PREV-NAME-FILE. DESBD323 00468 IF PREV-NAME-EOF-88 DESBD323 00469 DISPLAY 'PREV FILE EOF ' PREV-NAME-STATUS DESBD323 00470 ELSE DESBD323 00471 IF NOT PREV-NAME-OK-88 DESBD323 00472 DISPLAY 'PREVIOUS: BAD READ ' PREV-NAME-STATUS DESBD323 00473 SET NEW-NAME-EOF-88 TO TRUE DESBD323 00474 SET PREV-NAME-EOF-88 TO TRUE DESBD323 00475 ELSE DESBD323 00476 ADD +1 TO WRK-PREV-CNT DESBD323 00477 END-IF DESBD323 00478 END-IF. DESBD323 00479 DESBD323 00480 S1200-EXIT. DESBD323 00481 EXIT. DESBD323 00482 DESBD323 00483 S1210-WRITE-PREV. DESBD323 00484 MOVE '146' TO X146-REC-TYPE. DESBD323 00485 MOVE X147-SSN OF PREV-NAME-REC TO X146-SSN. DESBD323 00486 MOVE X147-EFF-DATE OF PREV-NAME-REC TO L001-FED-8-DATE-9. DESBD323 00487 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DESBD323 00488 MOVE L001-SLASH-8-DATE TO X146-EFF-DATE. DESBD323 00489 MOVE X147-LAST-NAME OF PREV-NAME-REC DESBD323 00490 TO X146-LAST-NAME. DESBD323 00491 MOVE X147-FIRST-NAME OF PREV-NAME-REC DESBD323 00492 TO X146-FIRST-NAME. DESBD323 00493 MOVE X147-MID-INIT OF PREV-NAME-REC DESBD323 00494 TO X146-MID-INIT. DESBD323 00495 MOVE L005-SLASH-8-DATE TO X146-PROCESS-DATE. DESBD323 00496 DESBD323 00497 WRITE OUT-NAME-REC FROM WRK-X146-REC. DESBD323 00498 IF NOT OUT-NAME-OK-88 DESBD323 00499 DISPLAY 'CANNOT WRITE OUTPUT REC ' OUT-NAME-STATUS DESBD323 00500 PERFORM S999-ABEND THRU S999-EXIT DESBD323 00501 ELSE DESBD323 00502 ADD +1 TO WRK-PREV-OUT-CNT DESBD323 00503 END-IF. DESBD323 00504 DESBD323 00505 S1210-EXIT. DESBD323 00506 EXIT. DESBD323 00507 DESBD323 00508 S999-ABEND. DESBD323 00509 DISPLAY '*** DESBD323 ABENDING : ' DESBD323 00510 WRK-ABEND-MSG. DESBD323 00511 DESBD323 00512 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD323 00513 S999-EXIT. DESBD323 00514 EXIT. DESBD323