MFmainframe-rea
WS carddemo · 26f629ef

Converted program · 699 lines of TypeScript from 1560 lines of COBOL · 1216 COBOL lines cited (78%)COCRDUPC

Run it on the 3270 →Analysis →All programs

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

1/**
2 * COCRDUPC — credit card update (transaction CCUP).
3 * Converted from app/cbl/COCRDUPC.cbl; screen COCRDUP/CCRDUPA; file CARDDAT (READ, READ UPDATE, REWRITE).
4 *
5 * States live in CCUP-CHANGE-ACTION inside WS-THIS-PROGCOMMAREA:
6 * not fetched -> 'S' details shown -> 'E' edit errors / 'N' validated, F5 to save
7 * -> 'C' saved, or 'L' / 'F' save failed.
8 * EXEC CICS HANDLE ABEND LABEL(ABEND-ROUTINE) is not modelled: the runtime's abend
9 * screen is shown instead of ABEND-DATA (only reachable on 'UNEXPECTED DATA SCENARIO').
10 */
11import { digits, isNumericText, upper } from "../runtime/cobol.js";
12import { RESP, type Cics, type CardDemoCommarea, type Program } from "../runtime/cics.js";
13import type { SymbolicMap } from "../runtime/screen.js";
14import type { CardRecord } from "../generated/records.js";
15import { populateHeaderInfo } from "./common.js";
16import {
17 BYTE,
18 cardNum16,
19 cardNumIsZero,
20 fileErrorMessage,
21 fieldX,
22 initializeCommarea,
23 isLowOrSpaces,
24 isStarOrSpaces,
25 low,
26 outValue,
27 receive,
28 resp2Of,
29 storePfkey,
30 xctlCommarea,
31 zonedIsZero,
32 zonedValue,
33 type CcardAid,
34} from "./cards-lib.js";
35
36// WS-LITERALS (COCRDUPC.cbl:218-263)
37const LIT_THISPGM = "COCRDUPC";
38const LIT_THISTRANID = "CCUP";
39const LIT_THISMAPSET = "COCRDUP"; // 'COCRDUP ' PIC X(8); CDEMO-LAST-MAPSET is X(7)
40const LIT_THISMAP = "CCRDUPA";
41const LIT_CCLISTPGM = "COCRDLIC";
42const LIT_CCLISTMAPSET = "COCRDLI";
43const LIT_MENUPGM = "COMEN01C";
44const LIT_MENUTRANID = "CM00";
45const LIT_CARDFILENAME = "CARDDAT";
46
47// WS-INFO-MSG 88 levels (COCRDUPC.cbl:157-171)
48const FOUND_CARDS_FOR_ACCOUNT = "Details of selected card shown above";
49const PROMPT_FOR_SEARCH_KEYS = "Please enter Account and Card Number";
50const PROMPT_FOR_CHANGES = "Update card details presented above.";
51const PROMPT_FOR_CONFIRMATION = "Changes validated.Press F5 to save";
52const CONFIRM_UPDATE_SUCCESS = "Changes committed to database";
53const INFORM_FAILURE = "Changes unsuccessful. Please try again";
54
55// WS-RETURN-MSG 88 levels (COCRDUPC.cbl:173-214)
56const WS_PROMPT_FOR_ACCT = "Account number not provided";
57const WS_PROMPT_FOR_CARD = "Card number not provided";
58const WS_PROMPT_FOR_NAME = "Card name not provided";
59const WS_NAME_MUST_BE_ALPHA = "Card name can only contain alphabets and spaces";
60const NO_SEARCH_CRITERIA_RECEIVED = "No input received";
61const NO_CHANGES_DETECTED = "No change detected with respect to values fetched.";
62const CARD_STATUS_MUST_BE_YES_NO = "Card Active Status must be Y or N";
63const CARD_EXPIRY_MONTH_NOT_VALID = "Card expiry month must be between 1 and 12";
64const CARD_EXPIRY_YEAR_NOT_VALID = "Invalid card expiry year";
65const DID_NOT_FIND_ACCTCARD_COMBO = "Did not find cards for this search condition";
66const COULD_NOT_LOCK_FOR_UPDATE = "Could not lock record for update";
67const DATA_WAS_CHANGED_BEFORE_UPDATE = "Record changed by some one else. Please review";
68const LOCKED_BUT_UPDATE_FAILED = "Update of record failed";
69
70/** CCUP-OLD-DETAILS / CCUP-NEW-DETAILS: PIC X items, "\0" = LOW-VALUES. */
71interface CardDetails {
72 acctId: string; // X(11)
73 cardId: string; // X(16)
74 cvvCd: string; // X(3)
75 crdName: string; // X(50)
76 expYear: string; // X(4)
77 expMon: string; // X(2)
78 expDay: string; // X(2)
79 crdStcd: string; // X(1)
80}
81
82/** WS-THIS-PROGCOMMAREA (COCRDUPC.cbl:274-321) */
83export interface CardUpdateCommarea {
84 /** CCUP-CHANGE-ACTION: LOW-VALUES/space = not fetched, S, E, N, C, L, F */
85 changeAction: string;
86 old: CardDetails;
87 new: CardDetails;
88}
89
90function blankDetails(): CardDetails {
91 return { acctId: " ".repeat(11), cardId: " ".repeat(16), cvvCd: " ", crdName: " ".repeat(50), expYear: " ", expMon: " ", expDay: " ", crdStcd: " " };
92}
93
94/** INITIALIZE WS-THIS-PROGCOMMAREA */
95function initialProgCommarea(): CardUpdateCommarea {
96 return { changeAction: " ", old: blankDetails(), new: blankDetails() };
97}
98
99/** CCUP-OLD-CARDDATA / CCUP-NEW-CARDDATA as one 59-byte group. */
100function cardData(d: CardDetails): string {
101 return d.crdName + d.expYear + d.expMon + d.expDay + d.crdStcd;
102}
103
104/** WS-MISC-STORAGE (INITIALIZEd: flags are spaces) and CC-WORK-AREA. */
105interface Task {
106 ctx: Cics;
107 area: CardDemoCommarea;
108 ext: CardUpdateCommarea;
109 out: SymbolicMap;
110 ccardAid: CcardAid;
111 ccAcctId: string;
112 ccCardNum: string;
113 inputFlag: string;
114 acctFlag: string;
115 cardFlag: string;
116 nameFlag: string;
117 statusFlag: string;
118 monFlag: string;
119 yearFlag: string;
120 infoMsg: string;
121 returnMsg: string;
122 card: CardRecord | undefined;
123}
124
125function freshMisc(t: Pick<Task, "inputFlag" | "acctFlag" | "cardFlag" | "nameFlag" | "statusFlag" | "monFlag" | "yearFlag" | "infoMsg" | "returnMsg">): void {
126 t.inputFlag = " ";
127 t.acctFlag = " ";
128 t.cardFlag = " ";
129 t.nameFlag = " ";
130 t.statusFlag = " ";
131 t.monFlag = " ";
132 t.yearFlag = " ";
133 t.infoMsg = "";
134 t.returnMsg = "";
135}
136
137const notFetched = (t: Task) => [" ", "", "\0"].includes(t.ext.changeAction);
138const changesMade = (t: Task) => ["E", "N", "C", "L", "F"].includes(t.ext.changeAction);
139const changesFailed = (t: Task) => ["L", "F"].includes(t.ext.changeAction);
140
141export const COCRDUPC: Program = {
142 name: LIT_THISPGM,
143 source: "app/cbl/COCRDUPC.cbl",
144 run(ctx: Cics) {
145 // 0000-MAIN (COCRDUPC.cbl:367-544)
146 const area = ctx.area();
147 const t = {
148 ctx,
149 area,
150 ext: ctx.ext(initialProgCommarea),
151 out: ctx.map(LIT_THISMAPSET, LIT_THISMAP),
152 ccardAid: "",
153 ccAcctId: "",
154 ccCardNum: "",
155 card: undefined,
156 } as unknown as Task;
157 freshMisc(t);
158 const { ext } = t;
159 const from = () => area.fromProgram.trim();
160
161 if (ctx.eib.calen === 0 || (from() === LIT_MENUPGM && area.pgmContext !== 1)) {
162 initializeCommarea(area);
163 Object.assign(ext, initialProgCommarea());
164 area.pgmContext = 0;
165 ext.changeAction = ""; // SET CCUP-DETAILS-NOT-FETCHED (LOW-VALUES)
166 }
167
168 t.ccardAid = storePfkey(ctx.eib.aid);
169 const pfkValid =
170 t.ccardAid === "ENTER" ||
171 t.ccardAid === "PFK03" ||
172 (t.ccardAid === "PFK05" && ext.changeAction === "N") ||
173 (t.ccardAid === "PFK12" && !notFetched(t));
174 if (!pfkValid) t.ccardAid = "ENTER";
175
176 const lastMapsetIsList = () => area.lastMapset.trim() === LIT_CCLISTMAPSET;
177
178 if (t.ccardAid === "PFK03" || (ext.changeAction === "C" && lastMapsetIsList()) || (changesFailed(t) && lastMapsetIsList())) {
179 // :435-476 exit, or done with an update started from the card list
180 t.ccardAid = "PFK03";
181 area.toTranid = isLowOrSpaces(area.fromTranid, 4) ? LIT_MENUTRANID : area.fromTranid;
182 area.toProgram = isLowOrSpaces(area.fromProgram, 8) ? LIT_MENUPGM : area.fromProgram;
183 area.fromTranid = LIT_THISTRANID;
184 area.fromProgram = LIT_THISPGM;
185 if (lastMapsetIsList()) {
186 area.acctId = 0;
187 area.cardNum = "0".repeat(16);
188 }
189 area.userType = "U";
190 area.pgmContext = 0;
191 area.lastMapset = LIT_THISMAPSET;
192 area.lastMap = LIT_THISMAP;
193 ctx.syncpoint();
194 xctlCommarea(ctx, area.toProgram);
195 } else if ((area.pgmContext === 0 && from() === LIT_CCLISTPGM) || (t.ccardAid === "PFK12" && from() === LIT_CCLISTPGM)) {
196 // :482-497 came from the card list (or F12 there): fetch the selected card
197 area.pgmContext = 1;
198 t.inputFlag = "0";
199 t.acctFlag = "1";
200 t.cardFlag = "1";
201 t.ccAcctId = digits(area.acctId, 11);
202 t.ccCardNum = cardNum16(area.cardNum);
203 readData(t);
204 ext.changeAction = "S";
205 sendMap(t);
206 commonReturn(t);
207 } else if ((notFetched(t) && area.pgmContext === 0) || (from() === LIT_MENUPGM && area.pgmContext !== 1)) {
208 // :502-511 fresh entry: ask for the keys
209 Object.assign(ext, initialProgCommarea());
210 sendMap(t);
211 area.pgmContext = 1;
212 ext.changeAction = "";
213 commonReturn(t);
214 } else if (ext.changeAction === "C" || changesFailed(t)) {
215 // :517-528 update done (or failed): reset the keys and ask again
216 Object.assign(ext, initialProgCommarea());
217 freshMisc(t);
218 area.acctId = 0;
219 area.cardNum = "0".repeat(16);
220 area.pgmContext = 0;
221 sendMap(t);
222 area.pgmContext = 1;
223 ext.changeAction = "";
224 commonReturn(t);
225 } else {
226 // :535-542 details on screen: edit the input and decide
227 processInputs(t);
228 decideAction(t);
229 sendMap(t);
230 commonReturn(t);
231 }
232 },
233};
234
235/** COMMON-RETURN (COCRDUPC.cbl:546-559) */
236function commonReturn(t: Task): never {
237 t.ctx.return(LIT_THISTRANID, t.area);
238}
239
240/** 1000-PROCESS-INPUTS (COCRDUPC.cbl:564-573) */
241function processInputs(t: Task): void {
242 receiveMap(t);
243 editMapInputs(t);
244}
245
246/** 1100-RECEIVE-MAP (COCRDUPC.cbl:578-636) */
247function receiveMap(t: Task): void {
248 const inp = receive(t.ctx, LIT_THISMAPSET, LIT_THISMAP);
249 t.out = inp;
250 const n = t.ext.new;
251 Object.assign(n, blankDetails()); // INITIALIZE CCUP-NEW-DETAILS
252
253 const acct = fieldX(inp, "ACCTSID", 11);
254 t.ccAcctId = isStarOrSpaces(acct, 11) ? low(11) : acct;
255 n.acctId = t.ccAcctId;
256
257 const card = fieldX(inp, "CARDSID", 16);
258 t.ccCardNum = isStarOrSpaces(card, 16) ? low(16) : card;
259 n.cardId = t.ccCardNum;
260
261 const name = fieldX(inp, "CRDNAME", 50);
262 n.crdName = isStarOrSpaces(name, 50) ? low(50) : name;
263
264 const stcd = fieldX(inp, "CRDSTCD", 1);
265 n.crdStcd = isStarOrSpaces(stcd, 1) ? low(1) : stcd;
266
267 n.expDay = fieldX(inp, "EXPDAY", 2);
268
269 const mon = fieldX(inp, "EXPMON", 2);
270 n.expMon = isStarOrSpaces(mon, 2) ? low(2) : mon;
271
272 const year = fieldX(inp, "EXPYEAR", 4);
273 n.expYear = isStarOrSpaces(year, 4) ? low(4) : year;
274}
275
276/** 1200-EDIT-MAP-INPUTS (COCRDUPC.cbl:641-715) */
277function editMapInputs(t: Task): void {
278 const { ext, area } = t;
279 t.inputFlag = "0";
280
281 if (notFetched(t)) {
282 // Validate the search keys only.
283 editAccount(t);
284 editCard(t);
285 const n = ext.new;
286 n.crdName = low(50); // MOVE LOW-VALUES TO CCUP-NEW-CARDDATA
287 n.expYear = low(4);
288 n.expMon = low(2);
289 n.expDay = low(2);
290 n.crdStcd = low(1);
291 if (t.acctFlag === " " && t.cardFlag === " ") t.returnMsg = NO_SEARCH_CRITERIA_RECEIVED;
292 return;
293 }
294
295 // Search keys already validated and data fetched.
296 t.infoMsg = FOUND_CARDS_FOR_ACCOUNT;
297 t.acctFlag = "1";
298 t.cardFlag = "1";
299 area.acctId = zonedValue(ext.old.acctId, 11) ?? 0;
300 area.cardNum = cardNum16(ext.old.cardId);
301
302 if (upper(cardData(ext.new)) === upper(cardData(ext.old))) t.returnMsg = NO_CHANGES_DETECTED;
303
304 if (t.returnMsg === NO_CHANGES_DETECTED || ext.changeAction === "N" || ext.changeAction === "C") {
305 t.nameFlag = "1";
306 t.statusFlag = "1";
307 t.monFlag = "1";
308 t.yearFlag = "1";
309 return;
310 }
311
312 ext.changeAction = "E"; // SET CCUP-CHANGES-NOT-OK
313 editName(t);
314 editCardStatus(t);
315 editExpiryMon(t);
316 editExpiryYear(t);
317 if (t.inputFlag !== "1") ext.changeAction = "N";
318}
319
320/** 1210-EDIT-ACCOUNT (COCRDUPC.cbl:721-756) */
321function editAccount(t: Task): void {
322 t.acctFlag = "0";
323 if (isLowOrSpaces(t.ccAcctId, 11) || zonedIsZero(t.ccAcctId, 11)) {
324 t.inputFlag = "1";
325 t.acctFlag = " ";
326 if (t.returnMsg === "") t.returnMsg = WS_PROMPT_FOR_ACCT;
327 t.area.acctId = 0;
328 t.ext.new.acctId = low(11);
329 return;
330 }
331 if (!isNumericText(t.ccAcctId)) {
332 t.inputFlag = "1";
333 t.acctFlag = "0";
334 if (t.returnMsg === "") t.returnMsg = "ACCOUNT FILTER,IF SUPPLIED MUST BE A 11 DIGIT NUMBER";
335 t.area.acctId = 0;
336 t.ext.new.acctId = low(11);
337 return;
338 }
339 t.area.acctId = Number(t.ccAcctId);
340 t.ext.new.acctId = t.ccAcctId;
341 t.acctFlag = "1";
342}
343
344/** 1220-EDIT-CARD (COCRDUPC.cbl:762-800) */
345function editCard(t: Task): void {
346 t.cardFlag = "0";
347 if (isLowOrSpaces(t.ccCardNum, 16) || zonedIsZero(t.ccCardNum, 16)) {
348 t.inputFlag = "1";
349 t.cardFlag = " ";
350 if (t.returnMsg === "") t.returnMsg = WS_PROMPT_FOR_CARD;
351 t.area.cardNum = "0".repeat(16);
352 t.ext.new.cardId = "0".repeat(16); // MOVE ZEROES TO ... CCUP-NEW-CARDID
353 return;
354 }
355 if (!isNumericText(t.ccCardNum)) {
356 t.inputFlag = "1";
357 t.cardFlag = "0";
358 if (t.returnMsg === "") t.returnMsg = "CARD ID FILTER,IF SUPPLIED MUST BE A 16 DIGIT NUMBER";
359 t.area.cardNum = "0".repeat(16);
360 t.ext.new.cardId = low(16);
361 return;
362 }
363 t.area.cardNum = t.ccCardNum;
364 t.ext.new.cardId = t.ccCardNum;
365 t.cardFlag = "1";
366}
367
368/**
369 * 1230-EDIT-NAME (COCRDUPC.cbl:806-840): INSPECT CONVERTING letters to spaces, then
370 * FUNCTION LENGTH(FUNCTION TRIM(...)) = 0 means only letters and spaces were typed.
371 */
372function editName(t: Task): void {
373 t.nameFlag = "0";
374 const name = t.ext.new.crdName;
375 if (name === low(50) || name === " ".repeat(50) || name === "0".repeat(50)) {
376 t.inputFlag = "1";
377 t.nameFlag = " ";
378 if (t.returnMsg === "") t.returnMsg = WS_PROMPT_FOR_NAME;
379 return;
380 }
381 const check = name.replace(/[A-Za-z]/g, " ");
382 if (check.trim().length !== 0 || /\0/.test(check)) {
383 t.inputFlag = "1";
384 t.nameFlag = "0";
385 if (t.returnMsg === "") t.returnMsg = WS_NAME_MUST_BE_ALPHA;
386 return;
387 }
388 t.nameFlag = "1";
389}
390
391/** 1240-EDIT-CARDSTATUS (COCRDUPC.cbl:845-873) */
392function editCardStatus(t: Task): void {
393 t.statusFlag = "0";
394 const s = t.ext.new.crdStcd;
395 if (s === "\0" || s === " " || s === "0") {
396 t.inputFlag = "1";
397 t.statusFlag = " ";
398 if (t.returnMsg === "") t.returnMsg = CARD_STATUS_MUST_BE_YES_NO;
399 return;
400 }
401 if (s === "Y" || s === "N") {
402 t.statusFlag = "1"; // FLG-YES-NO-VALID
403 } else {
404 t.inputFlag = "1";
405 t.statusFlag = "0";
406 if (t.returnMsg === "") t.returnMsg = CARD_STATUS_MUST_BE_YES_NO;
407 }
408}
409
410/**
411 * 1250-EDIT-EXPIRY-MON (COCRDUPC.cbl:877-908): 88 VALID-MONTH VALUES 1 THRU 12 on the
412 * PIC 9(2) view; EXPMON is JUSTIFY=RIGHT, so a single digit arrives as ' 5' and is
413 * accepted (the blank counts as a zero digit in the numeric comparison).
414 */
415function editExpiryMon(t: Task): void {
416 t.monFlag = "0";
417 const m = t.ext.new.expMon;
418 if (m === low(2) || m === " " || m === "00") {
419 t.inputFlag = "1";
420 t.monFlag = " ";
421 if (t.returnMsg === "") t.returnMsg = CARD_EXPIRY_MONTH_NOT_VALID;
422 return;
423 }
424 const v = zonedValue(m, 2);
425 if (v !== undefined && v >= 1 && v <= 12) {
426 t.monFlag = "1";
427 } else {
428 t.inputFlag = "1";
429 t.monFlag = "0";
430 if (t.returnMsg === "") t.returnMsg = CARD_EXPIRY_MONTH_NOT_VALID;
431 }
432}
433
434/** 1260-EDIT-EXPIRY-YEAR (COCRDUPC.cbl:913-944): 88 VALID-YEAR VALUES 1950 THRU 2099 */
435function editExpiryYear(t: Task): void {
436 const y = t.ext.new.expYear;
437 if (y === low(4) || y === " " || y === "0000") {
438 t.inputFlag = "1";
439 t.yearFlag = " ";
440 if (t.returnMsg === "") t.returnMsg = CARD_EXPIRY_YEAR_NOT_VALID;
441 return;
442 }
443 t.yearFlag = "0";
444 const v = zonedValue(y, 4);
445 if (v !== undefined && v >= 1950 && v <= 2099) {
446 t.yearFlag = "1";
447 } else {
448 t.inputFlag = "1";
449 t.yearFlag = "0";
450 if (t.returnMsg === "") t.returnMsg = CARD_EXPIRY_YEAR_NOT_VALID;
451 }
452}
453
454/** 2000-DECIDE-ACTION (COCRDUPC.cbl:948-1028) */
455function decideAction(t: Task): void {
456 const { ext, area } = t;
457 if (notFetched(t) || t.ccardAid === "PFK12") {
458 // No details shown yet, or F12 = cancel the changes: (re)read the card.
459 if (t.acctFlag === "1" && t.cardFlag === "1") {
460 readData(t);
461 // FOUND-CARDS-FOR-ACCOUNT was already set by 1200 for F12, so this holds even
462 // when the re-read fails (faithful).
463 if (t.infoMsg === FOUND_CARDS_FOR_ACCOUNT) ext.changeAction = "S";
464 }
465 } else if (ext.changeAction === "S") {
466 if (!(t.inputFlag === "1" || t.returnMsg === NO_CHANGES_DETECTED)) ext.changeAction = "N";
467 } else if (ext.changeAction === "E") {
468 // CONTINUE
469 } else if (ext.changeAction === "N" && t.ccardAid === "PFK05") {
470 writeProcessing(t);
471 if (t.returnMsg === COULD_NOT_LOCK_FOR_UPDATE) ext.changeAction = "L";
472 else if (t.returnMsg === LOCKED_BUT_UPDATE_FAILED) ext.changeAction = "F";
473 else if (t.returnMsg === DATA_WAS_CHANGED_BEFORE_UPDATE) ext.changeAction = "S";
474 else ext.changeAction = "C";
475 } else if (ext.changeAction === "N") {
476 // CONTINUE: F5 not pressed, show the confirmation again
477 } else if (ext.changeAction === "C") {
478 ext.changeAction = "S";
479 if (isLowOrSpaces(area.fromTranid, 4)) {
480 area.acctId = 0;
481 area.cardNum = "0".repeat(16);
482 area.acctStatus = "\0";
483 }
484 } else {
485 // :1019-1026 ABEND-ROUTINE: SEND ABEND-DATA, ABEND ABCODE('9999')
486 t.ctx.abend("9999", `${LIT_THISPGM} 0001 UNEXPECTED DATA SCENARIO`);
487 }
488}
489
490/** 3000-SEND-MAP (COCRDUPC.cbl:1035-1046) */
491function sendMap(t: Task): void {
492 screenInit(t);
493 setupScreenVars(t);
494 setupInfoMsg(t);
495 setupScreenAttrs(t);
496 sendScreen(t);
497}
498
499/** 3100-SCREEN-INIT (COCRDUPC.cbl:1052-1076) */
500function screenInit(t: Task): void {
501 t.out.clear();
502 populateHeaderInfo(t.ctx, t.out, LIT_THISTRANID, LIT_THISPGM);
503}
504
505/** 3200-SETUP-SCREEN-VARS (COCRDUPC.cbl:1082-1134) */
506function setupScreenVars(t: Task): void {
507 const { area, out, ext } = t;
508 if (area.pgmContext === 0) return;
509 out.set("ACCTSID", zonedIsZero(t.ccAcctId, 11) ? null : outValue(t.ccAcctId));
510 out.set("CARDSID", zonedIsZero(t.ccCardNum, 16) ? null : outValue(t.ccCardNum));
511 const o = ext.old;
512 const n = ext.new;
513 if (notFetched(t)) {
514 for (const f of ["CRDNAME", "CRDSTCD", "EXPDAY", "EXPMON", "EXPYEAR"]) out.set(f, null);
515 } else if (ext.changeAction === "S") {
516 out.set("CRDNAME", outValue(o.crdName));
517 out.set("CRDSTCD", outValue(o.crdStcd));
518 out.set("EXPDAY", outValue(o.expDay));
519 out.set("EXPMON", outValue(o.expMon));
520 out.set("EXPYEAR", outValue(o.expYear));
521 } else if (changesMade(t)) {
522 out.set("CRDNAME", outValue(n.crdName));
523 out.set("CRDSTCD", outValue(n.crdStcd));
524 out.set("EXPMON", outValue(n.expMon));
525 out.set("EXPYEAR", outValue(n.expYear));
526 out.set("EXPDAY", outValue(o.expDay)); // the day cannot be changed (for now)
527 } else {
528 out.set("CRDNAME", outValue(o.crdName));
529 out.set("CRDSTCD", outValue(o.crdStcd));
530 out.set("EXPDAY", outValue(o.expDay));
531 out.set("EXPMON", outValue(o.expMon));
532 out.set("EXPYEAR", outValue(o.expYear));
533 }
534}
535
536/** 3250-SETUP-INFOMSG (COCRDUPC.cbl:1138-1164) */
537function setupInfoMsg(t: Task): void {
538 const a = t.ext.changeAction;
539 if (t.area.pgmContext === 0) t.infoMsg = PROMPT_FOR_SEARCH_KEYS;
540 else if (notFetched(t)) t.infoMsg = PROMPT_FOR_SEARCH_KEYS;
541 else if (a === "S") t.infoMsg = FOUND_CARDS_FOR_ACCOUNT;
542 else if (a === "E") t.infoMsg = PROMPT_FOR_CHANGES;
543 else if (a === "N") t.infoMsg = PROMPT_FOR_CONFIRMATION;
544 else if (a === "C") t.infoMsg = CONFIRM_UPDATE_SUCCESS;
545 else if (a === "L" || a === "F") t.infoMsg = INFORM_FAILURE;
546 else if (t.infoMsg === "") t.infoMsg = PROMPT_FOR_SEARCH_KEYS;
547 t.out.set("INFOMSG", t.infoMsg);
548 t.out.set("ERRMSG", t.returnMsg);
549}
550
551/** 3300-SETUP-SCREEN-ATTRS (COCRDUPC.cbl:1168-1318) */
552function setupScreenAttrs(t: Task): void {
553 const { area, out, ext } = t;
554 const a = ext.changeAction;
555 const details = ["CRDNAME", "CRDSTCD", "EXPMON", "EXPYEAR"]; // EXPDAYA is commented out
556 if (notFetched(t)) {
557 out.attr("ACCTSID", BYTE.FSE).attr("CARDSID", BYTE.FSE);
558 for (const f of details) out.attr(f, BYTE.PRF);
559 } else if (a === "S" || a === "E") {
560 out.attr("ACCTSID", BYTE.PRF).attr("CARDSID", BYTE.PRF);
561 for (const f of details) out.attr(f, BYTE.FSE);
562 } else if (a === "N" || a === "C") {
563 out.attr("ACCTSID", BYTE.PRF).attr("CARDSID", BYTE.PRF);
564 for (const f of details) out.attr(f, BYTE.PRF);
565 } else {
566 out.attr("ACCTSID", BYTE.FSE).attr("CARDSID", BYTE.FSE);
567 for (const f of details) out.attr(f, BYTE.PRF);
568 }
569
570 // POSITION CURSOR
571 const bad = (flag: string) => flag === "0" || flag === " ";
572 if (t.infoMsg === FOUND_CARDS_FOR_ACCOUNT || t.returnMsg === NO_CHANGES_DETECTED) out.cursor("CRDNAME");
573 else if (bad(t.acctFlag)) out.cursor("ACCTSID");
574 else if (bad(t.cardFlag)) out.cursor("CARDSID");
575 else if (bad(t.nameFlag)) out.cursor("CRDNAME");
576 else if (bad(t.statusFlag)) out.cursor("CRDSTCD");
577 else if (bad(t.monFlag)) out.cursor("EXPMON");
578 else if (bad(t.yearFlag)) out.cursor("EXPYEAR");
579 else out.cursor("ACCTSID");
580
581 // SETUP COLOR
582 if (area.lastMapset.trim() === LIT_CCLISTMAPSET) {
583 out.color("ACCTSID", "DEFAULT");
584 out.color("CARDSID", "DEFAULT");
585 }
586 const reenter = area.pgmContext === 1;
587 if (t.acctFlag === "0") out.color("ACCTSID", "RED");
588 if (t.acctFlag === " " && reenter) out.set("ACCTSID", "*").color("ACCTSID", "RED");
589 if (t.cardFlag === "0") out.color("CARDSID", "RED");
590 if (t.cardFlag === " " && reenter) out.set("CARDSID", "*").color("CARDSID", "RED");
591 const notOk = a === "E";
592 if (t.nameFlag === "0" && notOk) out.color("CRDNAME", "RED");
593 if (t.nameFlag === " " && notOk) out.set("CRDNAME", "*").color("CRDNAME", "RED");
594 if (t.statusFlag === "0" && notOk) out.color("CRDSTCD", "RED");
595 if (t.statusFlag === " " && notOk) out.set("CRDSTCD", "*").color("CRDSTCD", "RED");
596 // MOVE DFHBMDAR TO EXPDAYC puts an attribute value in a colour byte; EXPDAY is DRK anyway.
597 if (t.monFlag === "0" && notOk) out.color("EXPMON", "RED");
598 if (t.monFlag === " " && notOk) out.set("EXPMON", "*").color("EXPMON", "RED");
599 if (t.yearFlag === "0" && notOk) out.color("EXPYEAR", "RED");
600 if (t.yearFlag === " " && notOk) out.set("EXPYEAR", "*").color("EXPYEAR", "RED");
601
602 out.attr("INFOMSG", t.infoMsg === "" ? BYTE.DAR : BYTE.BRY);
603 if (t.infoMsg === PROMPT_FOR_CONFIRMATION) out.attr("FKEYSC", BYTE.BRY); // shows 'F5=Save F12=Cancel'
604}
605
606/** 3400-SEND-SCREEN (COCRDUPC.cbl:1324-1337) */
607function sendScreen(t: Task): void {
608 t.ctx.sendMap(t.out, { cursor: true, erase: true, freekb: true });
609}
610
611/** 9000-READ-DATA (COCRDUPC.cbl:1343-1370) */
612function readData(t: Task): void {
613 const o = t.ext.old;
614 Object.assign(o, blankDetails()); // INITIALIZE CCUP-OLD-DETAILS
615 o.acctId = t.ccAcctId.padEnd(11, " ").slice(0, 11);
616 o.cardId = t.ccCardNum.padEnd(16, " ").slice(0, 16);
617 getcardByAcctCard(t);
618 if (t.infoMsg === FOUND_CARDS_FOR_ACCOUNT && t.card) {
619 const c = t.card;
620 o.cvvCd = digits(c.cardCvvCd, 3);
621 o.crdName = upper(c.cardEmbossedName.padEnd(50, " ").slice(0, 50)); // INSPECT CONVERTING LIT-LOWER TO LIT-UPPER
622 const exp = c.cardExpiraionDate.padEnd(10, " ");
623 o.expYear = exp.slice(0, 4);
624 o.expMon = exp.slice(5, 7);
625 o.expDay = exp.slice(8, 10);
626 o.crdStcd = c.cardActiveStatus.padEnd(1, " ").slice(0, 1);
627 }
628}
629
630/** 9100-GETCARD-BYACCTCARD (COCRDUPC.cbl:1376-1413) */
631function getcardByAcctCard(t: Task): void {
632 const { resp, record } = t.ctx.read<CardRecord>(LIT_CARDFILENAME, t.ccCardNum.replace(/\0/g, " "));
633 if (resp === RESP.NORMAL && record) {
634 t.card = record;
635 t.infoMsg = FOUND_CARDS_FOR_ACCOUNT;
636 } else if (resp === RESP.NOTFND) {
637 t.inputFlag = "1";
638 t.acctFlag = "0";
639 t.cardFlag = "0";
640 if (t.returnMsg === "") t.returnMsg = DID_NOT_FIND_ACCTCARD_COMBO;
641 } else {
642 t.inputFlag = "1";
643 if (t.returnMsg === "") t.acctFlag = "0";
644 t.returnMsg = fileErrorMessage("READ", LIT_CARDFILENAME, resp, resp2Of(resp)).slice(0, 75);
645 }
646}
647
648/** 9200-WRITE-PROCESSING (COCRDUPC.cbl:1420-1493) */
649function writeProcessing(t: Task): void {
650 const { ctx, ext } = t;
651 const { resp, record } = ctx.read<CardRecord>(LIT_CARDFILENAME, t.ccCardNum.replace(/\0/g, " "), { update: true });
652 if (resp !== RESP.NORMAL || !record) {
653 t.inputFlag = "1";
654 if (t.returnMsg === "") t.returnMsg = COULD_NOT_LOCK_FOR_UPDATE;
655 return;
656 }
657 t.card = record;
658 if (checkChangeInRec(t)) return; // DATA-WAS-CHANGED-BEFORE-UPDATE
659
660 // CARD-UPDATE-RECORD. CCUP-NEW-CVV-CD is never filled (INITIALIZEd to spaces in
661 // 1100), so the CVV moves through CARD-CVV-CD-X/-N as spaces and is written as 000.
662 const n = ext.new;
663 const update: CardRecord = {
664 cardNum: n.cardId,
665 cardAcctId: zonedValue(t.ccAcctId, 11) ?? 0,
666 cardCvvCd: zonedValue(n.cvvCd, 3) ?? 0,
667 cardEmbossedName: n.crdName,
668 cardExpiraionDate: `${n.expYear}-${n.expMon}-${n.expDay}`,
669 cardActiveStatus: n.crdStcd,
670 };
671 const rw = ctx.rewrite(LIT_CARDFILENAME, update);
672 if (rw !== RESP.NORMAL) t.returnMsg = LOCKED_BUT_UPDATE_FAILED;
673}
674
675/** 9300-CHECK-CHANGE-IN-REC (COCRDUPC.cbl:1498-1520): true when someone changed the card meanwhile. */
676function checkChangeInRec(t: Task): boolean {
677 const c = t.card!;
678 const o = t.ext.old;
679 const name = upper(c.cardEmbossedName.padEnd(50, " ").slice(0, 50));
680 const exp = c.cardExpiraionDate.padEnd(10, " ");
681 if (
682 digits(c.cardCvvCd, 3) === o.cvvCd &&
683 name === o.crdName &&
684 exp.slice(0, 4) === o.expYear &&
685 exp.slice(5, 7) === o.expMon &&
686 exp.slice(8, 10) === o.expDay &&
687 c.cardActiveStatus === o.crdStcd
688 ) {
689 return false;
690 }
691 t.returnMsg = DATA_WAS_CHANGED_BEFORE_UPDATE;
692 o.cvvCd = digits(c.cardCvvCd, 3);
693 o.crdName = name;
694 o.expYear = exp.slice(0, 4);
695 o.expMon = exp.slice(5, 7);
696 o.expDay = exp.slice(8, 10);
697 o.crdStcd = c.cardActiveStatus;
698 return true;
699}

COBOL app/cbl/COCRDUPC.cbl

1 *****************************************************************
2 * Program: COCRDUPC.CBL *
3 * Layer: Business logic *
4 * Function: Accept and process credit card detail 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
22 IDENTIFICATION DIVISION.
23 PROGRAM-ID.
24 COCRDUPC.
25 DATE-WRITTEN.
26 April 2022.
27 DATE-COMPILED.
28 Today.
29
30 ENVIRONMENT DIVISION.
31 INPUT-OUTPUT SECTION.
32
33 DATA DIVISION.
34
35 WORKING-STORAGE SECTION.
36 01 WS-MISC-STORAGE.
37 ******************************************************************
38 * General CICS related
39 ******************************************************************
40 05 WS-CICS-PROCESSNG-VARS.
41 07 WS-RESP-CD PIC S9(09) COMP
42 VALUE ZEROS.
43 07 WS-REAS-CD PIC S9(09) COMP
44 VALUE ZEROS.
45 07 WS-TRANID PIC X(4)
46 VALUE SPACES.
47 07 WS-UCTRANS PIC X(4)
48 VALUE SPACES.
49 ******************************************************************
50 * Input edits
51 ******************************************************************
52
53 05 WS-INPUT-FLAG PIC X(1).
54 88 INPUT-OK VALUE '0'.
55 88 INPUT-ERROR VALUE '1'.
56 88 INPUT-PENDING VALUE LOW-VALUES.
57 05 WS-EDIT-ACCT-FLAG PIC X(1).
58 88 FLG-ACCTFILTER-NOT-OK VALUE '0'.
59 88 FLG-ACCTFILTER-ISVALID VALUE '1'.
60 88 FLG-ACCTFILTER-BLANK VALUE ' '.
61 05 WS-EDIT-CARD-FLAG PIC X(1).
62 88 FLG-CARDFILTER-NOT-OK VALUE '0'.
63 88 FLG-CARDFILTER-ISVALID VALUE '1'.
64 88 FLG-CARDFILTER-BLANK VALUE ' '.
65 05 WS-EDIT-CARDNAME-FLAG PIC X(1).
66 88 FLG-CARDNAME-NOT-OK VALUE '0'.
67 88 FLG-CARDNAME-ISVALID VALUE '1'.
68 88 FLG-CARDNAME-BLANK VALUE ' '.
69 05 WS-EDIT-CARDSTATUS-FLAG PIC X(1).
70 88 FLG-CARDSTATUS-NOT-OK VALUE '0'.
71 88 FLG-CARDSTATUS-ISVALID VALUE '1'.
72 88 FLG-CARDSTATUS-BLANK VALUE ' '.
73 05 WS-EDIT-CARDEXPMON-FLAG PIC X(1).
74 88 FLG-CARDEXPMON-NOT-OK VALUE '0'.
75 88 FLG-CARDEXPMON-ISVALID VALUE '1'.
76 88 FLG-CARDEXPMON-BLANK VALUE ' '.
77 05 WS-EDIT-CARDEXPYEAR-FLAG PIC X(1).
78 88 FLG-CARDEXPYEAR-NOT-OK VALUE '0'.
79 88 FLG-CARDEXPYEAR-ISVALID VALUE '1'.
80 88 FLG-CARDEXPYEAR-BLANK VALUE ' '.
81 05 WS-RETURN-FLAG PIC X(1).
82 88 WS-RETURN-FLAG-OFF VALUE LOW-VALUES.
83 88 WS-RETURN-FLAG-ON VALUE '1'.
84 05 WS-PFK-FLAG PIC X(1).
85 88 PFK-VALID VALUE '0'.
86 88 PFK-INVALID VALUE '1'.
87 05 CARD-NAME-CHECK PIC X(50)
88 VALUE LOW-VALUES.
89 05 FLG-YES-NO-CHECK PIC X(1)
90 VALUE 'N'.
91 88 FLG-YES-NO-VALID VALUES 'Y', 'N'.
92 05 CARD-MONTH-CHECK PIC X(2).
93 05 CARD-MONTH-CHECK-N REDEFINES
94 CARD-MONTH-CHECK PIC 9(2).
95 88 VALID-MONTH VALUES 1 THRU 12.
96 05 CARD-YEAR-CHECK PIC X(4).
97 05 CARD-YEAR-CHECK-N REDEFINES
98 CARD-YEAR-CHECK PIC 9(4).
99 88 VALID-YEAR VALUES 1950 THRU 2099.
100 ******************************************************************
101 * Output edits
102 ******************************************************************
103 05 CICS-OUTPUT-EDIT-VARS.
104 10 CARD-ACCT-ID-X PIC X(11).
105 10 CARD-ACCT-ID-N REDEFINES CARD-ACCT-ID-X
106 PIC 9(11).
107 10 CARD-CVV-CD-X PIC X(03).
108 10 CARD-CVV-CD-N REDEFINES CARD-CVV-CD-X
109 PIC 9(03).
110 10 CARD-CARD-NUM-X PIC X(16).
111 10 CARD-CARD-NUM-N REDEFINES CARD-CARD-NUM-X
112 PIC 9(16).
113 10 CARD-NAME-EMBOSSED-X PIC X(50).
114 10 CARD-STATUS-X PIC X.
115 10 CARD-EXPIRAION-DATE-X PIC X(10).
116 10 FILLER REDEFINES CARD-EXPIRAION-DATE-X.
117 20 CARD-EXPIRY-YEAR PIC X(4).
118 20 FILLER PIC X(1).
119 20 CARD-EXPIRY-MONTH PIC X(2).
120 20 FILLER PIC X(1).
121 20 CARD-EXPIRY-DAY PIC X(2).
122 10 CARD-EXPIRAION-DATE-N REDEFINES
123 CARD-EXPIRAION-DATE-X PIC 9(10).
124
125 ******************************************************************
126 * File and data Handling
127 ******************************************************************
128 05 WS-CARD-RID.
129 10 WS-CARD-RID-CARDNUM PIC X(16).
130 10 WS-CARD-RID-ACCT-ID PIC 9(11).
131 10 WS-CARD-RID-ACCT-ID-X REDEFINES
132 WS-CARD-RID-ACCT-ID PIC X(11).
133 05 WS-FILE-ERROR-MESSAGE.
134 10 FILLER PIC X(12)
135 VALUE 'File Error: '.
136 10 ERROR-OPNAME PIC X(8)
137 VALUE SPACES.
138 10 FILLER PIC X(4)
139 VALUE ' on '.
140 10 ERROR-FILE PIC X(9)
141 VALUE SPACES.
142 10 FILLER PIC X(15)
143 VALUE
144 ' returned RESP '.
145 10 ERROR-RESP PIC X(10)
146 VALUE SPACES.
147 10 FILLER PIC X(7)
148 VALUE ',RESP2 '.
149 10 ERROR-RESP2 PIC X(10)
150 VALUE SPACES.
151 10 FILLER PIC X(5)
152 VALUE SPACES.
153 ******************************************************************
154 * Output Message Construction
155 ******************************************************************
156 05 WS-LONG-MSG PIC X(500).
157 05 WS-INFO-MSG PIC X(40).
158 88 WS-NO-INFO-MESSAGE VALUES
159 SPACES LOW-VALUES.
160 88 FOUND-CARDS-FOR-ACCOUNT VALUE
161 'Details of selected card shown above'.
162 88 PROMPT-FOR-SEARCH-KEYS VALUE
163 'Please enter Account and Card Number'.
164 88 PROMPT-FOR-CHANGES VALUE
165 'Update card details presented above.'.
166 88 PROMPT-FOR-CONFIRMATION VALUE
167 'Changes validated.Press F5 to save'.
168 88 CONFIRM-UPDATE-SUCCESS VALUE
169 'Changes committed to database'.
170 88 INFORM-FAILURE VALUE
171 'Changes unsuccessful. Please try again'.
172
173 05 WS-RETURN-MSG PIC X(75).
174 88 WS-RETURN-MSG-OFF VALUE SPACES.
175 88 WS-EXIT-MESSAGE VALUE
176 'PF03 pressed.Exiting '.
177 88 WS-PROMPT-FOR-ACCT VALUE
178 'Account number not provided'.
179 88 WS-PROMPT-FOR-CARD VALUE
180 'Card number not provided'.
181 88 WS-PROMPT-FOR-NAME VALUE
182 'Card name not provided'.
183 88 WS-NAME-MUST-BE-ALPHA VALUE
184 'Card name can only contain alphabets and spaces'.
185 88 NO-SEARCH-CRITERIA-RECEIVED VALUE
186 'No input received'.
187 88 NO-CHANGES-DETECTED VALUE
188 'No change detected with respect to values fetched.'.
189 88 SEARCHED-ACCT-ZEROES VALUE
190 'Account number must be a non zero 11 digit number'.
191 88 SEARCHED-ACCT-NOT-NUMERIC VALUE
192 'Account number must be a non zero 11 digit number'.
193 88 SEARCHED-CARD-NOT-NUMERIC VALUE
194 'Card number if supplied must be a 16 digit number'.
195 88 CARD-STATUS-MUST-BE-YES-NO VALUE
196 'Card Active Status must be Y or N'.
197 88 CARD-EXPIRY-MONTH-NOT-VALID VALUE
198 'Card expiry month must be between 1 and 12'.
199 88 CARD-EXPIRY-YEAR-NOT-VALID VALUE
200 'Invalid card expiry year'.
201 88 DID-NOT-FIND-ACCT-IN-CARDXREF VALUE
202 'Did not find this account in cards database'.
203 88 DID-NOT-FIND-ACCTCARD-COMBO VALUE
204 'Did not find cards for this search condition'.
205 88 COULD-NOT-LOCK-FOR-UPDATE VALUE
206 'Could not lock record for update'.
207 88 DATA-WAS-CHANGED-BEFORE-UPDATE VALUE
208 'Record changed by some one else. Please review'.
209 88 LOCKED-BUT-UPDATE-FAILED VALUE
210 'Update of record failed'.
211 88 XREF-READ-ERROR VALUE
212 'Error reading Card Data File'.
213 88 CODING-TO-BE-DONE VALUE
214 'Looks Good.... so far'.
215 ******************************************************************
216 * Literals and Constants
217 ******************************************************************
218 01 WS-LITERALS.
219 05 LIT-THISPGM PIC X(8)
220 VALUE 'COCRDUPC'.
221 05 LIT-THISTRANID PIC X(4)
222 VALUE 'CCUP'.
223 05 LIT-THISMAPSET PIC X(8)
224 VALUE 'COCRDUP '.
225 05 LIT-THISMAP PIC X(7)
226 VALUE 'CCRDUPA'.
227 05 LIT-CCLISTPGM PIC X(8)
228 VALUE 'COCRDLIC'.
229 05 LIT-CCLISTTRANID PIC X(4)
230 VALUE 'CCLI'.
231 05 LIT-CCLISTMAPSET PIC X(7)
232 VALUE 'COCRDLI'.
233 05 LIT-CCLISTMAP PIC X(7)
234 VALUE 'CCRDSLA'.
235 05 LIT-MENUPGM PIC X(8)
236 VALUE 'COMEN01C'.
237 05 LIT-MENUTRANID PIC X(4)
238 VALUE 'CM00'.
239 05 LIT-MENUMAPSET PIC X(7)
240 VALUE 'COMEN01'.
241 05 LIT-MENUMAP PIC X(7)
242 VALUE 'COMEN1A'.
243 05 LIT-CARDDTLPGM PIC X(8)
244 VALUE 'COCRDSLC'.
245 05 LIT-CARDDTLTRANID PIC X(4)
246 VALUE 'CCDL'.
247 05 LIT-CARDDTLMAPSET PIC X(7)
248 VALUE 'COCRDSL'.
249 05 LIT-CARDDTLMAP PIC X(7)
250 VALUE 'CCRDSLA'.
251 05 LIT-CARDFILENAME PIC X(8)
252 VALUE 'CARDDAT '.
253 05 LIT-CARDFILENAME-ACCT-PATH PIC X(8)
254 VALUE 'CARDAIX '.
255 05 LIT-ALL-ALPHA-FROM PIC X(52)
256 VALUE
257 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'.
258 05 LIT-ALL-SPACES-TO PIC X(52)
259 VALUE SPACES.
260 05 LIT-UPPER PIC X(26)
261 VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
262 05 LIT-LOWER PIC X(26)
263 VALUE 'abcdefghijklmnopqrstuvwxyz'.
264
265 ******************************************************************
266 *Other common working storage Variables
267 ******************************************************************
268 COPY CVCRD01Y.
269
270 ******************************************************************
271 *Application Commmarea Copybook
272 COPY COCOM01Y.
273
274 01 WS-THIS-PROGCOMMAREA.
275 05 CARD-UPDATE-SCREEN-DATA.
276 10 CCUP-CHANGE-ACTION PIC X(1)
277 VALUE LOW-VALUES.
278 88 CCUP-DETAILS-NOT-FETCHED VALUES
279 LOW-VALUES,
280 SPACES.
281 88 CCUP-SHOW-DETAILS VALUE 'S'.
282 88 CCUP-CHANGES-MADE VALUES 'E', 'N'
283 , 'C', 'L'
284 , 'F'.
285 88 CCUP-CHANGES-NOT-OK VALUE 'E'.
286 88 CCUP-CHANGES-OK-NOT-CONFIRMED VALUE 'N'.
287 88 CCUP-CHANGES-OKAYED-AND-DONE VALUE 'C'.
288 88 CCUP-CHANGES-FAILED VALUES 'L', 'F'.
289 88 CCUP-CHANGES-OKAYED-LOCK-ERROR VALUE 'L'.
290 88 CCUP-CHANGES-OKAYED-BUT-FAILED VALUE 'F'.
291 05 CCUP-OLD-DETAILS.
292 10 CCUP-OLD-ACCTID PIC X(11).
293 10 CCUP-OLD-CARDID PIC X(16).
294 10 CCUP-OLD-CVV-CD PIC X(3).
295 10 CCUP-OLD-CARDDATA.
296 20 CCUP-OLD-CRDNAME PIC X(50).
297 20 CCUP-OLD-EXPIRAION-DATE.
298 25 CCUP-OLD-EXPYEAR PIC X(4).
299 25 CCUP-OLD-EXPMON PIC X(2).
300 25 CCUP-OLD-EXPDAY PIC X(2).
301 20 CCUP-OLD-CRDSTCD PIC X(1).
302
303 05 CCUP-NEW-DETAILS.
304 10 CCUP-NEW-ACCTID PIC X(11).
305 10 CCUP-NEW-CARDID PIC X(16).
306 10 CCUP-NEW-CVV-CD PIC X(3).
307 10 CCUP-NEW-CARDDATA.
308 20 CCUP-NEW-CRDNAME PIC X(50).
309 20 CCUP-NEW-EXPIRAION-DATE.
310 25 CCUP-NEW-EXPYEAR PIC X(4).
311 25 CCUP-NEW-EXPMON PIC X(2).
312 25 CCUP-NEW-EXPDAY PIC X(2).
313 20 CCUP-NEW-CRDSTCD PIC X(1).
314 05 CARD-UPDATE-RECORD.
315 10 CARD-UPDATE-NUM PIC X(16).
316 10 CARD-UPDATE-ACCT-ID PIC 9(11).
317 10 CARD-UPDATE-CVV-CD PIC 9(03).
318 10 CARD-UPDATE-EMBOSSED-NAME PIC X(50).
319 10 CARD-UPDATE-EXPIRAION-DATE PIC X(10).
320 10 CARD-UPDATE-ACTIVE-STATUS PIC X(01).
321 10 FILLER PIC X(59).
322
323
324 01 WS-COMMAREA PIC X(2000).
325
326 *IBM SUPPLIED COPYBOOKS
327 COPY DFHBMSCA.
328 COPY DFHAID.
329
330 *COMMON COPYBOOKS
331 *Screen Titles
332 COPY COTTL01Y.
333 *Credit Card Update Screen Layout
334 COPY COCRDUP.
335
336 *Current Date
337 COPY CSDAT01Y.
338
339 *Common Messages
340 COPY CSMSG01Y.
341
342 *Abend Variables
343 COPY CSMSG02Y.
344
345 *Signed on user data
346 COPY CSUSR01Y.
347
348 *Dataset layouts
349 *ACCOUNT RECORD LAYOUT
350 *COPY CVACT01Y.
351
352 *CARD RECORD LAYOUT
353 COPY CVACT02Y.
354
355 *CARD XREF LAYOUT
356 *COPY CVACT03Y.
357
358 *CUSTOMER LAYOUT
359 COPY CVCUS01Y.
360
361 LINKAGE SECTION.
362 01 DFHCOMMAREA.
363 05 FILLER PIC X(1)
364 OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
365
366 PROCEDURE DIVISION.
367 0000-MAIN.
368
369
370 EXEC CICS HANDLE ABEND
371 LABEL(ABEND-ROUTINE)
372 END-EXEC
373
374 INITIALIZE CC-WORK-AREA
375 WS-MISC-STORAGE
376 WS-COMMAREA
377 *****************************************************************
378 * Store our context
379 *****************************************************************
380 MOVE LIT-THISTRANID TO WS-TRANID
381 *****************************************************************
382 * Ensure error message is cleared *
383 *****************************************************************
384 SET WS-RETURN-MSG-OFF TO TRUE
385 *****************************************************************
386 * Store passed data if any *
387 *****************************************************************
388 IF EIBCALEN IS EQUAL TO 0
389 OR (CDEMO-FROM-PROGRAM = LIT-MENUPGM
390 AND NOT CDEMO-PGM-REENTER)
391 INITIALIZE CARDDEMO-COMMAREA
392 WS-THIS-PROGCOMMAREA
393 SET CDEMO-PGM-ENTER TO TRUE
394 SET CCUP-DETAILS-NOT-FETCHED TO TRUE
395 ELSE
396 MOVE DFHCOMMAREA (1:LENGTH OF CARDDEMO-COMMAREA) TO
397 CARDDEMO-COMMAREA
398 MOVE DFHCOMMAREA(LENGTH OF CARDDEMO-COMMAREA + 1:
399 LENGTH OF WS-THIS-PROGCOMMAREA ) TO
400 WS-THIS-PROGCOMMAREA
401 END-IF
402 *****************************************************************
403 * Remap PFkeys as needed.
404 * Store the Mapped PF Key
405 *****************************************************************
406 PERFORM YYYY-STORE-PFKEY
407 THRU YYYY-STORE-PFKEY-EXIT
408 *****************************************************************
409 * Check the AID to see if its valid at this point *
410 * F3 - Exit
411 * Enter show screen again
412 *****************************************************************
413 SET PFK-INVALID TO TRUE
414 IF CCARD-AID-ENTER OR
415 CCARD-AID-PFK03 OR
416 (CCARD-AID-PFK05 AND CCUP-CHANGES-OK-NOT-CONFIRMED)
417 OR
418 (CCARD-AID-PFK12 AND NOT CCUP-DETAILS-NOT-FETCHED)
419 SET PFK-VALID TO TRUE
420 END-IF
421
422 IF PFK-INVALID
423 SET CCARD-AID-ENTER TO TRUE
424 END-IF
425
426 *****************************************************************
427 * Decide what to do based on inputs received
428 *****************************************************************
429 EVALUATE TRUE
430 ******************************************************************
431 * USER PRESSES PF03 TO EXIT
432 * OR USER IS DONE WITH UPDATE
433 * XCTL TO CALLING PROGRAM OR MAIN MENU
434 ******************************************************************
435 WHEN CCARD-AID-PFK03
436 WHEN (CCUP-CHANGES-OKAYED-AND-DONE
437 AND CDEMO-LAST-MAPSET EQUAL LIT-CCLISTMAPSET)
438 WHEN (CCUP-CHANGES-FAILED
439 AND CDEMO-LAST-MAPSET EQUAL LIT-CCLISTMAPSET)
440 SET CCARD-AID-PFK03 TO TRUE
441
442 IF CDEMO-FROM-TRANID EQUAL LOW-VALUES
443 OR CDEMO-FROM-TRANID EQUAL SPACES
444 MOVE LIT-MENUTRANID TO CDEMO-TO-TRANID
445 ELSE
446 MOVE CDEMO-FROM-TRANID TO CDEMO-TO-TRANID
447 END-IF
448
449 IF CDEMO-FROM-PROGRAM EQUAL LOW-VALUES
450 OR CDEMO-FROM-PROGRAM EQUAL SPACES
451 MOVE LIT-MENUPGM TO CDEMO-TO-PROGRAM
452 ELSE
453 MOVE CDEMO-FROM-PROGRAM TO CDEMO-TO-PROGRAM
454 END-IF
455
456 MOVE LIT-THISTRANID TO CDEMO-FROM-TRANID
457 MOVE LIT-THISPGM TO CDEMO-FROM-PROGRAM
458
459 IF CDEMO-LAST-MAPSET EQUAL LIT-CCLISTMAPSET
460 MOVE ZEROS TO CDEMO-ACCT-ID
461 CDEMO-CARD-NUM
462 END-IF
463
464 SET CDEMO-USRTYP-USER TO TRUE
465 SET CDEMO-PGM-ENTER TO TRUE
466 MOVE LIT-THISMAPSET TO CDEMO-LAST-MAPSET
467 MOVE LIT-THISMAP TO CDEMO-LAST-MAP
468
469 EXEC CICS
470 SYNCPOINT
471 END-EXEC
472 *
473 EXEC CICS XCTL
474 PROGRAM (CDEMO-TO-PROGRAM)
475 COMMAREA(CARDDEMO-COMMAREA)
476 END-EXEC
477 ******************************************************************
478 * USER CAME FROM CREDIT CARD LIST SCREEN
479 * SO WE ALREADY HAVE THE FILTER KEYS
480 * FETCH THE ASSSOCIATED CARD DETAILS FOR UPDATE
481 ******************************************************************
482 WHEN CDEMO-PGM-ENTER
483 AND CDEMO-FROM-PROGRAM EQUAL LIT-CCLISTPGM
484 WHEN CCARD-AID-PFK12
485 AND CDEMO-FROM-PROGRAM EQUAL LIT-CCLISTPGM
486 SET CDEMO-PGM-REENTER TO TRUE
487 SET INPUT-OK TO TRUE
488 SET FLG-ACCTFILTER-ISVALID TO TRUE
489 SET FLG-CARDFILTER-ISVALID TO TRUE
490 MOVE CDEMO-ACCT-ID TO CC-ACCT-ID-N
491 MOVE CDEMO-CARD-NUM TO CC-CARD-NUM-N
492 PERFORM 9000-READ-DATA
493 THRU 9000-READ-DATA-EXIT
494 SET CCUP-SHOW-DETAILS TO TRUE
495 PERFORM 3000-SEND-MAP
496 THRU 3000-SEND-MAP-EXIT
497 GO TO COMMON-RETURN
498 ******************************************************************
499 * FRESH ENTRY INTO PROGRAM
500 * ASK THE USER FOR THE KEYS TO FETCH CARD TO BE UPDATED
501 ******************************************************************
502 WHEN CCUP-DETAILS-NOT-FETCHED
503 AND CDEMO-PGM-ENTER
504 WHEN CDEMO-FROM-PROGRAM EQUAL LIT-MENUPGM
505 AND NOT CDEMO-PGM-REENTER
506 INITIALIZE WS-THIS-PROGCOMMAREA
507 PERFORM 3000-SEND-MAP THRU
508 3000-SEND-MAP-EXIT
509 SET CDEMO-PGM-REENTER TO TRUE
510 SET CCUP-DETAILS-NOT-FETCHED TO TRUE
511 GO TO COMMON-RETURN
512 ******************************************************************
513 * CARD DATA CHANGES REVIEWED, OKAYED AND DONE SUCESSFULLY
514 * RESET THE SEARCH KEYS
515 * ASK THE USER FOR FRESH SEARCH CRITERIA
516 ******************************************************************
517 WHEN CCUP-CHANGES-OKAYED-AND-DONE
518 WHEN CCUP-CHANGES-FAILED
519 INITIALIZE WS-THIS-PROGCOMMAREA
520 WS-MISC-STORAGE
521 CDEMO-ACCT-ID
522 CDEMO-CARD-NUM
523 SET CDEMO-PGM-ENTER TO TRUE
524 PERFORM 3000-SEND-MAP THRU
525 3000-SEND-MAP-EXIT
526 SET CDEMO-PGM-REENTER TO TRUE
527 SET CCUP-DETAILS-NOT-FETCHED TO TRUE
528 GO TO COMMON-RETURN
529 ******************************************************************
530 * CARD DATA HAS BEEN PRESENTED TO USER
531 * CHECK THE USER INPUTS
532 * DECIDE WHAT TO DO
533 * PRESENT NEXT STEPS TO USER
534 ******************************************************************
535 WHEN OTHER
536 PERFORM 1000-PROCESS-INPUTS
537 THRU 1000-PROCESS-INPUTS-EXIT
538 PERFORM 2000-DECIDE-ACTION
539 THRU 2000-DECIDE-ACTION-EXIT
540 PERFORM 3000-SEND-MAP
541 THRU 3000-SEND-MAP-EXIT
542 GO TO COMMON-RETURN
543 END-EVALUATE
544 .
545
546 COMMON-RETURN.
547 MOVE WS-RETURN-MSG TO CCARD-ERROR-MSG
548
549 MOVE CARDDEMO-COMMAREA TO WS-COMMAREA
550 MOVE WS-THIS-PROGCOMMAREA TO
551 WS-COMMAREA(LENGTH OF CARDDEMO-COMMAREA + 1:
552 LENGTH OF WS-THIS-PROGCOMMAREA )
553
554 EXEC CICS RETURN
555 TRANSID (LIT-THISTRANID)
556 COMMAREA (WS-COMMAREA)
557 LENGTH(LENGTH OF WS-COMMAREA)
558 END-EXEC
559 .
560 0000-MAIN-EXIT.
561 EXIT
562 .
563
564 1000-PROCESS-INPUTS.
565 PERFORM 1100-RECEIVE-MAP
566 THRU 1100-RECEIVE-MAP-EXIT
567 PERFORM 1200-EDIT-MAP-INPUTS
568 THRU 1200-EDIT-MAP-INPUTS-EXIT
569 MOVE WS-RETURN-MSG TO CCARD-ERROR-MSG
570 MOVE LIT-THISPGM TO CCARD-NEXT-PROG
571 MOVE LIT-THISMAPSET TO CCARD-NEXT-MAPSET
572 MOVE LIT-THISMAP TO CCARD-NEXT-MAP
573 .
574
575 1000-PROCESS-INPUTS-EXIT.
576 EXIT
577 .
578 1100-RECEIVE-MAP.
579 EXEC CICS RECEIVE MAP(LIT-THISMAP)
580 MAPSET(LIT-THISMAPSET)
581 INTO(CCRDUPAI)
582 RESP(WS-RESP-CD)
583 RESP2(WS-REAS-CD)
584 END-EXEC
585
586 INITIALIZE CCUP-NEW-DETAILS
587
588 * REPLACE * WITH LOW-VALUES
589 IF ACCTSIDI OF CCRDUPAI = '*'
590 OR ACCTSIDI OF CCRDUPAI = SPACES
591 MOVE LOW-VALUES TO CC-ACCT-ID
592 CCUP-NEW-ACCTID
593 ELSE
594 MOVE ACCTSIDI OF CCRDUPAI TO CC-ACCT-ID
595 CCUP-NEW-ACCTID
596 END-IF
597
598 IF CARDSIDI OF CCRDUPAI = '*'
599 OR CARDSIDI OF CCRDUPAI = SPACES
600 MOVE LOW-VALUES TO CC-CARD-NUM
601 CCUP-NEW-CARDID
602 ELSE
603 MOVE CARDSIDI OF CCRDUPAI TO CC-CARD-NUM
604 CCUP-NEW-CARDID
605 END-IF
606
607 IF CRDNAMEI OF CCRDUPAI = '*'
608 OR CRDNAMEI OF CCRDUPAI = SPACES
609 MOVE LOW-VALUES TO CCUP-NEW-CRDNAME
610 ELSE
611 MOVE CRDNAMEI OF CCRDUPAI TO CCUP-NEW-CRDNAME
612 END-IF
613
614 IF CRDSTCDI OF CCRDUPAI = '*'
615 OR CRDSTCDI OF CCRDUPAI = SPACES
616 MOVE LOW-VALUES TO CCUP-NEW-CRDSTCD
617 ELSE
618 MOVE CRDSTCDI OF CCRDUPAI TO CCUP-NEW-CRDSTCD
619 END-IF
620
621 MOVE EXPDAYI OF CCRDUPAI TO CCUP-NEW-EXPDAY
622
623 IF EXPMONI OF CCRDUPAI = '*'
624 OR EXPMONI OF CCRDUPAI = SPACES
625 MOVE LOW-VALUES TO CCUP-NEW-EXPMON
626 ELSE
627 MOVE EXPMONI OF CCRDUPAI TO CCUP-NEW-EXPMON
628 END-IF
629
630 IF EXPYEARI OF CCRDUPAI = '*'
631 OR EXPYEARI OF CCRDUPAI = SPACES
632 MOVE LOW-VALUES TO CCUP-NEW-EXPYEAR
633 ELSE
634 MOVE EXPYEARI OF CCRDUPAI TO CCUP-NEW-EXPYEAR
635 END-IF
636 .
637
638 1100-RECEIVE-MAP-EXIT.
639 EXIT
640 .
641 1200-EDIT-MAP-INPUTS.
642
643 SET INPUT-OK TO TRUE
644
645 IF CCUP-DETAILS-NOT-FETCHED
646 * VALIDATE THE SEARCH KEYS
647 PERFORM 1210-EDIT-ACCOUNT
648 THRU 1210-EDIT-ACCOUNT-EXIT
649
650 PERFORM 1220-EDIT-CARD
651 THRU 1220-EDIT-CARD-EXIT
652
653 MOVE LOW-VALUES TO CCUP-NEW-CARDDATA
654
655 * IF THE SEARCH CONDITIONS HAVE PROBLEMS SKIP OTHER EDITS
656 IF FLG-ACCTFILTER-BLANK
657 AND FLG-CARDFILTER-BLANK
658 SET NO-SEARCH-CRITERIA-RECEIVED TO TRUE
659 END-IF
660
661 GO TO 1200-EDIT-MAP-INPUTS-EXIT
662
663 ELSE
664 CONTINUE
665 END-IF
666
667 * SEARCH KEYS ALREADY VALIDATED AND DATA FETCHED
668 SET FOUND-CARDS-FOR-ACCOUNT TO TRUE
669 SET FLG-ACCTFILTER-ISVALID TO TRUE
670 SET FLG-CARDFILTER-ISVALID TO TRUE
671 MOVE CCUP-OLD-ACCTID TO CDEMO-ACCT-ID
672 MOVE CCUP-OLD-CARDID TO CDEMO-CARD-NUM
673 MOVE CCUP-OLD-CRDNAME TO CARD-EMBOSSED-NAME
674 MOVE CCUP-OLD-CRDSTCD TO CARD-ACTIVE-STATUS
675 MOVE CCUP-OLD-EXPDAY TO CARD-EXPIRY-DAY
676 MOVE CCUP-OLD-EXPMON TO CARD-EXPIRY-MONTH
677 MOVE CCUP-OLD-EXPYEAR TO CARD-EXPIRY-YEAR
678
679 * NEW DATA IS SAME AS OLD DATA
680 IF (FUNCTION UPPER-CASE(CCUP-NEW-CARDDATA) EQUAL
681 FUNCTION UPPER-CASE(CCUP-OLD-CARDDATA))
682 SET NO-CHANGES-DETECTED TO TRUE
683 END-IF
684
685 IF NO-CHANGES-DETECTED
686 OR CCUP-CHANGES-OK-NOT-CONFIRMED
687 OR CCUP-CHANGES-OKAYED-AND-DONE
688 SET FLG-CARDNAME-ISVALID TO TRUE
689 SET FLG-CARDSTATUS-ISVALID TO TRUE
690 SET FLG-CARDEXPMON-ISVALID TO TRUE
691 SET FLG-CARDEXPYEAR-ISVALID TO TRUE
692 GO TO 1200-EDIT-MAP-INPUTS-EXIT
693 END-IF
694
695
696 SET CCUP-CHANGES-NOT-OK TO TRUE
697
698 PERFORM 1230-EDIT-NAME
699 THRU 1230-EDIT-NAME-EXIT
700
701 PERFORM 1240-EDIT-CARDSTATUS
702 THRU 1240-EDIT-CARDSTATUS-EXIT
703
704 PERFORM 1250-EDIT-EXPIRY-MON
705 THRU 1250-EDIT-EXPIRY-MON-EXIT
706
707 PERFORM 1260-EDIT-EXPIRY-YEAR
708 THRU 1260-EDIT-EXPIRY-YEAR-EXIT
709
710 IF INPUT-ERROR
711 CONTINUE
712 ELSE
713 SET CCUP-CHANGES-OK-NOT-CONFIRMED TO TRUE
714 END-IF
715 .
716
717 1200-EDIT-MAP-INPUTS-EXIT.
718 EXIT
719 .
720
721 1210-EDIT-ACCOUNT.
722 SET FLG-ACCTFILTER-NOT-OK TO TRUE
723
724 * Not supplied
725 IF CC-ACCT-ID EQUAL LOW-VALUES
726 OR CC-ACCT-ID EQUAL SPACES
727 OR CC-ACCT-ID-N EQUAL ZEROS
728 SET INPUT-ERROR TO TRUE
729 SET FLG-ACCTFILTER-BLANK TO TRUE
730 IF WS-RETURN-MSG-OFF
731 SET WS-PROMPT-FOR-ACCT TO TRUE
732 END-IF
733 MOVE ZEROES TO CDEMO-ACCT-ID
734 MOVE LOW-VALUES TO CCUP-NEW-ACCTID
735 GO TO 1210-EDIT-ACCOUNT-EXIT
736 END-IF
737 *
738 * Not numeric
739 * Not 11 characters
740 IF CC-ACCT-ID IS NOT NUMERIC
741 SET INPUT-ERROR TO TRUE
742 SET FLG-ACCTFILTER-NOT-OK TO TRUE
743 IF WS-RETURN-MSG-OFF
744 MOVE
745 'ACCOUNT FILTER,IF SUPPLIED MUST BE A 11 DIGIT NUMBER'
746 TO WS-RETURN-MSG
747 END-IF
748 MOVE ZERO TO CDEMO-ACCT-ID
749 MOVE LOW-VALUES TO CCUP-NEW-ACCTID
750 GO TO 1210-EDIT-ACCOUNT-EXIT
751 ELSE
752 MOVE CC-ACCT-ID TO CDEMO-ACCT-ID
753 CCUP-NEW-ACCTID
754 SET FLG-ACCTFILTER-ISVALID TO TRUE
755 END-IF
756 .
757
758 1210-EDIT-ACCOUNT-EXIT.
759 EXIT
760 .
761
762 1220-EDIT-CARD.
763 * Not numeric
764 * Not 16 characters
765 SET FLG-CARDFILTER-NOT-OK TO TRUE
766
767 * Not supplied
768 IF CC-CARD-NUM EQUAL LOW-VALUES
769 OR CC-CARD-NUM EQUAL SPACES
770 OR CC-CARD-NUM-N EQUAL ZEROS
771 SET INPUT-ERROR TO TRUE
772 SET FLG-CARDFILTER-BLANK TO TRUE
773 IF WS-RETURN-MSG-OFF
774 SET WS-PROMPT-FOR-CARD TO TRUE
775 END-IF
776
777 MOVE ZEROES TO CDEMO-CARD-NUM
778 CCUP-NEW-CARDID
779 GO TO 1220-EDIT-CARD-EXIT
780 END-IF
781 *
782 * Not numeric
783 * Not 16 characters
784 IF CC-CARD-NUM IS NOT NUMERIC
785 SET INPUT-ERROR TO TRUE
786 SET FLG-CARDFILTER-NOT-OK TO TRUE
787 IF WS-RETURN-MSG-OFF
788 MOVE
789 'CARD ID FILTER,IF SUPPLIED MUST BE A 16 DIGIT NUMBER'
790 TO WS-RETURN-MSG
791 END-IF
792 MOVE ZERO TO CDEMO-CARD-NUM
793 MOVE LOW-VALUES TO CCUP-NEW-CARDID
794 GO TO 1220-EDIT-CARD-EXIT
795 ELSE
796 MOVE CC-CARD-NUM-N TO CDEMO-CARD-NUM
797 MOVE CC-CARD-NUM TO CCUP-NEW-CARDID
798 SET FLG-CARDFILTER-ISVALID TO TRUE
799 END-IF
800 .
801
802 1220-EDIT-CARD-EXIT.
803 EXIT
804 .
805
806 1230-EDIT-NAME.
807 * Not BLANK
808 SET FLG-CARDNAME-NOT-OK TO TRUE
809
810 * Not supplied
811 IF CCUP-NEW-CRDNAME EQUAL LOW-VALUES
812 OR CCUP-NEW-CRDNAME EQUAL SPACES
813 OR CCUP-NEW-CRDNAME EQUAL ZEROS
814 SET INPUT-ERROR TO TRUE
815 SET FLG-CARDNAME-BLANK TO TRUE
816 IF WS-RETURN-MSG-OFF
817 SET WS-PROMPT-FOR-NAME TO TRUE
818 END-IF
819 GO TO 1230-EDIT-NAME-EXIT
820 END-IF
821
822 * Only Alphabets and space allowed
823 MOVE CCUP-NEW-CRDNAME TO CARD-NAME-CHECK
824 INSPECT CARD-NAME-CHECK
825 CONVERTING LIT-ALL-ALPHA-FROM
826 TO LIT-ALL-SPACES-TO
827
828 IF FUNCTION LENGTH(FUNCTION TRIM(CARD-NAME-CHECK)) = 0
829 CONTINUE
830 ELSE
831 SET INPUT-ERROR TO TRUE
832 SET FLG-CARDNAME-NOT-OK TO TRUE
833 IF WS-RETURN-MSG-OFF
834 SET WS-NAME-MUST-BE-ALPHA TO TRUE
835 END-IF
836 GO TO 1230-EDIT-NAME-EXIT
837 END-IF
838
839 SET FLG-CARDNAME-ISVALID TO TRUE
840 .
841 1230-EDIT-NAME-EXIT.
842 EXIT
843 .
844
845 1240-EDIT-CARDSTATUS.
846 * Must be Y or N
847 SET FLG-CARDSTATUS-NOT-OK TO TRUE
848
849 * Not supplied
850 IF CCUP-NEW-CRDSTCD EQUAL LOW-VALUES
851 OR CCUP-NEW-CRDSTCD EQUAL SPACES
852 OR CCUP-NEW-CRDSTCD EQUAL ZEROS
853 SET INPUT-ERROR TO TRUE
854 SET FLG-CARDSTATUS-BLANK TO TRUE
855 IF WS-RETURN-MSG-OFF
856 SET CARD-STATUS-MUST-BE-YES-NO TO TRUE
857 END-IF
858 GO TO 1240-EDIT-CARDSTATUS-EXIT
859 END-IF
860
861 MOVE CCUP-NEW-CRDSTCD TO FLG-YES-NO-CHECK
862
863 IF FLG-YES-NO-VALID
864 SET FLG-CARDSTATUS-ISVALID TO TRUE
865 ELSE
866 SET INPUT-ERROR TO TRUE
867 SET FLG-CARDSTATUS-NOT-OK TO TRUE
868 IF WS-RETURN-MSG-OFF
869 SET CARD-STATUS-MUST-BE-YES-NO TO TRUE
870 END-IF
871 GO TO 1240-EDIT-CARDSTATUS-EXIT
872 END-IF
873 .
874 1240-EDIT-CARDSTATUS-EXIT.
875 EXIT
876 .
877 1250-EDIT-EXPIRY-MON.
878
879
880 SET FLG-CARDEXPMON-NOT-OK TO TRUE
881
882 * Not supplied
883 IF CCUP-NEW-EXPMON EQUAL LOW-VALUES
884 OR CCUP-NEW-EXPMON EQUAL SPACES
885 OR CCUP-NEW-EXPMON EQUAL ZEROS
886 SET INPUT-ERROR TO TRUE
887 SET FLG-CARDEXPMON-BLANK TO TRUE
888 IF WS-RETURN-MSG-OFF
889 SET CARD-EXPIRY-MONTH-NOT-VALID TO TRUE
890 END-IF
891 GO TO 1250-EDIT-EXPIRY-MON-EXIT
892 END-IF
893
894 * Must be numeric
895 * Must be 1 to 12
896 MOVE CCUP-NEW-EXPMON TO CARD-MONTH-CHECK
897
898 IF VALID-MONTH
899 SET FLG-CARDEXPMON-ISVALID TO TRUE
900 ELSE
901 SET INPUT-ERROR TO TRUE
902 SET FLG-CARDEXPMON-NOT-OK TO TRUE
903 IF WS-RETURN-MSG-OFF
904 SET CARD-EXPIRY-MONTH-NOT-VALID TO TRUE
905 END-IF
906 GO TO 1250-EDIT-EXPIRY-MON-EXIT
907 END-IF
908 .
909
910 1250-EDIT-EXPIRY-MON-EXIT.
911 EXIT
912 .
913 1260-EDIT-EXPIRY-YEAR.
914
915 * Not supplied
916 IF CCUP-NEW-EXPYEAR EQUAL LOW-VALUES
917 OR CCUP-NEW-EXPYEAR EQUAL SPACES
918 OR CCUP-NEW-EXPYEAR EQUAL ZEROS
919 SET INPUT-ERROR TO TRUE
920 SET FLG-CARDEXPYEAR-BLANK TO TRUE
921 IF WS-RETURN-MSG-OFF
922 SET CARD-EXPIRY-YEAR-NOT-VALID TO TRUE
923 END-IF
924 GO TO 1260-EDIT-EXPIRY-YEAR-EXIT
925 END-IF
926
927 * Must be numeric
928 * Must be 1 to 12
929
930 SET FLG-CARDEXPYEAR-NOT-OK TO TRUE
931
932 MOVE CCUP-NEW-EXPYEAR TO CARD-YEAR-CHECK
933
934 IF VALID-YEAR
935 SET FLG-CARDEXPYEAR-ISVALID TO TRUE
936 ELSE
937 SET INPUT-ERROR TO TRUE
938 SET FLG-CARDEXPYEAR-NOT-OK TO TRUE
939 IF WS-RETURN-MSG-OFF
940 SET CARD-EXPIRY-YEAR-NOT-VALID TO TRUE
941 END-IF
942 GO TO 1260-EDIT-EXPIRY-YEAR-EXIT
943 END-IF
944 .
945 1260-EDIT-EXPIRY-YEAR-EXIT.
946 EXIT
947 .
948 2000-DECIDE-ACTION.
949 EVALUATE TRUE
950 ******************************************************************
951 * NO DETAILS SHOWN.
952 * SO GET THEM AND SETUP DETAIL EDIT SCREEN
953 ******************************************************************
954 WHEN CCUP-DETAILS-NOT-FETCHED
955 ******************************************************************
956 * CHANGES MADE. BUT USER CANCELS
957 ******************************************************************
958 WHEN CCARD-AID-PFK12
959 IF FLG-ACCTFILTER-ISVALID
960 AND FLG-CARDFILTER-ISVALID
961 PERFORM 9000-READ-DATA
962 THRU 9000-READ-DATA-EXIT
963 IF FOUND-CARDS-FOR-ACCOUNT
964 SET CCUP-SHOW-DETAILS TO TRUE
965 END-IF
966 END-IF
967 ******************************************************************
968 * DETAILS SHOWN
969 * CHECK CHANGES AND ASK CONFIRMATION IF GOOD
970 ******************************************************************
971 WHEN CCUP-SHOW-DETAILS
972 IF INPUT-ERROR
973 OR NO-CHANGES-DETECTED
974 CONTINUE
975 ELSE
976 SET CCUP-CHANGES-OK-NOT-CONFIRMED TO TRUE
977 END-IF
978 ******************************************************************
979 * DETAILS SHOWN
980 * BUT INPUT EDIT ERRORS FOUND
981 ******************************************************************
982 WHEN CCUP-CHANGES-NOT-OK
983 CONTINUE
984 ******************************************************************
985 * DETAILS EDITED , FOUND OK, CONFIRM SAVE REQUESTED
986 * CONFIRMATION GIVEN.SO SAVE THE CHANGES
987 ******************************************************************
988 WHEN CCUP-CHANGES-OK-NOT-CONFIRMED
989 AND CCARD-AID-PFK05
990 PERFORM 9200-WRITE-PROCESSING
991 THRU 9200-WRITE-PROCESSING-EXIT
992 EVALUATE TRUE
993 WHEN COULD-NOT-LOCK-FOR-UPDATE
994 SET CCUP-CHANGES-OKAYED-LOCK-ERROR TO TRUE
995 WHEN LOCKED-BUT-UPDATE-FAILED
996 SET CCUP-CHANGES-OKAYED-BUT-FAILED TO TRUE
997 WHEN DATA-WAS-CHANGED-BEFORE-UPDATE
998 SET CCUP-SHOW-DETAILS TO TRUE
999 WHEN OTHER
1000 SET CCUP-CHANGES-OKAYED-AND-DONE TO TRUE
1001 END-EVALUATE
1002 ******************************************************************
1003 * DETAILS EDITED , FOUND OK, CONFIRM SAVE REQUESTED
1004 * CONFIRMATION NOT GIVEN. SO SHOW DETAILS AGAIN
1005 ******************************************************************
1006 WHEN CCUP-CHANGES-OK-NOT-CONFIRMED
1007 CONTINUE
1008 ******************************************************************
1009 * SHOW CONFIRMATION. GO BACK TO SQUARE 1
1010 ******************************************************************
1011 WHEN CCUP-CHANGES-OKAYED-AND-DONE
1012 SET CCUP-SHOW-DETAILS TO TRUE
1013 IF CDEMO-FROM-TRANID EQUAL LOW-VALUES
1014 OR CDEMO-FROM-TRANID EQUAL SPACES
1015 MOVE ZEROES TO CDEMO-ACCT-ID
1016 CDEMO-CARD-NUM
1017 MOVE LOW-VALUES TO CDEMO-ACCT-STATUS
1018 END-IF
1019 WHEN OTHER
1020 MOVE LIT-THISPGM TO ABEND-CULPRIT
1021 MOVE '0001' TO ABEND-CODE
1022 MOVE SPACES TO ABEND-REASON
1023 MOVE 'UNEXPECTED DATA SCENARIO'
1024 TO ABEND-MSG
1025 PERFORM ABEND-ROUTINE
1026 THRU ABEND-ROUTINE-EXIT
1027 END-EVALUATE
1028 .
1029 2000-DECIDE-ACTION-EXIT.
1030 EXIT
1031 .
1032
1033
1034
1035 3000-SEND-MAP.
1036 PERFORM 3100-SCREEN-INIT
1037 THRU 3100-SCREEN-INIT-EXIT
1038 PERFORM 3200-SETUP-SCREEN-VARS
1039 THRU 3200-SETUP-SCREEN-VARS-EXIT
1040 PERFORM 3250-SETUP-INFOMSG
1041 THRU 3250-SETUP-INFOMSG-EXIT
1042 PERFORM 3300-SETUP-SCREEN-ATTRS
1043 THRU 3300-SETUP-SCREEN-ATTRS-EXIT
1044 PERFORM 3400-SEND-SCREEN
1045 THRU 3400-SEND-SCREEN-EXIT
1046 .
1047
1048 3000-SEND-MAP-EXIT.
1049 EXIT
1050 .
1051
1052 3100-SCREEN-INIT.
1053 MOVE LOW-VALUES TO CCRDUPAO
1054
1055 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
1056
1057 MOVE CCDA-TITLE01 TO TITLE01O OF CCRDUPAO
1058 MOVE CCDA-TITLE02 TO TITLE02O OF CCRDUPAO
1059 MOVE LIT-THISTRANID TO TRNNAMEO OF CCRDUPAO
1060 MOVE LIT-THISPGM TO PGMNAMEO OF CCRDUPAO
1061
1062 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
1063
1064 MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
1065 MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
1066 MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
1067
1068 MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF CCRDUPAO
1069
1070 MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
1071 MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
1072 MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
1073
1074 MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF CCRDUPAO
1075
1076 .
1077
1078 3100-SCREEN-INIT-EXIT.
1079 EXIT
1080 .
1081
1082 3200-SETUP-SCREEN-VARS.
1083 * INITIALIZE SEARCH CRITERIA
1084 IF CDEMO-PGM-ENTER
1085 CONTINUE
1086 ELSE
1087 IF CC-ACCT-ID-N = 0
1088 MOVE LOW-VALUES TO ACCTSIDO OF CCRDUPAO
1089 ELSE
1090 MOVE CC-ACCT-ID TO ACCTSIDO OF CCRDUPAO
1091 END-IF
1092
1093 IF CC-CARD-NUM-N = 0
1094 MOVE LOW-VALUES TO CARDSIDO OF CCRDUPAO
1095 ELSE
1096 MOVE CC-CARD-NUM TO CARDSIDO OF CCRDUPAO
1097 END-IF
1098
1099 EVALUATE TRUE
1100 WHEN CCUP-DETAILS-NOT-FETCHED
1101 MOVE LOW-VALUES TO CRDNAMEO OF CCRDUPAO
1102 CRDNAMEO OF CCRDUPAO
1103 CRDSTCDO OF CCRDUPAO
1104 EXPDAYO OF CCRDUPAO
1105 EXPMONO OF CCRDUPAO
1106 EXPYEARO OF CCRDUPAO
1107 WHEN CCUP-SHOW-DETAILS
1108 MOVE CCUP-OLD-CRDNAME TO CRDNAMEO OF CCRDUPAO
1109 MOVE CCUP-OLD-CRDSTCD TO CRDSTCDO OF CCRDUPAO
1110 MOVE CCUP-OLD-EXPDAY TO EXPDAYO OF CCRDUPAO
1111 MOVE CCUP-OLD-EXPMON TO EXPMONO OF CCRDUPAO
1112 MOVE CCUP-OLD-EXPYEAR TO EXPYEARO OF CCRDUPAO
1113 WHEN CCUP-CHANGES-MADE
1114 MOVE CCUP-NEW-CRDNAME TO CRDNAMEO OF CCRDUPAO
1115 MOVE CCUP-NEW-CRDSTCD TO CRDSTCDO OF CCRDUPAO
1116 MOVE CCUP-NEW-EXPMON TO EXPMONO OF CCRDUPAO
1117 MOVE CCUP-NEW-EXPYEAR TO EXPYEARO OF CCRDUPAO
1118 ******************************************************************
1119 * MOVE OLD VALUES TO NON-DISPLAY FIELDS
1120 * THAT WE ARE NOT ALLOWING USER TO CHANGE(FOR NOW)
1121 *****************************************************************
1122 * MOVE CCUP-NEW-EXPDAY TO EXPDAYO OF CCRDUPAO
1123 MOVE CCUP-OLD-EXPDAY TO EXPDAYO OF CCRDUPAO
1124 WHEN OTHER
1125 MOVE CCUP-OLD-CRDNAME TO CRDNAMEO OF CCRDUPAO
1126 MOVE CCUP-OLD-CRDSTCD TO CRDSTCDO OF CCRDUPAO
1127 MOVE CCUP-OLD-EXPDAY TO EXPDAYO OF CCRDUPAO
1128 MOVE CCUP-OLD-EXPMON TO EXPMONO OF CCRDUPAO
1129 MOVE CCUP-OLD-EXPYEAR TO EXPYEARO OF CCRDUPAO
1130 END-EVALUATE
1131
1132
1133 END-IF
1134 .
1135 3200-SETUP-SCREEN-VARS-EXIT.
1136 EXIT
1137 .
1138 3250-SETUP-INFOMSG.
1139 * SETUP INFORMATION MESSAGE
1140 EVALUATE TRUE
1141 WHEN CDEMO-PGM-ENTER
1142 SET PROMPT-FOR-SEARCH-KEYS TO TRUE
1143 WHEN CCUP-DETAILS-NOT-FETCHED
1144 SET PROMPT-FOR-SEARCH-KEYS TO TRUE
1145 WHEN CCUP-SHOW-DETAILS
1146 SET FOUND-CARDS-FOR-ACCOUNT TO TRUE
1147 WHEN CCUP-CHANGES-NOT-OK
1148 SET PROMPT-FOR-CHANGES TO TRUE
1149 WHEN CCUP-CHANGES-OK-NOT-CONFIRMED
1150 SET PROMPT-FOR-CONFIRMATION TO TRUE
1151 WHEN CCUP-CHANGES-OKAYED-AND-DONE
1152 SET CONFIRM-UPDATE-SUCCESS TO TRUE
1153 WHEN CCUP-CHANGES-OKAYED-LOCK-ERROR
1154 SET INFORM-FAILURE TO TRUE
1155 WHEN CCUP-CHANGES-OKAYED-BUT-FAILED
1156 SET INFORM-FAILURE TO TRUE
1157 WHEN WS-NO-INFO-MESSAGE
1158 SET PROMPT-FOR-SEARCH-KEYS TO TRUE
1159 END-EVALUATE
1160
1161 MOVE WS-INFO-MSG TO INFOMSGO OF CCRDUPAO
1162
1163 MOVE WS-RETURN-MSG TO ERRMSGO OF CCRDUPAO
1164 .
1165 3250-SETUP-INFOMSG-EXIT.
1166 EXIT
1167 .
1168 3300-SETUP-SCREEN-ATTRS.
1169
1170
1171 * PROTECT OR UNPROTECT BASED ON CONTEXT
1172 EVALUATE TRUE
1173 WHEN CCUP-DETAILS-NOT-FETCHED
1174 MOVE DFHBMFSE TO ACCTSIDA OF CCRDUPAI
1175 CARDSIDA OF CCRDUPAI
1176 MOVE DFHBMPRF TO CRDNAMEA OF CCRDUPAI
1177 CRDSTCDA OF CCRDUPAI
1178 * EXPDAYA OF CCRDUPAI
1179 EXPMONA OF CCRDUPAI
1180 EXPYEARA OF CCRDUPAI
1181 WHEN CCUP-SHOW-DETAILS
1182 WHEN CCUP-CHANGES-NOT-OK
1183 MOVE DFHBMPRF TO ACCTSIDA OF CCRDUPAI
1184 CARDSIDA OF CCRDUPAI
1185 * EXPDAYA OF CCRDUPAI
1186 MOVE DFHBMFSE TO CRDNAMEA OF CCRDUPAI
1187 CRDSTCDA OF CCRDUPAI
1188
1189 EXPMONA OF CCRDUPAI
1190 EXPYEARA OF CCRDUPAI
1191 WHEN CCUP-CHANGES-OK-NOT-CONFIRMED
1192 WHEN CCUP-CHANGES-OKAYED-AND-DONE
1193 MOVE DFHBMPRF TO ACCTSIDA OF CCRDUPAI
1194 CARDSIDA OF CCRDUPAI
1195 CRDNAMEA OF CCRDUPAI
1196 CRDSTCDA OF CCRDUPAI
1197 * EXPDAYA OF CCRDUPAI
1198 EXPMONA OF CCRDUPAI
1199 EXPYEARA OF CCRDUPAI
1200 WHEN OTHER
1201 MOVE DFHBMFSE TO ACCTSIDA OF CCRDUPAI
1202 CARDSIDA OF CCRDUPAI
1203 MOVE DFHBMPRF TO CRDNAMEA OF CCRDUPAI
1204 CRDSTCDA OF CCRDUPAI
1205 * EXPDAYA OF CCRDUPAI
1206 EXPMONA OF CCRDUPAI
1207 EXPYEARA OF CCRDUPAI
1208 END-EVALUATE
1209
1210 * POSITION CURSOR
1211 EVALUATE TRUE
1212 WHEN FOUND-CARDS-FOR-ACCOUNT
1213 WHEN NO-CHANGES-DETECTED
1214 MOVE -1 TO CRDNAMEL OF CCRDUPAI
1215 WHEN FLG-ACCTFILTER-NOT-OK
1216 WHEN FLG-ACCTFILTER-BLANK
1217 MOVE -1 TO ACCTSIDL OF CCRDUPAI
1218 WHEN FLG-CARDFILTER-NOT-OK
1219 WHEN FLG-CARDFILTER-BLANK
1220 MOVE -1 TO CARDSIDL OF CCRDUPAI
1221 WHEN FLG-CARDNAME-NOT-OK
1222 WHEN FLG-CARDNAME-BLANK
1223 MOVE -1 TO CRDNAMEL OF CCRDUPAI
1224 WHEN FLG-CARDSTATUS-NOT-OK
1225 WHEN FLG-CARDSTATUS-BLANK
1226 MOVE -1 TO CRDSTCDL OF CCRDUPAI
1227 WHEN FLG-CARDEXPMON-NOT-OK
1228 WHEN FLG-CARDEXPMON-BLANK
1229 MOVE -1 TO EXPMONL OF CCRDUPAI
1230 WHEN FLG-CARDEXPYEAR-NOT-OK
1231 WHEN FLG-CARDEXPYEAR-BLANK
1232 MOVE -1 TO EXPYEARL OF CCRDUPAI
1233 WHEN OTHER
1234 MOVE -1 TO ACCTSIDL OF CCRDUPAI
1235 END-EVALUATE
1236
1237 * SETUP COLOR
1238 IF CDEMO-LAST-MAPSET EQUAL LIT-CCLISTMAPSET
1239 MOVE DFHDFCOL TO ACCTSIDC OF CCRDUPAO
1240 MOVE DFHDFCOL TO CARDSIDC OF CCRDUPAO
1241 END-IF
1242
1243 IF FLG-ACCTFILTER-NOT-OK
1244 MOVE DFHRED TO ACCTSIDC OF CCRDUPAO
1245 END-IF
1246
1247 IF FLG-ACCTFILTER-BLANK
1248 AND CDEMO-PGM-REENTER
1249 MOVE '*' TO ACCTSIDO OF CCRDUPAO
1250 MOVE DFHRED TO ACCTSIDC OF CCRDUPAO
1251 END-IF
1252
1253 IF FLG-CARDFILTER-NOT-OK
1254 MOVE DFHRED TO CARDSIDC OF CCRDUPAO
1255 END-IF
1256
1257 IF FLG-CARDFILTER-BLANK
1258 AND CDEMO-PGM-REENTER
1259 MOVE '*' TO CARDSIDO OF CCRDUPAO
1260 MOVE DFHRED TO CARDSIDC OF CCRDUPAO
1261 END-IF
1262
1263 IF FLG-CARDNAME-NOT-OK
1264 AND CCUP-CHANGES-NOT-OK
1265 MOVE DFHRED TO CRDNAMEC OF CCRDUPAO
1266 END-IF
1267
1268 IF FLG-CARDNAME-BLANK
1269 AND CCUP-CHANGES-NOT-OK
1270 MOVE '*' TO CRDNAMEO OF CCRDUPAO
1271 MOVE DFHRED TO CRDNAMEC OF CCRDUPAO
1272 END-IF
1273
1274 IF FLG-CARDSTATUS-NOT-OK
1275 AND CCUP-CHANGES-NOT-OK
1276 MOVE DFHRED TO CRDSTCDC OF CCRDUPAO
1277 END-IF
1278
1279 IF FLG-CARDSTATUS-BLANK
1280 AND CCUP-CHANGES-NOT-OK
1281 MOVE '*' TO CRDSTCDO OF CCRDUPAO
1282 MOVE DFHRED TO CRDSTCDC OF CCRDUPAO
1283 END-IF
1284
1285 MOVE DFHBMDAR TO EXPDAYC OF CCRDUPAO
1286
1287 IF FLG-CARDEXPMON-NOT-OK
1288 AND CCUP-CHANGES-NOT-OK
1289 MOVE DFHRED TO EXPMONC OF CCRDUPAO
1290 END-IF
1291
1292 IF FLG-CARDEXPMON-BLANK
1293 AND CCUP-CHANGES-NOT-OK
1294 MOVE '*' TO EXPMONO OF CCRDUPAO
1295 MOVE DFHRED TO EXPMONC OF CCRDUPAO
1296 END-IF
1297
1298 IF FLG-CARDEXPYEAR-NOT-OK
1299 AND CCUP-CHANGES-NOT-OK
1300 MOVE DFHRED TO EXPYEARC OF CCRDUPAO
1301 END-IF
1302
1303 IF FLG-CARDEXPYEAR-BLANK
1304 AND CCUP-CHANGES-NOT-OK
1305 MOVE '*' TO EXPYEARO OF CCRDUPAO
1306 MOVE DFHRED TO EXPYEARC OF CCRDUPAO
1307 END-IF
1308
1309 IF WS-NO-INFO-MESSAGE
1310 MOVE DFHBMDAR TO INFOMSGA OF CCRDUPAI
1311 ELSE
1312 MOVE DFHBMBRY TO INFOMSGA OF CCRDUPAI
1313 END-IF
1314
1315 IF PROMPT-FOR-CONFIRMATION
1316 MOVE DFHBMBRY TO FKEYSCA OF CCRDUPAI
1317 END-IF
1318 .
1319 3300-SETUP-SCREEN-ATTRS-EXIT.
1320 EXIT
1321 .
1322
1323
1324 3400-SEND-SCREEN.
1325
1326 MOVE LIT-THISMAPSET TO CCARD-NEXT-MAPSET
1327 MOVE LIT-THISMAP TO CCARD-NEXT-MAP
1328
1329 EXEC CICS SEND MAP(CCARD-NEXT-MAP)
1330 MAPSET(CCARD-NEXT-MAPSET)
1331 FROM(CCRDUPAO)
1332 CURSOR
1333 ERASE
1334 FREEKB
1335 RESP(WS-RESP-CD)
1336 END-EXEC
1337 .
1338 3400-SEND-SCREEN-EXIT.
1339 EXIT
1340 .
1341
1342
1343 9000-READ-DATA.
1344
1345 INITIALIZE CCUP-OLD-DETAILS
1346 MOVE CC-ACCT-ID TO CCUP-OLD-ACCTID
1347 MOVE CC-CARD-NUM TO CCUP-OLD-CARDID
1348
1349 PERFORM 9100-GETCARD-BYACCTCARD
1350 THRU 9100-GETCARD-BYACCTCARD-EXIT
1351
1352 IF FOUND-CARDS-FOR-ACCOUNT
1353
1354 MOVE CARD-CVV-CD TO CCUP-OLD-CVV-CD
1355
1356 INSPECT CARD-EMBOSSED-NAME
1357 CONVERTING LIT-LOWER
1358 TO LIT-UPPER
1359
1360 MOVE CARD-EMBOSSED-NAME TO CCUP-OLD-CRDNAME
1361 MOVE CARD-EXPIRAION-DATE(1:4)
1362 TO CCUP-OLD-EXPYEAR
1363 MOVE CARD-EXPIRAION-DATE(6:2)
1364 TO CCUP-OLD-EXPMON
1365 MOVE CARD-EXPIRAION-DATE(9:2)
1366 TO CCUP-OLD-EXPDAY
1367 MOVE CARD-ACTIVE-STATUS TO CCUP-OLD-CRDSTCD
1368
1369 END-IF
1370 .
1371
1372 9000-READ-DATA-EXIT.
1373 EXIT
1374 .
1375
1376 9100-GETCARD-BYACCTCARD.
1377 * Read the Card file
1378 *
1379 * MOVE CC-ACCT-ID-N TO WS-CARD-RID-ACCT-ID
1380 MOVE CC-CARD-NUM TO WS-CARD-RID-CARDNUM
1381
1382 EXEC CICS READ
1383 FILE (LIT-CARDFILENAME)
1384 RIDFLD (WS-CARD-RID-CARDNUM)
1385 KEYLENGTH (LENGTH OF WS-CARD-RID-CARDNUM)
1386 INTO (CARD-RECORD)
1387 LENGTH (LENGTH OF CARD-RECORD)
1388 RESP (WS-RESP-CD)
1389 RESP2 (WS-REAS-CD)
1390 END-EXEC
1391
1392 EVALUATE WS-RESP-CD
1393 WHEN DFHRESP(NORMAL)
1394 SET FOUND-CARDS-FOR-ACCOUNT TO TRUE
1395 WHEN DFHRESP(NOTFND)
1396 SET INPUT-ERROR TO TRUE
1397 SET FLG-ACCTFILTER-NOT-OK TO TRUE
1398 SET FLG-CARDFILTER-NOT-OK TO TRUE
1399 IF WS-RETURN-MSG-OFF
1400 SET DID-NOT-FIND-ACCTCARD-COMBO TO TRUE
1401 END-IF
1402 WHEN OTHER
1403 SET INPUT-ERROR TO TRUE
1404 IF WS-RETURN-MSG-OFF
1405 SET FLG-ACCTFILTER-NOT-OK TO TRUE
1406 END-IF
1407 MOVE 'READ' TO ERROR-OPNAME
1408 MOVE LIT-CARDFILENAME TO ERROR-FILE
1409 MOVE WS-RESP-CD TO ERROR-RESP
1410 MOVE WS-REAS-CD TO ERROR-RESP2
1411 MOVE WS-FILE-ERROR-MESSAGE TO WS-RETURN-MSG
1412 END-EVALUATE
1413 .
1414
1415 9100-GETCARD-BYACCTCARD-EXIT.
1416 EXIT
1417 .
1418
1419
1420 9200-WRITE-PROCESSING.
1421
1422 * Read the Card file
1423 *
1424 * MOVE CC-ACCT-ID-N TO WS-CARD-RID-ACCT-ID
1425 MOVE CC-CARD-NUM TO WS-CARD-RID-CARDNUM
1426
1427 EXEC CICS READ
1428 FILE (LIT-CARDFILENAME)
1429 UPDATE
1430 RIDFLD (WS-CARD-RID-CARDNUM)
1431 KEYLENGTH (LENGTH OF WS-CARD-RID-CARDNUM)
1432 INTO (CARD-RECORD)
1433 LENGTH (LENGTH OF CARD-RECORD)
1434 RESP (WS-RESP-CD)
1435 RESP2 (WS-REAS-CD)
1436 END-EXEC
1437
1438 *****************************************************************
1439 * Could we lock the record ?
1440 *****************************************************************
1441 IF WS-RESP-CD EQUAL TO DFHRESP(NORMAL)
1442 CONTINUE
1443 ELSE
1444 SET INPUT-ERROR TO TRUE
1445 IF WS-RETURN-MSG-OFF
1446 SET COULD-NOT-LOCK-FOR-UPDATE TO TRUE
1447 END-IF
1448 GO TO 9200-WRITE-PROCESSING-EXIT
1449 END-IF
1450 *****************************************************************
1451 * Did someone change the record while we were out ?
1452 *****************************************************************
1453 PERFORM 9300-CHECK-CHANGE-IN-REC
1454 THRU 9300-CHECK-CHANGE-IN-REC-EXIT
1455 IF DATA-WAS-CHANGED-BEFORE-UPDATE
1456 GO TO 9200-WRITE-PROCESSING-EXIT
1457 END-IF
1458 *****************************************************************
1459 * Prepare the update
1460 *****************************************************************
1461 INITIALIZE CARD-UPDATE-RECORD
1462 MOVE CCUP-NEW-CARDID TO CARD-UPDATE-NUM
1463 MOVE CC-ACCT-ID-N TO CARD-UPDATE-ACCT-ID
1464 MOVE CCUP-NEW-CVV-CD TO CARD-CVV-CD-X
1465 MOVE CARD-CVV-CD-N TO CARD-UPDATE-CVV-CD
1466 MOVE CCUP-NEW-CRDNAME TO CARD-UPDATE-EMBOSSED-NAME
1467 STRING CCUP-NEW-EXPYEAR
1468 '-'
1469 CCUP-NEW-EXPMON
1470 '-'
1471 CCUP-NEW-EXPDAY
1472 DELIMITED BY SIZE
1473 INTO CARD-UPDATE-EXPIRAION-DATE
1474 END-STRING
1475 MOVE CCUP-NEW-CRDSTCD TO CARD-UPDATE-ACTIVE-STATUS
1476
1477 EXEC CICS
1478 REWRITE FILE(LIT-CARDFILENAME)
1479 FROM(CARD-UPDATE-RECORD)
1480 LENGTH(LENGTH OF CARD-UPDATE-RECORD)
1481 RESP (WS-RESP-CD)
1482 RESP2 (WS-REAS-CD)
1483 END-EXEC.
1484
1485 *****************************************************************
1486 * Did the update succeed ? *
1487 *****************************************************************
1488 IF WS-RESP-CD EQUAL TO DFHRESP(NORMAL)
1489 CONTINUE
1490 ELSE
1491 SET LOCKED-BUT-UPDATE-FAILED TO TRUE
1492 END-IF
1493 .
1494 9200-WRITE-PROCESSING-EXIT.
1495 EXIT
1496 .
1497
1498 9300-CHECK-CHANGE-IN-REC.
1499 INSPECT CARD-EMBOSSED-NAME
1500 CONVERTING LIT-LOWER
1501 TO LIT-UPPER
1502
1503 IF CARD-CVV-CD EQUAL TO CCUP-OLD-CVV-CD
1504 AND CARD-EMBOSSED-NAME EQUAL TO CCUP-OLD-CRDNAME
1505 AND CARD-EXPIRAION-DATE(1:4) EQUAL TO CCUP-OLD-EXPYEAR
1506 AND CARD-EXPIRAION-DATE(6:2) EQUAL TO CCUP-OLD-EXPMON
1507 AND CARD-EXPIRAION-DATE(9:2) EQUAL TO CCUP-OLD-EXPDAY
1508 AND CARD-ACTIVE-STATUS EQUAL TO CCUP-OLD-CRDSTCD
1509 CONTINUE
1510 ELSE
1511 SET DATA-WAS-CHANGED-BEFORE-UPDATE TO TRUE
1512 MOVE CARD-CVV-CD TO CCUP-OLD-CVV-CD
1513 MOVE CARD-EMBOSSED-NAME TO CCUP-OLD-CRDNAME
1514 MOVE CARD-EXPIRAION-DATE(1:4) TO CCUP-OLD-EXPYEAR
1515 MOVE CARD-EXPIRAION-DATE(6:2) TO CCUP-OLD-EXPMON
1516 MOVE CARD-EXPIRAION-DATE(9:2) TO CCUP-OLD-EXPDAY
1517 MOVE CARD-ACTIVE-STATUS TO CCUP-OLD-CRDSTCD
1518 GO TO 9200-WRITE-PROCESSING-EXIT
1519 END-IF EXIT
1520 .
1521 9300-CHECK-CHANGE-IN-REC-EXIT.
1522 EXIT
1523 .
1524
1525 ******************************************************************
1526 *Common code to store PFKey
1527 ******************************************************************
1528 COPY 'CSSTRPFY'
1529 .
1530 340000
1531 ABEND-ROUTINE.
1532
1533 IF ABEND-MSG EQUAL LOW-VALUES
1534 MOVE 'UNEXPECTED ABEND OCCURRED.' TO ABEND-MSG
1535 END-IF
1536
1537 MOVE LIT-THISPGM TO ABEND-CULPRIT
1538
1539 EXEC CICS SEND
1540 FROM (ABEND-DATA)
1541 LENGTH(LENGTH OF ABEND-DATA)
1542 NOHANDLE
1543 ERASE
1544 END-EXEC
1545
1546 EXEC CICS HANDLE ABEND
1547 CANCEL
1548 END-EXEC
1549
1550 EXEC CICS ABEND
1551 ABCODE('9999')
1552 END-EXEC
1553 .
1554 ABEND-ROUTINE-EXIT.
1555 EXIT
1556 .
1557
1558 *
1559 * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:33 CDT
1560 *