MFmainframe-rea
WS carddemo · 26f629ef

Converted program · 403 lines of TypeScript from 783 lines of COBOL · 611 COBOL lines cited (78%)COTRN02C

Run it on the 3270 →Analysis →All programs

TypeScript carddemo-ts/src/programs/COTRN02C.ts

1/**
2 * COTRN02C — add a transaction to TRANSACT (transaction CT02).
3 * Converted from app/cbl/COTRN02C.cbl; screen COTRN02/COTRN2A; files TRANSACT,
4 * CCXREF (by card number) and CXACAIX (CCXREF path by account id).
5 *
6 * SEND-TRNADD-SCREEN ends with EXEC CICS RETURN TRANSID(CT02) (COTRN02C.cbl:530-534),
7 * so the first message sent ends the task: every validation stops at the first error.
8 */
9import { alnum, digits, editNumber, isBlank, numval } from "../runtime/cobol.js";
10import { RESP, type Cics, type Program } from "../runtime/cics.js";
11import type { SymbolicMap } from "../runtime/screen.js";
12import { LAYOUTS, type CardXrefRecord, type TranRecord } from "../generated/records.js";
13import { blank } from "../runtime/codec.js";
14import { CCDA_MSG_INVALID_KEY, populateHeaderInfo } from "./common.js";
15import { csutldtc, ctInfo, fieldI, isNumericX, nextTranId } from "./transactions-lib.js";
16
17const WS_PGMNAME = "COTRN02C";
18const WS_TRANID = "CT02";
19const WS_TRANSACT_FILE = "TRANSACT";
20const WS_CCXREF_FILE = "CCXREF";
21const WS_CXACAIX_FILE = "CXACAIX";
22const HIGH_VALUES = "￿";
23
24/** WS-VARIABLES (COTRN02C.cbl:35-60) plus the TRAN-RECORD / CARD-XREF-RECORD areas. */
25interface Ws {
26 message: string;
27 errFlg: string;
28 usrModified: string;
29 /** TRAN-ID of TRAN-RECORD (RIDFLD of the browse) */
30 tranId: string;
31 tran: TranRecord;
32 xref: CardXrefRecord;
33}
34
35type Ctx = { ctx: Cics; out: SymbolicMap; ws: Ws };
36
37/** Data fields blanked by VALIDATE-INPUT-DATA-FIELDS when an error is pending. */
38const DATA_FIELDS = ["TTYPCD", "TCATCD", "TRNSRC", "TRNAMT", "TDESC", "TORIGDT", "TPROCDT", "MID", "MNAME", "MCITY", "MZIP"];
39
40export const COTRN02C: Program = {
41 name: WS_PGMNAME,
42 source: "app/cbl/COTRN02C.cbl",
43 run(ctx: Cics) {
44 const ws: Ws = {
45 message: "",
46 errFlg: "N",
47 usrModified: "N",
48 tranId: "",
49 tran: blank<TranRecord>(LAYOUTS.CVTRA05Y),
50 xref: blank<CardXrefRecord>(LAYOUTS.CVACT03Y),
51 };
52 const c: Ctx = { ctx, out: ctx.map("COTRN02", "COTRN2A"), ws };
53
54 // MAIN-PARA (COTRN02C.cbl:107-159)
55 ws.errFlg = "N";
56 ws.usrModified = "N";
57 ws.message = "";
58 c.out.set("ERRMSG", "");
59
60 if (ctx.eib.calen === 0) {
61 ctx.area().toProgram = "COSGN00C";
62 returnToPrevScreen(c);
63 }
64 const area = ctx.area();
65 const info = ctInfo(ctx); // CDEMO-CT02-INFO
66 if (area.pgmContext !== 1) {
67 area.pgmContext = 1;
68 c.out.clear();
69 c.out.cursor("ACTIDIN");
70 if (!isBlank(info.trnSelected)) {
71 c.out.set("CARDNIN", info.trnSelected);
72 processEnterKey(c);
73 }
74 sendTrnaddScreen(c);
75 } else {
76 receiveTrnaddScreen(c);
77 switch (ctx.eib.aid) {
78 case "ENTER":
79 processEnterKey(c);
80 break;
81 case "PF3":
82 area.toProgram = isBlank(area.fromProgram) ? "COMEN01C" : area.fromProgram;
83 returnToPrevScreen(c);
84 // falls through: XCTL does not return
85 case "PF4":
86 clearCurrentScreen(c);
87 break;
88 case "PF5":
89 copyLastTranData(c);
90 break;
91 default:
92 ws.errFlg = "Y";
93 ws.message = CCDA_MSG_INVALID_KEY;
94 sendTrnaddScreen(c);
95 }
96 }
97 ctx.return(WS_TRANID, area);
98 },
99};
100
101/** PROCESS-ENTER-KEY (COTRN02C.cbl:164-188) */
102function processEnterKey(c: Ctx): void {
103 const { out, ws } = c;
104 validateInputKeyFields(c);
105 validateInputDataFields(c);
106
107 const confirm = fieldI(out, "CONFIRM");
108 if (confirm === "Y" || confirm === "y") {
109 addTransaction(c);
110 } else if (confirm === "N" || confirm === "n" || confirm === " " || confirm === "\0") {
111 ws.errFlg = "Y";
112 ws.message = "Confirm to add this transaction...";
113 out.cursor("CONFIRM");
114 sendTrnaddScreen(c);
115 } else {
116 ws.errFlg = "Y";
117 ws.message = "Invalid value. Valid values are (Y/N)...";
118 out.cursor("CONFIRM");
119 sendTrnaddScreen(c);
120 }
121}
122
123/** VALIDATE-INPUT-KEY-FIELDS (COTRN02C.cbl:193-230) */
124function validateInputKeyFields(c: Ctx): void {
125 const { out, ws } = c;
126 const actidin = fieldI(out, "ACTIDIN");
127 const cardnin = fieldI(out, "CARDNIN");
128 if (!isBlank(actidin)) {
129 if (!isNumericX(actidin)) {
130 ws.errFlg = "Y";
131 ws.message = "Account ID must be Numeric...";
132 out.cursor("ACTIDIN");
133 sendTrnaddScreen(c);
134 }
135 // COMPUTE WS-ACCT-ID-N = FUNCTION NUMVAL(ACTIDINI); MOVE to XREF-ACCT-ID and ACTIDINI.
136 const acctIdN = digits(actidin, 11);
137 ws.xref.xrefAcctId = Number(acctIdN);
138 out.set("ACTIDIN", acctIdN);
139 readCxacaixFile(c);
140 out.set("CARDNIN", ws.xref.xrefCardNum);
141 } else if (!isBlank(cardnin)) {
142 if (!isNumericX(cardnin)) {
143 ws.errFlg = "Y";
144 ws.message = "Card Number must be Numeric...";
145 out.cursor("CARDNIN");
146 sendTrnaddScreen(c);
147 }
148 // WS-CARD-NUM-N PIC 9(16): the 16 digits as text (a double would round them).
149 const cardNumN = cardnin;
150 ws.xref.xrefCardNum = cardNumN;
151 out.set("CARDNIN", cardNumN);
152 readCcxrefFile(c);
153 out.set("ACTIDIN", digits(ws.xref.xrefAcctId, 11));
154 } else {
155 ws.errFlg = "Y";
156 ws.message = "Account or Card Number must be entered...";
157 out.cursor("ACTIDIN");
158 sendTrnaddScreen(c);
159 }
160}
161
162/** VALIDATE-INPUT-DATA-FIELDS (COTRN02C.cbl:235-437) */
163function validateInputDataFields(c: Ctx): void {
164 const { out, ws } = c;
165 // Dead code in practice: every error above already ended the task with SEND + RETURN.
166 if (ws.errFlg === "Y") for (const f of DATA_FIELDS) out.set(f, " ");
167
168 const fail = (field: string, message: string): never => {
169 ws.errFlg = "Y";
170 ws.message = message;
171 out.cursor(field);
172 sendTrnaddScreen(c);
173 };
174
175 const empty: [string, string][] = [
176 ["TTYPCD", "Type CD can NOT be empty..."],
177 ["TCATCD", "Category CD can NOT be empty..."],
178 ["TRNSRC", "Source can NOT be empty..."],
179 ["TDESC", "Description can NOT be empty..."],
180 ["TRNAMT", "Amount can NOT be empty..."],
181 ["TORIGDT", "Orig Date can NOT be empty..."],
182 ["TPROCDT", "Proc Date can NOT be empty..."],
183 ["MID", "Merchant ID can NOT be empty..."],
184 ["MNAME", "Merchant Name can NOT be empty..."],
185 ["MCITY", "Merchant City can NOT be empty..."],
186 ["MZIP", "Merchant Zip can NOT be empty..."],
187 ];
188 for (const [field, message] of empty) if (isBlank(fieldI(out, field))) fail(field, message);
189
190 if (!isNumericX(fieldI(out, "TTYPCD"))) fail("TTYPCD", "Type CD must be Numeric...");
191 if (!isNumericX(fieldI(out, "TCATCD"))) fail("TCATCD", "Category CD must be Numeric...");
192
193 const amt = fieldI(out, "TRNAMT");
194 if (
195 (amt[0] !== "-" && amt[0] !== "+") ||
196 !isNumericX(amt.slice(1, 9)) ||
197 amt[9] !== "." ||
198 !isNumericX(amt.slice(10, 12))
199 ) {
200 fail("TRNAMT", "Amount should be in format -99999999.99");
201 }
202
203 const badDate = (d: string) => !isNumericX(d.slice(0, 4)) || d[4] !== "-" || !isNumericX(d.slice(5, 7)) || d[7] !== "-" || !isNumericX(d.slice(8, 10));
204 if (badDate(fieldI(out, "TORIGDT"))) fail("TORIGDT", "Orig Date should be in format YYYY-MM-DD");
205 if (badDate(fieldI(out, "TPROCDT"))) fail("TPROCDT", "Proc Date should be in format YYYY-MM-DD");
206
207 // COMPUTE WS-TRAN-AMT-N = FUNCTION NUMVAL-C(TRNAMTI); MOVE via WS-TRAN-AMT-E back to TRNAMTI.
208 const amtN = numval(amt) ?? 0;
209 out.set("TRNAMT", editNumber(amtN, "+99999999.99"));
210
211 // CALL 'CSUTLDTC' with WS-DATE-FORMAT 'YYYY-MM-DD': message 2513 (outside the supported range) is not an error here.
212 let result = csutldtc(alnum(fieldI(out, "TORIGDT"), 10));
213 if (result.sevCd !== "0000" && result.msgNum !== "2513") fail("TORIGDT", "Orig Date - Not a valid date...");
214 result = csutldtc(alnum(fieldI(out, "TPROCDT"), 10));
215 if (result.sevCd !== "0000" && result.msgNum !== "2513") fail("TPROCDT", "Proc Date - Not a valid date...");
216
217 if (!isNumericX(fieldI(out, "MID"))) fail("MID", "Merchant ID must be Numeric...");
218}
219
220/** ADD-TRANSACTION (COTRN02C.cbl:442-466) */
221function addTransaction(c: Ctx): void {
222 const { out, ws } = c;
223 ws.tranId = HIGH_VALUES;
224 startbrTransactFile(c);
225 readprevTransactFile(c);
226 endbrTransactFile(c);
227 const tranIdN = nextTranId(ws.tranId); // MOVE TRAN-ID TO WS-TRAN-ID-N; ADD 1
228 // INITIALIZE TRAN-RECORD
229 const tran = blank<TranRecord>(LAYOUTS.CVTRA05Y);
230 tran.tranId = tranIdN;
231 ws.tranId = tranIdN;
232 tran.tranTypeCd = fieldI(out, "TTYPCD");
233 tran.tranCatCd = Number(fieldI(out, "TCATCD"));
234 tran.tranSource = fieldI(out, "TRNSRC");
235 tran.tranDesc = fieldI(out, "TDESC");
236 tran.tranAmt = numval(fieldI(out, "TRNAMT")) ?? 0;
237 tran.tranCardNum = fieldI(out, "CARDNIN");
238 tran.tranMerchantId = Number(fieldI(out, "MID"));
239 tran.tranMerchantName = fieldI(out, "MNAME");
240 tran.tranMerchantCity = fieldI(out, "MCITY");
241 tran.tranMerchantZip = fieldI(out, "MZIP");
242 tran.tranOrigTs = fieldI(out, "TORIGDT");
243 tran.tranProcTs = fieldI(out, "TPROCDT");
244 ws.tran = tran;
245 writeTransactFile(c);
246}
247
248/** COPY-LAST-TRAN-DATA (COTRN02C.cbl:471-495) — PF5 */
249function copyLastTranData(c: Ctx): void {
250 const { out, ws } = c;
251 validateInputKeyFields(c);
252 ws.tranId = HIGH_VALUES;
253 startbrTransactFile(c);
254 readprevTransactFile(c);
255 endbrTransactFile(c);
256 if (ws.errFlg !== "Y") {
257 const tran = ws.tran;
258 out.set("TTYPCD", tran.tranTypeCd);
259 out.set("TCATCD", digits(tran.tranCatCd, 4));
260 out.set("TRNSRC", tran.tranSource);
261 out.set("TRNAMT", editNumber(tran.tranAmt, "+99999999.99")); // WS-TRAN-AMT-E
262 out.set("TDESC", tran.tranDesc);
263 out.set("TORIGDT", tran.tranOrigTs);
264 out.set("TPROCDT", tran.tranProcTs);
265 out.set("MID", digits(tran.tranMerchantId, 9));
266 out.set("MNAME", tran.tranMerchantName);
267 out.set("MCITY", tran.tranMerchantCity);
268 out.set("MZIP", tran.tranMerchantZip);
269 }
270 processEnterKey(c);
271}
272
273/** RETURN-TO-PREV-SCREEN (COTRN02C.cbl:500-511) */
274function returnToPrevScreen(c: Ctx): never {
275 const area = c.ctx.area();
276 if (isBlank(area.toProgram)) area.toProgram = "COSGN00C";
277 area.fromTranid = WS_TRANID;
278 area.fromProgram = WS_PGMNAME;
279 area.pgmContext = 0;
280 c.ctx.xctl(area.toProgram, area);
281}
282
283/** SEND-TRNADD-SCREEN (COTRN02C.cbl:516-534) — SEND MAP ERASE CURSOR, then RETURN. */
284function sendTrnaddScreen(c: Ctx): never {
285 populateHeaderInfo(c.ctx, c.out, WS_TRANID, WS_PGMNAME);
286 c.out.set("ERRMSG", c.ws.message);
287 c.ctx.sendMap(c.out, { erase: true, cursor: true });
288 c.ctx.return(WS_TRANID, c.ctx.area());
289}
290
291/** RECEIVE-TRNADD-SCREEN (COTRN02C.cbl:539-547) */
292function receiveTrnaddScreen(c: Ctx): void {
293 c.out = c.ctx.receiveMap("COTRN02", "COTRN2A").map;
294}
295
296/** READ-CXACAIX-FILE (COTRN02C.cbl:576-604) */
297function readCxacaixFile(c: Ctx): void {
298 const { ctx, out, ws } = c;
299 const { resp, record } = ctx.read<CardXrefRecord>(WS_CXACAIX_FILE, digits(ws.xref.xrefAcctId, 11));
300 if (resp === RESP.NORMAL) {
301 ws.xref = record!;
302 } else if (resp === RESP.NOTFND) {
303 ws.errFlg = "Y";
304 ws.message = "Account ID NOT found...";
305 out.cursor("ACTIDIN");
306 sendTrnaddScreen(c);
307 } else {
308 ws.errFlg = "Y";
309 ws.message = "Unable to lookup Acct in XREF AIX file...";
310 out.cursor("ACTIDIN");
311 sendTrnaddScreen(c);
312 }
313}
314
315/** READ-CCXREF-FILE (COTRN02C.cbl:609-637) */
316function readCcxrefFile(c: Ctx): void {
317 const { ctx, out, ws } = c;
318 const { resp, record } = ctx.read<CardXrefRecord>(WS_CCXREF_FILE, alnum(ws.xref.xrefCardNum, 16));
319 if (resp === RESP.NORMAL) {
320 ws.xref = record!;
321 } else if (resp === RESP.NOTFND) {
322 ws.errFlg = "Y";
323 ws.message = "Card Number NOT found...";
324 out.cursor("CARDNIN");
325 sendTrnaddScreen(c);
326 } else {
327 ws.errFlg = "Y";
328 ws.message = "Unable to lookup Card # in XREF file...";
329 out.cursor("CARDNIN");
330 sendTrnaddScreen(c);
331 }
332}
333
334/** STARTBR-TRANSACT-FILE (COTRN02C.cbl:642-668) */
335function startbrTransactFile(c: Ctx): void {
336 const { ctx, out, ws } = c;
337 const resp = ctx.startbr(WS_TRANSACT_FILE, ws.tranId);
338 if (resp === RESP.NORMAL) return;
339 ws.errFlg = "Y";
340 ws.message = resp === RESP.NOTFND ? "Transaction ID NOT found..." : "Unable to lookup Transaction...";
341 out.cursor("ACTIDIN");
342 sendTrnaddScreen(c);
343}
344
345/** READPREV-TRANSACT-FILE (COTRN02C.cbl:673-697) */
346function readprevTransactFile(c: Ctx): void {
347 const { ctx, out, ws } = c;
348 const { resp, record } = ctx.readprev<TranRecord>(WS_TRANSACT_FILE);
349 if (resp === RESP.NORMAL) {
350 ws.tran = record!;
351 ws.tranId = record!.tranId;
352 } else if (resp === RESP.ENDFILE) {
353 ws.tranId = "0".repeat(16); // MOVE ZEROS TO TRAN-ID
354 ws.tran.tranId = ws.tranId;
355 } else {
356 ws.errFlg = "Y";
357 ws.message = "Unable to lookup Transaction...";
358 out.cursor("ACTIDIN");
359 sendTrnaddScreen(c);
360 }
361}
362
363/** ENDBR-TRANSACT-FILE (COTRN02C.cbl:702-706) */
364function endbrTransactFile(c: Ctx): void {
365 c.ctx.endbr(WS_TRANSACT_FILE);
366}
367
368/** WRITE-TRANSACT-FILE (COTRN02C.cbl:711-749) */
369function writeTransactFile(c: Ctx): void {
370 const { ctx, out, ws } = c;
371 const resp = ctx.write(WS_TRANSACT_FILE, ws.tran);
372 if (resp === RESP.NORMAL) {
373 initializeAllFields(c);
374 ws.message = "";
375 out.color("ERRMSG", "GREEN");
376 // STRING ... TRAN-ID DELIMITED BY SPACE ...
377 ws.message = `Transaction added successfully. Your Tran ID is ${ws.tran.tranId.split(" ")[0]}.`;
378 sendTrnaddScreen(c);
379 } else if (resp === RESP.DUPKEY || resp === RESP.DUPREC) {
380 ws.errFlg = "Y";
381 ws.message = "Tran ID already exist...";
382 out.cursor("ACTIDIN");
383 sendTrnaddScreen(c);
384 } else {
385 ws.errFlg = "Y";
386 ws.message = "Unable to Add Transaction...";
387 out.cursor("ACTIDIN");
388 sendTrnaddScreen(c);
389 }
390}
391
392/** CLEAR-CURRENT-SCREEN (COTRN02C.cbl:754-757) */
393function clearCurrentScreen(c: Ctx): void {
394 initializeAllFields(c);
395 sendTrnaddScreen(c);
396}
397
398/** INITIALIZE-ALL-FIELDS (COTRN02C.cbl:762-779) */
399function initializeAllFields(c: Ctx): void {
400 c.out.cursor("ACTIDIN");
401 for (const f of ["ACTIDIN", "CARDNIN", ...DATA_FIELDS, "CONFIRM"]) c.out.set(f, " ");
402 c.ws.message = "";
403}

COBOL app/cbl/COTRN02C.cbl

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 *