| 1 | ****************************************************************** |
| 2 | * Copyright Amazon.com, Inc. or its affiliates. |
| 3 | * All Rights Reserved. |
| 4 | * |
| 5 | * Licensed under the Apache License, Version 2.0 (the "License"). |
| 6 | * You may not use this file except in compliance with the License. |
| 7 | * You may obtain a copy of the License at |
| 8 | * |
| 9 | * http://www.apache.org/licenses/LICENSE-2.0 |
| 10 | * |
| 11 | * Unless required by applicable law or agreed to in writing, |
| 12 | * software distributed under the License is distributed on an |
| 13 | * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, |
| 14 | * either express or implied. See the License for the specific |
| 15 | * language governing permissions and limitations under the License |
| 16 | ****************************************************************** |
| 17 | IDENTIFICATION DIVISION. 00010000 |
| 18 | PROGRAM-ID. DBUNLDGS. 00020000 |
| 19 | AUTHOR. AWS. 00030000 |
| 20 | 00040000 |
| 21 | ENVIRONMENT DIVISION. 00050000 |
| 22 | CONFIGURATION SECTION. 00060000 |
| 23 | 00070000 |
| 24 | INPUT-OUTPUT SECTION. 00080000 |
| 25 | FILE-CONTROL. 00090000 |
| 26 | * SELECT OPFILE1 ASSIGN TO OUTFIL1 00100000 |
| 27 | * ORGANIZATION IS SEQUENTIAL 00110000 |
| 28 | * ACCESS MODE IS SEQUENTIAL 00120000 |
| 29 | * FILE STATUS IS WS-OUTFL1-STATUS. 00130000 |
| 30 | 00140000 |
| 31 | * 00150000 |
| 32 | * SELECT OPFILE2 ASSIGN TO OUTFIL2 00160000 |
| 33 | * ORGANIZATION IS SEQUENTIAL 00170000 |
| 34 | * ACCESS MODE IS SEQUENTIAL 00180000 |
| 35 | * FILE STATUS IS WS-OUTFL2-STATUS. 00190000 |
| 36 | 00200000 |
| 37 | * 00210000 |
| 38 | *----------------------------------------------------------------*00220000 |
| 39 | DATA DIVISION. 00230000 |
| 40 | *----------------------------------------------------------------*00240000 |
| 41 | * 00250000 |
| 42 | *FILE SECTION. 00260000 |
| 43 | *FD OPFILE1. 00270000 |
| 44 | *01 OPFIL1-REC PIC X(100). 00280000 |
| 45 | *FD OPFILE2. 00290000 |
| 46 | *01 OPFIL2-REC. 00300000 |
| 47 | * 05 ROOT-SEG-KEY PIC S9(11) COMP-3. 00310000 |
| 48 | * 05 CHILD-SEG-REC PIC X(200). 00320000 |
| 49 | * 00330000 |
| 50 | *----------------------------------------------------------------*00340000 |
| 51 | WORKING-STORAGE SECTION. 00350000 |
| 52 | *----------------------------------------------------------------*00360000 |
| 53 | 01 OPFIL1-REC PIC X(100). 00361000 |
| 54 | 01 OPFIL2-REC. 00362000 |
| 55 | 05 ROOT-SEG-KEY PIC S9(11) COMP-3. 00363000 |
| 56 | 05 CHILD-SEG-REC PIC X(200). 00364000 |
| 57 | 01 WS-VARIABLES. 00370000 |
| 58 | 05 WS-PGMNAME PIC X(08) VALUE 'IMSUNLOD'. 00380000 |
| 59 | 05 CURRENT-DATE PIC 9(06). 00390000 |
| 60 | 05 CURRENT-YYDDD PIC 9(05). 00400000 |
| 61 | 05 WS-AUTH-DATE PIC 9(05). 00410000 |
| 62 | 05 WS-EXPIRY-DAYS PIC S9(4) COMP. 00420000 |
| 63 | 05 WS-DAY-DIFF PIC S9(4) COMP. 00430000 |
| 64 | 05 IDX PIC S9(4) COMP. 00440000 |
| 65 | 05 WS-CURR-APP-ID PIC 9(11). 00450000 |
| 66 | * 00460000 |
| 67 | 05 WS-NO-CHKP PIC 9(8) VALUE 0. 00470000 |
| 68 | 05 WS-AUTH-SMRY-PROC-CNT PIC 9(8) VALUE 0. 00480000 |
| 69 | 05 WS-TOT-REC-WRITTEN PIC S9(8) COMP VALUE 0. 00490000 |
| 70 | 05 WS-NO-SUMRY-READ PIC S9(8) COMP VALUE 0. 00500000 |
| 71 | 05 WS-NO-SUMRY-DELETED PIC S9(8) COMP VALUE 0. 00510000 |
| 72 | 05 WS-NO-DTL-READ PIC S9(8) COMP VALUE 0. 00520000 |
| 73 | 05 WS-NO-DTL-DELETED PIC S9(8) COMP VALUE 0. 00530000 |
| 74 | * 00540000 |
| 75 | 05 WS-ERR-FLG PIC X(01) VALUE 'N'. 00550000 |
| 76 | 88 ERR-FLG-ON VALUE 'Y'. 00560000 |
| 77 | 88 ERR-FLG-OFF VALUE 'N'. 00570000 |
| 78 | 05 WS-END-OF-AUTHDB-FLAG PIC X(01) VALUE 'N'. 00580000 |
| 79 | 88 END-OF-AUTHDB VALUE 'Y'. 00590000 |
| 80 | 88 NOT-END-OF-AUTHDB VALUE 'N'. 00600000 |
| 81 | 05 WS-MORE-AUTHS-FLAG PIC X(01) VALUE 'N'. 00610000 |
| 82 | 88 MORE-AUTHS VALUE 'Y'. 00620000 |
| 83 | 88 NO-MORE-AUTHS VALUE 'N'. 00630000 |
| 84 | 05 WS-END-OF-ROOT-SEG PIC X(01) VALUE SPACES. 00640000 |
| 85 | 05 WS-END-OF-CHILD-SEG PIC X(01) VALUE SPACES. 00650000 |
| 86 | 05 WS-INFILE-STATUS PIC X(02) VALUE SPACES. 00660000 |
| 87 | 05 WS-OUTFL1-STATUS PIC X(02) VALUE SPACES. 00670000 |
| 88 | 05 WS-OUTFL2-STATUS PIC X(02) VALUE SPACES. 00680000 |
| 89 | 05 WS-CUSTID-STATUS PIC X(02) VALUE SPACES. 00690000 |
| 90 | 88 END-OF-FILE VALUE '10'. 00700000 |
| 91 | * 00710000 |
| 92 | 05 WK-CHKPT-ID. 00720000 |
| 93 | 10 FILLER PIC X(04) VALUE 'RMAD'. 00730000 |
| 94 | 10 WK-CHKPT-ID-CTR PIC 9(04) VALUE ZEROES. 00740000 |
| 95 | * 00750000 |
| 96 | 01 WS-IMS-VARIABLES. 00760000 |
| 97 | * 05 PSB-NAME PIC X(8) VALUE 'IMSUNLOD'. 00770000 |
| 98 | * 05 PCB-OFFSET. 00780000 |
| 99 | * 10 PAUT-PCB-NUM PIC S9(4) COMP VALUE +2. 00790000 |
| 100 | 05 IMS-RETURN-CODE PIC X(02). 00800000 |
| 101 | 88 STATUS-OK VALUE ' ', 'FW'. 00810000 |
| 102 | 88 SEGMENT-NOT-FOUND VALUE 'GE'. 00820000 |
| 103 | 88 DUPLICATE-SEGMENT-FOUND VALUE 'II'. 00830000 |
| 104 | 88 WRONG-PARENTAGE VALUE 'GP'. 00840000 |
| 105 | 88 END-OF-DB VALUE 'GB'. 00850000 |
| 106 | 88 DATABASE-UNAVAILABLE VALUE 'BA'. 00860000 |
| 107 | 88 PSB-SCHEDULED-MORE-THAN-ONCE VALUE 'TC'. 00870000 |
| 108 | 88 COULD-NOT-SCHEDULE-PSB VALUE 'TE'. 00880000 |
| 109 | 88 RETRY-CONDITION VALUE 'BA', 'FH', 'TE'. 00890000 |
| 110 | 05 WS-IMS-PSB-SCHD-FLG PIC X(1). 00900000 |
| 111 | 88 IMS-PSB-SCHD VALUE 'Y'. 00910000 |
| 112 | 88 IMS-PSB-NOT-SCHD VALUE 'N'. 00920000 |
| 113 | 00930000 |
| 114 | * 00940000 |
| 115 | 01 ROOT-UNQUAL-SSA. 00950000 |
| 116 | 05 FILLER PIC X(08) VALUE 'PAUTSUM0'. 00960000 |
| 117 | 05 FILLER PIC X(01) VALUE ' '. 00970000 |
| 118 | * 00980000 |
| 119 | 01 CHILD-UNQUAL-SSA. 00990000 |
| 120 | 05 FILLER PIC X(08) VALUE 'PAUTDTL1'. 01000000 |
| 121 | 05 FILLER PIC X(01) VALUE ' '. 01010000 |
| 122 | * 01020000 |
| 123 | 01 PRM-INFO. 01030000 |
| 124 | 05 P-EXPIRY-DAYS PIC 9(02). 01040000 |
| 125 | 05 FILLER PIC X(01). 01050000 |
| 126 | 05 P-CHKP-FREQ PIC X(05). 01060000 |
| 127 | 05 FILLER PIC X(01). 01070000 |
| 128 | 05 P-CHKP-DIS-FREQ PIC X(05). 01080000 |
| 129 | 05 FILLER PIC X(01). 01090000 |
| 130 | 05 P-DEBUG-FLAG PIC X(01). 01100000 |
| 131 | 88 DEBUG-ON VALUE 'Y'. 01110000 |
| 132 | 88 DEBUG-OFF VALUE 'N'. 01120000 |
| 133 | 05 FILLER PIC X(01). 01130000 |
| 134 | * 01140000 |
| 135 | * 01150000 |
| 136 | COPY IMSFUNCS. 01160000 |
| 137 | *----------------------------------------------------------------*01170000 |
| 138 | * IMS SEGMENT LAYOUT 01180000 |
| 139 | *----------------------------------------------------------------*01190000 |
| 140 | 01200000 |
| 141 | *- PENDING AUTHORIZATION SUMMARY SEGMENT - ROOT 01210000 |
| 142 | 01 PENDING-AUTH-SUMMARY. 01220000 |
| 143 | COPY CIPAUSMY. 01230000 |
| 144 | 01240000 |
| 145 | *- PENDING AUTHORIZATION DETAILS SEGMENT - CHILD 01250000 |
| 146 | 01 PENDING-AUTH-DETAILS. 01260000 |
| 147 | COPY CIPAUDTY. 01270000 |
| 148 | 01280000 |
| 149 | * 01290000 |
| 150 | *----------------------------------------------------------------*01300000 |
| 151 | LINKAGE SECTION. 01310000 |
| 152 | *----------------------------------------------------------------*01320000 |
| 153 | * PCB MASKS FOLLOW 01330000 |
| 154 | COPY PAUTBPCB. 01340000 |
| 155 | COPY PASFLPCB. 01341000 |
| 156 | COPY PADFLPCB. 01342000 |
| 157 | * 01350000 |
| 158 | *----------------------------------------------------------------*01360000 |
| 159 | PROCEDURE DIVISION USING PAUTBPCB 01370000 |
| 160 | PASFLPCB 01380000 |
| 161 | PADFLPCB. 01381000 |
| 162 | *----------------------------------------------------------------*01390000 |
| 163 | * 01400000 |
| 164 | MAIN-PARA. 01410000 |
| 165 | ENTRY 'DLITCBL' USING PAUTBPCB 01420000 |
| 166 | PASFLPCB 01421000 |
| 167 | PADFLPCB. 01422000 |
| 168 | 01430000 |
| 169 | * 01440000 |
| 170 | PERFORM 1000-INITIALIZE THRU 1000-EXIT 01450000 |
| 171 | * 01460000 |
| 172 | PERFORM 2000-FIND-NEXT-AUTH-SUMMARY THRU 2000-EXIT 01470000 |
| 173 | UNTIL WS-END-OF-ROOT-SEG = 'Y' 01480000 |
| 174 | 01490000 |
| 175 | PERFORM 4000-FILE-CLOSE THRU 4000-EXIT 01500000 |
| 176 | * 01510000 |
| 177 | * 01520000 |
| 178 | * 01530000 |
| 179 | GOBACK. 01540000 |
| 180 | * 01550000 |
| 181 | *----------------------------------------------------------------*01560000 |
| 182 | 1000-INITIALIZE. 01570000 |
| 183 | *----------------------------------------------------------------*01580000 |
| 184 | * 01590000 |
| 185 | ACCEPT CURRENT-DATE FROM DATE 01600000 |
| 186 | ACCEPT CURRENT-YYDDD FROM DAY 01610000 |
| 187 | 01620000 |
| 188 | * ACCEPT PRM-INFO FROM SYSIN 01630000 |
| 189 | DISPLAY 'STARTING PROGRAM DBUNLDGS::' 01640000 |
| 190 | DISPLAY '*-------------------------------------*' 01650000 |
| 191 | DISPLAY 'TODAYS DATE :' CURRENT-DATE 01660000 |
| 192 | DISPLAY ' ' 01670000 |
| 193 | 01680000 |
| 194 | . 01690000 |
| 195 | * OPEN OUTPUT OPFILE1 01700000 |
| 196 | * IF WS-OUTFL1-STATUS = SPACES OR '00' 01710000 |
| 197 | * CONTINUE 01720000 |
| 198 | * ELSE 01730000 |
| 199 | * DISPLAY 'ERROR IN OPENING OPFILE1:' WS-OUTFL1-STATUS 01740000 |
| 200 | * PERFORM 9999-ABEND 01750000 |
| 201 | * END-IF 01760000 |
| 202 | * 01770000 |
| 203 | * OPEN OUTPUT OPFILE2 01780000 |
| 204 | * IF WS-OUTFL2-STATUS = SPACES OR '00' 01790000 |
| 205 | * CONTINUE 01800000 |
| 206 | * ELSE 01810000 |
| 207 | * DISPLAY 'ERROR IN OPENING OPFILE2:' WS-OUTFL2-STATUS 01820000 |
| 208 | * PERFORM 9999-ABEND 01830000 |
| 209 | * END-IF. 01840000 |
| 210 | * 01850000 |
| 211 | * 01860000 |
| 212 | 1000-EXIT. 01870000 |
| 213 | EXIT. 01880000 |
| 214 | * 01890000 |
| 215 | *----------------------------------------------------------------*01900000 |
| 216 | 2000-FIND-NEXT-AUTH-SUMMARY. 01910000 |
| 217 | *----------------------------------------------------------------*01920000 |
| 218 | * 01930000 |
| 219 | * DISPLAY 'IN 2000 READ ROOT SEGMENT PARA' 01940002 |
| 220 | * PAUT-PCB-STATUS 01950000 |
| 221 | INITIALIZE PAUT-PCB-STATUS 01960000 |
| 222 | CALL 'CBLTDLI' USING FUNC-GN 01970000 |
| 223 | PAUTBPCB 01980000 |
| 224 | PENDING-AUTH-SUMMARY 01990000 |
| 225 | ROOT-UNQUAL-SSA. 02000000 |
| 226 | * DISPLAY ' *******************************' 02010002 |
| 227 | * DISPLAY ' AFTER THE ROOT SEG IMS CALL ' 02020002 |
| 228 | * DISPLAY 'SEG LEVEL: ' PAUT-SEG-LEVEL 02030002 |
| 229 | * DISPLAY 'PCB STATU: ' PAUT-PCB-STATUS 02040002 |
| 230 | * DISPLAY 'SEG NAME : ' PAUT-SEG-NAME 02050002 |
| 231 | * DISPLAY ' *******************************' 02060000 |
| 232 | IF PAUT-PCB-STATUS = SPACES 02070000 |
| 233 | * SET NOT-END-OF-AUTHDB TO TRUE 02080000 |
| 234 | ADD 1 TO WS-NO-SUMRY-READ 02090000 |
| 235 | ADD 1 TO WS-AUTH-SMRY-PROC-CNT 02100000 |
| 236 | MOVE PENDING-AUTH-SUMMARY TO OPFIL1-REC 02110000 |
| 237 | INITIALIZE ROOT-SEG-KEY 02120000 |
| 238 | INITIALIZE CHILD-SEG-REC 02130000 |
| 239 | MOVE PA-ACCT-ID TO ROOT-SEG-KEY 02140000 |
| 240 | * DISPLAY 'WRITING FIRST FILE' 02150000 |
| 241 | IF PA-ACCT-ID IS NUMERIC 02160000 |
| 242 | * WRITE OPFIL1-REC 02170000 |
| 243 | PERFORM 3100-INSERT-PARENT-SEG-GSAM THRU 3100-EXIT 02171000 |
| 244 | INITIALIZE WS-END-OF-CHILD-SEG 02180000 |
| 245 | PERFORM 3000-FIND-NEXT-AUTH-DTL THRU 3000-EXIT 02190000 |
| 246 | UNTIL WS-END-OF-CHILD-SEG='Y' 02200000 |
| 247 | END-IF 02210000 |
| 248 | END-IF 02220000 |
| 249 | IF PAUT-PCB-STATUS = 'GB' 02230000 |
| 250 | SET END-OF-AUTHDB TO TRUE 02240000 |
| 251 | MOVE 'Y' TO WS-END-OF-ROOT-SEG 02250000 |
| 252 | END-IF 02260000 |
| 253 | IF PAUT-PCB-STATUS NOT EQUAL TO SPACES AND 'GB' 02270000 |
| 254 | DISPLAY 'AUTH SUM GN FAILED :' PAUT-PCB-STATUS 02280000 |
| 255 | DISPLAY 'KEY FEEDBACK AREA :' PAUT-KEYFB 02290000 |
| 256 | PERFORM 9999-ABEND 02300000 |
| 257 | . 02310000 |
| 258 | 2000-EXIT. 02320000 |
| 259 | EXIT. 02330000 |
| 260 | * 02340000 |
| 261 | * 02350000 |
| 262 | *----------------------------------------------------------------*02360000 |
| 263 | 3000-FIND-NEXT-AUTH-DTL. 02370000 |
| 264 | *----------------------------------------------------------------*02380000 |
| 265 | * 02390000 |
| 266 | * DISPLAY 'IN 3000 READ CHILD SEGMENT PARA' 02400002 |
| 267 | CALL 'CBLTDLI' USING FUNC-GNP 02410000 |
| 268 | PAUTBPCB 02420000 |
| 269 | PENDING-AUTH-DETAILS 02430000 |
| 270 | CHILD-UNQUAL-SSA. 02440000 |
| 271 | * DISPLAY '***************************' 02450002 |
| 272 | * DISPLAY ' AFTER CHILD SEG IMS CALL ' 02460002 |
| 273 | * DISPLAY 'PCB STATU: ' PAUT-PCB-STATUS 02470002 |
| 274 | * DISPLAY 'SEG NAME : ' PAUT-SEG-NAME 02480002 |
| 275 | * DISPLAY '***************************' 02490002 |
| 276 | IF PAUT-PCB-STATUS = SPACES 02500000 |
| 277 | SET MORE-AUTHS TO TRUE 02510000 |
| 278 | ADD 1 TO WS-NO-SUMRY-READ 02520000 |
| 279 | ADD 1 TO WS-AUTH-SMRY-PROC-CNT 02530000 |
| 280 | MOVE PENDING-AUTH-DETAILS TO CHILD-SEG-REC 02540000 |
| 281 | * WRITE OPFIL2-REC 02550000 |
| 282 | PERFORM 3200-INSERT-CHILD-SEG-GSAM THRU 3200-EXIT 02551000 |
| 283 | END-IF 02560000 |
| 284 | IF PAUT-PCB-STATUS = 'GE' 02570000 |
| 285 | * SET NO-MORE-AUTHS TO TRUE 02580000 |
| 286 | MOVE 'Y' TO WS-END-OF-CHILD-SEG 02590000 |
| 287 | DISPLAY 'CHILD SEG FLAG GE : ' 02600000 |
| 288 | WS-END-OF-CHILD-SEG 02610000 |
| 289 | END-IF 02620000 |
| 290 | IF PAUT-PCB-STATUS NOT EQUAL TO SPACES AND 'GE' 02630000 |
| 291 | DISPLAY 'GNP CALL FAILED :' PAUT-PCB-STATUS 02640000 |
| 292 | DISPLAY 'KFB AREA IN CHILD:' PAUT-KEYFB 02650000 |
| 293 | PERFORM 9999-ABEND 02660000 |
| 294 | END-IF. 02670000 |
| 295 | INITIALIZE PAUT-PCB-STATUS. 02680000 |
| 296 | 3000-EXIT. 02690000 |
| 297 | EXIT. 02700000 |
| 298 | * 02710000 |
| 299 | *----------------------------------------------------------------*02710100 |
| 300 | 3100-INSERT-PARENT-SEG-GSAM. 02710200 |
| 301 | * DISPLAY 'IN 3100 INSERT-PARENT-SEG-GSAM' 02710302 |
| 302 | CALL 'CBLTDLI' USING FUNC-ISRT 02710400 |
| 303 | PASFLPCB 02710500 |
| 304 | PENDING-AUTH-SUMMARY. 02710600 |
| 305 | * DISPLAY '***************************' 02710802 |
| 306 | * DISPLAY ' AFTER PARENT GSAM IMS CALL' 02710902 |
| 307 | * DISPLAY ' PASFL-DBDNAME : ' PASFL-DBDNAME 02711002 |
| 308 | * DISPLAY ' PASFL-PCB-PROCOPT : ' PASFL-PCB-PROCOPT 02711102 |
| 309 | * DISPLAY 'PCB STATUS: ' PASFL-PCB-STATUS 02711202 |
| 310 | * DISPLAY '***************************' 02711302 |
| 311 | IF PASFL-PCB-STATUS NOT EQUAL TO SPACES 02711401 |
| 312 | DISPLAY 'GSAM PARENT FAIL :' PASFL-PCB-STATUS 02711501 |
| 313 | DISPLAY 'KFB AREA IN GSAM:' PASFL-KEYFB 02711601 |
| 314 | PERFORM 9999-ABEND 02711701 |
| 315 | END-IF. 02711801 |
| 316 | 3100-EXIT. 02712000 |
| 317 | EXIT. 02713000 |
| 318 | *----------------------------------------------------------------*02720000 |
| 319 | 3200-INSERT-CHILD-SEG-GSAM. 02721000 |
| 320 | * DISPLAY 'IN 3200 INSERT-CHILD-SEG-GSAM' 02721102 |
| 321 | CALL 'CBLTDLI' USING FUNC-ISRT 02721200 |
| 322 | PADFLPCB 02721300 |
| 323 | PENDING-AUTH-DETAILS. 02721400 |
| 324 | * DISPLAY '***************************' 02721502 |
| 325 | * DISPLAY ' AFTER CHILD GSAM IMS CALL' 02721602 |
| 326 | * DISPLAY 'PADFL-DBDNAME : ' PADFL-DBDNAME 02721702 |
| 327 | * DISPLAY 'PCB STATUS: ' PADFL-PCB-STATUS 02721802 |
| 328 | * DISPLAY 'PADFL-PCB-PROCOPT : ' PADFL-PCB-PROCOPT 02721902 |
| 329 | * DISPLAY '***************************' 02722002 |
| 330 | IF PADFL-PCB-STATUS NOT EQUAL TO SPACES 02722101 |
| 331 | DISPLAY 'GSAM PARENT FAIL :' PADFL-PCB-STATUS 02722201 |
| 332 | DISPLAY 'KFB AREA IN GSAM:' PADFL-KEYFB 02722301 |
| 333 | PERFORM 9999-ABEND 02722401 |
| 334 | END-IF. 02722501 |
| 335 | 3200-EXIT. 02722601 |
| 336 | EXIT. 02723000 |
| 337 | *----------------------------------------------------------------*02724000 |
| 338 | 4000-FILE-CLOSE. 02730000 |
| 339 | DISPLAY 'CLOSING THE FILE'. 02740000 |
| 340 | * CLOSE OPFILE1. 02750000 |
| 341 | * 02760000 |
| 342 | * IF WS-OUTFL1-STATUS = SPACES OR '00' 02770000 |
| 343 | * CONTINUE 02780000 |
| 344 | * ELSE 02790000 |
| 345 | * DISPLAY 'ERROR IN CLOSING 1ST FILE:'WS-OUTFL1-STATUS 02800000 |
| 346 | * END-IF. 02810000 |
| 347 | * CLOSE OPFILE2. 02820000 |
| 348 | * 02830000 |
| 349 | * IF WS-OUTFL2-STATUS = SPACES OR '00' 02840000 |
| 350 | * CONTINUE 02850000 |
| 351 | * ELSE 02860000 |
| 352 | * DISPLAY 'ERROR IN CLOSING 2ND FILE:'WS-OUTFL2-STATUS 02870000 |
| 353 | * END-IF. 02880000 |
| 354 | 4000-EXIT. 02890000 |
| 355 | EXIT. 02900000 |
| 356 | *----------------------------------------------------------------*02910000 |
| 357 | 9999-ABEND. 02920000 |
| 358 | *----------------------------------------------------------------*02930000 |
| 359 | * 02940000 |
| 360 | DISPLAY 'DBUNLDGS ABENDING ...' 02950000 |
| 361 | 02960000 |
| 362 | MOVE 16 TO RETURN-CODE 02970000 |
| 363 | GOBACK. 02980000 |
| 364 | * 02990000 |
| 365 | 9999-EXIT. 03000000 |
| 366 | EXIT. 03010000 |