| 1 | ****************************************************************** |
| 2 | * Program : COTRN02C.CBL |
| 3 | * Application : CardDemo |
| 4 | * Type : CICS COBOL Program |
| 5 | * Function : Add a new Transaction to TRANSACT file |
| 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. COTRN02C. |
| 24 | AUTHOR. AWS. |
| 25 | |
| 26 | ENVIRONMENT DIVISION. |
| 27 | CONFIGURATION SECTION. |
| 28 | |
| 29 | DATA DIVISION. |
| 30 | *----------------------------------------------------------------* |
| 31 | * WORKING STORAGE SECTION |
| 32 | *----------------------------------------------------------------* |
| 33 | WORKING-STORAGE SECTION. |
| 34 | |
| 35 | 01 WS-VARIABLES. |
| 36 | 05 WS-PGMNAME PIC X(08) VALUE 'COTRN02C'. |
| 37 | 05 WS-TRANID PIC X(04) VALUE 'CT02'. |
| 38 | 05 WS-MESSAGE PIC X(80) VALUE SPACES. |
| 39 | 05 WS-TRANSACT-FILE PIC X(08) VALUE 'TRANSACT'. |
| 40 | 05 WS-ACCTDAT-FILE PIC X(08) VALUE 'ACCTDAT '. |
| 41 | 05 WS-CCXREF-FILE PIC X(08) VALUE 'CCXREF '. |
| 42 | 05 WS-CXACAIX-FILE PIC X(08) VALUE 'CXACAIX '. |
| 43 | |
| 44 | 05 WS-ERR-FLG PIC X(01) VALUE 'N'. |
| 45 | 88 ERR-FLG-ON VALUE 'Y'. |
| 46 | 88 ERR-FLG-OFF 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 | 05 WS-USR-MODIFIED PIC X(01) VALUE 'N'. |
| 50 | 88 USR-MODIFIED-YES VALUE 'Y'. |
| 51 | 88 USR-MODIFIED-NO VALUE 'N'. |
| 52 | |
| 53 | 05 WS-TRAN-AMT PIC +99999999.99. |
| 54 | 05 WS-TRAN-DATE PIC X(08) VALUE '00/00/00'. |
| 55 | 05 WS-ACCT-ID-N PIC 9(11) VALUE 0. |
| 56 | 05 WS-CARD-NUM-N PIC 9(16) VALUE 0. |
| 57 | 05 WS-TRAN-ID-N PIC 9(16) VALUE ZEROS. |
| 58 | 05 WS-TRAN-AMT-N PIC S9(9)V99 VALUE ZERO. |
| 59 | 05 WS-TRAN-AMT-E PIC +99999999.99 VALUE ZEROS. |
| 60 | 05 WS-DATE-FORMAT PIC X(10) VALUE 'YYYY-MM-DD'. |
| 61 | |
| 62 | 01 CSUTLDTC-PARM. |
| 63 | 05 CSUTLDTC-DATE PIC X(10). |
| 64 | 05 CSUTLDTC-DATE-FORMAT PIC X(10). |
| 65 | 05 CSUTLDTC-RESULT. |
| 66 | 10 CSUTLDTC-RESULT-SEV-CD PIC X(04). |
| 67 | 10 FILLER PIC X(11). |
| 68 | 10 CSUTLDTC-RESULT-MSG-NUM PIC X(04). |
| 69 | 10 CSUTLDTC-RESULT-MSG PIC X(61). |
| 70 | |
| 71 | COPY COCOM01Y. |
| 72 | 05 CDEMO-CT02-INFO. |
| 73 | 10 CDEMO-CT02-TRNID-FIRST PIC X(16). |
| 74 | 10 CDEMO-CT02-TRNID-LAST PIC X(16). |
| 75 | 10 CDEMO-CT02-PAGE-NUM PIC 9(08). |
| 76 | 10 CDEMO-CT02-NEXT-PAGE-FLG PIC X(01) VALUE 'N'. |
| 77 | 88 NEXT-PAGE-YES VALUE 'Y'. |
| 78 | 88 NEXT-PAGE-NO VALUE 'N'. |
| 79 | 10 CDEMO-CT02-TRN-SEL-FLG PIC X(01). |
| 80 | 10 CDEMO-CT02-TRN-SELECTED PIC X(16). |
| 81 | |
| 82 | COPY COTRN02. |
| 83 | |
| 84 | COPY COTTL01Y. |
| 85 | COPY CSDAT01Y. |
| 86 | COPY CSMSG01Y. |
| 87 | |
| 88 | COPY CVTRA05Y. |
| 89 | COPY CVACT01Y. |
| 90 | COPY CVACT03Y. |
| 91 | |
| 92 | COPY DFHAID. |
| 93 | COPY DFHBMSCA. |
| 94 | |
| 95 | *----------------------------------------------------------------* |
| 96 | * LINKAGE SECTION |
| 97 | *----------------------------------------------------------------* |
| 98 | LINKAGE SECTION. |
| 99 | 01 DFHCOMMAREA. |
| 100 | 05 LK-COMMAREA PIC X(01) |
| 101 | OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN. |
| 102 | |
| 103 | *----------------------------------------------------------------* |
| 104 | * PROCEDURE DIVISION |
| 105 | *----------------------------------------------------------------* |
| 106 | PROCEDURE DIVISION. |
| 107 | MAIN-PARA. |
| 108 | |
| 109 | SET ERR-FLG-OFF TO TRUE |
| 110 | SET USR-MODIFIED-NO TO TRUE |
| 111 | |
| 112 | MOVE SPACES TO WS-MESSAGE |
| 113 | ERRMSGO OF COTRN2AO |
| 114 | |
| 115 | IF EIBCALEN = 0 |
| 116 | MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM |
| 117 | PERFORM RETURN-TO-PREV-SCREEN |
| 118 | ELSE |
| 119 | MOVE DFHCOMMAREA(1:EIBCALEN) TO CARDDEMO-COMMAREA |
| 120 | IF NOT CDEMO-PGM-REENTER |
| 121 | SET CDEMO-PGM-REENTER TO TRUE |
| 122 | MOVE LOW-VALUES TO COTRN2AO |
| 123 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 124 | IF CDEMO-CT02-TRN-SELECTED NOT = |
| 125 | SPACES AND LOW-VALUES |
| 126 | MOVE CDEMO-CT02-TRN-SELECTED TO |
| 127 | CARDNINI OF COTRN2AI |
| 128 | PERFORM PROCESS-ENTER-KEY |
| 129 | END-IF |
| 130 | PERFORM SEND-TRNADD-SCREEN |
| 131 | ELSE |
| 132 | PERFORM RECEIVE-TRNADD-SCREEN |
| 133 | EVALUATE EIBAID |
| 134 | WHEN DFHENTER |
| 135 | PERFORM PROCESS-ENTER-KEY |
| 136 | WHEN DFHPF3 |
| 137 | IF CDEMO-FROM-PROGRAM = SPACES OR LOW-VALUES |
| 138 | MOVE 'COMEN01C' TO CDEMO-TO-PROGRAM |
| 139 | ELSE |
| 140 | MOVE CDEMO-FROM-PROGRAM TO |
| 141 | CDEMO-TO-PROGRAM |
| 142 | END-IF |
| 143 | PERFORM RETURN-TO-PREV-SCREEN |
| 144 | WHEN DFHPF4 |
| 145 | PERFORM CLEAR-CURRENT-SCREEN |
| 146 | WHEN DFHPF5 |
| 147 | PERFORM COPY-LAST-TRAN-DATA |
| 148 | WHEN OTHER |
| 149 | MOVE 'Y' TO WS-ERR-FLG |
| 150 | MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE |
| 151 | PERFORM SEND-TRNADD-SCREEN |
| 152 | END-EVALUATE |
| 153 | END-IF |
| 154 | END-IF |
| 155 | |
| 156 | EXEC CICS RETURN |
| 157 | TRANSID (WS-TRANID) |
| 158 | COMMAREA (CARDDEMO-COMMAREA) |
| 159 | END-EXEC. |
| 160 | |
| 161 | *----------------------------------------------------------------* |
| 162 | * PROCESS-ENTER-KEY |
| 163 | *----------------------------------------------------------------* |
| 164 | PROCESS-ENTER-KEY. |
| 165 | |
| 166 | PERFORM VALIDATE-INPUT-KEY-FIELDS |
| 167 | PERFORM VALIDATE-INPUT-DATA-FIELDS. |
| 168 | |
| 169 | EVALUATE CONFIRMI OF COTRN2AI |
| 170 | WHEN 'Y' |
| 171 | WHEN 'y' |
| 172 | PERFORM ADD-TRANSACTION |
| 173 | WHEN 'N' |
| 174 | WHEN 'n' |
| 175 | WHEN SPACES |
| 176 | WHEN LOW-VALUES |
| 177 | MOVE 'Y' TO WS-ERR-FLG |
| 178 | MOVE 'Confirm to add this transaction...' |
| 179 | TO WS-MESSAGE |
| 180 | MOVE -1 TO CONFIRML OF COTRN2AI |
| 181 | PERFORM SEND-TRNADD-SCREEN |
| 182 | WHEN OTHER |
| 183 | MOVE 'Y' TO WS-ERR-FLG |
| 184 | MOVE 'Invalid value. Valid values are (Y/N)...' |
| 185 | TO WS-MESSAGE |
| 186 | MOVE -1 TO CONFIRML OF COTRN2AI |
| 187 | PERFORM SEND-TRNADD-SCREEN |
| 188 | END-EVALUATE. |
| 189 | |
| 190 | *----------------------------------------------------------------* |
| 191 | * VALIDATE-INPUT-KEY-FIELDS |
| 192 | *----------------------------------------------------------------* |
| 193 | VALIDATE-INPUT-KEY-FIELDS. |
| 194 | |
| 195 | EVALUATE TRUE |
| 196 | WHEN ACTIDINI OF COTRN2AI NOT = SPACES AND LOW-VALUES |
| 197 | IF ACTIDINI OF COTRN2AI IS NOT NUMERIC |
| 198 | MOVE 'Y' TO WS-ERR-FLG |
| 199 | MOVE 'Account ID must be Numeric...' TO |
| 200 | WS-MESSAGE |
| 201 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 202 | PERFORM SEND-TRNADD-SCREEN |
| 203 | END-IF |
| 204 | COMPUTE WS-ACCT-ID-N = FUNCTION NUMVAL(ACTIDINI OF |
| 205 | COTRN2AI) |
| 206 | MOVE WS-ACCT-ID-N TO XREF-ACCT-ID |
| 207 | ACTIDINI OF COTRN2AI |
| 208 | PERFORM READ-CXACAIX-FILE |
| 209 | MOVE XREF-CARD-NUM TO CARDNINI OF COTRN2AI |
| 210 | WHEN CARDNINI OF COTRN2AI NOT = SPACES AND LOW-VALUES |
| 211 | IF CARDNINI OF COTRN2AI IS NOT NUMERIC |
| 212 | MOVE 'Y' TO WS-ERR-FLG |
| 213 | MOVE 'Card Number must be Numeric...' TO |
| 214 | WS-MESSAGE |
| 215 | MOVE -1 TO CARDNINL OF COTRN2AI |
| 216 | PERFORM SEND-TRNADD-SCREEN |
| 217 | END-IF |
| 218 | COMPUTE WS-CARD-NUM-N = FUNCTION NUMVAL(CARDNINI OF |
| 219 | COTRN2AI) |
| 220 | MOVE WS-CARD-NUM-N TO XREF-CARD-NUM |
| 221 | CARDNINI OF COTRN2AI |
| 222 | PERFORM READ-CCXREF-FILE |
| 223 | MOVE XREF-ACCT-ID TO ACTIDINI OF COTRN2AI |
| 224 | WHEN OTHER |
| 225 | MOVE 'Y' TO WS-ERR-FLG |
| 226 | MOVE 'Account or Card Number must be entered...' TO |
| 227 | WS-MESSAGE |
| 228 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 229 | PERFORM SEND-TRNADD-SCREEN |
| 230 | END-EVALUATE. |
| 231 | |
| 232 | *----------------------------------------------------------------* |
| 233 | * VALIDATE-INPUT-DATA-FIELDS |
| 234 | *----------------------------------------------------------------* |
| 235 | VALIDATE-INPUT-DATA-FIELDS. |
| 236 | |
| 237 | IF ERR-FLG-ON |
| 238 | MOVE SPACES TO TTYPCDI OF COTRN2AI |
| 239 | TCATCDI OF COTRN2AI |
| 240 | TRNSRCI OF COTRN2AI |
| 241 | TRNAMTI OF COTRN2AI |
| 242 | TDESCI OF COTRN2AI |
| 243 | TORIGDTI OF COTRN2AI |
| 244 | TPROCDTI OF COTRN2AI |
| 245 | MIDI OF COTRN2AI |
| 246 | MNAMEI OF COTRN2AI |
| 247 | MCITYI OF COTRN2AI |
| 248 | MZIPI OF COTRN2AI |
| 249 | END-IF. |
| 250 | |
| 251 | EVALUATE TRUE |
| 252 | WHEN TTYPCDI OF COTRN2AI = SPACES OR LOW-VALUES |
| 253 | MOVE 'Y' TO WS-ERR-FLG |
| 254 | MOVE 'Type CD can NOT be empty...' TO |
| 255 | WS-MESSAGE |
| 256 | MOVE -1 TO TTYPCDL OF COTRN2AI |
| 257 | PERFORM SEND-TRNADD-SCREEN |
| 258 | WHEN TCATCDI OF COTRN2AI = SPACES OR LOW-VALUES |
| 259 | MOVE 'Y' TO WS-ERR-FLG |
| 260 | MOVE 'Category CD can NOT be empty...' TO |
| 261 | WS-MESSAGE |
| 262 | MOVE -1 TO TCATCDL OF COTRN2AI |
| 263 | PERFORM SEND-TRNADD-SCREEN |
| 264 | WHEN TRNSRCI OF COTRN2AI = SPACES OR LOW-VALUES |
| 265 | MOVE 'Y' TO WS-ERR-FLG |
| 266 | MOVE 'Source can NOT be empty...' TO |
| 267 | WS-MESSAGE |
| 268 | MOVE -1 TO TRNSRCL OF COTRN2AI |
| 269 | PERFORM SEND-TRNADD-SCREEN |
| 270 | WHEN TDESCI OF COTRN2AI = SPACES OR LOW-VALUES |
| 271 | MOVE 'Y' TO WS-ERR-FLG |
| 272 | MOVE 'Description can NOT be empty...' TO |
| 273 | WS-MESSAGE |
| 274 | MOVE -1 TO TDESCL OF COTRN2AI |
| 275 | PERFORM SEND-TRNADD-SCREEN |
| 276 | WHEN TRNAMTI OF COTRN2AI = SPACES OR LOW-VALUES |
| 277 | MOVE 'Y' TO WS-ERR-FLG |
| 278 | MOVE 'Amount can NOT be empty...' TO |
| 279 | WS-MESSAGE |
| 280 | MOVE -1 TO TRNAMTL OF COTRN2AI |
| 281 | PERFORM SEND-TRNADD-SCREEN |
| 282 | WHEN TORIGDTI OF COTRN2AI = SPACES OR LOW-VALUES |
| 283 | MOVE 'Y' TO WS-ERR-FLG |
| 284 | MOVE 'Orig Date can NOT be empty...' TO |
| 285 | WS-MESSAGE |
| 286 | MOVE -1 TO TORIGDTL OF COTRN2AI |
| 287 | PERFORM SEND-TRNADD-SCREEN |
| 288 | WHEN TPROCDTI OF COTRN2AI = SPACES OR LOW-VALUES |
| 289 | MOVE 'Y' TO WS-ERR-FLG |
| 290 | MOVE 'Proc Date can NOT be empty...' TO |
| 291 | WS-MESSAGE |
| 292 | MOVE -1 TO TPROCDTL OF COTRN2AI |
| 293 | PERFORM SEND-TRNADD-SCREEN |
| 294 | WHEN MIDI OF COTRN2AI = SPACES OR LOW-VALUES |
| 295 | MOVE 'Y' TO WS-ERR-FLG |
| 296 | MOVE 'Merchant ID can NOT be empty...' TO |
| 297 | WS-MESSAGE |
| 298 | MOVE -1 TO MIDL OF COTRN2AI |
| 299 | PERFORM SEND-TRNADD-SCREEN |
| 300 | WHEN MNAMEI OF COTRN2AI = SPACES OR LOW-VALUES |
| 301 | MOVE 'Y' TO WS-ERR-FLG |
| 302 | MOVE 'Merchant Name can NOT be empty...' TO |
| 303 | WS-MESSAGE |
| 304 | MOVE -1 TO MNAMEL OF COTRN2AI |
| 305 | PERFORM SEND-TRNADD-SCREEN |
| 306 | WHEN MCITYI OF COTRN2AI = SPACES OR LOW-VALUES |
| 307 | MOVE 'Y' TO WS-ERR-FLG |
| 308 | MOVE 'Merchant City can NOT be empty...' TO |
| 309 | WS-MESSAGE |
| 310 | MOVE -1 TO MCITYL OF COTRN2AI |
| 311 | PERFORM SEND-TRNADD-SCREEN |
| 312 | WHEN MZIPI OF COTRN2AI = SPACES OR LOW-VALUES |
| 313 | MOVE 'Y' TO WS-ERR-FLG |
| 314 | MOVE 'Merchant Zip can NOT be empty...' TO |
| 315 | WS-MESSAGE |
| 316 | MOVE -1 TO MZIPL OF COTRN2AI |
| 317 | PERFORM SEND-TRNADD-SCREEN |
| 318 | WHEN OTHER |
| 319 | CONTINUE |
| 320 | END-EVALUATE. |
| 321 | |
| 322 | EVALUATE TRUE |
| 323 | WHEN TTYPCDI OF COTRN2AI NOT NUMERIC |
| 324 | MOVE 'Y' TO WS-ERR-FLG |
| 325 | MOVE 'Type CD must be Numeric...' TO |
| 326 | WS-MESSAGE |
| 327 | MOVE -1 TO TTYPCDL OF COTRN2AI |
| 328 | PERFORM SEND-TRNADD-SCREEN |
| 329 | WHEN TCATCDI OF COTRN2AI NOT NUMERIC |
| 330 | MOVE 'Y' TO WS-ERR-FLG |
| 331 | MOVE 'Category CD must be Numeric...' TO |
| 332 | WS-MESSAGE |
| 333 | MOVE -1 TO TCATCDL OF COTRN2AI |
| 334 | PERFORM SEND-TRNADD-SCREEN |
| 335 | WHEN OTHER |
| 336 | CONTINUE |
| 337 | END-EVALUATE |
| 338 | |
| 339 | EVALUATE TRUE |
| 340 | WHEN TRNAMTI OF COTRN2AI(1:1) NOT EQUAL '-' AND '+' |
| 341 | WHEN TRNAMTI OF COTRN2AI(2:8) NOT NUMERIC |
| 342 | WHEN TRNAMTI OF COTRN2AI(10:1) NOT = '.' |
| 343 | WHEN TRNAMTI OF COTRN2AI(11:2) IS NOT NUMERIC |
| 344 | MOVE 'Y' TO WS-ERR-FLG |
| 345 | MOVE 'Amount should be in format -99999999.99' TO |
| 346 | WS-MESSAGE |
| 347 | MOVE -1 TO TRNAMTL OF COTRN2AI |
| 348 | PERFORM SEND-TRNADD-SCREEN |
| 349 | WHEN OTHER |
| 350 | CONTINUE |
| 351 | END-EVALUATE |
| 352 | |
| 353 | EVALUATE TRUE |
| 354 | WHEN TORIGDTI OF COTRN2AI(1:4) IS NOT NUMERIC |
| 355 | WHEN TORIGDTI OF COTRN2AI(5:1) NOT EQUAL '-' |
| 356 | WHEN TORIGDTI OF COTRN2AI(6:2) NOT NUMERIC |
| 357 | WHEN TORIGDTI OF COTRN2AI(8:1) NOT EQUAL '-' |
| 358 | WHEN TORIGDTI OF COTRN2AI(9:2) NOT NUMERIC |
| 359 | MOVE 'Y' TO WS-ERR-FLG |
| 360 | MOVE 'Orig Date should be in format YYYY-MM-DD' TO |
| 361 | WS-MESSAGE |
| 362 | MOVE -1 TO TORIGDTL OF COTRN2AI |
| 363 | PERFORM SEND-TRNADD-SCREEN |
| 364 | WHEN OTHER |
| 365 | CONTINUE |
| 366 | END-EVALUATE |
| 367 | |
| 368 | EVALUATE TRUE |
| 369 | WHEN TPROCDTI OF COTRN2AI(1:4) IS NOT NUMERIC |
| 370 | WHEN TPROCDTI OF COTRN2AI(5:1) NOT EQUAL '-' |
| 371 | WHEN TPROCDTI OF COTRN2AI(6:2) NOT NUMERIC |
| 372 | WHEN TPROCDTI OF COTRN2AI(8:1) NOT EQUAL '-' |
| 373 | WHEN TPROCDTI OF COTRN2AI(9:2) NOT NUMERIC |
| 374 | MOVE 'Y' TO WS-ERR-FLG |
| 375 | MOVE 'Proc Date should be in format YYYY-MM-DD' TO |
| 376 | WS-MESSAGE |
| 377 | MOVE -1 TO TPROCDTL OF COTRN2AI |
| 378 | PERFORM SEND-TRNADD-SCREEN |
| 379 | WHEN OTHER |
| 380 | CONTINUE |
| 381 | END-EVALUATE |
| 382 | |
| 383 | COMPUTE WS-TRAN-AMT-N = FUNCTION NUMVAL-C(TRNAMTI OF |
| 384 | COTRN2AI) |
| 385 | MOVE WS-TRAN-AMT-N TO WS-TRAN-AMT-E |
| 386 | MOVE WS-TRAN-AMT-E TO TRNAMTI OF COTRN2AI |
| 387 | |
| 388 | |
| 389 | MOVE TORIGDTI OF COTRN2AI TO CSUTLDTC-DATE |
| 390 | MOVE WS-DATE-FORMAT TO CSUTLDTC-DATE-FORMAT |
| 391 | MOVE SPACES TO CSUTLDTC-RESULT |
| 392 | |
| 393 | CALL 'CSUTLDTC' USING CSUTLDTC-DATE |
| 394 | CSUTLDTC-DATE-FORMAT |
| 395 | CSUTLDTC-RESULT |
| 396 | |
| 397 | IF CSUTLDTC-RESULT-SEV-CD = '0000' |
| 398 | CONTINUE |
| 399 | ELSE |
| 400 | IF CSUTLDTC-RESULT-MSG-NUM NOT = '2513' |
| 401 | MOVE 'Orig Date - Not a valid date...' |
| 402 | TO WS-MESSAGE |
| 403 | MOVE 'Y' TO WS-ERR-FLG |
| 404 | MOVE -1 TO TORIGDTL OF COTRN2AI |
| 405 | PERFORM SEND-TRNADD-SCREEN |
| 406 | END-IF |
| 407 | END-IF |
| 408 | |
| 409 | MOVE TPROCDTI OF COTRN2AI TO CSUTLDTC-DATE |
| 410 | MOVE WS-DATE-FORMAT TO CSUTLDTC-DATE-FORMAT |
| 411 | MOVE SPACES TO CSUTLDTC-RESULT |
| 412 | |
| 413 | CALL 'CSUTLDTC' USING CSUTLDTC-DATE |
| 414 | CSUTLDTC-DATE-FORMAT |
| 415 | CSUTLDTC-RESULT |
| 416 | |
| 417 | IF CSUTLDTC-RESULT-SEV-CD = '0000' |
| 418 | CONTINUE |
| 419 | ELSE |
| 420 | IF CSUTLDTC-RESULT-MSG-NUM NOT = '2513' |
| 421 | MOVE 'Proc Date - Not a valid date...' |
| 422 | TO WS-MESSAGE |
| 423 | MOVE 'Y' TO WS-ERR-FLG |
| 424 | MOVE -1 TO TPROCDTL OF COTRN2AI |
| 425 | PERFORM SEND-TRNADD-SCREEN |
| 426 | END-IF |
| 427 | END-IF |
| 428 | |
| 429 | |
| 430 | IF MIDI OF COTRN2AI IS NOT NUMERIC |
| 431 | MOVE 'Y' TO WS-ERR-FLG |
| 432 | MOVE 'Merchant ID must be Numeric...' TO |
| 433 | WS-MESSAGE |
| 434 | MOVE -1 TO MIDL OF COTRN2AI |
| 435 | PERFORM SEND-TRNADD-SCREEN |
| 436 | END-IF |
| 437 | . |
| 438 | |
| 439 | *----------------------------------------------------------------* |
| 440 | * ADD-TRANSACTION |
| 441 | *----------------------------------------------------------------* |
| 442 | ADD-TRANSACTION. |
| 443 | |
| 444 | MOVE HIGH-VALUES TO TRAN-ID |
| 445 | PERFORM STARTBR-TRANSACT-FILE |
| 446 | PERFORM READPREV-TRANSACT-FILE |
| 447 | PERFORM ENDBR-TRANSACT-FILE |
| 448 | MOVE TRAN-ID TO WS-TRAN-ID-N |
| 449 | ADD 1 TO WS-TRAN-ID-N |
| 450 | INITIALIZE TRAN-RECORD |
| 451 | MOVE WS-TRAN-ID-N TO TRAN-ID |
| 452 | MOVE TTYPCDI OF COTRN2AI TO TRAN-TYPE-CD |
| 453 | MOVE TCATCDI OF COTRN2AI TO TRAN-CAT-CD |
| 454 | MOVE TRNSRCI OF COTRN2AI TO TRAN-SOURCE |
| 455 | MOVE TDESCI OF COTRN2AI TO TRAN-DESC |
| 456 | COMPUTE WS-TRAN-AMT-N = FUNCTION NUMVAL-C(TRNAMTI OF |
| 457 | COTRN2AI) |
| 458 | MOVE WS-TRAN-AMT-N TO TRAN-AMT |
| 459 | MOVE CARDNINI OF COTRN2AI TO TRAN-CARD-NUM |
| 460 | MOVE MIDI OF COTRN2AI TO TRAN-MERCHANT-ID |
| 461 | MOVE MNAMEI OF COTRN2AI TO TRAN-MERCHANT-NAME |
| 462 | MOVE MCITYI OF COTRN2AI TO TRAN-MERCHANT-CITY |
| 463 | MOVE MZIPI OF COTRN2AI TO TRAN-MERCHANT-ZIP |
| 464 | MOVE TORIGDTI OF COTRN2AI TO TRAN-ORIG-TS |
| 465 | MOVE TPROCDTI OF COTRN2AI TO TRAN-PROC-TS |
| 466 | PERFORM WRITE-TRANSACT-FILE. |
| 467 | |
| 468 | *----------------------------------------------------------------* |
| 469 | * COPY-LAST-TRAN-DATA |
| 470 | *----------------------------------------------------------------* |
| 471 | COPY-LAST-TRAN-DATA. |
| 472 | |
| 473 | PERFORM VALIDATE-INPUT-KEY-FIELDS |
| 474 | |
| 475 | MOVE HIGH-VALUES TO TRAN-ID |
| 476 | PERFORM STARTBR-TRANSACT-FILE |
| 477 | PERFORM READPREV-TRANSACT-FILE |
| 478 | PERFORM ENDBR-TRANSACT-FILE |
| 479 | |
| 480 | IF NOT ERR-FLG-ON |
| 481 | MOVE TRAN-AMT TO WS-TRAN-AMT-E |
| 482 | MOVE TRAN-TYPE-CD TO TTYPCDI OF COTRN2AI |
| 483 | MOVE TRAN-CAT-CD TO TCATCDI OF COTRN2AI |
| 484 | MOVE TRAN-SOURCE TO TRNSRCI OF COTRN2AI |
| 485 | MOVE WS-TRAN-AMT-E TO TRNAMTI OF COTRN2AI |
| 486 | MOVE TRAN-DESC TO TDESCI OF COTRN2AI |
| 487 | MOVE TRAN-ORIG-TS TO TORIGDTI OF COTRN2AI |
| 488 | MOVE TRAN-PROC-TS TO TPROCDTI OF COTRN2AI |
| 489 | MOVE TRAN-MERCHANT-ID TO MIDI OF COTRN2AI |
| 490 | MOVE TRAN-MERCHANT-NAME TO MNAMEI OF COTRN2AI |
| 491 | MOVE TRAN-MERCHANT-CITY TO MCITYI OF COTRN2AI |
| 492 | MOVE TRAN-MERCHANT-ZIP TO MZIPI OF COTRN2AI |
| 493 | END-IF |
| 494 | |
| 495 | PERFORM PROCESS-ENTER-KEY. |
| 496 | |
| 497 | *----------------------------------------------------------------* |
| 498 | * RETURN-TO-PREV-SCREEN |
| 499 | *----------------------------------------------------------------* |
| 500 | RETURN-TO-PREV-SCREEN. |
| 501 | |
| 502 | IF CDEMO-TO-PROGRAM = LOW-VALUES OR SPACES |
| 503 | MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM |
| 504 | END-IF |
| 505 | MOVE WS-TRANID TO CDEMO-FROM-TRANID |
| 506 | MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM |
| 507 | MOVE ZEROS TO CDEMO-PGM-CONTEXT |
| 508 | EXEC CICS |
| 509 | XCTL PROGRAM(CDEMO-TO-PROGRAM) |
| 510 | COMMAREA(CARDDEMO-COMMAREA) |
| 511 | END-EXEC. |
| 512 | |
| 513 | *----------------------------------------------------------------* |
| 514 | * SEND-TRNADD-SCREEN |
| 515 | *----------------------------------------------------------------* |
| 516 | SEND-TRNADD-SCREEN. |
| 517 | |
| 518 | PERFORM POPULATE-HEADER-INFO |
| 519 | |
| 520 | MOVE WS-MESSAGE TO ERRMSGO OF COTRN2AO |
| 521 | |
| 522 | EXEC CICS SEND |
| 523 | MAP('COTRN2A') |
| 524 | MAPSET('COTRN02') |
| 525 | FROM(COTRN2AO) |
| 526 | ERASE |
| 527 | CURSOR |
| 528 | END-EXEC. |
| 529 | |
| 530 | EXEC CICS RETURN |
| 531 | TRANSID (WS-TRANID) |
| 532 | COMMAREA (CARDDEMO-COMMAREA) |
| 533 | * LENGTH(LENGTH OF CARDDEMO-COMMAREA) |
| 534 | END-EXEC. |
| 535 | |
| 536 | *----------------------------------------------------------------* |
| 537 | * RECEIVE-TRNADD-SCREEN |
| 538 | *----------------------------------------------------------------* |
| 539 | RECEIVE-TRNADD-SCREEN. |
| 540 | |
| 541 | EXEC CICS RECEIVE |
| 542 | MAP('COTRN2A') |
| 543 | MAPSET('COTRN02') |
| 544 | INTO(COTRN2AI) |
| 545 | RESP(WS-RESP-CD) |
| 546 | RESP2(WS-REAS-CD) |
| 547 | END-EXEC. |
| 548 | |
| 549 | *----------------------------------------------------------------* |
| 550 | * POPULATE-HEADER-INFO |
| 551 | *----------------------------------------------------------------* |
| 552 | POPULATE-HEADER-INFO. |
| 553 | |
| 554 | MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA |
| 555 | |
| 556 | MOVE CCDA-TITLE01 TO TITLE01O OF COTRN2AO |
| 557 | MOVE CCDA-TITLE02 TO TITLE02O OF COTRN2AO |
| 558 | MOVE WS-TRANID TO TRNNAMEO OF COTRN2AO |
| 559 | MOVE WS-PGMNAME TO PGMNAMEO OF COTRN2AO |
| 560 | |
| 561 | MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM |
| 562 | MOVE WS-CURDATE-DAY TO WS-CURDATE-DD |
| 563 | MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY |
| 564 | |
| 565 | MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF COTRN2AO |
| 566 | |
| 567 | MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH |
| 568 | MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM |
| 569 | MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS |
| 570 | |
| 571 | MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF COTRN2AO. |
| 572 | |
| 573 | *----------------------------------------------------------------* |
| 574 | * READ-CXACAIX-FILE |
| 575 | *----------------------------------------------------------------* |
| 576 | READ-CXACAIX-FILE. |
| 577 | |
| 578 | EXEC CICS READ |
| 579 | DATASET (WS-CXACAIX-FILE) |
| 580 | INTO (CARD-XREF-RECORD) |
| 581 | LENGTH (LENGTH OF CARD-XREF-RECORD) |
| 582 | RIDFLD (XREF-ACCT-ID) |
| 583 | KEYLENGTH (LENGTH OF XREF-ACCT-ID) |
| 584 | RESP (WS-RESP-CD) |
| 585 | RESP2 (WS-REAS-CD) |
| 586 | END-EXEC |
| 587 | |
| 588 | EVALUATE WS-RESP-CD |
| 589 | WHEN DFHRESP(NORMAL) |
| 590 | CONTINUE |
| 591 | WHEN DFHRESP(NOTFND) |
| 592 | MOVE 'Y' TO WS-ERR-FLG |
| 593 | MOVE 'Account ID NOT found...' TO |
| 594 | WS-MESSAGE |
| 595 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 596 | PERFORM SEND-TRNADD-SCREEN |
| 597 | WHEN OTHER |
| 598 | DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD |
| 599 | MOVE 'Y' TO WS-ERR-FLG |
| 600 | MOVE 'Unable to lookup Acct in XREF AIX file...' TO |
| 601 | WS-MESSAGE |
| 602 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 603 | PERFORM SEND-TRNADD-SCREEN |
| 604 | END-EVALUATE. |
| 605 | |
| 606 | *----------------------------------------------------------------* |
| 607 | * READ-CCXREF-FILE |
| 608 | *----------------------------------------------------------------* |
| 609 | READ-CCXREF-FILE. |
| 610 | |
| 611 | EXEC CICS READ |
| 612 | DATASET (WS-CCXREF-FILE) |
| 613 | INTO (CARD-XREF-RECORD) |
| 614 | LENGTH (LENGTH OF CARD-XREF-RECORD) |
| 615 | RIDFLD (XREF-CARD-NUM) |
| 616 | KEYLENGTH (LENGTH OF XREF-CARD-NUM) |
| 617 | RESP (WS-RESP-CD) |
| 618 | RESP2 (WS-REAS-CD) |
| 619 | END-EXEC |
| 620 | |
| 621 | EVALUATE WS-RESP-CD |
| 622 | WHEN DFHRESP(NORMAL) |
| 623 | CONTINUE |
| 624 | WHEN DFHRESP(NOTFND) |
| 625 | MOVE 'Y' TO WS-ERR-FLG |
| 626 | MOVE 'Card Number NOT found...' TO |
| 627 | WS-MESSAGE |
| 628 | MOVE -1 TO CARDNINL OF COTRN2AI |
| 629 | PERFORM SEND-TRNADD-SCREEN |
| 630 | WHEN OTHER |
| 631 | DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD |
| 632 | MOVE 'Y' TO WS-ERR-FLG |
| 633 | MOVE 'Unable to lookup Card # in XREF file...' TO |
| 634 | WS-MESSAGE |
| 635 | MOVE -1 TO CARDNINL OF COTRN2AI |
| 636 | PERFORM SEND-TRNADD-SCREEN |
| 637 | END-EVALUATE. |
| 638 | |
| 639 | *----------------------------------------------------------------* |
| 640 | * STARTBR-TRANSACT-FILE |
| 641 | *----------------------------------------------------------------* |
| 642 | STARTBR-TRANSACT-FILE. |
| 643 | |
| 644 | EXEC CICS STARTBR |
| 645 | DATASET (WS-TRANSACT-FILE) |
| 646 | RIDFLD (TRAN-ID) |
| 647 | KEYLENGTH (LENGTH OF TRAN-ID) |
| 648 | RESP (WS-RESP-CD) |
| 649 | RESP2 (WS-REAS-CD) |
| 650 | END-EXEC |
| 651 | |
| 652 | EVALUATE WS-RESP-CD |
| 653 | WHEN DFHRESP(NORMAL) |
| 654 | CONTINUE |
| 655 | WHEN DFHRESP(NOTFND) |
| 656 | MOVE 'Y' TO WS-ERR-FLG |
| 657 | MOVE 'Transaction ID NOT found...' TO |
| 658 | WS-MESSAGE |
| 659 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 660 | PERFORM SEND-TRNADD-SCREEN |
| 661 | WHEN OTHER |
| 662 | DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD |
| 663 | MOVE 'Y' TO WS-ERR-FLG |
| 664 | MOVE 'Unable to lookup Transaction...' TO |
| 665 | WS-MESSAGE |
| 666 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 667 | PERFORM SEND-TRNADD-SCREEN |
| 668 | END-EVALUATE. |
| 669 | |
| 670 | *----------------------------------------------------------------* |
| 671 | * READPREV-TRANSACT-FILE |
| 672 | *----------------------------------------------------------------* |
| 673 | READPREV-TRANSACT-FILE. |
| 674 | |
| 675 | EXEC CICS READPREV |
| 676 | DATASET (WS-TRANSACT-FILE) |
| 677 | INTO (TRAN-RECORD) |
| 678 | LENGTH (LENGTH OF TRAN-RECORD) |
| 679 | RIDFLD (TRAN-ID) |
| 680 | KEYLENGTH (LENGTH OF TRAN-ID) |
| 681 | RESP (WS-RESP-CD) |
| 682 | RESP2 (WS-REAS-CD) |
| 683 | END-EXEC |
| 684 | |
| 685 | EVALUATE WS-RESP-CD |
| 686 | WHEN DFHRESP(NORMAL) |
| 687 | CONTINUE |
| 688 | WHEN DFHRESP(ENDFILE) |
| 689 | MOVE ZEROS TO TRAN-ID |
| 690 | WHEN OTHER |
| 691 | DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD |
| 692 | MOVE 'Y' TO WS-ERR-FLG |
| 693 | MOVE 'Unable to lookup Transaction...' TO |
| 694 | WS-MESSAGE |
| 695 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 696 | PERFORM SEND-TRNADD-SCREEN |
| 697 | END-EVALUATE. |
| 698 | |
| 699 | *----------------------------------------------------------------* |
| 700 | * ENDBR-TRANSACT-FILE |
| 701 | *----------------------------------------------------------------* |
| 702 | ENDBR-TRANSACT-FILE. |
| 703 | |
| 704 | EXEC CICS ENDBR |
| 705 | DATASET (WS-TRANSACT-FILE) |
| 706 | END-EXEC. |
| 707 | |
| 708 | *----------------------------------------------------------------* |
| 709 | * WRITE-TRANSACT-FILE |
| 710 | *----------------------------------------------------------------* |
| 711 | WRITE-TRANSACT-FILE. |
| 712 | |
| 713 | EXEC CICS WRITE |
| 714 | DATASET (WS-TRANSACT-FILE) |
| 715 | FROM (TRAN-RECORD) |
| 716 | LENGTH (LENGTH OF TRAN-RECORD) |
| 717 | RIDFLD (TRAN-ID) |
| 718 | KEYLENGTH (LENGTH OF TRAN-ID) |
| 719 | RESP (WS-RESP-CD) |
| 720 | RESP2 (WS-REAS-CD) |
| 721 | END-EXEC |
| 722 | |
| 723 | EVALUATE WS-RESP-CD |
| 724 | WHEN DFHRESP(NORMAL) |
| 725 | PERFORM INITIALIZE-ALL-FIELDS |
| 726 | MOVE SPACES TO WS-MESSAGE |
| 727 | MOVE DFHGREEN TO ERRMSGC OF COTRN2AO |
| 728 | STRING 'Transaction added successfully. ' |
| 729 | DELIMITED BY SIZE |
| 730 | ' Your Tran ID is ' DELIMITED BY SIZE |
| 731 | TRAN-ID DELIMITED BY SPACE |
| 732 | '.' DELIMITED BY SIZE |
| 733 | INTO WS-MESSAGE |
| 734 | PERFORM SEND-TRNADD-SCREEN |
| 735 | WHEN DFHRESP(DUPKEY) |
| 736 | WHEN DFHRESP(DUPREC) |
| 737 | MOVE 'Y' TO WS-ERR-FLG |
| 738 | MOVE 'Tran ID already exist...' TO |
| 739 | WS-MESSAGE |
| 740 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 741 | PERFORM SEND-TRNADD-SCREEN |
| 742 | WHEN OTHER |
| 743 | DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD |
| 744 | MOVE 'Y' TO WS-ERR-FLG |
| 745 | MOVE 'Unable to Add Transaction...' TO |
| 746 | WS-MESSAGE |
| 747 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 748 | PERFORM SEND-TRNADD-SCREEN |
| 749 | END-EVALUATE. |
| 750 | |
| 751 | *----------------------------------------------------------------* |
| 752 | * CLEAR-CURRENT-SCREEN |
| 753 | *----------------------------------------------------------------* |
| 754 | CLEAR-CURRENT-SCREEN. |
| 755 | |
| 756 | PERFORM INITIALIZE-ALL-FIELDS. |
| 757 | PERFORM SEND-TRNADD-SCREEN. |
| 758 | |
| 759 | *----------------------------------------------------------------* |
| 760 | * INITIALIZE-ALL-FIELDS |
| 761 | *----------------------------------------------------------------* |
| 762 | INITIALIZE-ALL-FIELDS. |
| 763 | |
| 764 | MOVE -1 TO ACTIDINL OF COTRN2AI |
| 765 | MOVE SPACES TO ACTIDINI OF COTRN2AI |
| 766 | CARDNINI OF COTRN2AI |
| 767 | TTYPCDI OF COTRN2AI |
| 768 | TCATCDI OF COTRN2AI |
| 769 | TRNSRCI OF COTRN2AI |
| 770 | TRNAMTI OF COTRN2AI |
| 771 | TDESCI OF COTRN2AI |
| 772 | TORIGDTI OF COTRN2AI |
| 773 | TPROCDTI OF COTRN2AI |
| 774 | MIDI OF COTRN2AI |
| 775 | MNAMEI OF COTRN2AI |
| 776 | MCITYI OF COTRN2AI |
| 777 | MZIPI OF COTRN2AI |
| 778 | CONFIRMI OF COTRN2AI |
| 779 | WS-MESSAGE. |
| 780 | |
| 781 | * |
| 782 | * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:34 CDT |
| 783 | * |