| 1 | ****************************************************************** |
| 2 | * Program : COPAUS2C.CBL |
| 3 | * Application : CardDemo - Authorization Module |
| 4 | * Type : CICS COBOL IMS DB2 Program |
| 5 | * Function : Mark Authorization Message Fraud |
| 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. COPAUS2C. |
| 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-PGMNAME PIC X(08) VALUE 'COPAUS2C'. |
| 34 | 05 WS-LENGTH PIC S9(4) COMP VALUE ZERO. |
| 35 | 05 WS-AUTH-TIME PIC 9(09). |
| 36 | 05 WS-AUTH-TIME-AN REDEFINES WS-AUTH-TIME |
| 37 | PIC X(09). |
| 38 | 05 WS-AUTH-TS. |
| 39 | 10 WS-AUTH-YY PIC X(02). |
| 40 | 10 FILLER PIC X(01) VALUE '-'. |
| 41 | 10 WS-AUTH-MM PIC X(02). |
| 42 | 10 FILLER PIC X(01) VALUE '-'. |
| 43 | 10 WS-AUTH-DD PIC X(02). |
| 44 | 10 FILLER PIC X(01) VALUE ' '. |
| 45 | 10 WS-AUTH-HH PIC X(02). |
| 46 | 10 FILLER PIC X(01) VALUE '.'. |
| 47 | 10 WS-AUTH-MI PIC X(02). |
| 48 | 10 FILLER PIC X(01) VALUE '.'. |
| 49 | 10 WS-AUTH-SS PIC X(02). |
| 50 | 10 WS-AUTH-SSS PIC X(03). |
| 51 | 10 FILLER PIC X(03) VALUE '000'. |
| 52 | 05 WS-ERR-FLG PIC X(01) VALUE 'N'. |
| 53 | 88 ERR-FLG-ON VALUE 'Y'. |
| 54 | 88 ERR-FLG-OF VALUE 'N'. |
| 55 | 05 WS-SQLCODE PIC +9(06). |
| 56 | 05 WS-SQLSTATE PIC +9(09). |
| 57 | |
| 58 | 05 WS-ABS-TIME PIC S9(15) COMP-3 VALUE 0. |
| 59 | 05 WS-CUR-DATE PIC X(08) VALUE SPACES. |
| 60 | |
| 61 | *COPY DFHBMSCA. |
| 62 | /**************************************************** |
| 63 | * SQL INCLUDE FOR SQLCA * |
| 64 | ***************************************************** |
| 65 | EXEC SQL |
| 66 | INCLUDE SQLCA |
| 67 | END-EXEC. |
| 68 | EXEC SQL |
| 69 | INCLUDE AUTHFRDS |
| 70 | END-EXEC. |
| 71 | |
| 72 | |
| 73 | LINKAGE SECTION. |
| 74 | 01 DFHCOMMAREA. |
| 75 | 02 WS-ACCT-ID PIC 9(11). |
| 76 | 02 WS-CUST-ID PIC 9(9). |
| 77 | 02 WS-FRAUD-AUTH-RECORD. |
| 78 | COPY CIPAUDTY. |
| 79 | 02 WS-FRAUD-STATUS-RECORD. |
| 80 | 05 WS-FRD-ACTION PIC X(01). |
| 81 | 88 WS-REPORT-FRAUD VALUE 'F'. |
| 82 | 88 WS-REMOVE-FRAUD VALUE 'R'. |
| 83 | 05 WS-FRD-UPDATE-STATUS PIC X(01). |
| 84 | 88 WS-FRD-UPDT-SUCCESS VALUE 'S'. |
| 85 | 88 WS-FRD-UPDT-FAILED VALUE 'F'. |
| 86 | 05 WS-FRD-ACT-MSG PIC X(50). |
| 87 | |
| 88 | PROCEDURE DIVISION. |
| 89 | MAIN-PARA. |
| 90 | |
| 91 | EXEC CICS ASKTIME NOHANDLE |
| 92 | ABSTIME(WS-ABS-TIME) |
| 93 | NOHANDLE |
| 94 | END-EXEC |
| 95 | EXEC CICS FORMATTIME |
| 96 | ABSTIME(WS-ABS-TIME) |
| 97 | MMDDYY(WS-CUR-DATE) |
| 98 | DATESEP |
| 99 | NOHANDLE |
| 100 | END-EXEC |
| 101 | MOVE WS-CUR-DATE TO PA-FRAUD-RPT-DATE |
| 102 | |
| 103 | MOVE PA-AUTH-ORIG-DATE(1:2) TO WS-AUTH-YY |
| 104 | MOVE PA-AUTH-ORIG-DATE(3:2) TO WS-AUTH-MM |
| 105 | MOVE PA-AUTH-ORIG-DATE(5:2) TO WS-AUTH-DD |
| 106 | |
| 107 | COMPUTE WS-AUTH-TIME = 999999999 - PA-AUTH-TIME-9C |
| 108 | MOVE WS-AUTH-TIME-AN(1:2) TO WS-AUTH-HH |
| 109 | MOVE WS-AUTH-TIME-AN(3:2) TO WS-AUTH-MI |
| 110 | MOVE WS-AUTH-TIME-AN(5:2) TO WS-AUTH-SS |
| 111 | MOVE WS-AUTH-TIME-AN(7:3) TO WS-AUTH-SSS |
| 112 | |
| 113 | MOVE PA-CARD-NUM TO CARD-NUM |
| 114 | MOVE WS-AUTH-TS TO AUTH-TS |
| 115 | MOVE PA-AUTH-TYPE TO AUTH-TYPE |
| 116 | MOVE PA-CARD-EXPIRY-DATE TO CARD-EXPIRY-DATE |
| 117 | MOVE PA-MESSAGE-TYPE TO MESSAGE-TYPE |
| 118 | MOVE PA-MESSAGE-SOURCE TO MESSAGE-SOURCE |
| 119 | MOVE PA-AUTH-ID-CODE TO AUTH-ID-CODE |
| 120 | MOVE PA-AUTH-RESP-CODE TO AUTH-RESP-CODE |
| 121 | MOVE PA-AUTH-RESP-REASON TO AUTH-RESP-REASON |
| 122 | MOVE PA-PROCESSING-CODE TO PROCESSING-CODE |
| 123 | MOVE PA-TRANSACTION-AMT TO TRANSACTION-AMT |
| 124 | MOVE PA-APPROVED-AMT TO APPROVED-AMT |
| 125 | MOVE PA-MERCHANT-CATAGORY-CODE |
| 126 | TO MERCHANT-CATAGORY-CODE |
| 127 | MOVE PA-ACQR-COUNTRY-CODE TO ACQR-COUNTRY-CODE |
| 128 | MOVE PA-POS-ENTRY-MODE TO POS-ENTRY-MODE |
| 129 | MOVE PA-MERCHANT-ID TO MERCHANT-ID |
| 130 | MOVE LENGTH OF PA-MERCHANT-NAME TO MERCHANT-NAME-LEN |
| 131 | MOVE PA-MERCHANT-NAME TO MERCHANT-NAME-TEXT |
| 132 | MOVE PA-MERCHANT-CITY TO MERCHANT-CITY |
| 133 | MOVE PA-MERCHANT-STATE TO MERCHANT-STATE |
| 134 | MOVE PA-MERCHANT-ZIP TO MERCHANT-ZIP |
| 135 | MOVE PA-TRANSACTION-ID TO TRANSACTION-ID |
| 136 | MOVE PA-MATCH-STATUS TO MATCH-STATUS |
| 137 | MOVE WS-FRD-ACTION TO AUTH-FRAUD |
| 138 | MOVE WS-ACCT-ID TO ACCT-ID |
| 139 | MOVE WS-CUST-ID TO CUST-ID |
| 140 | |
| 141 | EXEC SQL |
| 142 | INSERT INTO CARDDEMO.AUTHFRDS |
| 143 | (CARD_NUM |
| 144 | ,AUTH_TS |
| 145 | ,AUTH_TYPE |
| 146 | ,CARD_EXPIRY_DATE |
| 147 | ,MESSAGE_TYPE |
| 148 | ,MESSAGE_SOURCE |
| 149 | ,AUTH_ID_CODE |
| 150 | ,AUTH_RESP_CODE |
| 151 | ,AUTH_RESP_REASON |
| 152 | ,PROCESSING_CODE |
| 153 | ,TRANSACTION_AMT |
| 154 | ,APPROVED_AMT |
| 155 | ,MERCHANT_CATAGORY_CODE |
| 156 | ,ACQR_COUNTRY_CODE |
| 157 | ,POS_ENTRY_MODE |
| 158 | ,MERCHANT_ID |
| 159 | ,MERCHANT_NAME |
| 160 | ,MERCHANT_CITY |
| 161 | ,MERCHANT_STATE |
| 162 | ,MERCHANT_ZIP |
| 163 | ,TRANSACTION_ID |
| 164 | ,MATCH_STATUS |
| 165 | ,AUTH_FRAUD |
| 166 | ,FRAUD_RPT_DATE |
| 167 | ,ACCT_ID |
| 168 | ,CUST_ID) |
| 169 | VALUES |
| 170 | ( :CARD-NUM |
| 171 | ,TIMESTAMP_FORMAT (:AUTH-TS, |
| 172 | 'YY-MM-DD HH24.MI.SSNNNNNN') |
| 173 | ,:AUTH-TYPE |
| 174 | ,:CARD-EXPIRY-DATE |
| 175 | ,:MESSAGE-TYPE |
| 176 | ,:MESSAGE-SOURCE |
| 177 | ,:AUTH-ID-CODE |
| 178 | ,:AUTH-RESP-CODE |
| 179 | ,:AUTH-RESP-REASON |
| 180 | ,:PROCESSING-CODE |
| 181 | ,:TRANSACTION-AMT |
| 182 | ,:APPROVED-AMT |
| 183 | ,:MERCHANT-CATAGORY-CODE |
| 184 | ,:ACQR-COUNTRY-CODE |
| 185 | ,:POS-ENTRY-MODE |
| 186 | ,:MERCHANT-ID |
| 187 | ,:MERCHANT-NAME |
| 188 | ,:MERCHANT-CITY |
| 189 | ,:MERCHANT-STATE |
| 190 | ,:MERCHANT-ZIP |
| 191 | ,:TRANSACTION-ID |
| 192 | ,:MATCH-STATUS |
| 193 | ,:AUTH-FRAUD |
| 194 | ,CURRENT DATE |
| 195 | ,:ACCT-ID |
| 196 | ,:CUST-ID |
| 197 | ) |
| 198 | END-EXEC |
| 199 | IF SQLCODE = ZERO |
| 200 | SET WS-FRD-UPDT-SUCCESS TO TRUE |
| 201 | MOVE 'ADD SUCCESS' TO WS-FRD-ACT-MSG |
| 202 | ELSE |
| 203 | IF SQLCODE = -803 |
| 204 | PERFORM FRAUD-UPDATE |
| 205 | ELSE |
| 206 | SET WS-FRD-UPDT-FAILED TO TRUE |
| 207 | |
| 208 | MOVE SQLCODE TO WS-SQLCODE |
| 209 | MOVE SQLSTATE TO WS-SQLSTATE |
| 210 | |
| 211 | STRING ' SYSTEM ERROR DB2: CODE:' WS-SQLCODE |
| 212 | ', STATE: ' WS-SQLSTATE DELIMITED BY SIZE |
| 213 | INTO WS-FRD-ACT-MSG |
| 214 | END-STRING |
| 215 | END-IF |
| 216 | END-IF |
| 217 | |
| 218 | EXEC CICS RETURN |
| 219 | END-EXEC |
| 220 | . |
| 221 | FRAUD-UPDATE. |
| 222 | EXEC SQL |
| 223 | UPDATE CARDDEMO.AUTHFRDS |
| 224 | SET AUTH_FRAUD = :AUTH-FRAUD, |
| 225 | FRAUD_RPT_DATE = CURRENT DATE |
| 226 | WHERE CARD_NUM = :CARD-NUM |
| 227 | AND AUTH_TS = TIMESTAMP_FORMAT (:AUTH-TS, |
| 228 | 'YY-MM-DD HH24.MI.SSNNNNNN') |
| 229 | END-EXEC |
| 230 | IF SQLCODE = ZERO |
| 231 | SET WS-FRD-UPDT-SUCCESS TO TRUE |
| 232 | MOVE 'UPDT SUCCESS' TO WS-FRD-ACT-MSG |
| 233 | ELSE |
| 234 | SET WS-FRD-UPDT-FAILED TO TRUE |
| 235 | |
| 236 | MOVE SQLCODE TO WS-SQLCODE |
| 237 | MOVE SQLSTATE TO WS-SQLSTATE |
| 238 | |
| 239 | STRING ' UPDT ERROR DB2: CODE:' WS-SQLCODE |
| 240 | ', STATE: ' WS-SQLSTATE DELIMITED BY SIZE |
| 241 | INTO WS-FRD-ACT-MSG |
| 242 | END-STRING |
| 243 | END-IF |
| 244 | . |