Converted program · 384 lines of TypeScript from 941 lines of COBOL · 675 COBOL lines cited (72%)COACTVWC

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

1	/**
2	* COACTVWC — account view (transaction CAVW).
3	* Converted from app/cbl/COACTVWC.cbl; screen COACTVW/CACTVWA; files CXACAIX (card
4	* xref by account), ACCTDAT, CUSTDAT. PF keys are normalised by CSSTRPFY.
5	*/
6	import { editNumber, isBlank, isNumericText } from "../runtime/cobol.js";
7	import { newCommarea, RESP, type Cics, type Program } from "../runtime/cics.js";
8	import { ATTR, type SymbolicMap } from "../runtime/screen.js";
9	import type { AccountRecord, CardXrefRecord, CustomerRecord } from "../generated/records.js";
10	import { populateHeaderInfo } from "./common.js";
11	import { resp2Of, respX10 } from "./account-lib.js";
12
13	// WS-LITERALS (COACTVWC.cbl:142-202)
14	const LIT_THISPGM = "COACTVWC";
15	const LIT_THISTRANID = "CAVW";
16	const LIT_THISMAPSET = "COACTVW";
17	const LIT_THISMAP = "CACTVWA";
18	const LIT_MENUPGM = "COMEN01C";
19	const LIT_MENUTRANID = "CM00";
20	const LIT_ACCTFILENAME = "ACCTDAT ";
21	const LIT_CUSTFILENAME = "CUSTDAT ";
22	const LIT_CARDXREFNAME_ACCT_PATH = "CXACAIX ";
23
24	// WS-INFO-MSG / WS-RETURN-MSG condition values (COACTVWC.cbl:110-138)
25	const WS_PROMPT_FOR_INPUT = "Enter or update id of account to display";
26	const WS_PROMPT_FOR_ACCT = "Account number not provided";
27	const NO_SEARCH_CRITERIA_RECEIVED = "No input received";
28
29	/** WS-THIS-PROGCOMMAREA (COACTVWC.cbl:213-216) */
30	interface ThisProgCommarea {
31	caFromProgram: string;
32	caFromTranid: string;
33	}
34
35	/** WS-MISC-STORAGE + CC-WORK-AREA after INITIALIZE (COACTVWC.cbl:35-138, 268-270). */
36	interface Ws {
37	/** WS-INPUT-FLAG: '0' INPUT-OK, '1' INPUT-ERROR */
38	inputFlag: string;
39	/** WS-PFK-FLAG: '0' PFK-VALID, '1' PFK-INVALID */
40	pfkFlag: string;
41	/** WS-EDIT-ACCT-FLAG: '0' NOT-OK, '1' ISVALID, ' ' BLANK (INITIALIZE gives a space) */
42	editAcctFlag: string;
43	/** WS-EDIT-CUST-FLAG */
44	editCustFlag: string;
45	foundAcctInMaster: boolean;
46	foundCustInMaster: boolean;
47	/** WS-INFO-MSG PIC X(40) */
48	infoMsg: string;
49	/** WS-RETURN-MSG PIC X(75) */
50	returnMsg: string;
51	/** CCARD-AID PIC X(5) */
52	ccardAid: string;
53	/** CC-ACCT-ID PIC X(11); "" stands for LOW-VALUES */
54	ccAcctId: string;
55	/** WS-CARD-RID-ACCT-ID-X / WS-CARD-RID-CUST-ID-X */
56	ridAcctId: string;
57	ridCustId: string;
58	account?: AccountRecord;
59	customer?: CustomerRecord;
60	}
61
62	const setMsg = (ws: Ws, msg: string) => {
63	ws.returnMsg = msg.slice(0, 75);
64	};
65	const returnMsgOff = (ws: Ws) => isBlank(ws.returnMsg);
66
67	export const COACTVWC: Program = {
68	name: LIT_THISPGM,
69	source: "app/cbl/COACTVWC.cbl",
70	run(ctx: Cics) {
71	// 0000-MAIN (COACTVWC.cbl:262-393). HANDLE ABEND LABEL(ABEND-ROUTINE): the runtime
72	// backs out and reports abends itself.
73	const ws: Ws = {
74	inputFlag: " ",
75	pfkFlag: " ",
76	editAcctFlag: " ",
77	editCustFlag: " ",
78	foundAcctInMaster: false,
79	foundCustInMaster: false,
80	infoMsg: "",
81	returnMsg: "", // SET WS-RETURN-MSG-OFF TO TRUE
82	ccardAid: "",
83	ccAcctId: "",
84	ridAcctId: "",
85	ridCustId: "",
86	};
87	const area = ctx.area();
88	const init = (): ThisProgCommarea => ({ caFromProgram: "", caFromTranid: "" });
89
90	// IF EIBCALEN = 0 OR (CDEMO-FROM-PROGRAM = LIT-MENUPGM AND NOT CDEMO-PGM-REENTER)
91	// INITIALIZE CARDDEMO-COMMAREA WS-THIS-PROGCOMMAREA (COACTVWC.cbl:282-293)
92	if (ctx.eib.calen === 0 \|\| (area.fromProgram.trim() === LIT_MENUPGM && area.pgmContext !== 1)) {
93	// Faithful quirk: this also blanks CDEMO-USER-ID / CDEMO-USER-TYPE.
94	const fresh = newCommarea();
95	for (const k of Object.keys(fresh) as (keyof typeof fresh)[]) if (k !== "ext") (area as unknown as Record<string, unknown>)[k] = fresh[k];
96	area.ext[ctx.program] = init();
97	}
98	ctx.ext(init);
99
100	yyyyStorePfkey(ctx, ws);
101
102	// Only ENTER and PF3 are valid; anything else is treated as ENTER (COACTVWC.cbl:306-314).
103	ws.pfkFlag = "1";
104	if (ws.ccardAid === "ENTER" \|\| ws.ccardAid === "PFK03") ws.pfkFlag = "0";
105	if (ws.pfkFlag === "1") ws.ccardAid = "ENTER";
106
107	// EVALUATE TRUE (COACTVWC.cbl:323-383)
108	if (ws.ccardAid === "PFK03") {
109	// XCTL to the calling program or the main menu (COACTVWC.cbl:328-352)
110	area.toTranid = isBlank(area.fromTranid) ? LIT_MENUTRANID : area.fromTranid;
111	area.toProgram = isBlank(area.fromProgram) ? LIT_MENUPGM : area.fromProgram;
112	area.fromTranid = LIT_THISTRANID;
113	area.fromProgram = LIT_THISPGM;
114	area.userType = "U"; // SET CDEMO-USRTYP-USER TO TRUE
115	area.pgmContext = 0; // SET CDEMO-PGM-ENTER TO TRUE
116	area.lastMapset = LIT_THISMAPSET;
117	area.lastMap = LIT_THISMAP;
118	ctx.xctl(area.toProgram, area);
119	} else if (area.pgmContext === 0) {
120	// Coming from some other context: selection criteria to be gathered.
121	sendMap(ctx, ws);
122	commonReturn(ctx);
123	} else if (area.pgmContext === 1) {
124	processInputs(ctx, ws);
125	if (ws.inputFlag === "1") {
126	sendMap(ctx, ws);
127	commonReturn(ctx);
128	} else {
129	readAcct(ctx, ws);
130	sendMap(ctx, ws);
131	commonReturn(ctx);
132	}
133	} else {
134	// WHEN OTHER: ABEND-CULPRIT/CODE '0001' and plain text.
135	setMsg(ws, "UNEXPECTED DATA SCENARIO");
136	sendPlainText(ctx, ws);
137	}
138	// (COACTVWC.cbl:387-392 — 'IF INPUT-ERROR ... SEND-MAP' is unreachable: every branch above ends the task.)
139	commonReturn(ctx);
140	},
141	};
142
143	/** COMMON-RETURN (COACTVWC.cbl:394-407): RETURN TRANSID(CAVW) with CARDDEMO-COMMAREA + WS-THIS-PROGCOMMAREA. */
144	function commonReturn(ctx: Cics): never {
145	ctx.return(LIT_THISTRANID, ctx.area());
146	}
147
148	/** 1000-SEND-MAP (COACTVWC.cbl:416-425) */
149	function sendMap(ctx: Cics, ws: Ws): void {
150	const out = screenInit(ctx);
151	setupScreenVars(ctx, out, ws);
152	setupScreenAttrs(ctx, out, ws);
153	sendScreen(ctx, out);
154	}
155
156	/** 1100-SCREEN-INIT (COACTVWC.cbl:431-455): MOVE LOW-VALUES TO CACTVWAO, header. */
157	function screenInit(ctx: Cics): SymbolicMap {
158	const out = ctx.map(LIT_THISMAPSET, LIT_THISMAP);
159	populateHeaderInfo(ctx, out, LIT_THISTRANID, LIT_THISPGM);
160	return out;
161	}
162
163	/** 1200-SETUP-SCREEN-VARS (COACTVWC.cbl:460-535) */
164	function setupScreenVars(ctx: Cics, out: SymbolicMap, ws: Ws): void {
165	if (ctx.eib.calen === 0) {
166	ws.infoMsg = WS_PROMPT_FOR_INPUT;
167	} else {
168	if (ws.editAcctFlag === " ") out.set("ACCTSID", null);
169	else out.set("ACCTSID", ws.ccAcctId);
170
171	const acct = ws.account;
172	if ((ws.foundAcctInMaster \|\| ws.foundCustInMaster) && acct) {
173	const pic = "+ZZZ,ZZZ,ZZZ.99"; // ACURBALO etc. PICOUT (COACTVW.bms / COACTVW.CPY)
174	out.set("ACSTTUS", acct.acctActiveStatus);
175	out.set("ACURBAL", editNumber(acct.acctCurrBal, pic));
176	out.set("ACRDLIM", editNumber(acct.acctCreditLimit, pic));
177	out.set("ACSHLIM", editNumber(acct.acctCashCreditLimit, pic));
178	out.set("ACRCYCR", editNumber(acct.acctCurrCycCredit, pic));
179	out.set("ACRCYDB", editNumber(acct.acctCurrCycDebit, pic));
180	out.set("ADTOPEN", acct.acctOpenDate);
181	out.set("AEXPDT", acct.acctExpiraionDate);
182	out.set("AREISDT", acct.acctReissueDate);
183	out.set("AADDGRP", acct.acctGroupId);
184	}
185
186	const cust = ws.customer;
187	if (ws.foundCustInMaster && cust) {
188	out.set("ACSTNUM", String(cust.custId).padStart(9, "0"));
189	// STRING CUST-SSN(1:3) '-' CUST-SSN(4:2) '-' CUST-SSN(6:4)
190	const ssn = String(cust.custSsn).padStart(9, "0").slice(-9);
191	out.set("ACSTSSN", `${ssn.slice(0, 3)}-${ssn.slice(3, 5)}-${ssn.slice(5, 9)}`);
192	out.set("ACSTFCO", String(cust.custFicoCreditScore).padStart(3, "0").slice(-3));
193	out.set("ACSTDOB", cust.custDobYyyyMmDd);
194	out.set("ACSFNAM", cust.custFirstName);
195	out.set("ACSMNAM", cust.custMiddleName);
196	out.set("ACSLNAM", cust.custLastName);
197	out.set("ACSADL1", cust.custAddrLine1);
198	out.set("ACSADL2", cust.custAddrLine2);
199	out.set("ACSCITY", cust.custAddrLine3); // ADDR-LINE-3 is shown as the city
200	out.set("ACSSTTE", cust.custAddrStateCd);
201	out.set("ACSZIPC", cust.custAddrZip); // X(10) into X(5): cut
202	out.set("ACSCTRY", cust.custAddrCountryCd);
203	out.set("ACSPHN1", cust.custPhoneNum1); // X(15) into X(13)
204	out.set("ACSPHN2", cust.custPhoneNum2);
205	out.set("ACSGOVT", cust.custGovtIssuedId);
206	out.set("ACSEFTC", cust.custEftAccountId);
207	out.set("ACSPFLG", cust.custPriCardHolderInd);
208	}
209	}
210
211	// SETUP MESSAGE
212	if (isBlank(ws.infoMsg)) ws.infoMsg = WS_PROMPT_FOR_INPUT;
213	out.set("ERRMSG", ws.returnMsg);
214	out.set("INFOMSG", ws.infoMsg);
215	}
216
217	/** 1300-SETUP-SCREEN-ATTRS (COACTVWC.cbl:541-572) */
218	function setupScreenAttrs(ctx: Cics, out: SymbolicMap, ws: Ws): void {
219	out.attr("ACCTSID", ATTR.DFHBMFSE);
220	// Both EVALUATE branches position the cursor on the account id.
221	out.cursor("ACCTSID");
222	out.color("ACCTSID", "DEFAULT");
223	if (ws.editAcctFlag === "0") out.color("ACCTSID", "RED");
224	if (ws.editAcctFlag === " " && ctx.area().pgmContext === 1) {
225	out.set("ACCTSID", "*");
226	out.color("ACCTSID", "RED");
227	}
228	// MOVE DFHBMDAR TO INFOMSGC is unreachable (1200 always sets an info message).
229	if (isBlank(ws.infoMsg)) out.attr("INFOMSG", ATTR.DFHBMDAR);
230	else out.color("INFOMSG", "NEUTRAL");
231	}
232
233	/** 1400-SEND-SCREEN (COACTVWC.cbl:577-591) */
234	function sendScreen(ctx: Cics, out: SymbolicMap): void {
235	ctx.area().pgmContext = 1; // SET CDEMO-PGM-REENTER TO TRUE
236	ctx.sendMap(out, { cursor: true, erase: true, freekb: true });
237	}
238
239	/** 2000-PROCESS-INPUTS (COACTVWC.cbl:596-605) */
240	function processInputs(ctx: Cics, ws: Ws): void {
241	const inp = receiveMap(ctx);
242	editMapInputs(ctx, ws, inp);
243	}
244
245	/** 2100-RECEIVE-MAP (COACTVWC.cbl:610-617) */
246	function receiveMap(ctx: Cics): SymbolicMap {
247	return ctx.receiveMap(LIT_THISMAPSET, LIT_THISMAP).map;
248	}
249
250	/** 2200-EDIT-MAP-INPUTS (COACTVWC.cbl:622-643) */
251	function editMapInputs(ctx: Cics, ws: Ws, inp: SymbolicMap): void {
252	ws.inputFlag = "0";
253	ws.editAcctFlag = "1";
254	// REPLACE * WITH LOW-VALUES
255	const acctsid = inp.get("ACCTSID");
256	const padded = acctsid.padEnd(11, " ").slice(0, 11);
257	if (padded === "* " \|\| padded.trim() === "") ws.ccAcctId = "";
258	else ws.ccAcctId = inp.isLow("ACCTSID") ? "" : padded;
259
260	editAccount(ctx, ws);
261
262	// CROSS FIELD EDITS
263	if (ws.editAcctFlag === " ") setMsg(ws, NO_SEARCH_CRITERIA_RECEIVED);
264	}
265
266	/** 2210-EDIT-ACCOUNT (COACTVWC.cbl:649-681) */
267	function editAccount(ctx: Cics, ws: Ws): void {
268	const area = ctx.area();
269	ws.editAcctFlag = "0";
270	if (isBlank(ws.ccAcctId)) {
271	ws.inputFlag = "1";
272	ws.editAcctFlag = " ";
273	if (returnMsgOff(ws)) setMsg(ws, WS_PROMPT_FOR_ACCT);
274	area.acctId = 0;
275	return;
276	}
277	if (!isNumericText(ws.ccAcctId) \|\| Number(ws.ccAcctId) === 0) {
278	ws.inputFlag = "1";
279	ws.editAcctFlag = "0";
280	// Note the double space: the literal reads 'Account Filter must be ...'.
281	if (returnMsgOff(ws)) setMsg(ws, "Account Filter must be a non-zero 11 digit number");
282	area.acctId = 0;
283	return;
284	}
285	area.acctId = Number(ws.ccAcctId);
286	ws.editAcctFlag = "1";
287	}
288
289	/** 9000-READ-ACCT (COACTVWC.cbl:687-718) */
290	function readAcct(ctx: Cics, ws: Ws): void {
291	const area = ctx.area();
292	ws.infoMsg = ""; // SET WS-NO-INFO-MESSAGE TO TRUE
293	ws.ridAcctId = String(area.acctId).padStart(11, "0");
294
295	getCardXrefByAcct(ctx, ws);
296	if (ws.editAcctFlag === "0") return;
297
298	getAcctDataByAcct(ctx, ws);
299	// IF DID-NOT-FIND-ACCT-IN-ACCTDAT: that 88 is never set (commented out at line 792),
300	// so the customer read is attempted even when the account was not found.
301
302	ws.ridCustId = String(area.custId).padStart(9, "0");
303	getCustDataByCust(ctx, ws);
304	}
305
306	/** WS-FILE-ERROR-MESSAGE (COACTVWC.cbl:86-105) */
307	function fileErrorMessage(op: string, file: string, resp: number): string {
308	return `File Error: ${op.padEnd(8).slice(0, 8)} on ${file.padEnd(9).slice(0, 9)} returned RESP ${respX10(resp)},RESP2 ${respX10(resp2Of(resp))} `;
309	}
310
311	/** 9200-GETCARDXREF-BYACCT (COACTVWC.cbl:723-770) */
312	function getCardXrefByAcct(ctx: Cics, ws: Ws): void {
313	const area = ctx.area();
314	const { resp, record } = ctx.read<CardXrefRecord>(LIT_CARDXREFNAME_ACCT_PATH.trim(), ws.ridAcctId);
315	if (resp === RESP.NORMAL && record) {
316	area.custId = record.xrefCustId;
317	area.cardNum = record.xrefCardNum;
318	} else if (resp === RESP.NOTFND) {
319	ws.inputFlag = "1";
320	ws.editAcctFlag = "0";
321	if (returnMsgOff(ws)) {
322	setMsg(ws, `Account:${ws.ridAcctId} not found in Cross ref file. Resp:${respX10(resp)} Reas:${respX10(resp2Of(resp))}`);
323	}
324	} else {
325	ws.inputFlag = "1";
326	ws.editAcctFlag = "0";
327	setMsg(ws, fileErrorMessage("READ", LIT_CARDXREFNAME_ACCT_PATH, resp));
328	}
329	}
330
331	/** 9300-GETACCTDATA-BYACCT (COACTVWC.cbl:774-820) */
332	function getAcctDataByAcct(ctx: Cics, ws: Ws): void {
333	const { resp, record } = ctx.read<AccountRecord>(LIT_ACCTFILENAME.trim(), ws.ridAcctId);
334	if (resp === RESP.NORMAL && record) {
335	ws.account = record;
336	ws.foundAcctInMaster = true;
337	} else if (resp === RESP.NOTFND) {
338	ws.inputFlag = "1";
339	ws.editAcctFlag = "0";
340	if (returnMsgOff(ws)) {
341	setMsg(ws, `Account:${ws.ridAcctId} not found in Acct Master file.Resp:${respX10(resp)} Reas:${respX10(resp2Of(resp))}`);
342	}
343	} else {
344	ws.inputFlag = "1";
345	ws.editAcctFlag = "0";
346	setMsg(ws, fileErrorMessage("READ", LIT_ACCTFILENAME, resp));
347	}
348	}
349
350	/** 9400-GETCUSTDATA-BYCUST (COACTVWC.cbl:825-869) */
351	function getCustDataByCust(ctx: Cics, ws: Ws): void {
352	const { resp, record } = ctx.read<CustomerRecord>(LIT_CUSTFILENAME.trim(), ws.ridCustId);
353	if (resp === RESP.NORMAL && record) {
354	ws.customer = record;
355	ws.foundCustInMaster = true;
356	} else if (resp === RESP.NOTFND) {
357	ws.inputFlag = "1";
358	ws.editCustFlag = "0";
359	if (returnMsgOff(ws)) {
360	setMsg(ws, `CustId:${ws.ridCustId} not found in customer master.Resp: ${respX10(resp)} REAS:${respX10(resp2Of(resp))}`);
361	}
362	} else {
363	ws.inputFlag = "1";
364	ws.editCustFlag = "0";
365	setMsg(ws, fileErrorMessage("READ", LIT_CUSTFILENAME, resp));
366	}
367	}
368
369	/** SEND-PLAIN-TEXT (COACTVWC.cbl:877-887) */
370	function sendPlainText(ctx: Cics, ws: Ws): never {
371	ctx.sendText(ws.returnMsg);
372	ctx.return();
373	}
374
375	/** YYYY-STORE-PFKEY (app/cpy/CSSTRPFY.cpy, COPY at COACTVWC.cbl:913): PF13-24 fold onto PF1-12. */
376	function yyyyStorePfkey(ctx: Cics, ws: Ws): void {
377	const aid = ctx.eib.aid;
378	if (aid === "ENTER" \|\| aid === "CLEAR" \|\| aid === "PA1" \|\| aid === "PA2") ws.ccardAid = aid;
379	else if (aid.startsWith("PF")) {
380	const n = ((Number(aid.slice(2)) - 1) % 12) + 1;
381	ws.ccardAid = `PFK${String(n).padStart(2, "0")}`;
382	}
383	// PA3: no WHEN matches, CCARD-AID keeps its INITIALIZEd value (spaces).
384	}

COBOL app/cbl/COACTVWC.cbl

1	*****************************************************************
2	* Program: COACTVWC.CBL *
3	* Layer: Business logic *
4	* Function: Accept and process Account View request *
5	******************************************************************
6	* Copyright Amazon.com, Inc. or its affiliates.
7	* All Rights Reserved.
8	*
9	* Licensed under the Apache License, Version 2.0 (the "License").
10	* You may not use this file except in compliance with the License.
11	* You may obtain a copy of the License at
12	*
13	* http://www.apache.org/licenses/LICENSE-2.0
14	*
15	* Unless required by applicable law or agreed to in writing,
16	* software distributed under the License is distributed on an
17	* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
18	* either express or implied. See the License for the specific
19	* language governing permissions and limitations under the License
20	******************************************************************
21	IDENTIFICATION DIVISION.
22	PROGRAM-ID.
23	COACTVWC.
24	DATE-WRITTEN.
25	May 2022.
26	DATE-COMPILED.
27	Today.
28
29	ENVIRONMENT DIVISION.
30	INPUT-OUTPUT SECTION.
31
32	DATA DIVISION.
33
34	WORKING-STORAGE SECTION.
35	01 WS-MISC-STORAGE.
36	******************************************************************
37	* General CICS related
38	******************************************************************
39	05 WS-CICS-PROCESSNG-VARS.
40	07 WS-RESP-CD PIC S9(09) COMP
41	VALUE ZEROS.
42	07 WS-REAS-CD PIC S9(09) COMP
43	VALUE ZEROS.
44	07 WS-TRANID PIC X(4)
45	VALUE SPACES.
46	******************************************************************
47	* Input edits
48	******************************************************************
49
50	05 WS-INPUT-FLAG PIC X(1).
51	88 INPUT-OK VALUE '0'.
52	88 INPUT-ERROR VALUE '1'.
53	88 INPUT-PENDING VALUE LOW-VALUES.
54	05 WS-PFK-FLAG PIC X(1).
55	88 PFK-VALID VALUE '0'.
56	88 PFK-INVALID VALUE '1'.
57	88 INPUT-PENDING VALUE LOW-VALUES.
58	05 WS-EDIT-ACCT-FLAG PIC X(1).
59	88 FLG-ACCTFILTER-NOT-OK VALUE '0'.
60	88 FLG-ACCTFILTER-ISVALID VALUE '1'.
61	88 FLG-ACCTFILTER-BLANK VALUE ' '.
62	05 WS-EDIT-CUST-FLAG PIC X(1).
63	88 FLG-CUSTFILTER-NOT-OK VALUE '0'.
64	88 FLG-CUSTFILTER-ISVALID VALUE '1'.
65	88 FLG-CUSTFILTER-BLANK VALUE ' '.
66	******************************************************************
67	* Output edits
68	******************************************************************
69	* 05 EDIT-FIELD-9-2 PIC +ZZZ,ZZZ,ZZZ.99.
70	******************************************************************
71	* File and data Handling
72	******************************************************************
73	05 WS-XREF-RID.
74	10 WS-CARD-RID-CARDNUM PIC X(16).
75	10 WS-CARD-RID-CUST-ID PIC 9(09).
76	10 WS-CARD-RID-CUST-ID-X REDEFINES
77	WS-CARD-RID-CUST-ID PIC X(09).
78	10 WS-CARD-RID-ACCT-ID PIC 9(11).
79	10 WS-CARD-RID-ACCT-ID-X REDEFINES
80	WS-CARD-RID-ACCT-ID PIC X(11).
81	05 WS-FILE-READ-FLAGS.
82	10 WS-ACCOUNT-MASTER-READ-FLAG PIC X(1).
83	88 FOUND-ACCT-IN-MASTER VALUE '1'.
84	10 WS-CUST-MASTER-READ-FLAG PIC X(1).
85	88 FOUND-CUST-IN-MASTER VALUE '1'.
86	05 WS-FILE-ERROR-MESSAGE.
87	10 FILLER PIC X(12)
88	VALUE 'File Error: '.
89	10 ERROR-OPNAME PIC X(8)
90	VALUE SPACES.
91	10 FILLER PIC X(4)
92	VALUE ' on '.
93	10 ERROR-FILE PIC X(9)
94	VALUE SPACES.
95	10 FILLER PIC X(15)
96	VALUE
97	' returned RESP '.
98	10 ERROR-RESP PIC X(10)
99	VALUE SPACES.
100	10 FILLER PIC X(7)
101	VALUE ',RESP2 '.
102	10 ERROR-RESP2 PIC X(10)
103	VALUE SPACES.
104	10 FILLER PIC X(5)
105	VALUE SPACES.
106	******************************************************************
107	* Output Message Construction
108	******************************************************************
109	05 WS-LONG-MSG PIC X(500).
110	05 WS-INFO-MSG PIC X(40).
111	88 WS-NO-INFO-MESSAGE VALUES
112	SPACES LOW-VALUES.
113	88 WS-PROMPT-FOR-INPUT VALUE
114	'Enter or update id of account to display'.
115	88 WS-INFORM-OUTPUT VALUE
116	'Displaying details of given Account'.
117	05 WS-RETURN-MSG PIC X(75).
118	88 WS-RETURN-MSG-OFF VALUE SPACES.
119	88 WS-EXIT-MESSAGE VALUE
120	'PF03 pressed.Exiting '.
121	88 WS-PROMPT-FOR-ACCT VALUE
122	'Account number not provided'.
123	88 NO-SEARCH-CRITERIA-RECEIVED VALUE
124	'No input received'.
125	88 SEARCHED-ACCT-ZEROES VALUE
126	'Account number must be a non zero 11 digit number'.
127	88 SEARCHED-ACCT-NOT-NUMERIC VALUE
128	'Account number must be a non zero 11 digit number'.
129	88 DID-NOT-FIND-ACCT-IN-CARDXREF VALUE
130	'Did not find this account in account card xref file'.
131	88 DID-NOT-FIND-ACCT-IN-ACCTDAT VALUE
132	'Did not find this account in account master file'.
133	88 DID-NOT-FIND-CUST-IN-CUSTDAT VALUE
134	'Did not find associated customer in master file'.
135	88 XREF-READ-ERROR VALUE
136	'Error reading account card xref File'.
137	88 CODING-TO-BE-DONE VALUE
138	'Looks Good.... so far'.
139	*****************************************************************
140	* Literals and Constants
141	******************************************************************
142	01 WS-LITERALS.
143	05 LIT-THISPGM PIC X(8)
144	VALUE 'COACTVWC'.
145	05 LIT-THISTRANID PIC X(4)
146	VALUE 'CAVW'.
147	05 LIT-THISMAPSET PIC X(8)
148	VALUE 'COACTVW '.
149	05 LIT-THISMAP PIC X(7)
150	VALUE 'CACTVWA'.
151	05 LIT-CCLISTPGM PIC X(8)
152	VALUE 'COCRDLIC'.
153	05 LIT-CCLISTTRANID PIC X(4)
154	VALUE 'CCLI'.
155	05 LIT-CCLISTMAPSET PIC X(7)
156	VALUE 'COCRDLI'.
157	05 LIT-CCLISTMAP PIC X(7)
158	VALUE 'CCRDSLA'.
159	05 LIT-CARDUPDATEPGM PIC X(8)
160	VALUE 'COCRDUPC'.
161	05 LIT-CARDUDPATETRANID PIC X(4)
162	VALUE 'CCUP'.
163	05 LIT-CARDUPDATEMAPSET PIC X(8)
164	VALUE 'COCRDUP '.
165	05 LIT-CARDUPDATEMAP PIC X(7)
166	VALUE 'CCRDUPA'.
167
168	05 LIT-MENUPGM PIC X(8)
169	VALUE 'COMEN01C'.
170	05 LIT-MENUTRANID PIC X(4)
171	VALUE 'CM00'.
172	05 LIT-MENUMAPSET PIC X(7)
173	VALUE 'COMEN01'.
174	05 LIT-MENUMAP PIC X(7)
175	VALUE 'COMEN1A'.
176	05 LIT-CARDDTLPGM PIC X(8)
177	VALUE 'COCRDSLC'.
178	05 LIT-CARDDTLTRANID PIC X(4)
179	VALUE 'CCDL'.
180	05 LIT-CARDDTLMAPSET PIC X(7)
181	VALUE 'COCRDSL'.
182	05 LIT-CARDDTLMAP PIC X(7)
183	VALUE 'CCRDSLA'.
184	05 LIT-ACCTFILENAME PIC X(8)
185	VALUE 'ACCTDAT '.
186	05 LIT-CARDFILENAME PIC X(8)
187	VALUE 'CARDDAT '.
188	05 LIT-CUSTFILENAME PIC X(8)
189	VALUE 'CUSTDAT '.
190	05 LIT-CARDFILENAME-ACCT-PATH PIC X(8)
191	VALUE 'CARDAIX '.
192	05 LIT-CARDXREFNAME-ACCT-PATH PIC X(8)
193	VALUE 'CXACAIX '.
194	05 LIT-ALL-ALPHA-FROM PIC X(52)
195	VALUE
196	'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'.
197	05 LIT-ALL-SPACES-TO PIC X(52)
198	VALUE SPACES.
199	05 LIT-UPPER PIC X(26)
200	VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
201	05 LIT-LOWER PIC X(26)
202	VALUE 'abcdefghijklmnopqrstuvwxyz'.
203
204	******************************************************************
205	*Other common working storage Variables
206	******************************************************************
207	COPY CVCRD01Y.
208
209	******************************************************************
210	*Application Commmarea Copybook
211	COPY COCOM01Y.
212
213	01 WS-THIS-PROGCOMMAREA.
214	05 CA-CALL-CONTEXT.
215	10 CA-FROM-PROGRAM PIC X(08).
216	10 CA-FROM-TRANID PIC X(04).
217
218	01 WS-COMMAREA PIC X(2000).
219
220	*IBM SUPPLIED COPYBOOKS
221	COPY DFHBMSCA.
222	COPY DFHAID.
223
224	*COMMON COPYBOOKS
225	*Screen Titles
226	COPY COTTL01Y.
227
228	*BMS Copybook
229	COPY COACTVW.
230
231	*Current Date
232	COPY CSDAT01Y.
233
234	*Common Messages
235	COPY CSMSG01Y.
236
237	*Abend Variables
238	COPY CSMSG02Y.
239
240	*Signed on user data
241	COPY CSUSR01Y.
242
243	*ACCOUNT RECORD LAYOUT
244	COPY CVACT01Y.
245
246
247	*CUSTOMER RECORD LAYOUT
248	COPY CVACT02Y.
249
250	*CARD XREF LAYOUT
251	COPY CVACT03Y.
252
253	*CUSTOMER LAYOUT
254	COPY CVCUS01Y.
255
256	LINKAGE SECTION.
257	01 DFHCOMMAREA.
258	05 FILLER PIC X(1)
259	OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
260
261	PROCEDURE DIVISION.
262	0000-MAIN.
263
264	EXEC CICS HANDLE ABEND
265	LABEL(ABEND-ROUTINE)
266	END-EXEC
267
268	INITIALIZE CC-WORK-AREA
269	WS-MISC-STORAGE
270	WS-COMMAREA
271	*****************************************************************
272	* Store our context
273	*****************************************************************
274	MOVE LIT-THISTRANID TO WS-TRANID
275	*****************************************************************
276	* Ensure error message is cleared *
277	*****************************************************************
278	SET WS-RETURN-MSG-OFF TO TRUE
279	*****************************************************************
280	* Store passed data if any *
281	*****************************************************************
282	IF EIBCALEN IS EQUAL TO 0
283	OR (CDEMO-FROM-PROGRAM = LIT-MENUPGM
284	AND NOT CDEMO-PGM-REENTER)
285	INITIALIZE CARDDEMO-COMMAREA
286	WS-THIS-PROGCOMMAREA
287	ELSE
288	MOVE DFHCOMMAREA (1:LENGTH OF CARDDEMO-COMMAREA) TO
289	CARDDEMO-COMMAREA
290	MOVE DFHCOMMAREA(LENGTH OF CARDDEMO-COMMAREA + 1:
291	LENGTH OF WS-THIS-PROGCOMMAREA ) TO
292	WS-THIS-PROGCOMMAREA
293	END-IF
294
295	*****************************************************************
296	* Remap PFkeys as needed.
297	* Store the Mapped PF Key
298	*****************************************************************
299	PERFORM YYYY-STORE-PFKEY
300	THRU YYYY-STORE-PFKEY-EXIT
301	*****************************************************************
302	* Check the AID to see if its valid at this point *
303	* F3 - Exit
304	* Enter show screen again
305	*****************************************************************
306	SET PFK-INVALID TO TRUE
307	IF CCARD-AID-ENTER OR
308	CCARD-AID-PFK03
309	SET PFK-VALID TO TRUE
310	END-IF
311
312	IF PFK-INVALID
313	SET CCARD-AID-ENTER TO TRUE
314	END-IF
315
316	*****************************************************************
317	* Decide what to do based on inputs received
318	*****************************************************************
319	*****************************************************************
320	*****************************************************************
321	* Decide what to do based on inputs received
322	*****************************************************************
323	EVALUATE TRUE
324	WHEN CCARD-AID-PFK03
325	******************************************************************
326	* XCTL TO CALLING PROGRAM OR MAIN MENU
327	******************************************************************
328	IF CDEMO-FROM-TRANID EQUAL LOW-VALUES
329	OR CDEMO-FROM-TRANID EQUAL SPACES
330	MOVE LIT-MENUTRANID TO CDEMO-TO-TRANID
331	ELSE
332	MOVE CDEMO-FROM-TRANID TO CDEMO-TO-TRANID
333	END-IF
334	IF CDEMO-FROM-PROGRAM EQUAL LOW-VALUES
335	OR CDEMO-FROM-PROGRAM EQUAL SPACES
336	MOVE LIT-MENUPGM TO CDEMO-TO-PROGRAM
337	ELSE
338	MOVE CDEMO-FROM-PROGRAM TO CDEMO-TO-PROGRAM
339	END-IF
340
341	MOVE LIT-THISTRANID TO CDEMO-FROM-TRANID
342	MOVE LIT-THISPGM TO CDEMO-FROM-PROGRAM
343
344	SET CDEMO-USRTYP-USER TO TRUE
345	SET CDEMO-PGM-ENTER TO TRUE
346	MOVE LIT-THISMAPSET TO CDEMO-LAST-MAPSET
347	MOVE LIT-THISMAP TO CDEMO-LAST-MAP
348	*
349	EXEC CICS XCTL
350	PROGRAM (CDEMO-TO-PROGRAM)
351	COMMAREA(CARDDEMO-COMMAREA)
352	END-EXEC
353	WHEN CDEMO-PGM-ENTER
354	******************************************************************
355	* COMING FROM SOME OTHER CONTEXT
356	* SELECTION CRITERIA TO BE GATHERED
357	******************************************************************
358	PERFORM 1000-SEND-MAP THRU
359	1000-SEND-MAP-EXIT
360	GO TO COMMON-RETURN
361	WHEN CDEMO-PGM-REENTER
362	PERFORM 2000-PROCESS-INPUTS
363	THRU 2000-PROCESS-INPUTS-EXIT
364	IF INPUT-ERROR
365	PERFORM 1000-SEND-MAP
366	THRU 1000-SEND-MAP-EXIT
367	GO TO COMMON-RETURN
368	ELSE
369	PERFORM 9000-READ-ACCT
370	THRU 9000-READ-ACCT-EXIT
371	PERFORM 1000-SEND-MAP
372	THRU 1000-SEND-MAP-EXIT
373	GO TO COMMON-RETURN
374	END-IF
375	WHEN OTHER
376	MOVE LIT-THISPGM TO ABEND-CULPRIT
377	MOVE '0001' TO ABEND-CODE
378	MOVE SPACES TO ABEND-REASON
379	MOVE 'UNEXPECTED DATA SCENARIO'
380	TO WS-RETURN-MSG
381	PERFORM SEND-PLAIN-TEXT
382	THRU SEND-PLAIN-TEXT-EXIT
383	END-EVALUATE
384
385	* If we had an error setup error message that slipped through
386	* Display and return
387	IF INPUT-ERROR
388	MOVE WS-RETURN-MSG TO CCARD-ERROR-MSG
389	PERFORM 1000-SEND-MAP
390	THRU 1000-SEND-MAP-EXIT
391	GO TO COMMON-RETURN
392	END-IF
393	.
394	COMMON-RETURN.
395	MOVE WS-RETURN-MSG TO CCARD-ERROR-MSG
396
397	MOVE CARDDEMO-COMMAREA TO WS-COMMAREA
398	MOVE WS-THIS-PROGCOMMAREA TO
399	WS-COMMAREA(LENGTH OF CARDDEMO-COMMAREA + 1:
400	LENGTH OF WS-THIS-PROGCOMMAREA )
401
402	EXEC CICS RETURN
403	TRANSID (LIT-THISTRANID)
404	COMMAREA (WS-COMMAREA)
405	LENGTH(LENGTH OF WS-COMMAREA)
406	END-EXEC
407	.
408	0000-MAIN-EXIT.
409	EXIT
410	.
411	0000-MAIN-EXIT.
412	EXIT
413	.
414
415
416	1000-SEND-MAP.
417	PERFORM 1100-SCREEN-INIT
418	THRU 1100-SCREEN-INIT-EXIT
419	PERFORM 1200-SETUP-SCREEN-VARS
420	THRU 1200-SETUP-SCREEN-VARS-EXIT
421	PERFORM 1300-SETUP-SCREEN-ATTRS
422	THRU 1300-SETUP-SCREEN-ATTRS-EXIT
423	PERFORM 1400-SEND-SCREEN
424	THRU 1400-SEND-SCREEN-EXIT
425	.
426
427	1000-SEND-MAP-EXIT.
428	EXIT
429	.
430
431	1100-SCREEN-INIT.
432	MOVE LOW-VALUES TO CACTVWAO
433
434	MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
435
436	MOVE CCDA-TITLE01 TO TITLE01O OF CACTVWAO
437	MOVE CCDA-TITLE02 TO TITLE02O OF CACTVWAO
438	MOVE LIT-THISTRANID TO TRNNAMEO OF CACTVWAO
439	MOVE LIT-THISPGM TO PGMNAMEO OF CACTVWAO
440
441	MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
442
443	MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
444	MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
445	MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
446
447	MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF CACTVWAO
448
449	MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
450	MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
451	MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
452
453	MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF CACTVWAO
454
455	.
456
457	1100-SCREEN-INIT-EXIT.
458	EXIT
459	.
460	1200-SETUP-SCREEN-VARS.
461	* INITIALIZE SEARCH CRITERIA
462	IF EIBCALEN = 0
463	SET WS-PROMPT-FOR-INPUT TO TRUE
464	ELSE
465	IF FLG-ACCTFILTER-BLANK
466	MOVE LOW-VALUES TO ACCTSIDO OF CACTVWAO
467	ELSE
468	MOVE CC-ACCT-ID TO ACCTSIDO OF CACTVWAO
469	END-IF
470
471	IF FOUND-ACCT-IN-MASTER
472	OR FOUND-CUST-IN-MASTER
473	MOVE ACCT-ACTIVE-STATUS TO ACSTTUSO OF CACTVWAO
474
475	MOVE ACCT-CURR-BAL TO ACURBALO OF CACTVWAO
476
477	MOVE ACCT-CREDIT-LIMIT TO ACRDLIMO OF CACTVWAO
478
479	MOVE ACCT-CASH-CREDIT-LIMIT
480	TO ACSHLIMO OF CACTVWAO
481
482	MOVE ACCT-CURR-CYC-CREDIT
483	TO ACRCYCRO OF CACTVWAO
484
485	MOVE ACCT-CURR-CYC-DEBIT TO ACRCYDBO OF CACTVWAO
486
487	MOVE ACCT-OPEN-DATE TO ADTOPENO OF CACTVWAO
488	MOVE ACCT-EXPIRAION-DATE TO AEXPDTO OF CACTVWAO
489	MOVE ACCT-REISSUE-DATE TO AREISDTO OF CACTVWAO
490	MOVE ACCT-GROUP-ID TO AADDGRPO OF CACTVWAO
491	END-IF
492
493	IF FOUND-CUST-IN-MASTER
494	MOVE CUST-ID TO ACSTNUMO OF CACTVWAO
495	* MOVE CUST-SSN TO ACSTSSNO OF CACTVWAO
496	STRING
497	CUST-SSN(1:3)
498	'-'
499	CUST-SSN(4:2)
500	'-'
501	CUST-SSN(6:4)
502	DELIMITED BY SIZE
503	INTO ACSTSSNO OF CACTVWAO
504	END-STRING
505	MOVE CUST-FICO-CREDIT-SCORE
506	TO ACSTFCOO OF CACTVWAO
507	MOVE CUST-DOB-YYYY-MM-DD TO ACSTDOBO OF CACTVWAO
508	MOVE CUST-FIRST-NAME TO ACSFNAMO OF CACTVWAO
509	MOVE CUST-MIDDLE-NAME TO ACSMNAMO OF CACTVWAO
510	MOVE CUST-LAST-NAME TO ACSLNAMO OF CACTVWAO
511	MOVE CUST-ADDR-LINE-1 TO ACSADL1O OF CACTVWAO
512	MOVE CUST-ADDR-LINE-2 TO ACSADL2O OF CACTVWAO
513	MOVE CUST-ADDR-LINE-3 TO ACSCITYO OF CACTVWAO
514	MOVE CUST-ADDR-STATE-CD TO ACSSTTEO OF CACTVWAO
515	MOVE CUST-ADDR-ZIP TO ACSZIPCO OF CACTVWAO
516	MOVE CUST-ADDR-COUNTRY-CD TO ACSCTRYO OF CACTVWAO
517	MOVE CUST-PHONE-NUM-1 TO ACSPHN1O OF CACTVWAO
518	MOVE CUST-PHONE-NUM-2 TO ACSPHN2O OF CACTVWAO
519	MOVE CUST-GOVT-ISSUED-ID TO ACSGOVTO OF CACTVWAO
520	MOVE CUST-EFT-ACCOUNT-ID TO ACSEFTCO OF CACTVWAO
521	MOVE CUST-PRI-CARD-HOLDER-IND
522	TO ACSPFLGO OF CACTVWAO
523	END-IF
524
525	END-IF
526
527	* SETUP MESSAGE
528	IF WS-NO-INFO-MESSAGE
529	SET WS-PROMPT-FOR-INPUT TO TRUE
530	END-IF
531
532	MOVE WS-RETURN-MSG TO ERRMSGO OF CACTVWAO
533
534	MOVE WS-INFO-MSG TO INFOMSGO OF CACTVWAO
535	.
536
537	1200-SETUP-SCREEN-VARS-EXIT.
538	EXIT
539	.
540
541	1300-SETUP-SCREEN-ATTRS.
542	* PROTECT OR UNPROTECT BASED ON CONTEXT
543	MOVE DFHBMFSE TO ACCTSIDA OF CACTVWAI
544
545	* POSITION CURSOR
546	EVALUATE TRUE
547	WHEN FLG-ACCTFILTER-NOT-OK
548	WHEN FLG-ACCTFILTER-BLANK
549	MOVE -1 TO ACCTSIDL OF CACTVWAI
550	WHEN OTHER
551	MOVE -1 TO ACCTSIDL OF CACTVWAI
552	END-EVALUATE
553
554	* SETUP COLOR
555	MOVE DFHDFCOL TO ACCTSIDC OF CACTVWAO
556
557	IF FLG-ACCTFILTER-NOT-OK
558	MOVE DFHRED TO ACCTSIDC OF CACTVWAO
559	END-IF
560
561	IF FLG-ACCTFILTER-BLANK
562	AND CDEMO-PGM-REENTER
563	MOVE '*' TO ACCTSIDO OF CACTVWAO
564	MOVE DFHRED TO ACCTSIDC OF CACTVWAO
565	END-IF
566
567	IF WS-NO-INFO-MESSAGE
568	MOVE DFHBMDAR TO INFOMSGC OF CACTVWAO
569	ELSE
570	MOVE DFHNEUTR TO INFOMSGC OF CACTVWAO
571	END-IF
572	.
573
574	1300-SETUP-SCREEN-ATTRS-EXIT.
575	EXIT
576	.
577	1400-SEND-SCREEN.
578
579	MOVE LIT-THISMAPSET TO CCARD-NEXT-MAPSET
580	MOVE LIT-THISMAP TO CCARD-NEXT-MAP
581	SET CDEMO-PGM-REENTER TO TRUE
582
583	EXEC CICS SEND MAP(CCARD-NEXT-MAP)
584	MAPSET(CCARD-NEXT-MAPSET)
585	FROM(CACTVWAO)
586	CURSOR
587	ERASE
588	FREEKB
589	RESP(WS-RESP-CD)
590	END-EXEC
591	.
592	1400-SEND-SCREEN-EXIT.
593	EXIT
594	.
595
596	2000-PROCESS-INPUTS.
597	PERFORM 2100-RECEIVE-MAP
598	THRU 2100-RECEIVE-MAP-EXIT
599	PERFORM 2200-EDIT-MAP-INPUTS
600	THRU 2200-EDIT-MAP-INPUTS-EXIT
601	MOVE WS-RETURN-MSG TO CCARD-ERROR-MSG
602	MOVE LIT-THISPGM TO CCARD-NEXT-PROG
603	MOVE LIT-THISMAPSET TO CCARD-NEXT-MAPSET
604	MOVE LIT-THISMAP TO CCARD-NEXT-MAP
605	.
606
607	2000-PROCESS-INPUTS-EXIT.
608	EXIT
609	.
610	2100-RECEIVE-MAP.
611	EXEC CICS RECEIVE MAP(LIT-THISMAP)
612	MAPSET(LIT-THISMAPSET)
613	INTO(CACTVWAI)
614	RESP(WS-RESP-CD)
615	RESP2(WS-REAS-CD)
616	END-EXEC
617	.
618
619	2100-RECEIVE-MAP-EXIT.
620	EXIT
621	.
622	2200-EDIT-MAP-INPUTS.
623
624	SET INPUT-OK TO TRUE
625	SET FLG-ACCTFILTER-ISVALID TO TRUE
626
627	* REPLACE * WITH LOW-VALUES
628	IF ACCTSIDI OF CACTVWAI = '*'
629	OR ACCTSIDI OF CACTVWAI = SPACES
630	MOVE LOW-VALUES TO CC-ACCT-ID
631	ELSE
632	MOVE ACCTSIDI OF CACTVWAI TO CC-ACCT-ID
633	END-IF
634
635	* INDIVIDUAL FIELD EDITS
636	PERFORM 2210-EDIT-ACCOUNT
637	THRU 2210-EDIT-ACCOUNT-EXIT
638
639	* CROSS FIELD EDITS
640	IF FLG-ACCTFILTER-BLANK
641	SET NO-SEARCH-CRITERIA-RECEIVED TO TRUE
642	END-IF
643	.
644
645	2200-EDIT-MAP-INPUTS-EXIT.
646	EXIT
647	.
648
649	2210-EDIT-ACCOUNT.
650	SET FLG-ACCTFILTER-NOT-OK TO TRUE
651
652	* Not supplied
653	IF CC-ACCT-ID EQUAL LOW-VALUES
654	OR CC-ACCT-ID EQUAL SPACES
655	SET INPUT-ERROR TO TRUE
656	SET FLG-ACCTFILTER-BLANK TO TRUE
657	IF WS-RETURN-MSG-OFF
658	SET WS-PROMPT-FOR-ACCT TO TRUE
659	END-IF
660	MOVE ZEROES TO CDEMO-ACCT-ID
661	GO TO 2210-EDIT-ACCOUNT-EXIT
662	END-IF
663	*
664	* Not numeric
665	* Not 11 characters
666	IF CC-ACCT-ID IS NOT NUMERIC
667	OR CC-ACCT-ID EQUAL ZEROES
668	SET INPUT-ERROR TO TRUE
669	SET FLG-ACCTFILTER-NOT-OK TO TRUE
670	IF WS-RETURN-MSG-OFF
671	MOVE
672	'Account Filter must be a non-zero 11 digit number' 00
673	TO WS-RETURN-MSG
674	END-IF
675	MOVE ZERO TO CDEMO-ACCT-ID
676	GO TO 2210-EDIT-ACCOUNT-EXIT
677	ELSE
678	MOVE CC-ACCT-ID TO CDEMO-ACCT-ID
679	SET FLG-ACCTFILTER-ISVALID TO TRUE
680	END-IF
681	.
682
683	2210-EDIT-ACCOUNT-EXIT.
684	EXIT
685	.
686
687	9000-READ-ACCT.
688
689	SET WS-NO-INFO-MESSAGE TO TRUE
690
691	MOVE CDEMO-ACCT-ID TO WS-CARD-RID-ACCT-ID
692
693	PERFORM 9200-GETCARDXREF-BYACCT
694	THRU 9200-GETCARDXREF-BYACCT-EXIT
695
696	* IF DID-NOT-FIND-ACCT-IN-CARDXREF
697	IF FLG-ACCTFILTER-NOT-OK
698	GO TO 9000-READ-ACCT-EXIT
699	END-IF
700
701	PERFORM 9300-GETACCTDATA-BYACCT
702	THRU 9300-GETACCTDATA-BYACCT-EXIT
703
704	IF DID-NOT-FIND-ACCT-IN-ACCTDAT
705	GO TO 9000-READ-ACCT-EXIT
706	END-IF
707
708	MOVE CDEMO-CUST-ID TO WS-CARD-RID-CUST-ID
709
710	PERFORM 9400-GETCUSTDATA-BYCUST
711	THRU 9400-GETCUSTDATA-BYCUST-EXIT
712
713	IF DID-NOT-FIND-CUST-IN-CUSTDAT
714	GO TO 9000-READ-ACCT-EXIT
715	END-IF
716
717
718	.
719
720	9000-READ-ACCT-EXIT.
721	EXIT
722	.
723	9200-GETCARDXREF-BYACCT.
724
725	* Read the Card file. Access via alternate index ACCTID
726	*
727	EXEC CICS READ
728	DATASET (LIT-CARDXREFNAME-ACCT-PATH)
729	RIDFLD (WS-CARD-RID-ACCT-ID-X)
730	KEYLENGTH (LENGTH OF WS-CARD-RID-ACCT-ID-X)
731	INTO (CARD-XREF-RECORD)
732	LENGTH (LENGTH OF CARD-XREF-RECORD)
733	RESP (WS-RESP-CD)
734	RESP2 (WS-REAS-CD)
735	END-EXEC
736
737	EVALUATE WS-RESP-CD
738	WHEN DFHRESP(NORMAL)
739	MOVE XREF-CUST-ID TO CDEMO-CUST-ID
740	MOVE XREF-CARD-NUM TO CDEMO-CARD-NUM
741	WHEN DFHRESP(NOTFND)
742	SET INPUT-ERROR TO TRUE
743	SET FLG-ACCTFILTER-NOT-OK TO TRUE
744	IF WS-RETURN-MSG-OFF
745	MOVE WS-RESP-CD TO ERROR-RESP
746	MOVE WS-REAS-CD TO ERROR-RESP2
747	STRING
748	'Account:'
749	WS-CARD-RID-ACCT-ID-X
750	' not found in'
751	' Cross ref file. Resp:'
752	ERROR-RESP
753	' Reas:'
754	ERROR-RESP2
755	DELIMITED BY SIZE
756	INTO WS-RETURN-MSG
757	END-STRING
758	END-IF
759	WHEN OTHER
760	SET INPUT-ERROR TO TRUE
761	SET FLG-ACCTFILTER-NOT-OK TO TRUE
762	MOVE 'READ' TO ERROR-OPNAME
763	MOVE LIT-CARDXREFNAME-ACCT-PATH TO ERROR-FILE
764	MOVE WS-RESP-CD TO ERROR-RESP
765	MOVE WS-REAS-CD TO ERROR-RESP2
766	MOVE WS-FILE-ERROR-MESSAGE TO WS-RETURN-MSG
767	* WS-LONG-MSG
768	* PERFORM SEND-LONG-TEXT
769	END-EVALUATE
770	.
771	9200-GETCARDXREF-BYACCT-EXIT.
772	EXIT
773	.
774	9300-GETACCTDATA-BYACCT.
775
776	EXEC CICS READ
777	DATASET (LIT-ACCTFILENAME)
778	RIDFLD (WS-CARD-RID-ACCT-ID-X)
779	KEYLENGTH (LENGTH OF WS-CARD-RID-ACCT-ID-X)
780	INTO (ACCOUNT-RECORD)
781	LENGTH (LENGTH OF ACCOUNT-RECORD)
782	RESP (WS-RESP-CD)
783	RESP2 (WS-REAS-CD)
784	END-EXEC
785
786	EVALUATE WS-RESP-CD
787	WHEN DFHRESP(NORMAL)
788	SET FOUND-ACCT-IN-MASTER TO TRUE
789	WHEN DFHRESP(NOTFND)
790	SET INPUT-ERROR TO TRUE
791	SET FLG-ACCTFILTER-NOT-OK TO TRUE
792	* SET DID-NOT-FIND-ACCT-IN-ACCTDAT TO TRUE
793	IF WS-RETURN-MSG-OFF
794	MOVE WS-RESP-CD TO ERROR-RESP
795	MOVE WS-REAS-CD TO ERROR-RESP2
796	STRING
797	'Account:'
798	WS-CARD-RID-ACCT-ID-X
799	' not found in'
800	' Acct Master file.Resp:'
801	ERROR-RESP
802	' Reas:'
803	ERROR-RESP2
804	DELIMITED BY SIZE
805	INTO WS-RETURN-MSG
806	END-STRING
807	END-IF
808	*
809	WHEN OTHER
810	SET INPUT-ERROR TO TRUE
811	SET FLG-ACCTFILTER-NOT-OK TO TRUE
812	MOVE 'READ' TO ERROR-OPNAME
813	MOVE LIT-ACCTFILENAME TO ERROR-FILE
814	MOVE WS-RESP-CD TO ERROR-RESP
815	MOVE WS-REAS-CD TO ERROR-RESP2
816	MOVE WS-FILE-ERROR-MESSAGE TO WS-RETURN-MSG
817	* WS-LONG-MSG
818	* PERFORM SEND-LONG-TEXT
819	END-EVALUATE
820	.
821	9300-GETACCTDATA-BYACCT-EXIT.
822	EXIT
823	.
824
825	9400-GETCUSTDATA-BYCUST.
826	EXEC CICS READ
827	DATASET (LIT-CUSTFILENAME)
828	RIDFLD (WS-CARD-RID-CUST-ID-X)
829	KEYLENGTH (LENGTH OF WS-CARD-RID-CUST-ID-X)
830	INTO (CUSTOMER-RECORD)
831	LENGTH (LENGTH OF CUSTOMER-RECORD)
832	RESP (WS-RESP-CD)
833	RESP2 (WS-REAS-CD)
834	END-EXEC
835
836	EVALUATE WS-RESP-CD
837	WHEN DFHRESP(NORMAL)
838	SET FOUND-CUST-IN-MASTER TO TRUE
839	WHEN DFHRESP(NOTFND)
840	SET INPUT-ERROR TO TRUE
841	SET FLG-CUSTFILTER-NOT-OK TO TRUE
842	* SET DID-NOT-FIND-CUST-IN-CUSTDAT TO TRUE
843	MOVE WS-RESP-CD TO ERROR-RESP
844	MOVE WS-REAS-CD TO ERROR-RESP2
845	IF WS-RETURN-MSG-OFF
846	STRING
847	'CustId:'
848	WS-CARD-RID-CUST-ID-X
849	' not found'
850	' in customer master.Resp: '
851	ERROR-RESP
852	' REAS:'
853	ERROR-RESP2
854	DELIMITED BY SIZE
855	INTO WS-RETURN-MSG
856	END-STRING
857	END-IF
858	WHEN OTHER
859	SET INPUT-ERROR TO TRUE
860	SET FLG-CUSTFILTER-NOT-OK TO TRUE
861	MOVE 'READ' TO ERROR-OPNAME
862	MOVE LIT-CUSTFILENAME TO ERROR-FILE
863	MOVE WS-RESP-CD TO ERROR-RESP
864	MOVE WS-REAS-CD TO ERROR-RESP2
865	MOVE WS-FILE-ERROR-MESSAGE TO WS-RETURN-MSG
866	* WS-LONG-MSG
867	* PERFORM SEND-LONG-TEXT
868	END-EVALUATE
869	.
870	9400-GETCUSTDATA-BYCUST-EXIT.
871	EXIT
872	.
873
874	*****************************************************************
875	* Plain text exit - Dont use in production *
876	*****************************************************************
877	SEND-PLAIN-TEXT.
878	EXEC CICS SEND TEXT
879	FROM(WS-RETURN-MSG)
880	LENGTH(LENGTH OF WS-RETURN-MSG)
881	ERASE
882	FREEKB
883	END-EXEC
884
885	EXEC CICS RETURN
886	END-EXEC
887	.
888	SEND-PLAIN-TEXT-EXIT.
889	EXIT
890	.
891	*****************************************************************
892	* Display Long text and exit *
893	* This is primarily for debugging and should not be used in *
894	* regular course *
895	*****************************************************************
896	SEND-LONG-TEXT.
897	EXEC CICS SEND TEXT
898	FROM(WS-LONG-MSG)
899	LENGTH(LENGTH OF WS-LONG-MSG)
900	ERASE
901	FREEKB
902	END-EXEC
903
904	EXEC CICS RETURN
905	END-EXEC
906	.
907	SEND-LONG-TEXT-EXIT.
908	EXIT
909	.
910	*****************************************************************
911	*Common code to store PFKey
912	******************************************************************
913	COPY 'CSSTRPFY'
914	.
915
916	ABEND-ROUTINE.
917
918	IF ABEND-MSG EQUAL LOW-VALUES
919	MOVE 'UNEXPECTED ABEND OCCURRED.' TO ABEND-MSG
920	END-IF
921
922	MOVE LIT-THISPGM TO ABEND-CULPRIT
923
924	EXEC CICS SEND
925	FROM (ABEND-DATA)
926	LENGTH(LENGTH OF ABEND-DATA)
927	NOHANDLE
928	END-EXEC
929
930	EXEC CICS HANDLE ABEND
931	CANCEL
932	END-EXEC
933
934	EXEC CICS ABEND
935	ABCODE('9999')
936	END-EXEC
937	.
938
939	*
940	* Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:32 CDT
941	*