516 lines
41 KiB
COBOL
516 lines
41 KiB
COBOL
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
|