| 1 | ****************************************************************** |
| 2 | * Program : COPAUS1C.CBL |
| 3 | * Application : CardDemo - Authorization Module |
| 4 | * Type : CICS COBOL IMS BMS Program |
| 5 | * Function : Detail View of Authorization Message |
| 6 | ****************************************************************** |
| 7 | * Copyright Amazon.com, Inc. or its affiliates. |
| 8 | * All Rights Reserved. |
| 9 | * |
| 10 | * Licensed under the Apache License, Version 2.0 (the "License"). |
| 11 | * You may not use this file except in compliance with the License. |
| 12 | * You may obtain a copy of the License at |
| 13 | * |
| 14 | * http://www.apache.org/licenses/LICENSE-2.0 |
| 15 | * |
| 16 | * Unless required by applicable law or agreed to in writing, |
| 17 | * software distributed under the License is distributed on an |
| 18 | * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, |
| 19 | * either express or implied. See the License for the specific |
| 20 | * language governing permissions and limitations under the License |
| 21 | ****************************************************************** |
| 22 | IDENTIFICATION DIVISION. |
| 23 | PROGRAM-ID. COPAUS1C. |
| 24 | AUTHOR. AWS. |
| 25 | |
| 26 | ENVIRONMENT DIVISION. |
| 27 | CONFIGURATION SECTION. |
| 28 | |
| 29 | DATA DIVISION. |
| 30 | WORKING-STORAGE SECTION. |
| 31 | |
| 32 | 01 WS-VARIABLES. |
| 33 | 05 WS-PGM-AUTH-DTL PIC X(08) VALUE 'COPAUS1C'. |
| 34 | 05 WS-PGM-AUTH-SMRY PIC X(08) VALUE 'COPAUS0C'. |
| 35 | 05 WS-PGM-AUTH-FRAUD PIC X(08) VALUE 'COPAUS2C'. |
| 36 | 05 WS-CICS-TRANID PIC X(04) VALUE 'CPVD'. |
| 37 | 05 WS-MESSAGE PIC X(80) VALUE SPACES. |
| 38 | 05 WS-ERR-FLG PIC X(01) VALUE 'N'. |
| 39 | 88 ERR-FLG-ON VALUE 'Y'. |
| 40 | 88 ERR-FLG-OFF VALUE 'N'. |
| 41 | 05 WS-AUTHS-EOF PIC X(01) VALUE 'N'. |
| 42 | 88 AUTHS-EOF VALUE 'Y'. |
| 43 | 88 AUTHS-NOT-EOF VALUE 'N'. |
| 44 | 05 WS-SEND-ERASE-FLG PIC X(01) VALUE 'Y'. |
| 45 | 88 SEND-ERASE-YES VALUE 'Y'. |
| 46 | 88 SEND-ERASE-NO VALUE 'N'. |
| 47 | 05 WS-RESP-CD PIC S9(09) COMP VALUE ZEROS. |
| 48 | 05 WS-REAS-CD PIC S9(09) COMP VALUE ZEROS. |
| 49 | |
| 50 | 05 WS-ACCT-ID PIC 9(11). |
| 51 | 05 WS-AUTH-KEY PIC X(08). |
| 52 | 05 WS-AUTH-AMT PIC -zzzzzzz9.99. |
| 53 | 05 WS-AUTH-DATE PIC X(08) VALUE '00/00/00'. |
| 54 | 05 WS-AUTH-TIME PIC X(08) VALUE '00:00:00'. |
| 55 | |
| 56 | 01 WS-TABLES. |
| 57 | 05 WS-DECLINE-REASON-TABLE. |
| 58 | 10 PIC X(20) VALUE '0000APPROVED'. |
| 59 | 10 PIC X(20) VALUE '3100INVALID CARD'. |
| 60 | 10 PIC X(20) VALUE '4100INSUFFICNT FUND'. |
| 61 | 10 PIC X(20) VALUE '4200CARD NOT ACTIVE'. |
| 62 | 10 PIC X(20) VALUE '4300ACCOUNT CLOSED'. |
| 63 | 10 PIC X(20) VALUE '4400EXCED DAILY LMT'. |
| 64 | 10 PIC X(20) VALUE '5100CARD FRAUD'. |
| 65 | 10 PIC X(20) VALUE '5200MERCHANT FRAUD'. |
| 66 | 10 PIC X(20) VALUE '5300LOST CARD'. |
| 67 | 10 PIC X(20) VALUE '9000UNKNOWN'. |
| 68 | 05 WS-DECLINE-REASON-TAB REDEFINES WS-DECLINE-REASON-TABLE |
| 69 | OCCURS 10 TIMES |
| 70 | ASCENDING KEY IS DECL-CODE |
| 71 | INDEXED BY WS-DECL-RSN-IDX. |
| 72 | 10 DECL-CODE PIC X(4). |
| 73 | 10 DECL-DESC PIC X(16). |
| 74 | |
| 75 | 01 WS-IMS-VARIABLES. |
| 76 | 05 PSB-NAME PIC X(8) VALUE 'PSBPAUTB'. |
| 77 | 05 PCB-OFFSET. |
| 78 | 10 PAUT-PCB-NUM PIC S9(4) COMP VALUE +1. |
| 79 | 05 IMS-RETURN-CODE PIC X(02). |
| 80 | 88 STATUS-OK VALUE ' ', 'FW'. |
| 81 | 88 SEGMENT-NOT-FOUND VALUE 'GE'. |
| 82 | 88 DUPLICATE-SEGMENT-FOUND VALUE 'II'. |
| 83 | 88 WRONG-PARENTAGE VALUE 'GP'. |
| 84 | 88 END-OF-DB VALUE 'GB'. |
| 85 | 88 DATABASE-UNAVAILABLE VALUE 'BA'. |
| 86 | 88 PSB-SCHEDULED-MORE-THAN-ONCE VALUE 'TC'. |
| 87 | 88 COULD-NOT-SCHEDULE-PSB VALUE 'TE'. |
| 88 | 88 RETRY-CONDITION VALUE 'BA', 'FH', 'TE'. |
| 89 | 05 WS-IMS-PSB-SCHD-FLG PIC X(1). |
| 90 | 88 IMS-PSB-SCHD VALUE 'Y'. |
| 91 | 88 IMS-PSB-NOT-SCHD VALUE 'N'. |
| 92 | |
| 93 | 01 WS-FRAUD-DATA. |
| 94 | 02 WS-FRD-ACCT-ID PIC 9(11). |
| 95 | 02 WS-FRD-CUST-ID PIC 9(9). |
| 96 | 02 WS-FRAUD-AUTH-RECORD PIC X(200). |
| 97 | 02 WS-FRAUD-STATUS-RECORD. |
| 98 | 05 WS-FRD-ACTION PIC X(01). |
| 99 | 88 WS-REPORT-FRAUD VALUE 'F'. |
| 100 | 88 WS-REMOVE-FRAUD VALUE 'R'. |
| 101 | 05 WS-FRD-UPDATE-STATUS PIC X(01). |
| 102 | 88 WS-FRD-UPDT-SUCCESS VALUE 'S'. |
| 103 | 88 WS-FRD-UPDT-FAILED VALUE 'F'. |
| 104 | 05 WS-FRD-ACT-MSG PIC X(50). |
| 105 | |
| 106 | |
| 107 | |
| 108 | |
| 109 | COPY COCOM01Y. |
| 110 | 05 CDEMO-CPVD-INFO. |
| 111 | 10 CDEMO-CPVD-PAU-SEL-FLG PIC X(01). |
| 112 | 10 CDEMO-CPVD-PAU-SELECTED PIC X(08). |
| 113 | 10 CDEMO-CPVD-PAUKEY-PREV-PG PIC X(08) OCCURS 20 TIMES. |
| 114 | 10 CDEMO-CPVD-PAUKEY-LAST PIC X(08). |
| 115 | 10 CDEMO-CPVD-PAGE-NUM PIC S9(04) COMP. |
| 116 | 10 CDEMO-CPVD-NEXT-PAGE-FLG PIC X(01) VALUE 'N'. |
| 117 | 88 NEXT-PAGE-YES VALUE 'Y'. |
| 118 | 88 NEXT-PAGE-NO VALUE 'N'. |
| 119 | 10 CDEMO-CPVD-AUTH-KEYS PIC X(08) OCCURS 5 TIMES. |
| 120 | 10 CDEMO-CPVD-FRAUD-DATA PIC X(100). |
| 121 | |
| 122 | COPY COPAU01. |
| 123 | |
| 124 | |
| 125 | *Screen Titles |
| 126 | COPY COTTL01Y. |
| 127 | |
| 128 | *Current Date |
| 129 | COPY CSDAT01Y. |
| 130 | |
| 131 | *Common Messages |
| 132 | COPY CSMSG01Y. |
| 133 | |
| 134 | *Abend Variables |
| 135 | COPY CSMSG02Y. |
| 136 | |
| 137 | *----------------------------------------------------------------* |
| 138 | * IMS SEGMENT LAYOUT |
| 139 | *----------------------------------------------------------------* |
| 140 | *- PENDING AUTHORIZATION SUMMARY SEGMENT - ROOT |
| 141 | 01 PENDING-AUTH-SUMMARY. |
| 142 | COPY CIPAUSMY. |
| 143 | |
| 144 | *- PENDING AUTHORIZATION DETAILS SEGMENT - CHILD |
| 145 | 01 PENDING-AUTH-DETAILS. |
| 146 | COPY CIPAUDTY. |
| 147 | |
| 148 | COPY DFHAID. |
| 149 | COPY DFHBMSCA. |
| 150 | |
| 151 | LINKAGE SECTION. |
| 152 | 01 DFHCOMMAREA. |
| 153 | 05 LK-COMMAREA PIC X(01) |
| 154 | OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN. |
| 155 | |
| 156 | PROCEDURE DIVISION. |
| 157 | MAIN-PARA. |
| 158 | |
| 159 | SET ERR-FLG-OFF TO TRUE |
| 160 | SET SEND-ERASE-YES TO TRUE |
| 161 | |
| 162 | MOVE SPACES TO WS-MESSAGE |
| 163 | ERRMSGO OF COPAU1AO |
| 164 | |
| 165 | IF EIBCALEN = 0 |
| 166 | INITIALIZE CARDDEMO-COMMAREA |
| 167 | |
| 168 | MOVE WS-PGM-AUTH-SMRY TO CDEMO-TO-PROGRAM |
| 169 | PERFORM RETURN-TO-PREV-SCREEN |
| 170 | ELSE |
| 171 | MOVE DFHCOMMAREA(1:EIBCALEN) TO CARDDEMO-COMMAREA |
| 172 | MOVE SPACES TO CDEMO-CPVD-FRAUD-DATA |
| 173 | IF NOT CDEMO-PGM-REENTER |
| 174 | SET CDEMO-PGM-REENTER TO TRUE |
| 175 | PERFORM PROCESS-ENTER-KEY |
| 176 | |
| 177 | PERFORM SEND-AUTHVIEW-SCREEN |
| 178 | ELSE |
| 179 | PERFORM RECEIVE-AUTHVIEW-SCREEN |
| 180 | EVALUATE EIBAID |
| 181 | WHEN DFHENTER |
| 182 | PERFORM PROCESS-ENTER-KEY |
| 183 | PERFORM SEND-AUTHVIEW-SCREEN |
| 184 | WHEN DFHPF3 |
| 185 | MOVE WS-PGM-AUTH-SMRY TO CDEMO-TO-PROGRAM |
| 186 | PERFORM RETURN-TO-PREV-SCREEN |
| 187 | WHEN DFHPF5 |
| 188 | PERFORM MARK-AUTH-FRAUD |
| 189 | PERFORM SEND-AUTHVIEW-SCREEN |
| 190 | WHEN DFHPF8 |
| 191 | PERFORM PROCESS-PF8-KEY |
| 192 | PERFORM SEND-AUTHVIEW-SCREEN |
| 193 | WHEN OTHER |
| 194 | PERFORM PROCESS-ENTER-KEY |
| 195 | |
| 196 | MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE |
| 197 | PERFORM SEND-AUTHVIEW-SCREEN |
| 198 | END-EVALUATE |
| 199 | END-IF |
| 200 | END-IF |
| 201 | |
| 202 | EXEC CICS RETURN |
| 203 | TRANSID (WS-CICS-TRANID) |
| 204 | COMMAREA (CARDDEMO-COMMAREA) |
| 205 | END-EXEC |
| 206 | . |
| 207 | |
| 208 | PROCESS-ENTER-KEY. |
| 209 | |
| 210 | MOVE LOW-VALUES TO COPAU1AO |
| 211 | IF CDEMO-ACCT-ID IS NUMERIC AND |
| 212 | CDEMO-CPVD-PAU-SELECTED NOT = SPACES AND LOW-VALUES |
| 213 | MOVE CDEMO-ACCT-ID TO WS-ACCT-ID |
| 214 | MOVE CDEMO-CPVD-PAU-SELECTED |
| 215 | TO WS-AUTH-KEY |
| 216 | PERFORM READ-AUTH-RECORD |
| 217 | |
| 218 | IF IMS-PSB-SCHD |
| 219 | SET IMS-PSB-NOT-SCHD TO TRUE |
| 220 | PERFORM TAKE-SYNCPOINT |
| 221 | END-IF |
| 222 | |
| 223 | ELSE |
| 224 | SET ERR-FLG-ON TO TRUE |
| 225 | END-IF |
| 226 | |
| 227 | PERFORM POPULATE-AUTH-DETAILS |
| 228 | . |
| 229 | |
| 230 | MARK-AUTH-FRAUD. |
| 231 | MOVE CDEMO-ACCT-ID TO WS-ACCT-ID |
| 232 | MOVE CDEMO-CPVD-PAU-SELECTED TO WS-AUTH-KEY |
| 233 | |
| 234 | PERFORM READ-AUTH-RECORD |
| 235 | |
| 236 | IF PA-FRAUD-CONFIRMED |
| 237 | SET PA-FRAUD-REMOVED TO TRUE |
| 238 | SET WS-REMOVE-FRAUD TO TRUE |
| 239 | ELSE |
| 240 | SET PA-FRAUD-CONFIRMED TO TRUE |
| 241 | SET WS-REPORT-FRAUD TO TRUE |
| 242 | END-IF |
| 243 | |
| 244 | MOVE PENDING-AUTH-DETAILS TO WS-FRAUD-AUTH-RECORD |
| 245 | MOVE CDEMO-ACCT-ID TO WS-FRD-ACCT-ID |
| 246 | MOVE CDEMO-CUST-ID TO WS-FRD-CUST-ID |
| 247 | |
| 248 | EXEC CICS LINK |
| 249 | PROGRAM(WS-PGM-AUTH-FRAUD) |
| 250 | COMMAREA(WS-FRAUD-DATA) |
| 251 | NOHANDLE |
| 252 | END-EXEC |
| 253 | IF EIBRESP = DFHRESP(NORMAL) |
| 254 | IF WS-FRD-UPDT-SUCCESS |
| 255 | PERFORM UPDATE-AUTH-DETAILS |
| 256 | ELSE |
| 257 | MOVE WS-FRD-ACT-MSG TO WS-MESSAGE |
| 258 | PERFORM ROLL-BACK |
| 259 | END-IF |
| 260 | ELSE |
| 261 | PERFORM ROLL-BACK |
| 262 | END-IF |
| 263 | |
| 264 | MOVE PA-AUTHORIZATION-KEY TO CDEMO-CPVD-PAU-SELECTED |
| 265 | PERFORM POPULATE-AUTH-DETAILS |
| 266 | . |
| 267 | |
| 268 | PROCESS-PF8-KEY. |
| 269 | |
| 270 | MOVE CDEMO-ACCT-ID TO WS-ACCT-ID |
| 271 | MOVE CDEMO-CPVD-PAU-SELECTED TO WS-AUTH-KEY |
| 272 | |
| 273 | PERFORM READ-AUTH-RECORD |
| 274 | PERFORM READ-NEXT-AUTH-RECORD |
| 275 | |
| 276 | IF IMS-PSB-SCHD |
| 277 | SET IMS-PSB-NOT-SCHD TO TRUE |
| 278 | PERFORM TAKE-SYNCPOINT |
| 279 | END-IF |
| 280 | |
| 281 | IF AUTHS-EOF |
| 282 | SET SEND-ERASE-NO TO TRUE |
| 283 | MOVE 'Already at the last Authorization...' |
| 284 | TO WS-MESSAGE |
| 285 | ELSE |
| 286 | MOVE PA-AUTHORIZATION-KEY TO CDEMO-CPVD-PAU-SELECTED |
| 287 | PERFORM POPULATE-AUTH-DETAILS |
| 288 | END-IF |
| 289 | . |
| 290 | |
| 291 | POPULATE-AUTH-DETAILS. |
| 292 | |
| 293 | |
| 294 | IF ERR-FLG-OFF |
| 295 | MOVE PA-CARD-NUM TO CARDNUMO |
| 296 | |
| 297 | MOVE PA-AUTH-ORIG-DATE(1:2) TO WS-CURDATE-YY |
| 298 | MOVE PA-AUTH-ORIG-DATE(3:2) TO WS-CURDATE-MM |
| 299 | MOVE PA-AUTH-ORIG-DATE(5:2) TO WS-CURDATE-DD |
| 300 | MOVE WS-CURDATE-MM-DD-YY TO WS-AUTH-DATE |
| 301 | MOVE WS-AUTH-DATE TO AUTHDTO |
| 302 | |
| 303 | MOVE PA-AUTH-ORIG-TIME(1:2) TO WS-AUTH-TIME(1:2) |
| 304 | MOVE PA-AUTH-ORIG-TIME(3:2) TO WS-AUTH-TIME(4:2) |
| 305 | MOVE PA-AUTH-ORIG-TIME(5:2) TO WS-AUTH-TIME(7:2) |
| 306 | MOVE WS-AUTH-TIME TO AUTHTMO |
| 307 | |
| 308 | MOVE PA-APPROVED-AMT TO WS-AUTH-AMT |
| 309 | MOVE WS-AUTH-AMT TO AUTHAMTO |
| 310 | |
| 311 | IF PA-AUTH-RESP-CODE = '00' |
| 312 | MOVE 'A' TO AUTHRSPO |
| 313 | MOVE DFHGREEN TO AUTHRSPC |
| 314 | ELSE |
| 315 | MOVE 'D' TO AUTHRSPO |
| 316 | MOVE DFHRED TO AUTHRSPC |
| 317 | END-IF |
| 318 | |
| 319 | SEARCH ALL WS-DECLINE-REASON-TAB |
| 320 | AT END |
| 321 | MOVE '9999' TO AUTHRSNO |
| 322 | MOVE '-' TO AUTHRSNO(5:1) |
| 323 | MOVE 'ERROR' TO AUTHRSNO(6:) |
| 324 | WHEN DECL-CODE(WS-DECL-RSN-IDX) = PA-AUTH-RESP-REASON |
| 325 | MOVE PA-AUTH-RESP-REASON TO AUTHRSNO |
| 326 | MOVE '-' TO AUTHRSNO(5:1) |
| 327 | MOVE DECL-DESC(WS-DECL-RSN-IDX) TO AUTHRSNO(6:) |
| 328 | END-SEARCH |
| 329 | |
| 330 | |
| 331 | MOVE PA-PROCESSING-CODE TO AUTHCDO |
| 332 | MOVE PA-POS-ENTRY-MODE TO POSEMDO |
| 333 | MOVE PA-MESSAGE-SOURCE TO AUTHSRCO |
| 334 | MOVE PA-MERCHANT-CATAGORY-CODE TO MCCCDO |
| 335 | |
| 336 | MOVE PA-CARD-EXPIRY-DATE(1:2) TO CRDEXPO(1:2) |
| 337 | MOVE '/' TO CRDEXPO(3:1) |
| 338 | MOVE PA-CARD-EXPIRY-DATE(3:2) TO CRDEXPO(4:2) |
| 339 | |
| 340 | MOVE PA-AUTH-TYPE TO AUTHTYPO |
| 341 | MOVE PA-TRANSACTION-ID TO TRNIDO |
| 342 | MOVE PA-MATCH-STATUS TO AUTHMTCO |
| 343 | |
| 344 | IF PA-FRAUD-CONFIRMED OR PA-FRAUD-REMOVED |
| 345 | MOVE PA-AUTH-FRAUD TO AUTHFRDO(1:1) |
| 346 | MOVE '-' TO AUTHFRDO(2:1) |
| 347 | MOVE PA-FRAUD-RPT-DATE TO AUTHFRDO(3:) |
| 348 | ELSE |
| 349 | MOVE '-' TO AUTHFRDO |
| 350 | END-IF |
| 351 | |
| 352 | MOVE PA-MERCHANT-NAME TO MERNAMEO |
| 353 | MOVE PA-MERCHANT-ID TO MERIDO |
| 354 | MOVE PA-MERCHANT-CITY TO MERCITYO |
| 355 | MOVE PA-MERCHANT-STATE TO MERSTO |
| 356 | MOVE PA-MERCHANT-ZIP TO MERZIPO |
| 357 | END-IF |
| 358 | . |
| 359 | |
| 360 | RETURN-TO-PREV-SCREEN. |
| 361 | |
| 362 | MOVE WS-CICS-TRANID TO CDEMO-FROM-TRANID |
| 363 | MOVE WS-PGM-AUTH-DTL TO CDEMO-FROM-PROGRAM |
| 364 | MOVE ZEROS TO CDEMO-PGM-CONTEXT |
| 365 | SET CDEMO-PGM-ENTER TO TRUE |
| 366 | |
| 367 | EXEC CICS |
| 368 | XCTL PROGRAM(CDEMO-TO-PROGRAM) |
| 369 | COMMAREA(CARDDEMO-COMMAREA) |
| 370 | END-EXEC. |
| 371 | |
| 372 | |
| 373 | SEND-AUTHVIEW-SCREEN. |
| 374 | |
| 375 | PERFORM POPULATE-HEADER-INFO |
| 376 | |
| 377 | MOVE WS-MESSAGE TO ERRMSGO OF COPAU1AO |
| 378 | MOVE -1 TO CARDNUML |
| 379 | |
| 380 | IF SEND-ERASE-YES |
| 381 | EXEC CICS SEND |
| 382 | MAP('COPAU1A') |
| 383 | MAPSET('COPAU01') |
| 384 | FROM(COPAU1AO) |
| 385 | ERASE |
| 386 | CURSOR |
| 387 | END-EXEC |
| 388 | ELSE |
| 389 | EXEC CICS SEND |
| 390 | MAP('COPAU1A') |
| 391 | MAPSET('COPAU01') |
| 392 | FROM(COPAU1AO) |
| 393 | CURSOR |
| 394 | END-EXEC |
| 395 | END-IF |
| 396 | . |
| 397 | |
| 398 | RECEIVE-AUTHVIEW-SCREEN. |
| 399 | |
| 400 | EXEC CICS RECEIVE |
| 401 | MAP('COPAU1A') |
| 402 | MAPSET('COPAU01') |
| 403 | INTO(COPAU1AI) |
| 404 | NOHANDLE |
| 405 | END-EXEC |
| 406 | . |
| 407 | |
| 408 | |
| 409 | POPULATE-HEADER-INFO. |
| 410 | |
| 411 | MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA |
| 412 | |
| 413 | MOVE CCDA-TITLE01 TO TITLE01O OF COPAU1AO |
| 414 | MOVE CCDA-TITLE02 TO TITLE02O OF COPAU1AO |
| 415 | MOVE WS-CICS-TRANID TO TRNNAMEO OF COPAU1AO |
| 416 | MOVE WS-PGM-AUTH-DTL TO PGMNAMEO OF COPAU1AO |
| 417 | |
| 418 | MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM |
| 419 | MOVE WS-CURDATE-DAY TO WS-CURDATE-DD |
| 420 | MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY |
| 421 | |
| 422 | MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF COPAU1AO |
| 423 | |
| 424 | MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH |
| 425 | MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM |
| 426 | MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS |
| 427 | |
| 428 | MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF COPAU1AO |
| 429 | . |
| 430 | |
| 431 | READ-AUTH-RECORD. |
| 432 | |
| 433 | PERFORM SCHEDULE-PSB |
| 434 | |
| 435 | |
| 436 | MOVE WS-ACCT-ID TO PA-ACCT-ID |
| 437 | MOVE WS-AUTH-KEY TO PA-AUTHORIZATION-KEY |
| 438 | |
| 439 | EXEC DLI GU USING PCB(PAUT-PCB-NUM) |
| 440 | SEGMENT (PAUTSUM0) |
| 441 | INTO (PENDING-AUTH-SUMMARY) |
| 442 | WHERE (ACCNTID = PA-ACCT-ID) |
| 443 | END-EXEC |
| 444 | |
| 445 | MOVE DIBSTAT TO IMS-RETURN-CODE |
| 446 | EVALUATE TRUE |
| 447 | WHEN STATUS-OK |
| 448 | SET AUTHS-NOT-EOF TO TRUE |
| 449 | WHEN SEGMENT-NOT-FOUND |
| 450 | WHEN END-OF-DB |
| 451 | SET AUTHS-EOF TO TRUE |
| 452 | WHEN OTHER |
| 453 | MOVE 'Y' TO WS-ERR-FLG |
| 454 | |
| 455 | STRING |
| 456 | ' System error while reading Auth Summary: Code:' |
| 457 | IMS-RETURN-CODE |
| 458 | DELIMITED BY SIZE |
| 459 | INTO WS-MESSAGE |
| 460 | END-STRING |
| 461 | PERFORM SEND-AUTHVIEW-SCREEN |
| 462 | END-EVALUATE |
| 463 | |
| 464 | IF AUTHS-NOT-EOF |
| 465 | EXEC DLI GNP USING PCB(PAUT-PCB-NUM) |
| 466 | SEGMENT (PAUTDTL1) |
| 467 | INTO (PENDING-AUTH-DETAILS) |
| 468 | WHERE (PAUT9CTS = PA-AUTHORIZATION-KEY) |
| 469 | END-EXEC |
| 470 | |
| 471 | MOVE DIBSTAT TO IMS-RETURN-CODE |
| 472 | EVALUATE TRUE |
| 473 | WHEN STATUS-OK |
| 474 | SET AUTHS-NOT-EOF TO TRUE |
| 475 | WHEN SEGMENT-NOT-FOUND |
| 476 | WHEN END-OF-DB |
| 477 | SET AUTHS-EOF TO TRUE |
| 478 | WHEN OTHER |
| 479 | MOVE 'Y' TO WS-ERR-FLG |
| 480 | |
| 481 | STRING |
| 482 | ' System error while reading Auth Details: Code:' |
| 483 | IMS-RETURN-CODE |
| 484 | DELIMITED BY SIZE |
| 485 | INTO WS-MESSAGE |
| 486 | END-STRING |
| 487 | PERFORM SEND-AUTHVIEW-SCREEN |
| 488 | END-EVALUATE |
| 489 | END-IF |
| 490 | |
| 491 | . |
| 492 | |
| 493 | READ-NEXT-AUTH-RECORD. |
| 494 | |
| 495 | EXEC DLI GNP USING PCB(PAUT-PCB-NUM) |
| 496 | SEGMENT (PAUTDTL1) |
| 497 | INTO (PENDING-AUTH-DETAILS) |
| 498 | END-EXEC |
| 499 | |
| 500 | MOVE DIBSTAT TO IMS-RETURN-CODE |
| 501 | EVALUATE TRUE |
| 502 | WHEN STATUS-OK |
| 503 | SET AUTHS-NOT-EOF TO TRUE |
| 504 | WHEN SEGMENT-NOT-FOUND |
| 505 | WHEN END-OF-DB |
| 506 | SET AUTHS-EOF TO TRUE |
| 507 | WHEN OTHER |
| 508 | MOVE 'Y' TO WS-ERR-FLG |
| 509 | |
| 510 | STRING |
| 511 | ' System error while reading next Auth: Code:' |
| 512 | IMS-RETURN-CODE |
| 513 | DELIMITED BY SIZE |
| 514 | INTO WS-MESSAGE |
| 515 | END-STRING |
| 516 | PERFORM SEND-AUTHVIEW-SCREEN |
| 517 | END-EVALUATE |
| 518 | . |
| 519 | |
| 520 | UPDATE-AUTH-DETAILS. |
| 521 | |
| 522 | MOVE WS-FRAUD-AUTH-RECORD TO PENDING-AUTH-DETAILS |
| 523 | DISPLAY 'RPT DT: ' PA-FRAUD-RPT-DATE |
| 524 | |
| 525 | EXEC DLI REPL USING PCB(PAUT-PCB-NUM) |
| 526 | SEGMENT (PAUTDTL1) |
| 527 | FROM (PENDING-AUTH-DETAILS) |
| 528 | END-EXEC |
| 529 | |
| 530 | MOVE DIBSTAT TO IMS-RETURN-CODE |
| 531 | EVALUATE TRUE |
| 532 | WHEN STATUS-OK |
| 533 | PERFORM TAKE-SYNCPOINT |
| 534 | IF PA-FRAUD-REMOVED |
| 535 | MOVE 'AUTH FRAUD REMOVED...' TO WS-MESSAGE |
| 536 | ELSE |
| 537 | MOVE 'AUTH MARKED FRAUD...' TO WS-MESSAGE |
| 538 | END-IF |
| 539 | WHEN OTHER |
| 540 | PERFORM ROLL-BACK |
| 541 | |
| 542 | MOVE 'Y' TO WS-ERR-FLG |
| 543 | |
| 544 | STRING |
| 545 | ' System error while FRAUD Tagging, ROLLBACK||' |
| 546 | IMS-RETURN-CODE |
| 547 | DELIMITED BY SIZE |
| 548 | INTO WS-MESSAGE |
| 549 | END-STRING |
| 550 | PERFORM SEND-AUTHVIEW-SCREEN |
| 551 | END-EVALUATE |
| 552 | . |
| 553 | |
| 554 | ***************************************************************** |
| 555 | * TAKE SYNCPOINT * |
| 556 | ***************************************************************** |
| 557 | TAKE-SYNCPOINT. |
| 558 | EXEC CICS SYNCPOINT |
| 559 | END-EXEC |
| 560 | . |
| 561 | |
| 562 | ***************************************************************** |
| 563 | * ROLLBACK THE DB CHANGES * |
| 564 | ***************************************************************** |
| 565 | ROLL-BACK. |
| 566 | EXEC CICS |
| 567 | SYNCPOINT ROLLBACK |
| 568 | END-EXEC |
| 569 | . |
| 570 | |
| 571 | ***************************************************************** |
| 572 | * SCHEDULE PSB * |
| 573 | ***************************************************************** |
| 574 | SCHEDULE-PSB. |
| 575 | EXEC DLI SCHD |
| 576 | PSB((PSB-NAME)) |
| 577 | NODHABEND |
| 578 | END-EXEC |
| 579 | MOVE DIBSTAT TO IMS-RETURN-CODE |
| 580 | IF PSB-SCHEDULED-MORE-THAN-ONCE |
| 581 | EXEC DLI TERM |
| 582 | END-EXEC |
| 583 | |
| 584 | EXEC DLI SCHD |
| 585 | PSB((PSB-NAME)) |
| 586 | NODHABEND |
| 587 | END-EXEC |
| 588 | MOVE DIBSTAT TO IMS-RETURN-CODE |
| 589 | END-IF |
| 590 | IF STATUS-OK |
| 591 | SET IMS-PSB-SCHD TO TRUE |
| 592 | ELSE |
| 593 | MOVE 'Y' TO WS-ERR-FLG |
| 594 | |
| 595 | STRING |
| 596 | ' System error while scheduling PSB: Code:' |
| 597 | IMS-RETURN-CODE |
| 598 | DELIMITED BY SIZE |
| 599 | INTO WS-MESSAGE |
| 600 | END-STRING |
| 601 | PERFORM SEND-AUTHVIEW-SCREEN |
| 602 | END-IF |
| 603 | . |
| 604 | |