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