cobol · 4236 lines · sha256 b5bb7d6ccad022e0 · guides at columns 7 and 72app/cbl/COACTUPC.cbl

1	************************************** ***********************
2	* Program: COACTUPC.CBL *
3	* Layer: Business logic *
4	* Function: Accept and process ACCOUNT UPDATE *
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	COACTUPC.
24	DATE-WRITTEN.
25	July 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	07 WS-UCTRANS PIC X(4)
47	VALUE SPACES.
48	******************************************************************
49	* Input edits
50	******************************************************************
51	* Generic Input Edits
52	05 WS-GENERIC-EDITS.
53	10 WS-EDIT-VARIABLE-NAME PIC X(25).
54
55	10 WS-EDIT-SIGNED-NUMBER-9V2-X PIC X(15).
56	10 WS-FLG-SIGNED-NUMBER-EDIT PIC X(1).
57	88 FLG-SIGNED-NUMBER-ISVALID VALUE LOW-VALUES.
58	88 FLG-SIGNED-NUMBER-NOT-OK VALUE '0'.
59	88 FLG-SIGNED-NUMBER-BLANK VALUE 'B'.
60
61	10 WS-EDIT-ALPHANUM-ONLY PIC X(256).
62	10 WS-EDIT-ALPHANUM-LENGTH PIC S9(4) COMP-3.
63
64	10 WS-EDIT-ALPHA-ONLY-FLAGS PIC X(1).
65	88 FLG-ALPHA-ISVALID VALUE LOW-VALUES.
66	88 FLG-ALPHA-NOT-OK VALUE '0'.
67	88 FLG-ALPHA-BLANK VALUE 'B'.
68	10 WS-EDIT-ALPHANUM-ONLY-FLAGS PIC X(1).
69	88 FLG-ALPHNANUM-ISVALID VALUE LOW-VALUES.
70	88 FLG-ALPHNANUM-NOT-OK VALUE '0'.
71	88 FLG-ALPHNANUM-BLANK VALUE 'B'.
72	10 WS-EDIT-MANDATORY-FLAGS PIC X(1).
73	88 FLG-MANDATORY-ISVALID VALUE LOW-VALUES.
74	88 FLG-MANDATORY-NOT-OK VALUE '0'.
75	88 FLG-MANDATORY-BLANK VALUE 'B'.
76	10 WS-EDIT-YES-NO PIC X(1)
77	VALUE 'N'.
78	88 FLG-YES-NO-ISVALID VALUES 'Y', 'N'.
79	88 FLG-YES-NO-NOT-OK VALUE '0'.
80	88 FLG-YES-NO-BLANK VALUE 'B'.
81
82	10 WS-EDIT-US-PHONE-NUM PIC X(15).
83	10 WS-EDIT-US-PHONE-NUM-X REDEFINES
84	WS-EDIT-US-PHONE-NUM.
85	20 FILLER PIC X(1).
86	* VALUE '('
87	20 WS-EDIT-US-PHONE-NUMA PIC X(3).
88	20 WS-EDIT-US-PHONE-NUMA-N REDEFINES
89	WS-EDIT-US-PHONE-NUMA PIC 9(3).
90	20 FILLER PIC X(1).
91	* VALUE ')'
92	20 WS-EDIT-US-PHONE-NUMB PIC X(3).
93	20 WS-EDIT-US-PHONE-NUMB-N REDEFINES
94	WS-EDIT-US-PHONE-NUMB PIC 9(3).
95	20 FILLER PIC X(1).
96	* VALUE '-'
97	20 WS-EDIT-US-PHONE-NUMC PIC X(4).
98	20 WS-EDIT-US-PHONE-NUMC-N REDEFINES
99	WS-EDIT-US-PHONE-NUMC PIC 9(4).
100	20 FILLER PIC X(2).
101	10 WS-EDIT-US-PHONE-NUM-FLGS.
102	88 WS-EDIT-US-PHONE-IS-INVALID VALUE '000'.
103	88 WS-EDIT-US-PHONE-IS-VALID VALUE LOW-VALUES.
104	20 WS-EDIT-US-PHONEA-FLG PIC X(01).
105	88 FLG-EDIT-US-PHONEA-ISVALID VALUE LOW-VALUES.
106	88 FLG-EDIT-US-PHONEA-NOT-OK VALUE '0'.
107	88 FLG-EDIT-US-PHONEA-BLANK VALUE 'B'.
108	20 WS-EDIT-EDIT-US-PHONEB PIC X(01).
109	88 FLG-EDIT-US-PHONEB-ISVALID VALUE LOW-VALUES.
110	88 FLG-EDIT-US-PHONEB-NOT-OK VALUE '0'.
111	88 FLG-EDIT-US-PHONEB-BLANK VALUE 'B'.
112	20 WS-EDIT-EDIT-PHONEC PIC X(01).
113	88 FLG-EDIT-US-PHONEC-ISVALID VALUE LOW-VALUES.
114	88 FLG-EDIT-US-PHONEC-NOT-OK VALUE '0'.
115	88 FLG-EDIT-US-PHONEC-BLANK VALUE 'B'.
116
117	10 WS-EDIT-US-SSN.
118	20 WS-EDIT-US-SSN-PART1 PIC X(3).
119	20 WS-EDIT-US-SSN-PART1-N REDEFINES
120	WS-EDIT-US-SSN-PART1 PIC 9(3).
121	88 INVALID-SSN-PART1 VALUES 0,
122	666,
123	900 THRU 999.
124	20 WS-EDIT-US-SSN-PART2 PIC X(2).
125	20 WS-EDIT-US-SSN-PART2-N REDEFINES
126	WS-EDIT-US-SSN-PART2 PIC 9(2).
127	20 WS-EDIT-US-SSN-PART3 PIC X(4).
128	20 WS-EDIT-US-SSN-PART3-N REDEFINES
129	WS-EDIT-US-SSN-PART3 PIC 9(4).
130	10 WS-EDIT-US-SSN-N REDEFINES
131	WS-EDIT-US-SSN PIC 9(09).
132	10 WS-EDIT-US-SSN-FLGS.
133	88 WS-EDIT-US-SSN-IS-INVALID VALUE '000'.
134	88 WS-EDIT-US-SSN-IS-VALID VALUE LOW-VALUES.
135	20 WS-EDIT-US-SSN-PART1-FLGS PIC X(01).
136	88 FLG-EDIT-US-SSN-PART1-ISVALID VALUE LOW-VALUES.
137	88 FLG-EDIT-US-SSN-PART1-NOT-OK VALUE '0'.
138	88 FLG-EDIT-US-SSN-PART1-BLANK VALUE 'B'.
139	20 WS-EDIT-US-SSN-PART2-FLGS PIC X(01).
140	88 FLG-EDIT-US-SSN-PART2-ISVALID VALUE LOW-VALUES.
141	88 FLG-EDIT-US-SSN-PART2-NOT-OK VALUE '0'.
142	88 FLG-EDIT-US-SSN-PART2-BLANK VALUE 'B'.
143	20 WS-EDIT-US-SSN-PART3-FLGS PIC X(01).
144	88 FLG-EDIT-US-SSN-PART3-ISVALID VALUE LOW-VALUES.
145	88 FLG-EDIT-US-SSN-PART3-NOT-OK VALUE '0'.
146	88 FLG-EDIT-US-SSN-PART3-BLANK VALUE 'B'.
147
148	******************************************************************
149	* Work variables
150	******************************************************************
151	05 WS-CALCULATION-VARS.
152	10 WS-DIV-BY PIC S9(4) COMP-3
153	VALUE 4.
154	10 WS-DIVIDEND PIC S9(4) COMP-3
155	VALUE 0.
156
157	10 WS-REMAINDER PIC S9(4) COMP-3
158	VALUE 0.
159	10 WS-CURR-DATE PIC X(21)
160	VALUE SPACES.
161
162
163	******************************************************************
164	* Generic date edit variables CCYYMMDD
165	******************************************************************
166	COPY 'CSUTLDWY'.
167	******************************************************************
168	05 WS-DATACHANGED-FLAG PIC X(1).
169	88 NO-CHANGES-FOUND VALUE '0'.
170	88 CHANGE-HAS-OCCURRED VALUE '1'.
171	05 WS-INPUT-FLAG PIC X(1).
172	88 INPUT-OK VALUE '0'.
173	88 INPUT-ERROR VALUE '1'.
174	88 INPUT-PENDING VALUE LOW-VALUES.
175	05 WS-RETURN-FLAG PIC X(1).
176	88 WS-RETURN-FLAG-OFF VALUE LOW-VALUES.
177	88 WS-RETURN-FLAG-ON VALUE '1'.
178	05 WS-PFK-FLAG PIC X(1).
179	88 PFK-VALID VALUE '0'.
180	88 PFK-INVALID VALUE '1'.
181
182	* Program specific edits
183	05 WS-EDIT-ACCT-FLAG PIC X(1).
184	88 FLG-ACCTFILTER-ISVALID VALUE '1'.
185	88 FLG-ACCTFILTER-NOT-OK VALUE '0'.
186	88 FLG-ACCTFILTER-BLANK VALUE ' '.
187	05 WS-EDIT-CUST-FLAG PIC X(1).
188	88 FLG-CUSTFILTER-ISVALID VALUE '1'.
189	88 FLG-CUSTFILTER-NOT-OK VALUE '0'.
190	88 FLG-CUSTFILTER-BLANK VALUE ' '.
191	05 WS-NON-KEY-FLAGS.
192	10 WS-EDIT-ACCT-STATUS PIC X(1).
193	88 FLG-ACCT-STATUS-ISVALID VALUES 'Y', 'N'.
194	88 FLG-ACCT-STATUS-NOT-OK VALUE '0'.
195	88 FLG-ACCT-STATUS-BLANK VALUE 'B'.
196	10 WS-EDIT-CREDIT-LIMIT PIC X(1).
197	88 FLG-CRED-LIMIT-ISVALID VALUE LOW-VALUES.
198	88 FLG-CRED-LIMIT-NOT-OK VALUE '0'.
199	88 FLG-CRED-LIMIT-BLANK VALUE 'B'.
200	10 WS-EDIT-CASH-CREDIT-LIMIT PIC X(1).
201	88 FLG-CASH-CREDIT-LIMIT-ISVALID VALUE LOW-VALUES.
202	88 FLG-CASH-CREDIT-LIMIT-NOT-OK VALUE '0'.
203	88 FLG-CASH-CREDIT-LIMIT-BLANK VALUE 'B'.
204	10 WS-EDIT-CURR-BAL PIC X(1).
205	88 FLG-CURR-BAL-ISVALID VALUE LOW-VALUES.
206	88 FLG-CURR-BAL-NOT-OK VALUE '0'.
207	88 FLG-CURR-BAL-BLANK VALUE 'B'.
208	10 WS-EDIT-CURR-CYC-CREDIT PIC X(1).
209	88 FLG-CURR-CYC-CREDIT-ISVALID VALUE LOW-VALUES.
210	88 FLG-CURR-CYC-CREDIT-NOT-OK VALUE '0'.
211	88 FLG-CURR-CYC-CREDIT-BLANK VALUE 'B'.
212	10 WS-EDIT-CURR-CYC-DEBIT PIC X(1).
213	88 FLG-CURR-CYC-DEBIT-ISVALID VALUE LOW-VALUES.
214	88 FLG-CURR-CYC-DEBIT-NOT-OK VALUE '0'.
215	88 FLG-CURR-CYC-DEBIT-BLANK VALUE 'B'.
216	10 WS-EDIT-DT-OF-BIRTH-FLGS.
217	88 WS-EDIT-DT-OF-BIRTH-INVALID VALUE '000'.
218	88 WS-EDIT-DT-OF-BIRTH-ISVALID VALUE LOW-VALUES.
219	20 WS-EDIT-DT-OF-BIRTH-YEAR-FLG PIC X(01).
220	88 FLG-DT-OF-BIRTH-YEAR-ISVALID VALUE LOW-VALUES.
221	88 FLG-DT-OF-BIRTH-YEAR-NOT-OK VALUE '0'.
222	88 FLG-DT-OF-BIRTH-YEAR-BLANK VALUE 'B'.
223	20 WS-EDIT-DT-OF-BIRTH-MONTH PIC X(01).
224	88 FLG-DT-OF-BIRTH-MONTH-ISVALID VALUE LOW-VALUES.
225	88 FLG-DT-OF-BIRTH-MONTH-NOT-OK VALUE '0'.
226	88 FLG-DT-OF-BIRTH-MONTH-BLANK VALUE 'B'.
227	20 WS-EDIT-DT-OF-BIRTH-DAY PIC X(01).
228	88 FLG-DT-OF-BIRTH-DAY-ISVALID VALUE LOW-VALUES.
229	88 FLG-DT-OF-BIRTH-DAY-NOT-OK VALUE '0'.
230	88 FLG-DT-OF-BIRTH-DAY-BLANK VALUE 'B'.
231	10 WS-EDIT-FICO-SCORE-FLGS PIC X(1).
232	88 FLG-FICO-SCORE-ISVALID VALUE LOW-VALUES.
233	88 FLG-FICO-SCORE-NOT-OK VALUE '0'.
234	88 FLG-FICO-SCORE-BLANK VALUE 'B'.
235	10 WS-EDIT-OPEN-DATE-FLGS.
236	88 WS-EDIT-OPEN-DATE-IS-INVALID VALUE '000'.
237	20 WS-EDIT-OPEN-YEAR-FLG PIC X(01).
238	88 FLG-OPEN-YEAR-ISVALID VALUE LOW-VALUES.
239	88 FLG-OPEN-YEAR-NOT-OK VALUE '0'.
240	88 FLG-OPEN-YEAR-BLANK VALUE 'B'.
241	20 WS-EDIT-OPEN-MONTH PIC X(01).
242	88 FLG-OPEN-MONTH-ISVALID VALUE LOW-VALUES.
243	88 FLG-OPEN-MONTH-NOT-OK VALUE '0'.
244	88 FLG-OPEN-MONTH-BLANK VALUE 'B'.
245	20 WS-EDIT-OPEN-DAY PIC X(01).
246	88 FLG-OPEN-DAY-ISVALID VALUE LOW-VALUES.
247	88 FLG-OPEN-DAY-NOT-OK VALUE '0'.
248	88 FLG-OPEN-DAY-BLANK VALUE 'B'.
249	10 WS-EXPIRY-DATE-FLGS.
250	88 WS-EDIT-EXPIRY-IS-INVALID VALUE '000'.
251	20 WS-EDIT-EXPIRY-YEAR-FLG PIC X(01).
252	88 FLG-EXPIRY-YEAR-ISVALID VALUE LOW-VALUES.
253	88 FLG-EXPIRY-YEAR-NOT-OK VALUE '0'.
254	88 FLG-EXPIRY-YEAR-BLANK VALUE 'B'.
255	20 WS-EDIT-EXPIRY-MONTH PIC X(01).
256	88 FLG-EXPIRY-MONTH-ISVALID VALUE LOW-VALUES.
257	88 FLG-EXPIRY-MONTH-NOT-OK VALUE '0'.
258	88 FLG-EXPIRY-MONTH-BLANK VALUE 'B'.
259	20 WS-EDIT-EXPIRY-DAY PIC X(01).
260	88 FLG-EXPIRY-DAY-ISVALID VALUE LOW-VALUES.
261	88 FLG-EXPIRY-DAY-NOT-OK VALUE '0'.
262	88 FLG-EXPIRY-DAY-BLANK VALUE 'B'.
263	10 WS-EDIT-REISSUE-DATE-FLGS.
264	88 WS-EDIT-REISSUE-DATE-INVALID VALUE '000'.
265	20 WS-EDIT-REISSUE-YEAR-FLG PIC X(01).
266	88 FLG-REISSUE-YEAR-ISVALID VALUE LOW-VALUES.
267	88 FLG-REISSUE-YEAR-NOT-OK VALUE '0'.
268	88 FLG-REISSUE-YEAR-BLANK VALUE 'B'.
269	20 WS-EDIT-REISSUE-MONTH PIC X(01).
270	88 FLG-REISSUE-MONTH-ISVALID VALUE LOW-VALUES.
271	88 FLG-REISSUE-MONTH-NOT-OK VALUE '0'.
272	88 FLG-REISSUE-MONTH-BLANK VALUE 'B'.
273	20 WS-EDIT-REISSUE-DAY PIC X(01).
274	88 FLG-REISSUE-DAY-ISVALID VALUE LOW-VALUES.
275	88 FLG-REISSUE-DAY-NOT-OK VALUE '0'.
276	88 FLG-REISSUE-DAY-BLANK VALUE 'B'.
277	10 WS-EDIT-NAME-FLAGS.
278	20 WS-EDIT-FIRST-NAME-FLGS PIC X(01).
279	88 FLG-FIRST-NAME-ISVALID VALUE LOW-VALUES.
280	88 FLG-FIRST-NAME-NOT-OK VALUE '0'.
281	88 FLG-FIRST-NAME-BLANK VALUE 'B'.
282	20 WS-EDIT-MIDDLE-NAME-FLGS PIC X(01).
283	88 FLG-MIDDLE-NAME-ISVALID VALUE LOW-VALUES.
284	88 FLG-MIDDLE-NAME-NOT-OK VALUE '0'.
285	88 FLG-MIDDLE-NAME-BLANK VALUE 'B'.
286	20 WS-EDIT-LAST-NAME-FLGS PIC X(01).
287	88 FLG-LAST-NAME-ISVALID VALUE LOW-VALUES.
288	88 FLG-LAST-NAME-NOT-OK VALUE '0'.
289	88 FLG-LAST-NAME-BLANK VALUE 'B'.
290	10 WS-EDIT-ADDRESS-FLAGS.
291	20 WS-EDIT-ADDRESS-LINE-1-FLGS PIC X(01).
292	88 FLG-ADDRESS-LINE-1-ISVALID VALUE LOW-VALUES.
293	88 FLG-ADDRESS-LINE-1-NOT-OK VALUE '0'.
294	88 FLG-ADDRESS-LINE-1-BLANK VALUE 'B'.
295	20 WS-EDIT-ADDRESS-LINE-2-FLGS PIC X(01).
296	88 FLG-ADDRESS-LINE-2-ISVALID VALUE LOW-VALUES.
297	88 FLG-ADDRESS-LINE-2-NOT-OK VALUE '0'.
298	88 FLG-ADDRESS-LINE-2-BLANK VALUE 'B'.
299	20 WS-EDIT-CITY-FLGS PIC X(01).
300	88 FLG-CITY-ISVALID VALUE LOW-VALUES.
301	88 FLG-CITY-NOT-OK VALUE '0'.
302	88 FLG-CITY-BLANK VALUE 'B'.
303	20 WS-EDIT-STATE-FLGS PIC X(01).
304	88 FLG-STATE-ISVALID VALUE LOW-VALUES.
305	88 FLG-STATE-NOT-OK VALUE '0'.
306	88 FLG-STATE-BLANK VALUE 'B'.
307	20 WS-EDIT-ZIPCODE-FLGS PIC X(01).
308	88 FLG-ZIPCODE-ISVALID VALUE LOW-VALUES.
309	88 FLG-ZIPCODE-NOT-OK VALUE '0'.
310	88 FLG-ZIPCODE-BLANK VALUE 'B'.
311	20 WS-EDIT-COUNTRY-FLGS PIC X(01).
312	88 FLG-COUNTRY-ISVALID VALUE LOW-VALUES.
313	88 FLG-COUNTRY-NOT-OK VALUE '0'.
314	88 FLG-COUNTRY-BLANK VALUE 'B'.
315	20 WS-EDIT-PHONE-NUM-1-FLGS.
316	88 WS-EDIT-PHONE-NUM-1-IS-INVALID
317	VALUE '000'.
318	30 WS-EDIT-PHONE-NUM-1A-FLG PIC X(01).
319	88 FLG-PHONE-NUM-1A-ISVALID VALUE LOW-VALUES.
320	88 FLG-PHONE-NUM-1A-NOT-OK VALUE '0'.
321	88 FLG-PHONE-NUM-1A-BLANK VALUE 'B'.
322	30 WS-EDIT-PHONE-NUM-1B PIC X(01).
323	88 FLG-PHONE-NUM-1B-ISVALID VALUE LOW-VALUES.
324	88 FLG-PHONE-NUM-1B-NOT-OK VALUE '0'.
325	88 FLG-PHONE-NUM-1B-BLANK VALUE 'B'.
326	30 WS-EDIT-PHONE-NUM-1C PIC X(01).
327	88 FLG-PHONE-NUM-1C-ISVALID VALUE LOW-VALUES.
328	88 FLG-PHONE-NUM-1C-NOT-OK VALUE '0'.
329	88 FLG-PHONE-NUM-1C-BLANK VALUE 'B'.
330	20 WS-EDIT-PHONE-NUM-2-FLGS.
331	88 WS-EDIT-PHONE-NUM-2-IS-INVALID
332	VALUE '000'.
333	30 WS-EDIT-PHONE-NUM-2A-FLG PIC X(01).
334	88 FLG-PHONE-NUM-2A-ISVALID VALUE LOW-VALUES.
335	88 FLG-PHONE-NUM-2A-NOT-OK VALUE '0'.
336	88 FLG-PHONE-NUM-2A-BLANK VALUE 'B'.
337	30 WS-EDIT-PHONE-NUM-2B PIC X(01).
338	88 FLG-PHONE-NUM-2B-ISVALID VALUE LOW-VALUES.
339	88 FLG-PHONE-NUM-2B-NOT-OK VALUE '0'.
340	88 FLG-PHONE-NUM-2B-BLANK VALUE 'B'.
341	30 WS-EDIT-PHONE-NUM-2C PIC X(01).
342	88 FLG-PHONE-NUM-2C-ISVALID VALUE LOW-VALUES.
343	88 FLG-PHONE-NUM-2C-NOT-OK VALUE '0'.
344	88 FLG-PHONE-NUM-2C-BLANK VALUE 'B'.
345	10 WS-EFT-ACCOUNT-ID-FLGS PIC X(01).
346	88 FLG-EFT-ACCOUNT-ID-ISVALID VALUE LOW-VALUES.
347	88 FLG-EFT-ACCOUNT-ID-NOT-OK VALUE '0'.
348	88 FLG-EFT-ACCOUNT-ID-BLANK VALUE 'B'.
349	10 WS-EDIT-PRI-CARDHOLDER PIC X(1).
350	88 FLG-PRI-CARDHOLDER-ISVALID VALUES 'Y', 'N'.
351	88 FLG-PRI-CARDHOLDER-NOT-OK VALUE '0'.
352	88 FLG-PRI-CARDHOLDER-BLANK VALUE 'B'.
353
354	******************************************************************
355	* Output edits
356	******************************************************************
357	05 CICS-OUTPUT-EDIT-VARS.
358	10 CUST-ACCT-ID-X PIC X(11).
359	10 CUST-ACCT-ID-N REDEFINES CUST-ACCT-ID-X
360	PIC 9(11).
361	10 WS-EDIT-DATE-X PIC X(10).
362	10 FILLER REDEFINES WS-EDIT-DATE-X.
363	20 WS-EDIT-DATE-X-YEAR PIC X(4).
364	20 FILLER PIC X(1).
365	20 WS-EDIT-DATE-MONTH PIC X(2).
366	20 FILLER PIC X(1).
367	20 WS-EDIT-DATE-DAY PIC X(2).
368	10 WS-EDIT-DATE-X REDEFINES
369	WS-EDIT-DATE-X PIC 9(10).
370	10 WS-EDIT-CURRENCY-9-2 PIC X(15).
371	10 WS-EDIT-CURRENCY-9-2-F PIC +ZZZ,ZZZ,ZZZ.99.
372
373	******************************************************************
374	* File and data Handling
375	******************************************************************
376	05 WS-XREF-RID.
377	10 WS-CARD-RID-CARDNUM PIC X(16).
378	10 WS-CARD-RID-CUST-ID PIC 9(09).
379	10 WS-CARD-RID-CUST-ID-X REDEFINES
380	WS-CARD-RID-CUST-ID PIC X(09).
381	10 WS-CARD-RID-ACCT-ID PIC 9(11).
382	10 WS-CARD-RID-ACCT-ID-X REDEFINES
383	WS-CARD-RID-ACCT-ID PIC X(11).
384	05 WS-FILE-READ-FLAGS.
385	10 WS-ACCOUNT-MASTER-READ-FLAG PIC X(1).
386	88 FOUND-ACCT-IN-MASTER VALUE '1'.
387	10 WS-CUST-MASTER-READ-FLAG PIC X(1).
388	88 FOUND-CUST-IN-MASTER VALUE '1'.
389	05 WS-FILE-ERROR-MESSAGE.
390	10 FILLER PIC X(12)
391	VALUE 'File Error: '.
392	10 ERROR-OPNAME PIC X(8)
393	VALUE SPACES.
394	10 FILLER PIC X(4)
395	VALUE ' on '.
396	10 ERROR-FILE PIC X(9)
397	VALUE SPACES.
398	10 FILLER PIC X(15)
399	VALUE
400	' returned RESP '.
401	10 ERROR-RESP PIC X(10)
402	VALUE SPACES.
403	10 FILLER PIC X(7)
404	VALUE ',RESP2 '.
405	10 ERROR-RESP2 PIC X(10)
406	VALUE SPACES.
407	10 FILLER PIC X(5)
408	VALUE SPACES.
409	* Alpha variables for editing numerics
410	*
411	05 ALPHA-VARS-FOR-DATA-EDITING.
412	15 ACUP-NEW-CREDIT-LIMIT-X PIC X(15).
413	15 ACUP-NEW-CASH-CREDIT-LIMIT-X PIC X(15).
414	15 ACUP-NEW-CURR-BAL-X PIC X(15).
415	15 ACUP-NEW-CURR-CYC-CREDIT-X PIC X(15).
416	15 ACUP-NEW-CURR-CYC-DEBIT-X PIC X(15).
417
418	05 ACCT-UPDATE-RECORD.
419	*****************************************************************
420	* Data-structure for account entity (RECLN 300)
421	*****************************************************************
422	15 ACCT-UPDATE-ID PIC 9(11).
423	15 ACCT-UPDATE-ACTIVE-STATUS PIC X(01).
424	15 ACCT-UPDATE-CURR-BAL PIC S9(10)V99.
425	15 ACCT-UPDATE-CREDIT-LIMIT PIC S9(10)V99.
426	15 ACCT-UPDATE-CASH-CREDIT-LIMIT PIC S9(10)V99.
427	15 ACCT-UPDATE-OPEN-DATE PIC X(10).
428	15 ACCT-UPDATE-EXPIRAION-DATE PIC X(10).
429	15 ACCT-UPDATE-REISSUE-DATE PIC X(10).
430	15 ACCT-UPDATE-CURR-CYC-CREDIT PIC S9(10)V99.
431	15 ACCT-UPDATE-CURR-CYC-DEBIT PIC S9(10)V99.
432	15 ACCT-UPDATE-GROUP-ID PIC X(10).
433	15 FILLER PIC X(188).
434	05 CUST-UPDATE-RECORD.
435	*****************************************************************
436	* Data-structure for CUSTOMER entity (RECLN 300)
437	*****************************************************************
438	15 CUST-UPDATE-ID PIC 9(09).
439	15 CUST-UPDATE-FIRST-NAME PIC X(25).
440	15 CUST-UPDATE-MIDDLE-NAME PIC X(25).
441	15 CUST-UPDATE-LAST-NAME PIC X(25).
442	15 CUST-UPDATE-ADDR-LINE-1 PIC X(50).
443	15 CUST-UPDATE-ADDR-LINE-2 PIC X(50).
444	15 CUST-UPDATE-ADDR-LINE-3 PIC X(50).
445	15 CUST-UPDATE-ADDR-STATE-CD PIC X(02).
446	15 CUST-UPDATE-ADDR-COUNTRY-CD PIC X(03).
447	15 CUST-UPDATE-ADDR-ZIP PIC X(10).
448	15 CUST-UPDATE-PHONE-NUM-1 PIC X(15).
449	15 CUST-UPDATE-PHONE-NUM-2 PIC X(15).
450	15 CUST-UPDATE-SSN PIC 9(09).
451	15 CUST-UPDATE-GOVT-ISSUED-ID PIC X(20).
452	15 CUST-UPDATE-DOB-YYYY-MM-DD PIC X(10).
453	15 CUST-UPDATE-EFT-ACCOUNT-ID PIC X(10).
454	15 CUST-UPDATE-PRI-CARD-IND PIC X(01).
455	15 CUST-UPDATE-FICO-CREDIT-SCORE PIC 9(03).
456	15 FILLER PIC X(168).
457
458
459	******************************************************************
460	* Output Message Construction
461	******************************************************************
462	05 WS-LONG-MSG PIC X(500).
463	05 WS-INFO-MSG PIC X(40).
464	88 WS-NO-INFO-MESSAGE VALUES
465	SPACES LOW-VALUES.
466	88 FOUND-ACCOUNT-DATA VALUE
467	'Details of selected account shown above'.
468	88 PROMPT-FOR-SEARCH-KEYS VALUE
469	'Enter or update id of account to update'.
470	88 PROMPT-FOR-CHANGES VALUE
471	'Update account details presented above.'.
472	88 PROMPT-FOR-CONFIRMATION VALUE
473	'Changes validated.Press F5 to save'.
474	88 CONFIRM-UPDATE-SUCCESS VALUE
475	'Changes committed to database'.
476	88 INFORM-FAILURE VALUE
477	'Changes unsuccessful. Please try again'.
478
479	05 WS-RETURN-MSG PIC X(75).
480	88 WS-RETURN-MSG-OFF VALUE SPACES.
481	88 WS-EXIT-MESSAGE VALUE
482	'PF03 pressed.Exiting '.
483	88 WS-PROMPT-FOR-ACCT VALUE
484	'Account number not provided'.
485	88 WS-PROMPT-FOR-LASTNAME VALUE
486	'Last name not provided'.
487	88 WS-NAME-MUST-BE-ALPHA VALUE
488	'Name can only contain alphabets and spaces'.
489	88 NO-SEARCH-CRITERIA-RECEIVED VALUE
490	'No input received'.
491	88 NO-CHANGES-DETECTED VALUE
492	'No change detected with respect to values fetched.'.
493	88 SEARCHED-ACCT-ZEROES VALUE
494	'Account number must be a non zero 11 digit number'.
495	88 SEARCHED-ACCT-NOT-NUMERIC VALUE
496	'Account number must be a non zero 11 digit number'.
497	88 DID-NOT-FIND-ACCT-IN-CARDXREF VALUE
498	'Did not find this account in account card xref file'.
499	88 DID-NOT-FIND-ACCT-IN-ACCTDAT VALUE
500	'Did not find this account in account master file'.
501	88 DID-NOT-FIND-CUST-IN-CUSTDAT VALUE
502	'Did not find associated customer in master file'.
503	88 ACCT-STATUS-MUST-BE-YES-NO VALUE
504	'Account Active Status must be Y or N'.
505	88 CRED-LIMIT-IS-BLANK VALUE
506	'Credit Limit must be supplied'.
507	88 CRED-LIMIT-IS-NOT-VALID VALUE
508	'Credit Limit is not valid'.
509	88 THIS-MONTH-NOT-VALID VALUE
510	'Card expiry month must be between 1 and 12'.
511	88 THIS-YEAR-NOT-VALID VALUE
512	'Invalid card expiry year'.
513	88 DID-NOT-FIND-ACCT-IN-CARDXREF VALUE
514	'Did not find this account in cards database'.
515	88 DID-NOT-FIND-ACCTCARD-COMBO VALUE
516	'Did not find cards for this search condition'.
517	88 COULD-NOT-LOCK-ACCT-FOR-UPDATE VALUE
518	'Could not lock account record for update'.
519	88 COULD-NOT-LOCK-CUST-FOR-UPDATE VALUE
520	'Could not lock customer record for update'.
521	88 DATA-WAS-CHANGED-BEFORE-UPDATE VALUE
522	'Record changed by some one else. Please review'.
523	88 LOCKED-BUT-UPDATE-FAILED VALUE
524	'Update of record failed'.
525	88 XREF-READ-ERROR VALUE
526	'Error reading Card Data File'.
527	88 CODING-TO-BE-DONE VALUE
528	'Looks Good.... so far'.
529	******************************************************************
530	* Literals and Constants
531	******************************************************************
532	01 WS-LITERALS.
533	05 LIT-THISPGM PIC X(8)
534	VALUE 'COACTUPC'.
535	05 LIT-THISTRANID PIC X(4)
536	VALUE 'CAUP'.
537	05 LIT-THISMAPSET PIC X(8)
538	VALUE 'COACTUP '.
539	05 LIT-THISMAP PIC X(7)
540	VALUE 'CACTUPA'.
541	05 LIT-CARDUPDATE-PGM PIC X(8)
542	VALUE 'COCRDUPC'.
543	05 LIT-CARDUPDATE-TRANID PIC X(4)
544	VALUE 'CCUP'.
545	05 LIT-CARDUPDATE-MAPSET PIC X(8)
546	VALUE 'COCRDUP '.
547	05 LIT-CARDUPDATE-MAP PIC X(7)
548	VALUE 'CCRDUPA'.
549	05 LIT-CCLISTPGM PIC X(8)
550	VALUE 'COCRDLIC'.
551	05 LIT-CCLISTTRANID PIC X(4)
552	VALUE 'CCLI'.
553	05 LIT-CCLISTMAPSET PIC X(7)
554	VALUE 'COCRDLI'.
555	05 LIT-CCLISTMAP PIC X(7)
556	VALUE 'CCRDSLA'.
557	05 LIT-MENUPGM PIC X(8)
558	VALUE 'COMEN01C'.
559	05 LIT-MENUTRANID PIC X(4)
560	VALUE 'CM00'.
561	05 LIT-MENUMAPSET PIC X(7)
562	VALUE 'COMEN01'.
563	05 LIT-MENUMAP PIC X(7)
564	VALUE 'COMEN1A'.
565	05 LIT-CARDDTLPGM PIC X(8)
566	VALUE 'COCRDSLC'.
567	05 LIT-CARDDTLTRANID PIC X(4)
568	VALUE 'CCDL'.
569	05 LIT-CARDDTLMAPSET PIC X(7)
570	VALUE 'COCRDSL'.
571	05 LIT-CARDDTLMAP PIC X(7)
572	VALUE 'CCRDSLA'.
573	05 LIT-ACCTFILENAME PIC X(8)
574	VALUE 'ACCTDAT '.
575	05 LIT-CUSTFILENAME PIC X(8)
576	VALUE 'CUSTDAT '.
577	05 LIT-CARDFILENAME PIC X(8)
578	VALUE 'CARDDAT '.
579	05 LIT-CARDFILENAME-ACCT-PATH PIC X(8)
580	VALUE 'CARDAIX '.
581	05 LIT-CARDXREFNAME-ACCT-PATH PIC X(8)
582	VALUE 'CXACAIX '.
583	******************************************************************
584	* Literals for use in INSPECT statements
585	******************************************************************
586	05 LIT-ALL-ALPHANUM-FROM-X.
587	10 LIT-ALL-ALPHA-FROM-X.
588	15 LIT-UPPER PIC X(26)
589	VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
590	15 LIT-LOWER PIC X(26)
591	VALUE 'abcdefghijklmnopqrstuvwxyz'.
592	10 LIT-NUMBERS PIC X(10)
593	VALUE '0123456789'.
594	******************************************************************
595	*Other common working storage Variables
596	******************************************************************
597	COPY CVCRD01Y.
598	******************************************************************
599	*Lookups
600	******************************************************************
601	*North America Phone Area codes
602	COPY CSLKPCDY.
603
604	******************************************************************
605	* Variables for use in INSPECT statements
606	******************************************************************
607	01 LIT-ALL-ALPHA-FROM PIC X(52) VALUE SPACES.
608	01 LIT-ALL-ALPHANUM-FROM PIC X(62) VALUE SPACES.
609	01 LIT-ALL-NUM-FROM PIC X(10) VALUE SPACES.
610	77 LIT-ALPHA-SPACES-TO PIC X(52) VALUE SPACES.
611	77 LIT-ALPHANUM-SPACES-TO PIC X(62) VALUE SPACES.
612	77 LIT-NUM-SPACES-TO PIC X(10) VALUE SPACES.
613
614	*IBM SUPPLIED COPYBOOKS
615	COPY DFHBMSCA.
616	COPY DFHAID.
617
618	*COMMON COPYBOOKS
619	*Screen Titles
620	COPY COTTL01Y.
621
622	*Account Update Screen Layout
623	COPY COACTUP.
624
625	*Current Date
626	COPY CSDAT01Y.
627
628	*Common Messages
629	COPY CSMSG01Y.
630
631	*Abend Variables
632	COPY CSMSG02Y.
633
634	*Signed on user data
635	COPY CSUSR01Y.
636
637	*Dataset layouts
638
639	*ACCT RECORD LAYOUT
640	COPY CVACT01Y.
641
642	*CARD XREF LAYOUT
643	COPY CVACT03Y.
644
645	*CUSTOMER LAYOUT
646	COPY CVCUS01Y.
647
648	******************************************************************
649	*Application Commmarea Copybook
650	COPY COCOM01Y.
651
652	01 WS-THIS-PROGCOMMAREA.
653	05 ACCT-UPDATE-SCREEN-DATA.
654	10 ACUP-CHANGE-ACTION PIC X(1)
655	VALUE LOW-VALUES.
656	88 ACUP-DETAILS-NOT-FETCHED VALUES
657	LOW-VALUES,
658	SPACES.
659	88 ACUP-SHOW-DETAILS VALUE 'S'.
660	88 ACUP-CHANGES-MADE VALUES 'E', 'N'
661	, 'C', 'L'
662	, 'F'.
663	88 ACUP-CHANGES-NOT-OK VALUE 'E'.
664	88 ACUP-CHANGES-OK-NOT-CONFIRMED VALUE 'N'.
665	88 ACUP-CHANGES-OKAYED-AND-DONE VALUE 'C'.
666	88 ACUP-CHANGES-FAILED VALUES 'L', 'F'.
667	88 ACUP-CHANGES-OKAYED-LOCK-ERROR VALUE 'L'.
668	88 ACUP-CHANGES-OKAYED-BUT-FAILED VALUE 'F'.
669	05 ACUP-OLD-DETAILS.
670	10 ACUP-OLD-ACCT-DATA.
671	15 ACUP-OLD-ACCT-ID-X PIC X(11).
672	15 ACUP-OLD-ACCT-ID REDEFINES
673	ACUP-OLD-ACCT-ID-X PIC 9(11).
674	15 ACUP-OLD-ACTIVE-STATUS PIC X(01).
675	15 ACUP-OLD-CURR-BAL PIC X(12).
676	15 ACUP-OLD-CURR-BAL-N REDEFINES
677	ACUP-OLD-CURR-BAL PIC S9(10)V99.
678	15 ACUP-OLD-CREDIT-LIMIT PIC X(12).
679	15 ACUP-OLD-CREDIT-LIMIT-N REDEFINES
680	ACUP-OLD-CREDIT-LIMIT PIC S9(10)V99.
681	15 ACUP-OLD-CASH-CREDIT-LIMIT PIC X(12).
682	15 ACUP-OLD-CASH-CREDIT-LIMIT-N REDEFINES
683	ACUP-OLD-CASH-CREDIT-LIMIT PIC S9(10)V99.
684	15 ACUP-OLD-OPEN-DATE PIC X(08).
685	15 ACUP-OLD-OPEN-DATE-PARTS REDEFINES
686	ACUP-OLD-OPEN-DATE.
687	20 ACUP-OLD-OPEN-YEAR PIC X(4).
688	20 ACUP-OLD-OPEN-MON PIC X(2).
689	20 ACUP-OLD-OPEN-DAY PIC X(2).
690	15 ACUP-OLD-EXPIRAION-DATE PIC X(08).
691	15 ACUP-OLD-EXPIRAION-DATE-PARTS REDEFINES
692	ACUP-OLD-EXPIRAION-DATE.
693	20 ACUP-OLD-EXP-YEAR PIC X(4).
694	20 ACUP-OLD-EXP-MON PIC X(2).
695	20 ACUP-OLD-EXP-DAY PIC X(2).
696	15 ACUP-OLD-REISSUE-DATE PIC X(08).
697	15 ACUP-OLD-REISSUE-DATE-PARTS REDEFINES
698	ACUP-OLD-REISSUE-DATE.
699	20 ACUP-OLD-REISSUE-YEAR PIC X(4).
700	20 ACUP-OLD-REISSUE-MON PIC X(2).
701	20 ACUP-OLD-REISSUE-DAY PIC X(2).
702	15 ACUP-OLD-CURR-CYC-CREDIT PIC X(12).
703	15 ACUP-OLD-CURR-CYC-CREDIT-N REDEFINES
704	ACUP-OLD-CURR-CYC-CREDIT PIC S9(10)V99.
705	15 ACUP-OLD-CURR-CYC-DEBIT PIC X(12).
706	15 ACUP-OLD-CURR-CYC-DEBIT-N REDEFINES
707	ACUP-OLD-CURR-CYC-DEBIT PIC S9(10)V99.
708	15 ACUP-OLD-GROUP-ID PIC X(10).
709	10 ACUP-OLD-CUST-DATA.
710	15 ACUP-OLD-CUST-ID-X PIC X(09).
711	15 ACUP-OLD-CUST-ID REDEFINES
712	ACUP-OLD-CUST-ID-X PIC 9(09).
713	15 ACUP-OLD-CUST-FIRST-NAME PIC X(25).
714	15 ACUP-OLD-CUST-MIDDLE-NAME PIC X(25).
715	15 ACUP-OLD-CUST-LAST-NAME PIC X(25).
716	15 ACUP-OLD-CUST-ADDR-LINE-1 PIC X(50).
717	15 ACUP-OLD-CUST-ADDR-LINE-2 PIC X(50).
718	15 ACUP-OLD-CUST-ADDR-LINE-3 PIC X(50).
719	15 ACUP-OLD-CUST-ADDR-STATE-CD PIC X(02).
720	15 ACUP-OLD-CUST-ADDR-COUNTRY-CD PIC X(03).
721	15 ACUP-OLD-CUST-ADDR-ZIP PIC X(10).
722	15 ACUP-OLD-CUST-PHONE-NUM-1 PIC X(15).
723	15 ACUP-OLD-CUST-PHONE-NUM-1-X REDEFINES
724	ACUP-OLD-CUST-PHONE-NUM-1.
725	20 FILLER PIC X(1).
726	20 ACUP-OLD-CUST-PHONE-NUM-1A PIC X(3).
727	20 FILLER PIC X(1).
728	20 ACUP-OLD-CUST-PHONE-NUM-1B PIC X(3).
729	20 FILLER PIC X(1).
730	20 ACUP-OLD-CUST-PHONE-NUM-1C PIC X(4).
731	20 FILLER PIC X(2).
732	15 ACUP-OLD-CUST-PHONE-NUM-2 PIC X(15).
733	15 ACUP-OLD-CUST-PHONE-NUM-2-X REDEFINES
734	ACUP-OLD-CUST-PHONE-NUM-2.
735	20 FILLER PIC X(1).
736	20 ACUP-OLD-CUST-PHONE-NUM-2A PIC X(3).
737	20 FILLER PIC X(1).
738	20 ACUP-OLD-CUST-PHONE-NUM-2B PIC X(3).
739	20 FILLER PIC X(1).
740	20 ACUP-OLD-CUST-PHONE-NUM-2C PIC X(4).
741	20 FILLER PIC X(2).
742	15 ACUP-OLD-CUST-SSN-X PIC X(09).
743	15 ACUP-OLD-CUST-SSN REDEFINES
744	ACUP-OLD-CUST-SSN-X PIC 9(09).
745	15 ACUP-OLD-CUST-GOVT-ISSUED-ID PIC X(20).
746	15 ACUP-OLD-CUST-DOB-YYYY-MM-DD PIC X(08).
747	15 ACUP-OLD-CUST-DOB-PARTS REDEFINES
748	ACUP-OLD-CUST-DOB-YYYY-MM-DD.
749	20 ACUP-OLD-CUST-DOB-YEAR PIC X(4).
750	20 ACUP-OLD-CUST-DOB-MON PIC X(2).
751	20 ACUP-OLD-CUST-DOB-DAY PIC X(2).
752	15 ACUP-OLD-CUST-EFT-ACCOUNT-ID PIC X(10).
753	15 ACUP-OLD-CUST-PRI-HOLDER-IND PIC X(01).
754	15 ACUP-OLD-CUST-FICO-SCORE-X PIC X(03).
755	15 ACUP-OLD-CUST-FICO-SCORE REDEFINES
756	ACUP-OLD-CUST-FICO-SCORE-X PIC 9(03).
757	05 ACUP-NEW-DETAILS.
758	10 ACUP-NEW-ACCT-DATA.
759	15 ACUP-NEW-ACCT-ID-X PIC X(11).
760	15 ACUP-NEW-ACCT-ID REDEFINES
761	ACUP-NEW-ACCT-ID-X PIC 9(11).
762	15 ACUP-NEW-ACTIVE-STATUS PIC X(01).
763	15 ACUP-NEW-CURR-BAL PIC X(12).
764	15 ACUP-NEW-CURR-BAL-N REDEFINES
765	ACUP-NEW-CURR-BAL PIC S9(10)V99.
766	15 ACUP-NEW-CREDIT-LIMIT PIC X(12).
767	15 ACUP-NEW-CREDIT-LIMIT-N REDEFINES
768	ACUP-NEW-CREDIT-LIMIT PIC S9(10)V99.
769	15 ACUP-NEW-CASH-CREDIT-LIMIT PIC X(12).
770	15 ACUP-NEW-CASH-CREDIT-LIMIT-N REDEFINES
771	ACUP-NEW-CASH-CREDIT-LIMIT PIC S9(10)V99.
772	15 ACUP-NEW-OPEN-DATE PIC X(08).
773	15 ACUP-NEW-OPEN-DATE-PARTS REDEFINES
774	ACUP-NEW-OPEN-DATE.
775	20 ACUP-NEW-OPEN-YEAR PIC X(4).
776	20 ACUP-NEW-OPEN-MON PIC X(2).
777	20 ACUP-NEW-OPEN-DAY PIC X(2).
778	15 ACUP-NEW-EXPIRAION-DATE PIC X(08).
779	15 ACUP-NEW-EXPIRAION-DATE-PARTS REDEFINES
780	ACUP-NEW-EXPIRAION-DATE.
781	20 ACUP-NEW-EXP-YEAR PIC X(4).
782	20 ACUP-NEW-EXP-MON PIC X(2).
783	20 ACUP-NEW-EXP-DAY PIC X(2).
784	15 ACUP-NEW-REISSUE-DATE PIC X(08).
785	15 ACUP-NEW-REISSUE-DATE-PARTS REDEFINES
786	ACUP-NEW-REISSUE-DATE.
787	20 ACUP-NEW-REISSUE-YEAR PIC X(4).
788	20 ACUP-NEW-REISSUE-MON PIC X(2).
789	20 ACUP-NEW-REISSUE-DAY PIC X(2).
790	15 ACUP-NEW-CURR-CYC-CREDIT PIC X(12).
791	15 ACUP-NEW-CURR-CYC-CREDIT-N REDEFINES
792	ACUP-NEW-CURR-CYC-CREDIT PIC S9(10)V99.
793	15 ACUP-NEW-CURR-CYC-DEBIT PIC X(12).
794	15 ACUP-NEW-CURR-CYC-DEBIT-N REDEFINES
795	ACUP-NEW-CURR-CYC-DEBIT PIC S9(10)V99.
796	15 ACUP-NEW-GROUP-ID PIC X(10).
797	10 ACUP-NEW-CUST-DATA.
798	15 ACUP-NEW-CUST-ID-X PIC X(09).
799	15 ACUP-NEW-CUST-ID REDEFINES
800	ACUP-NEW-CUST-ID-X PIC 9(09).
801	15 ACUP-NEW-CUST-FIRST-NAME PIC X(25).
802	15 ACUP-NEW-CUST-MIDDLE-NAME PIC X(25).
803	15 ACUP-NEW-CUST-LAST-NAME PIC X(25).
804	15 ACUP-NEW-CUST-ADDR-LINE-1 PIC X(50).
805	15 ACUP-NEW-CUST-ADDR-LINE-2 PIC X(50).
806	15 ACUP-NEW-CUST-ADDR-LINE-3 PIC X(50).
807	15 ACUP-NEW-CUST-ADDR-STATE-CD PIC X(02).
808	15 ACUP-NEW-CUST-ADDR-COUNTRY-CD PIC X(03).
809	15 ACUP-NEW-CUST-ADDR-ZIP PIC X(10).
810	15 ACUP-NEW-CUST-PHONE-NUM-1 PIC X(15).
811	15 ACUP-NEW-CUST-PHONE-NUM-1-X REDEFINES
812	ACUP-NEW-CUST-PHONE-NUM-1.
813	20 FILLER PIC X(1).
814	20 ACUP-NEW-CUST-PHONE-NUM-1A PIC X(3).
815	20 FILLER PIC X(1).
816	20 ACUP-NEW-CUST-PHONE-NUM-1B PIC X(3).
817	20 FILLER PIC X(1).
818	20 ACUP-NEW-CUST-PHONE-NUM-1C PIC X(4).
819	20 FILLER PIC X(2).
820	15 ACUP-NEW-CUST-PHONE-NUM-2 PIC X(15).
821	15 ACUP-NEW-CUST-PHONE-NUM-2-X REDEFINES
822	ACUP-NEW-CUST-PHONE-NUM-2.
823	20 FILLER PIC X(1).
824	20 ACUP-NEW-CUST-PHONE-NUM-2A PIC X(3).
825	20 FILLER PIC X(1).
826	20 ACUP-NEW-CUST-PHONE-NUM-2B PIC X(3).
827	20 FILLER PIC X(1).
828	20 ACUP-NEW-CUST-PHONE-NUM-2C PIC X(4).
829	20 FILLER PIC X(2).
830	15 ACUP-NEW-CUST-SSN-X.
831	20 ACUP-NEW-CUST-SSN-1 PIC X(03).
832	20 ACUP-NEW-CUST-SSN-2 PIC X(02).
833	20 ACUP-NEW-CUST-SSN-3 PIC X(04).
834	15 ACUP-NEW-CUST-SSN REDEFINES
835	ACUP-NEW-CUST-SSN-X PIC 9(09).
836	15 ACUP-NEW-CUST-GOVT-ISSUED-ID PIC X(20).
837	15 ACUP-NEW-CUST-DOB-YYYY-MM-DD PIC X(08).
838	15 ACUP-NEW-CUST-DOB-PARTS REDEFINES
839	ACUP-NEW-CUST-DOB-YYYY-MM-DD.
840	20 ACUP-NEW-CUST-DOB-YEAR PIC X(4).
841	20 ACUP-NEW-CUST-DOB-MON PIC X(2).
842	20 ACUP-NEW-CUST-DOB-DAY PIC X(2).
843	15 ACUP-NEW-CUST-EFT-ACCOUNT-ID PIC X(10).
844	15 ACUP-NEW-CUST-PRI-HOLDER-IND PIC X(01).
845	15 ACUP-NEW-CUST-FICO-SCORE-X PIC X(03).
846	15 ACUP-NEW-CUST-FICO-SCORE REDEFINES
847	ACUP-NEW-CUST-FICO-SCORE-X PIC 9(03).
848	88 FICO-RANGE-IS-VALID VALUES 300
849	THROUGH 850.
850	01 WS-COMMAREA PIC X(2000).
851
852
853	LINKAGE SECTION.
854	01 DFHCOMMAREA.
855	05 FILLER PIC X(1)
856	OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
857
858	PROCEDURE DIVISION.
859	0000-MAIN.
860
861
862	EXEC CICS HANDLE ABEND
863	LABEL(ABEND-ROUTINE)
864	END-EXEC
865
866	INITIALIZE CC-WORK-AREA
867	WS-MISC-STORAGE
868	WS-COMMAREA
869	*****************************************************************
870	* Store our context
871	*****************************************************************
872	MOVE LIT-THISTRANID TO WS-TRANID
873	*****************************************************************
874	* Ensure error message is cleared *
875	*****************************************************************
876	SET WS-RETURN-MSG-OFF TO TRUE
877	*****************************************************************
878	* Store passed data if any *
879	*****************************************************************
880	IF EIBCALEN IS EQUAL TO 0
881	OR (CDEMO-FROM-PROGRAM = LIT-MENUPGM
882	AND NOT CDEMO-PGM-REENTER)
883	INITIALIZE CARDDEMO-COMMAREA
884	WS-THIS-PROGCOMMAREA
885	SET CDEMO-PGM-ENTER TO TRUE
886	SET ACUP-DETAILS-NOT-FETCHED TO TRUE
887	ELSE
888	MOVE DFHCOMMAREA (1:LENGTH OF CARDDEMO-COMMAREA) TO
889	CARDDEMO-COMMAREA
890	MOVE DFHCOMMAREA(LENGTH OF CARDDEMO-COMMAREA + 1:
891	LENGTH OF WS-THIS-PROGCOMMAREA ) TO
892	WS-THIS-PROGCOMMAREA
893	END-IF
894	*****************************************************************
895	* Remap PFkeys as needed.
896	* Store the Mapped PF Key
897	*****************************************************************
898	PERFORM YYYY-STORE-PFKEY
899	THRU YYYY-STORE-PFKEY-EXIT
900	*****************************************************************
901	* Check the AID to see if its valid at this point *
902	* F3 - Exit
903	* Enter show screen again
904	*****************************************************************
905	SET PFK-INVALID TO TRUE
906	IF CCARD-AID-ENTER OR
907	CCARD-AID-PFK03 OR
908	(CCARD-AID-PFK05 AND ACUP-CHANGES-OK-NOT-CONFIRMED)
909	OR
910	(CCARD-AID-PFK12 AND NOT ACUP-DETAILS-NOT-FETCHED)
911	SET PFK-VALID TO TRUE
912	END-IF
913
914	IF PFK-INVALID
915	SET CCARD-AID-ENTER TO TRUE
916	END-IF
917
918	*****************************************************************
919	* Decide what to do based on inputs received
920	*****************************************************************
921	EVALUATE TRUE
922	******************************************************************
923	* USER PRESSES PF03 TO EXIT
924	* OR USER IS DONE WITH UPDATE
925	* XCTL TO CALLING PROGRAM OR MAIN MENU
926	******************************************************************
927	WHEN CCARD-AID-PFK03
928	SET CCARD-AID-PFK03 TO TRUE
929
930	IF CDEMO-FROM-TRANID EQUAL LOW-VALUES
931	OR CDEMO-FROM-TRANID EQUAL SPACES
932	MOVE LIT-MENUTRANID TO CDEMO-TO-TRANID
933	ELSE
934	MOVE CDEMO-FROM-TRANID TO CDEMO-TO-TRANID
935	END-IF
936
937	IF CDEMO-FROM-PROGRAM EQUAL LOW-VALUES
938	OR CDEMO-FROM-PROGRAM EQUAL SPACES
939	MOVE LIT-MENUPGM TO CDEMO-TO-PROGRAM
940	ELSE
941	MOVE CDEMO-FROM-PROGRAM TO CDEMO-TO-PROGRAM
942	END-IF
943
944	MOVE LIT-THISTRANID TO CDEMO-FROM-TRANID
945	MOVE LIT-THISPGM TO CDEMO-FROM-PROGRAM
946
947	SET CDEMO-USRTYP-USER TO TRUE
948	SET CDEMO-PGM-ENTER TO TRUE
949	MOVE LIT-THISMAPSET TO CDEMO-LAST-MAPSET
950	MOVE LIT-THISMAP TO CDEMO-LAST-MAP
951
952	EXEC CICS
953	SYNCPOINT
954	END-EXEC
955	*
956	EXEC CICS XCTL
957	PROGRAM (CDEMO-TO-PROGRAM)
958	COMMAREA(CARDDEMO-COMMAREA)
959	END-EXEC
960	******************************************************************
961	* FRESH ENTRY INTO PROGRAM
962	* ASK THE USER FOR THE KEYS TO FETCH CARD TO BE UPDATED
963	******************************************************************
964	WHEN ACUP-DETAILS-NOT-FETCHED
965	AND CDEMO-PGM-ENTER
966	WHEN CDEMO-FROM-PROGRAM EQUAL LIT-MENUPGM
967	AND NOT CDEMO-PGM-REENTER
968	INITIALIZE WS-THIS-PROGCOMMAREA
969	PERFORM 3000-SEND-MAP THRU
970	3000-SEND-MAP-EXIT
971	SET CDEMO-PGM-REENTER TO TRUE
972	SET ACUP-DETAILS-NOT-FETCHED TO TRUE
973	GO TO COMMON-RETURN
974	******************************************************************
975	* ACCT DATA CHANGES REVIEWED, OKAYED AND DONE SUCESSFULLY
976	* RESET THE SEARCH KEYS
977	* ASK THE USER FOR FRESH SEARCH CRITERIA
978	******************************************************************
979	WHEN ACUP-CHANGES-OKAYED-AND-DONE
980	WHEN ACUP-CHANGES-FAILED
981	INITIALIZE WS-THIS-PROGCOMMAREA
982	WS-MISC-STORAGE
983	CDEMO-ACCT-ID
984	SET CDEMO-PGM-ENTER TO TRUE
985	PERFORM 3000-SEND-MAP THRU
986	3000-SEND-MAP-EXIT
987	SET CDEMO-PGM-REENTER TO TRUE
988	SET ACUP-DETAILS-NOT-FETCHED TO TRUE
989	GO TO COMMON-RETURN
990	******************************************************************
991	* ACCT DATA HAS BEEN PRESENTED TO USER
992	* CHECK THE USER INPUTS
993	* DECIDE WHAT TO DO
994	* PRESENT NEXT STEPS TO USER
995	******************************************************************
996	WHEN OTHER
997	PERFORM 1000-PROCESS-INPUTS
998	THRU 1000-PROCESS-INPUTS-EXIT
999	PERFORM 2000-DECIDE-ACTION
1000	THRU 2000-DECIDE-ACTION-EXIT
1001	PERFORM 3000-SEND-MAP
1002	THRU 3000-SEND-MAP-EXIT
1003	GO TO COMMON-RETURN
1004	END-EVALUATE
1005	.
1006
1007	COMMON-RETURN.
1008	MOVE WS-RETURN-MSG TO CCARD-ERROR-MSG
1009
1010	MOVE CARDDEMO-COMMAREA TO WS-COMMAREA
1011	MOVE WS-THIS-PROGCOMMAREA TO
1012	WS-COMMAREA(LENGTH OF CARDDEMO-COMMAREA + 1:
1013	LENGTH OF WS-THIS-PROGCOMMAREA )
1014
1015	EXEC CICS RETURN
1016	TRANSID (LIT-THISTRANID)
1017	COMMAREA (WS-COMMAREA)
1018	LENGTH(LENGTH OF WS-COMMAREA)
1019	END-EXEC
1020	.
1021	0000-MAIN-EXIT.
1022	EXIT
1023	.
1024
1025	1000-PROCESS-INPUTS.
1026	PERFORM 1100-RECEIVE-MAP
1027	THRU 1100-RECEIVE-MAP-EXIT
1028	PERFORM 1200-EDIT-MAP-INPUTS
1029	THRU 1200-EDIT-MAP-INPUTS-EXIT
1030	MOVE WS-RETURN-MSG TO CCARD-ERROR-MSG
1031	MOVE LIT-THISPGM TO CCARD-NEXT-PROG
1032	MOVE LIT-THISMAPSET TO CCARD-NEXT-MAPSET
1033	MOVE LIT-THISMAP TO CCARD-NEXT-MAP
1034	.
1035	*
1036	1000-PROCESS-INPUTS-EXIT.
1037	EXIT
1038	.
1039	1100-RECEIVE-MAP.
1040	EXEC CICS RECEIVE MAP(LIT-THISMAP)
1041	MAPSET(LIT-THISMAPSET)
1042	INTO(CACTUPAI)
1043	RESP(WS-RESP-CD)
1044	RESP2(WS-REAS-CD)
1045	END-EXEC
1046	*
1047	INITIALIZE ACUP-NEW-DETAILS
1048	******************************************************************
1049	* Account Master data
1050	******************************************************************
1051	IF ACCTSIDI OF CACTUPAI = '*'
1052	OR ACCTSIDI OF CACTUPAI = SPACES
1053	MOVE LOW-VALUES TO CC-ACCT-ID
1054	ACUP-NEW-ACCT-ID-X
1055	ELSE
1056	MOVE ACCTSIDI OF CACTUPAI TO CC-ACCT-ID
1057	ACUP-NEW-ACCT-ID-X
1058	END-IF
1059
1060	IF ACUP-DETAILS-NOT-FETCHED
1061	GO TO 1100-RECEIVE-MAP-EXIT
1062	END-IF
1063
1064	* Active Status
1065	IF ACSTTUSI OF CACTUPAI = '*'
1066	OR ACSTTUSI OF CACTUPAI = SPACES
1067	MOVE LOW-VALUES TO ACUP-NEW-ACTIVE-STATUS
1068	ELSE
1069	MOVE ACSTTUSI OF CACTUPAI TO ACUP-NEW-ACTIVE-STATUS
1070	END-IF
1071
1072	* Credit Limit
1073	IF ACRDLIMI OF CACTUPAI = '*'
1074	OR ACRDLIMI OF CACTUPAI = SPACES
1075	MOVE LOW-VALUES TO ACUP-NEW-CREDIT-LIMIT-X
1076	ELSE
1077	MOVE ACRDLIMI OF CACTUPAI TO ACUP-NEW-CREDIT-LIMIT-X
1078	IF FUNCTION TEST-NUMVAL-C(ACUP-NEW-CREDIT-LIMIT-X) = 0
1079	COMPUTE ACUP-NEW-CREDIT-LIMIT-N =
1080	FUNCTION NUMVAL-C(ACRDLIMI OF CACTUPAI)
1081	ELSE
1082	CONTINUE
1083	END-IF
1084	END-IF
1085
1086	* Cash Limit
1087	IF ACSHLIMI OF CACTUPAI = '*'
1088	OR ACSHLIMI OF CACTUPAI = SPACES
1089	MOVE LOW-VALUES TO ACUP-NEW-CASH-CREDIT-LIMIT-X
1090	ELSE
1091	MOVE ACSHLIMI OF CACTUPAI TO ACUP-NEW-CASH-CREDIT-LIMIT-X
1092	IF FUNCTION TEST-NUMVAL-C(ACUP-NEW-CASH-CREDIT-LIMIT-X) = 0
1093	COMPUTE ACUP-NEW-CASH-CREDIT-LIMIT-N =
1094	FUNCTION NUMVAL-C(ACSHLIMI OF CACTUPAI)
1095	ELSE
1096	CONTINUE
1097	END-IF
1098	END-IF
1099
1100	* Current Balance
1101	IF ACURBALI OF CACTUPAI = '*'
1102	OR ACURBALI OF CACTUPAI = SPACES
1103	MOVE LOW-VALUES TO ACUP-NEW-CURR-BAL-X
1104	ELSE
1105	MOVE ACURBALI OF CACTUPAI TO ACUP-NEW-CURR-BAL-X
1106	IF FUNCTION TEST-NUMVAL-C(ACUP-NEW-CURR-BAL-X) = 0
1107	COMPUTE ACUP-NEW-CURR-BAL-N =
1108	FUNCTION NUMVAL-C(ACUP-NEW-CURR-BAL-X)
1109	ELSE
1110	CONTINUE
1111	END-IF
1112	END-IF
1113
1114	*Current Cycle Credit
1115	IF ACRCYCRI OF CACTUPAI = '*'
1116	OR ACRCYCRI OF CACTUPAI = SPACES
1117	MOVE LOW-VALUES TO ACUP-NEW-CURR-CYC-CREDIT-X
1118	ELSE
1119	MOVE ACRCYCRI OF CACTUPAI TO ACUP-NEW-CURR-CYC-CREDIT-X
1120	IF FUNCTION TEST-NUMVAL-C(ACUP-NEW-CURR-CYC-CREDIT-X) = 0
1121	COMPUTE ACUP-NEW-CURR-CYC-CREDIT-N =
1122	FUNCTION NUMVAL-C(ACRCYCRI OF CACTUPAI)
1123	ELSE
1124	CONTINUE
1125	END-IF
1126	END-IF
1127
1128	*Current Cycle Debit
1129	IF ACRCYDBI OF CACTUPAI = '*'
1130	OR ACRCYDBI OF CACTUPAI = SPACES
1131	MOVE LOW-VALUES TO ACUP-NEW-CURR-CYC-DEBIT-X
1132	ELSE
1133	MOVE ACRCYDBI OF CACTUPAI TO ACUP-NEW-CURR-CYC-DEBIT-X
1134	IF FUNCTION TEST-NUMVAL-C(ACUP-NEW-CURR-CYC-DEBIT-X) = 0
1135	COMPUTE ACUP-NEW-CURR-CYC-DEBIT-N =
1136	FUNCTION NUMVAL-C(ACRCYDBI OF CACTUPAI)
1137	ELSE
1138	CONTINUE
1139	END-IF
1140	END-IF
1141
1142	*Open date
1143	*
1144	IF OPNYEARI OF CACTUPAI = '*'
1145	OR OPNYEARI OF CACTUPAI = SPACES
1146	MOVE LOW-VALUES TO ACUP-NEW-OPEN-YEAR
1147	ELSE
1148	MOVE OPNYEARI OF CACTUPAI TO ACUP-NEW-OPEN-YEAR
1149	END-IF
1150
1151	IF OPNMONI OF CACTUPAI = '*'
1152	OR OPNMONI OF CACTUPAI = SPACES
1153	MOVE LOW-VALUES TO ACUP-NEW-OPEN-MON
1154	ELSE
1155	MOVE OPNMONI OF CACTUPAI TO ACUP-NEW-OPEN-MON
1156	END-IF
1157
1158	IF OPNDAYI OF CACTUPAI = '*'
1159	OR OPNDAYI OF CACTUPAI = SPACES
1160	MOVE LOW-VALUES TO ACUP-NEW-OPEN-DAY
1161	ELSE
1162	MOVE OPNDAYI OF CACTUPAI TO ACUP-NEW-OPEN-DAY
1163	END-IF
1164
1165	*Expiry date
1166	*
1167	IF EXPYEARI OF CACTUPAI = '*'
1168	OR EXPYEARI OF CACTUPAI = SPACES
1169	MOVE LOW-VALUES TO ACUP-NEW-EXP-YEAR
1170	ELSE
1171	MOVE EXPYEARI OF CACTUPAI TO ACUP-NEW-EXP-YEAR
1172	END-IF
1173
1174	IF EXPMONI OF CACTUPAI = '*'
1175	OR EXPMONI OF CACTUPAI = SPACES
1176	MOVE LOW-VALUES TO ACUP-NEW-EXP-MON
1177	ELSE
1178	MOVE EXPMONI OF CACTUPAI TO ACUP-NEW-EXP-MON
1179	END-IF
1180
1181	IF EXPDAYI OF CACTUPAI = '*'
1182	OR EXPDAYI OF CACTUPAI = SPACES
1183	MOVE LOW-VALUES TO ACUP-NEW-EXP-DAY
1184	ELSE
1185	MOVE EXPDAYI OF CACTUPAI TO ACUP-NEW-EXP-DAY
1186	END-IF
1187
1188	*Reissue date
1189	*
1190	IF RISYEARI OF CACTUPAI = '*'
1191	OR RISYEARI OF CACTUPAI = SPACES
1192	MOVE LOW-VALUES TO ACUP-NEW-REISSUE-YEAR
1193	ELSE
1194	MOVE RISYEARI OF CACTUPAI TO ACUP-NEW-REISSUE-YEAR
1195	END-IF
1196
1197	IF RISMONI OF CACTUPAI = '*'
1198	OR RISMONI OF CACTUPAI = SPACES
1199	MOVE LOW-VALUES TO ACUP-NEW-REISSUE-MON
1200	ELSE
1201	MOVE RISMONI OF CACTUPAI TO ACUP-NEW-REISSUE-MON
1202	END-IF
1203
1204	IF RISDAYI OF CACTUPAI = '*'
1205	OR RISDAYI OF CACTUPAI = SPACES
1206	MOVE LOW-VALUES TO ACUP-NEW-REISSUE-DAY
1207	ELSE
1208	MOVE RISDAYI OF CACTUPAI TO ACUP-NEW-REISSUE-DAY
1209	END-IF
1210
1211	*Account Group
1212	*
1213	IF AADDGRPI OF CACTUPAI = '*'
1214	OR AADDGRPI OF CACTUPAI = SPACES
1215	MOVE LOW-VALUES TO ACUP-NEW-GROUP-ID
1216	ELSE
1217	MOVE AADDGRPI OF CACTUPAI TO ACUP-NEW-GROUP-ID
1218	END-IF
1219	******************************************************************
1220	* Customer Master data
1221	******************************************************************
1222	*Customer Id (actually not editable)
1223	*
1224	IF ACSTNUMI OF CACTUPAI = '*'
1225	OR ACSTNUMI OF CACTUPAI = SPACES
1226	MOVE LOW-VALUES TO ACUP-NEW-CUST-ID-X
1227	ELSE
1228	MOVE ACSTNUMI OF CACTUPAI TO ACUP-NEW-CUST-ID-X
1229	END-IF
1230
1231	*Social Security Number
1232	*
1233	IF ACTSSN1I OF CACTUPAI = '*'
1234	OR ACTSSN1I OF CACTUPAI = SPACES
1235	MOVE LOW-VALUES TO ACUP-NEW-CUST-SSN-1
1236	ELSE
1237	MOVE ACTSSN1I OF CACTUPAI TO ACUP-NEW-CUST-SSN-1
1238	END-IF
1239
1240	IF ACTSSN2I OF CACTUPAI = '*'
1241	OR ACTSSN2I OF CACTUPAI = SPACES
1242	MOVE LOW-VALUES TO ACUP-NEW-CUST-SSN-2
1243	ELSE
1244	MOVE ACTSSN2I OF CACTUPAI TO ACUP-NEW-CUST-SSN-2
1245	END-IF
1246
1247	IF ACTSSN3I OF CACTUPAI = '*'
1248	OR ACTSSN3I OF CACTUPAI = SPACES
1249	MOVE LOW-VALUES TO ACUP-NEW-CUST-SSN-3
1250	ELSE
1251	MOVE ACTSSN3I OF CACTUPAI TO ACUP-NEW-CUST-SSN-3
1252	END-IF
1253	*
1254	*Date of birth
1255	*
1256	IF DOBYEARI OF CACTUPAI = '*'
1257	OR DOBYEARI OF CACTUPAI = SPACES
1258	MOVE LOW-VALUES TO ACUP-NEW-CUST-DOB-YEAR
1259	ELSE
1260	MOVE DOBYEARI OF CACTUPAI TO ACUP-NEW-CUST-DOB-YEAR
1261	END-IF
1262
1263	IF DOBMONI OF CACTUPAI = '*'
1264	OR DOBMONI OF CACTUPAI = SPACES
1265	MOVE LOW-VALUES TO ACUP-NEW-CUST-DOB-MON
1266	ELSE
1267	MOVE DOBMONI OF CACTUPAI TO ACUP-NEW-CUST-DOB-MON
1268	END-IF
1269
1270	IF DOBDAYI OF CACTUPAI = '*'
1271	OR DOBDAYI OF CACTUPAI = SPACES
1272	MOVE LOW-VALUES TO ACUP-NEW-CUST-DOB-DAY
1273	ELSE
1274	MOVE DOBDAYI OF CACTUPAI TO ACUP-NEW-CUST-DOB-DAY
1275	END-IF
1276	*
1277	*FICO
1278	*
1279	IF ACSTFCOI OF CACTUPAI = '*'
1280	OR ACSTFCOI OF CACTUPAI = SPACES
1281	MOVE LOW-VALUES TO ACUP-NEW-CUST-FICO-SCORE-X
1282	ELSE
1283	MOVE ACSTFCOI OF CACTUPAI TO ACUP-NEW-CUST-FICO-SCORE-X
1284	END-IF
1285	*
1286	*First Name
1287	*
1288	IF ACSFNAMI OF CACTUPAI = '*'
1289	OR ACSFNAMI OF CACTUPAI = SPACES
1290	MOVE LOW-VALUES TO ACUP-NEW-CUST-FIRST-NAME
1291	ELSE
1292	MOVE ACSFNAMI OF CACTUPAI TO ACUP-NEW-CUST-FIRST-NAME
1293	END-IF
1294	*
1295	*Middle Name
1296	*
1297	IF ACSMNAMI OF CACTUPAI = '*'
1298	OR ACSMNAMI OF CACTUPAI = SPACES
1299	MOVE LOW-VALUES TO ACUP-NEW-CUST-MIDDLE-NAME
1300	ELSE
1301	MOVE ACSMNAMI OF CACTUPAI TO ACUP-NEW-CUST-MIDDLE-NAME
1302	END-IF
1303	*
1304	*Last Name
1305	*
1306	IF ACSLNAMI OF CACTUPAI = '*'
1307	OR ACSLNAMI OF CACTUPAI = SPACES
1308	MOVE LOW-VALUES TO ACUP-NEW-CUST-LAST-NAME
1309	ELSE
1310	MOVE ACSLNAMI OF CACTUPAI TO ACUP-NEW-CUST-LAST-NAME
1311	END-IF
1312	*
1313	*Address
1314	*
1315	IF ACSADL1I OF CACTUPAI = '*'
1316	OR ACSADL1I OF CACTUPAI = SPACES
1317	MOVE LOW-VALUES TO ACUP-NEW-CUST-ADDR-LINE-1
1318	ELSE
1319	MOVE ACSADL1I OF CACTUPAI TO ACUP-NEW-CUST-ADDR-LINE-1
1320	END-IF
1321
1322	IF ACSADL2I OF CACTUPAI = '*'
1323	OR ACSADL2I OF CACTUPAI = SPACES
1324	MOVE LOW-VALUES TO ACUP-NEW-CUST-ADDR-LINE-2
1325	ELSE
1326	MOVE ACSADL2I OF CACTUPAI TO ACUP-NEW-CUST-ADDR-LINE-2
1327	END-IF
1328
1329	IF ACSCITYI OF CACTUPAI = '*'
1330	OR ACSCITYI OF CACTUPAI = SPACES
1331	MOVE LOW-VALUES TO ACUP-NEW-CUST-ADDR-LINE-3
1332	ELSE
1333	MOVE ACSCITYI OF CACTUPAI TO ACUP-NEW-CUST-ADDR-LINE-3
1334	END-IF
1335
1336	IF ACSSTTEI OF CACTUPAI = '*'
1337	OR ACSSTTEI OF CACTUPAI = SPACES
1338	MOVE LOW-VALUES TO ACUP-NEW-CUST-ADDR-STATE-CD
1339	ELSE
1340	MOVE ACSSTTEI OF CACTUPAI TO ACUP-NEW-CUST-ADDR-STATE-CD
1341	END-IF
1342
1343	IF ACSCTRYI OF CACTUPAI = '*'
1344	OR ACSCTRYI OF CACTUPAI = SPACES
1345	MOVE LOW-VALUES TO ACUP-NEW-CUST-ADDR-COUNTRY-CD
1346	ELSE
1347	MOVE ACSCTRYI OF CACTUPAI TO ACUP-NEW-CUST-ADDR-COUNTRY-CD
1348	END-IF
1349
1350	IF ACSZIPCI OF CACTUPAI = '*'
1351	OR ACSZIPCI OF CACTUPAI = SPACES
1352	MOVE LOW-VALUES TO ACUP-NEW-CUST-ADDR-ZIP
1353	ELSE
1354	MOVE ACSZIPCI OF CACTUPAI TO ACUP-NEW-CUST-ADDR-ZIP
1355	END-IF
1356
1357	IF ACSPH1AI OF CACTUPAI = '*'
1358	OR ACSPH1AI OF CACTUPAI = SPACES
1359	MOVE LOW-VALUES TO ACUP-NEW-CUST-PHONE-NUM-1A
1360	ELSE
1361	MOVE ACSPH1AI OF CACTUPAI TO ACUP-NEW-CUST-PHONE-NUM-1A
1362	END-IF
1363
1364	IF ACSPH1BI OF CACTUPAI = '*'
1365	OR ACSPH1BI OF CACTUPAI = SPACES
1366	MOVE LOW-VALUES TO ACUP-NEW-CUST-PHONE-NUM-1B
1367	ELSE
1368	MOVE ACSPH1BI OF CACTUPAI TO ACUP-NEW-CUST-PHONE-NUM-1B
1369	END-IF
1370
1371	IF ACSPH1CI OF CACTUPAI = '*'
1372	OR ACSPH1CI OF CACTUPAI = SPACES
1373	MOVE LOW-VALUES TO ACUP-NEW-CUST-PHONE-NUM-1C
1374	ELSE
1375	MOVE ACSPH1CI OF CACTUPAI TO ACUP-NEW-CUST-PHONE-NUM-1C
1376	END-IF
1377
1378	IF ACSPH2AI OF CACTUPAI = '*'
1379	OR ACSPH2AI OF CACTUPAI = SPACES
1380	MOVE LOW-VALUES TO ACUP-NEW-CUST-PHONE-NUM-2A
1381	ELSE
1382	MOVE ACSPH2AI OF CACTUPAI TO ACUP-NEW-CUST-PHONE-NUM-2A
1383	END-IF
1384
1385	IF ACSPH2BI OF CACTUPAI = '*'
1386	OR ACSPH2BI OF CACTUPAI = SPACES
1387	MOVE LOW-VALUES TO ACUP-NEW-CUST-PHONE-NUM-2B
1388	ELSE
1389	MOVE ACSPH2BI OF CACTUPAI TO ACUP-NEW-CUST-PHONE-NUM-2B
1390	END-IF
1391
1392	IF ACSPH2CI OF CACTUPAI = '*'
1393	OR ACSPH2CI OF CACTUPAI = SPACES
1394	MOVE LOW-VALUES TO ACUP-NEW-CUST-PHONE-NUM-2C
1395	ELSE
1396	MOVE ACSPH2CI OF CACTUPAI TO ACUP-NEW-CUST-PHONE-NUM-2C
1397	END-IF
1398	*
1399	*Government Id
1400	*
1401	IF ACSGOVTI OF CACTUPAI = '*'
1402	OR ACSGOVTI OF CACTUPAI = SPACES
1403	MOVE LOW-VALUES TO ACUP-NEW-CUST-GOVT-ISSUED-ID
1404	ELSE
1405	MOVE ACSGOVTI OF CACTUPAI TO ACUP-NEW-CUST-GOVT-ISSUED-ID
1406	END-IF
1407	*
1408	*EFT Code
1409	*
1410	IF ACSEFTCI OF CACTUPAI = '*'
1411	OR ACSEFTCI OF CACTUPAI = SPACES
1412	MOVE LOW-VALUES TO ACUP-NEW-CUST-EFT-ACCOUNT-ID
1413	ELSE
1414	MOVE ACSEFTCI OF CACTUPAI TO ACUP-NEW-CUST-EFT-ACCOUNT-ID
1415	END-IF
1416	*
1417	*Primary Holder Indicator
1418	*
1419	IF ACSPFLGI OF CACTUPAI = '*'
1420	OR ACSPFLGI OF CACTUPAI = SPACES
1421	MOVE LOW-VALUES TO ACUP-NEW-CUST-PRI-HOLDER-IND
1422	ELSE
1423	MOVE ACSPFLGI OF CACTUPAI TO ACUP-NEW-CUST-PRI-HOLDER-IND
1424	END-IF
1425	.
1426	1100-RECEIVE-MAP-EXIT.
1427	EXIT
1428	.
1429	1200-EDIT-MAP-INPUTS.
1430
1431	SET INPUT-OK TO TRUE
1432
1433	IF ACUP-DETAILS-NOT-FETCHED
1434	* VALIDATE THE SEARCH KEYS
1435	PERFORM 1210-EDIT-ACCOUNT
1436	THRU 1210-EDIT-ACCOUNT-EXIT
1437
1438	MOVE LOW-VALUES TO ACUP-OLD-ACCT-DATA
1439
1440	* IF THE SEARCH CONDITIONS HAVE PROBLEMS FLAG THEM
1441	IF FLG-ACCTFILTER-BLANK
1442	SET NO-SEARCH-CRITERIA-RECEIVED TO TRUE
1443	END-IF
1444
1445	* AT THIS STAGE. NO DETAILS FETCHED. NOTHING MORE TO EDIT.
1446	GO TO 1200-EDIT-MAP-INPUTS-EXIT
1447	ELSE
1448	CONTINUE
1449	END-IF
1450	*
1451	* SEARCH KEYS ALREADY VALIDATED AND DATA FETCHED
1452	SET FOUND-ACCOUNT-DATA TO TRUE
1453	SET FOUND-ACCT-IN-MASTER TO TRUE
1454	SET FLG-ACCTFILTER-ISVALID TO TRUE
1455
1456	SET FOUND-CUST-IN-MASTER TO TRUE
1457	SET FLG-CUSTFILTER-ISVALID TO TRUE
1458
1459	*
1460	PERFORM 1205-COMPARE-OLD-NEW
1461	THRU 1205-COMPARE-OLD-NEW-EXIT
1462
1463	IF NO-CHANGES-FOUND
1464	OR ACUP-CHANGES-OK-NOT-CONFIRMED
1465	OR ACUP-CHANGES-OKAYED-AND-DONE
1466	MOVE LOW-VALUES TO WS-NON-KEY-FLAGS
1467	GO TO 1200-EDIT-MAP-INPUTS-EXIT
1468	END-IF
1469
1470	SET ACUP-CHANGES-NOT-OK TO TRUE
1471
1472	MOVE 'Account Status' TO WS-EDIT-VARIABLE-NAME
1473	MOVE ACUP-NEW-ACTIVE-STATUS TO WS-EDIT-YES-NO
1474	PERFORM 1220-EDIT-YESNO
1475	THRU 1220-EDIT-YESNO-EXIT
1476	MOVE WS-EDIT-YES-NO TO WS-EDIT-ACCT-STATUS
1477
1478	MOVE 'Open Date' TO WS-EDIT-VARIABLE-NAME
1479	MOVE ACUP-NEW-OPEN-DATE TO WS-EDIT-DATE-CCYYMMDD
1480	PERFORM EDIT-DATE-CCYYMMDD
1481	THRU EDIT-DATE-CCYYMMDD-EXIT
1482	MOVE WS-EDIT-DATE-FLGS TO WS-EDIT-OPEN-DATE-FLGS
1483
1484	MOVE 'Credit Limit' TO WS-EDIT-VARIABLE-NAME
1485	MOVE ACUP-NEW-CREDIT-LIMIT-X TO WS-EDIT-SIGNED-NUMBER-9V2-X
1486	PERFORM 1250-EDIT-SIGNED-9V2
1487	THRU 1250-EDIT-SIGNED-9V2-EXIT
1488	MOVE WS-FLG-SIGNED-NUMBER-EDIT TO WS-EDIT-CREDIT-LIMIT
1489
1490	MOVE 'Expiry Date' TO WS-EDIT-VARIABLE-NAME
1491	MOVE ACUP-NEW-EXPIRAION-DATE TO WS-EDIT-DATE-CCYYMMDD
1492	PERFORM EDIT-DATE-CCYYMMDD
1493	THRU EDIT-DATE-CCYYMMDD-EXIT
1494	MOVE WS-EDIT-DATE-FLGS TO WS-EXPIRY-DATE-FLGS
1495
1496	MOVE 'Cash Credit Limit' TO WS-EDIT-VARIABLE-NAME
1497	MOVE ACUP-NEW-CASH-CREDIT-LIMIT-X
1498	TO WS-EDIT-SIGNED-NUMBER-9V2-X
1499	PERFORM 1250-EDIT-SIGNED-9V2
1500	THRU 1250-EDIT-SIGNED-9V2-EXIT
1501	MOVE WS-FLG-SIGNED-NUMBER-EDIT TO WS-EDIT-CASH-CREDIT-LIMIT
1502
1503	MOVE 'Reissue Date' TO WS-EDIT-VARIABLE-NAME
1504	MOVE ACUP-NEW-REISSUE-DATE TO WS-EDIT-DATE-CCYYMMDD
1505	PERFORM EDIT-DATE-CCYYMMDD
1506	THRU EDIT-DATE-CCYYMMDD-EXIT
1507	MOVE WS-EDIT-DATE-FLGS TO WS-EDIT-REISSUE-DATE-FLGS
1508
1509	MOVE 'Current Balance' TO WS-EDIT-VARIABLE-NAME
1510	MOVE ACUP-NEW-CURR-BAL-X TO WS-EDIT-SIGNED-NUMBER-9V2-X
1511	PERFORM 1250-EDIT-SIGNED-9V2
1512	THRU 1250-EDIT-SIGNED-9V2-EXIT
1513	MOVE WS-FLG-SIGNED-NUMBER-EDIT TO WS-EDIT-CURR-BAL
1514
1515	MOVE 'Current Cycle Credit Limit' TO WS-EDIT-VARIABLE-NAME
1516	MOVE ACUP-NEW-CURR-CYC-CREDIT-X
1517	TO WS-EDIT-SIGNED-NUMBER-9V2-X
1518	PERFORM 1250-EDIT-SIGNED-9V2
1519	THRU 1250-EDIT-SIGNED-9V2-EXIT
1520	MOVE WS-FLG-SIGNED-NUMBER-EDIT TO WS-EDIT-CURR-CYC-CREDIT
1521
1522	MOVE 'Current Cycle Debit Limit' TO WS-EDIT-VARIABLE-NAME
1523	MOVE ACUP-NEW-CURR-CYC-DEBIT-X
1524	TO WS-EDIT-SIGNED-NUMBER-9V2-X
1525	PERFORM 1250-EDIT-SIGNED-9V2
1526	THRU 1250-EDIT-SIGNED-9V2-EXIT
1527	MOVE WS-FLG-SIGNED-NUMBER-EDIT TO WS-EDIT-CURR-CYC-DEBIT
1528
1529	MOVE 'SSN' TO WS-EDIT-VARIABLE-NAME
1530	PERFORM 1265-EDIT-US-SSN
1531	THRU 1265-EDIT-US-SSN-EXIT
1532
1533	MOVE 'Date of Birth' TO WS-EDIT-VARIABLE-NAME
1534	MOVE ACUP-NEW-CUST-DOB-YYYY-MM-DD
1535	TO WS-EDIT-DATE-CCYYMMDD
1536	PERFORM EDIT-DATE-CCYYMMDD
1537	THRU EDIT-DATE-CCYYMMDD-EXIT
1538	MOVE WS-EDIT-DATE-FLGS TO WS-EDIT-DT-OF-BIRTH-FLGS
1539	IF WS-EDIT-DT-OF-BIRTH-ISVALID
1540	PERFORM EDIT-DATE-OF-BIRTH
1541	THRU EDIT-DATE-OF-BIRTH-EXIT
1542	MOVE WS-EDIT-DATE-FLGS TO WS-EDIT-DT-OF-BIRTH-FLGS
1543	END-IF
1544
1545	MOVE 'FICO Score' TO WS-EDIT-VARIABLE-NAME
1546	MOVE ACUP-NEW-CUST-FICO-SCORE-X
1547	TO WS-EDIT-ALPHANUM-ONLY
1548	MOVE 3 TO WS-EDIT-ALPHANUM-LENGTH
1549	PERFORM 1245-EDIT-NUM-REQD
1550	THRU 1245-EDIT-NUM-REQD-EXIT
1551	MOVE WS-EDIT-ALPHANUM-ONLY-FLAGS
1552	TO WS-EDIT-FICO-SCORE-FLGS
1553	IF FLG-FICO-SCORE-ISVALID
1554	PERFORM 1275-EDIT-FICO-SCORE
1555	THRU 1275-EDIT-FICO-SCORE-EXIT
1556	END-IF
1557	******************************************************************
1558	* Edit names
1559	******************************************************************
1560	MOVE 'First Name' TO WS-EDIT-VARIABLE-NAME
1561	MOVE ACUP-NEW-CUST-FIRST-NAME TO WS-EDIT-ALPHANUM-ONLY
1562	MOVE 25 TO WS-EDIT-ALPHANUM-LENGTH
1563	PERFORM 1225-EDIT-ALPHA-REQD
1564	THRU 1225-EDIT-ALPHA-REQD-EXIT
1565	MOVE WS-EDIT-ALPHA-ONLY-FLAGS
1566	TO WS-EDIT-FIRST-NAME-FLGS
1567
1568	MOVE 'Middle Name' TO WS-EDIT-VARIABLE-NAME
1569	MOVE ACUP-NEW-CUST-MIDDLE-NAME TO WS-EDIT-ALPHANUM-ONLY
1570	MOVE 25 TO WS-EDIT-ALPHANUM-LENGTH
1571	PERFORM 1235-EDIT-ALPHA-OPT
1572	THRU 1235-EDIT-ALPHA-OPT-EXIT
1573	MOVE WS-EDIT-ALPHA-ONLY-FLAGS
1574	TO WS-EDIT-MIDDLE-NAME-FLGS
1575
1576	MOVE 'Last Name' TO WS-EDIT-VARIABLE-NAME
1577	MOVE ACUP-NEW-CUST-LAST-NAME TO WS-EDIT-ALPHANUM-ONLY
1578	MOVE 25 TO WS-EDIT-ALPHANUM-LENGTH
1579	PERFORM 1225-EDIT-ALPHA-REQD
1580	THRU 1225-EDIT-ALPHA-REQD-EXIT
1581	MOVE WS-EDIT-ALPHA-ONLY-FLAGS
1582	TO WS-EDIT-LAST-NAME-FLGS
1583
1584	MOVE 'Address Line 1' TO WS-EDIT-VARIABLE-NAME
1585	MOVE ACUP-NEW-CUST-ADDR-LINE-1 TO WS-EDIT-ALPHANUM-ONLY
1586	MOVE 50 TO WS-EDIT-ALPHANUM-LENGTH
1587	PERFORM 1215-EDIT-MANDATORY
1588	THRU 1215-EDIT-MANDATORY-EXIT
1589	MOVE WS-EDIT-MANDATORY-FLAGS
1590	TO WS-EDIT-ADDRESS-LINE-1-FLGS
1591
1592	MOVE 'State' TO WS-EDIT-VARIABLE-NAME
1593	MOVE ACUP-NEW-CUST-ADDR-STATE-CD TO WS-EDIT-ALPHANUM-ONLY
1594	MOVE 2 TO WS-EDIT-ALPHANUM-LENGTH
1595	PERFORM 1225-EDIT-ALPHA-REQD
1596	THRU 1225-EDIT-ALPHA-REQD-EXIT
1597	MOVE WS-EDIT-ALPHA-ONLY-FLAGS
1598	TO WS-EDIT-STATE-FLGS
1599	IF FLG-ALPHA-ISVALID
1600	PERFORM 1270-EDIT-US-STATE-CD
1601	THRU 1270-EDIT-US-STATE-CD-EXIT
1602	END-IF
1603
1604
1605	MOVE 'Zip' TO WS-EDIT-VARIABLE-NAME
1606	MOVE ACUP-NEW-CUST-ADDR-ZIP TO WS-EDIT-ALPHANUM-ONLY
1607	MOVE 5 TO WS-EDIT-ALPHANUM-LENGTH
1608	PERFORM 1245-EDIT-NUM-REQD
1609	THRU 1245-EDIT-NUM-REQD-EXIT
1610	MOVE WS-EDIT-ALPHANUM-ONLY-FLAGS
1611	TO WS-EDIT-ZIPCODE-FLGS
1612
1613	* Address Line 2 is optional
1614	* MOVE 'Address Line 2' TO WS-EDIT-VARIABLE-NAME
1615	MOVE 'City' TO WS-EDIT-VARIABLE-NAME
1616	MOVE ACUP-NEW-CUST-ADDR-LINE-3 TO WS-EDIT-ALPHANUM-ONLY
1617	MOVE 50 TO WS-EDIT-ALPHANUM-LENGTH
1618	PERFORM 1225-EDIT-ALPHA-REQD
1619	THRU 1225-EDIT-ALPHA-REQD-EXIT
1620	MOVE WS-EDIT-ALPHA-ONLY-FLAGS
1621	TO WS-EDIT-CITY-FLGS
1622
1623	MOVE 'Country' TO WS-EDIT-VARIABLE-NAME
1624	MOVE ACUP-NEW-CUST-ADDR-COUNTRY-CD
1625	TO WS-EDIT-ALPHANUM-ONLY
1626	MOVE 3 TO WS-EDIT-ALPHANUM-LENGTH
1627	PERFORM 1225-EDIT-ALPHA-REQD
1628	THRU 1225-EDIT-ALPHA-REQD-EXIT
1629	MOVE WS-EDIT-ALPHA-ONLY-FLAGS
1630	TO WS-EDIT-COUNTRY-FLGS
1631
1632	MOVE 'Phone Number 1' TO WS-EDIT-VARIABLE-NAME
1633	MOVE ACUP-NEW-CUST-PHONE-NUM-1
1634	TO WS-EDIT-US-PHONE-NUM
1635	PERFORM 1260-EDIT-US-PHONE-NUM
1636	THRU 1260-EDIT-US-PHONE-NUM-EXIT
1637	MOVE WS-EDIT-US-PHONE-NUM-FLGS
1638	TO WS-EDIT-PHONE-NUM-1-FLGS
1639
1640	MOVE 'Phone Number 2' TO WS-EDIT-VARIABLE-NAME
1641	MOVE ACUP-NEW-CUST-PHONE-NUM-2
1642	TO WS-EDIT-US-PHONE-NUM
1643	PERFORM 1260-EDIT-US-PHONE-NUM
1644	THRU 1260-EDIT-US-PHONE-NUM-EXIT
1645	MOVE WS-EDIT-US-PHONE-NUM-FLGS
1646	TO WS-EDIT-PHONE-NUM-2-FLGS
1647
1648	MOVE 'EFT Account Id' TO WS-EDIT-VARIABLE-NAME
1649	MOVE ACUP-NEW-CUST-EFT-ACCOUNT-ID
1650	TO WS-EDIT-ALPHANUM-ONLY
1651	MOVE 10 TO WS-EDIT-ALPHANUM-LENGTH
1652	PERFORM 1245-EDIT-NUM-REQD
1653	THRU 1245-EDIT-NUM-REQD-EXIT
1654	MOVE WS-EDIT-ALPHANUM-ONLY-FLAGS
1655	TO WS-EFT-ACCOUNT-ID-FLGS
1656
1657	MOVE 'Primary Card Holder' TO WS-EDIT-VARIABLE-NAME
1658	MOVE ACUP-NEW-CUST-PRI-HOLDER-IND
1659	TO WS-EDIT-YES-NO
1660	PERFORM 1220-EDIT-YESNO
1661	THRU 1220-EDIT-YESNO-EXIT
1662	MOVE WS-EDIT-YES-NO TO WS-EDIT-PRI-CARDHOLDER
1663
1664	* Cross field edits begin here
1665	IF FLG-STATE-ISVALID
1666	AND FLG-ZIPCODE-ISVALID
1667	PERFORM 1280-EDIT-US-STATE-ZIP-CD
1668	THRU 1280-EDIT-US-STATE-ZIP-CD-EXIT
1669	END-IF
1670
1671	IF INPUT-ERROR
1672	CONTINUE
1673	ELSE
1674	SET ACUP-CHANGES-OK-NOT-CONFIRMED TO TRUE
1675	END-IF
1676	.
1677
1678	1200-EDIT-MAP-INPUTS-EXIT.
1679	EXIT
1680	.
1681	1205-COMPARE-OLD-NEW.
1682	SET NO-CHANGES-FOUND TO TRUE
1683
1684	IF ACUP-NEW-ACCT-ID-X = ACUP-OLD-ACCT-ID-X
1685	AND FUNCTION UPPER-CASE (
1686	ACUP-NEW-ACTIVE-STATUS) =
1687	FUNCTION UPPER-CASE (
1688	ACUP-OLD-ACTIVE-STATUS)
1689	AND ACUP-NEW-CURR-BAL = ACUP-OLD-CURR-BAL
1690	AND ACUP-NEW-CREDIT-LIMIT = ACUP-OLD-CREDIT-LIMIT
1691	AND ACUP-NEW-CASH-CREDIT-LIMIT = ACUP-OLD-CASH-CREDIT-LIMIT
1692	AND ACUP-NEW-OPEN-DATE = ACUP-OLD-OPEN-DATE
1693	AND ACUP-NEW-EXPIRAION-DATE = ACUP-OLD-EXPIRAION-DATE
1694	AND ACUP-NEW-REISSUE-DATE = ACUP-OLD-REISSUE-DATE
1695	AND ACUP-NEW-CURR-CYC-CREDIT = ACUP-OLD-CURR-CYC-CREDIT
1696	AND ACUP-NEW-CURR-CYC-DEBIT = ACUP-OLD-CURR-CYC-DEBIT
1697	AND FUNCTION UPPER-CASE (
1698	FUNCTION TRIM (ACUP-NEW-GROUP-ID))=
1699	FUNCTION UPPER-CASE (
1700	FUNCTION TRIM (ACUP-OLD-GROUP-ID))
1701	CONTINUE
1702	ELSE
1703	SET CHANGE-HAS-OCCURRED TO TRUE
1704	GO TO 1205-COMPARE-OLD-NEW-EXIT
1705	END-IF
1706
1707
1708	IF FUNCTION UPPER-CASE (
1709	FUNCTION TRIM (ACUP-NEW-CUST-ID-X))=
1710	FUNCTION UPPER-CASE (
1711	FUNCTION TRIM (ACUP-OLD-CUST-ID-X))
1712	AND FUNCTION UPPER-CASE (
1713	FUNCTION TRIM (ACUP-NEW-CUST-FIRST-NAME))=
1714	FUNCTION UPPER-CASE (
1715	FUNCTION TRIM (ACUP-OLD-CUST-FIRST-NAME))
1716	AND FUNCTION UPPER-CASE (
1717	FUNCTION TRIM (ACUP-NEW-CUST-MIDDLE-NAME))=
1718	FUNCTION UPPER-CASE (
1719	FUNCTION TRIM (ACUP-OLD-CUST-MIDDLE-NAME))
1720	AND FUNCTION UPPER-CASE (
1721	FUNCTION TRIM (ACUP-NEW-CUST-LAST-NAME))=
1722	FUNCTION UPPER-CASE (
1723	FUNCTION TRIM (ACUP-OLD-CUST-LAST-NAME))
1724	AND FUNCTION UPPER-CASE (
1725	FUNCTION TRIM (ACUP-NEW-CUST-ADDR-LINE-1))=
1726	FUNCTION UPPER-CASE (
1727	FUNCTION TRIM (ACUP-OLD-CUST-ADDR-LINE-1))
1728	AND FUNCTION UPPER-CASE (
1729	FUNCTION TRIM (ACUP-NEW-CUST-ADDR-LINE-2))=
1730	FUNCTION UPPER-CASE (
1731	FUNCTION TRIM (ACUP-OLD-CUST-ADDR-LINE-2))
1732	AND FUNCTION UPPER-CASE (
1733	FUNCTION TRIM (ACUP-NEW-CUST-ADDR-LINE-3))=
1734	FUNCTION UPPER-CASE (
1735	FUNCTION TRIM (ACUP-OLD-CUST-ADDR-LINE-3))
1736	AND FUNCTION UPPER-CASE (
1737	FUNCTION TRIM (ACUP-NEW-CUST-ADDR-STATE-CD))=
1738	FUNCTION UPPER-CASE (
1739	FUNCTION TRIM (ACUP-OLD-CUST-ADDR-STATE-CD))
1740	AND FUNCTION UPPER-CASE (
1741	FUNCTION TRIM (ACUP-NEW-CUST-ADDR-COUNTRY-CD))=
1742	FUNCTION UPPER-CASE (
1743	FUNCTION TRIM (ACUP-OLD-CUST-ADDR-COUNTRY-CD))
1744	AND FUNCTION UPPER-CASE (
1745	FUNCTION TRIM (ACUP-NEW-CUST-ADDR-ZIP))=
1746	FUNCTION UPPER-CASE (
1747	FUNCTION TRIM (ACUP-OLD-CUST-ADDR-ZIP))
1748	AND ACUP-NEW-CUST-PHONE-NUM-1A = ACUP-OLD-CUST-PHONE-NUM-1A
1749	AND ACUP-NEW-CUST-PHONE-NUM-1B = ACUP-OLD-CUST-PHONE-NUM-1B
1750	AND ACUP-NEW-CUST-PHONE-NUM-1C = ACUP-OLD-CUST-PHONE-NUM-1C
1751	AND ACUP-NEW-CUST-PHONE-NUM-2A = ACUP-OLD-CUST-PHONE-NUM-2A
1752	AND ACUP-NEW-CUST-PHONE-NUM-2B = ACUP-OLD-CUST-PHONE-NUM-2B
1753	AND ACUP-NEW-CUST-PHONE-NUM-2C = ACUP-OLD-CUST-PHONE-NUM-2C
1754	AND ACUP-NEW-CUST-SSN-X = ACUP-OLD-CUST-SSN-X
1755	AND FUNCTION UPPER-CASE (
1756	FUNCTION TRIM (ACUP-NEW-CUST-GOVT-ISSUED-ID ))=
1757	FUNCTION UPPER-CASE (
1758	FUNCTION TRIM (ACUP-OLD-CUST-GOVT-ISSUED-ID))
1759	AND ACUP-NEW-CUST-DOB-YYYY-MM-DD
1760	= ACUP-OLD-CUST-DOB-YYYY-MM-DD
1761	AND ACUP-NEW-CUST-EFT-ACCOUNT-ID
1762	= ACUP-OLD-CUST-EFT-ACCOUNT-ID
1763	AND FUNCTION UPPER-CASE (
1764	FUNCTION TRIM (ACUP-NEW-CUST-PRI-HOLDER-IND))=
1765	FUNCTION UPPER-CASE (
1766	FUNCTION TRIM (ACUP-OLD-CUST-PRI-HOLDER-IND))
1767	AND ACUP-NEW-CUST-FICO-SCORE-X
1768	= ACUP-OLD-CUST-FICO-SCORE-X
1769	SET NO-CHANGES-DETECTED TO TRUE
1770	ELSE
1771	SET CHANGE-HAS-OCCURRED TO TRUE
1772	GO TO 1205-COMPARE-OLD-NEW-EXIT
1773	END-IF
1774
1775	.
1776
1777	1205-COMPARE-OLD-NEW-EXIT.
1778	EXIT
1779	.
1780
1781
1782	*
1783	1210-EDIT-ACCOUNT.
1784	SET FLG-ACCTFILTER-NOT-OK TO TRUE
1785
1786	* Not supplied
1787	IF CC-ACCT-ID EQUAL LOW-VALUES
1788	OR CC-ACCT-ID EQUAL SPACES
1789	SET INPUT-ERROR TO TRUE
1790	SET FLG-ACCTFILTER-BLANK TO TRUE
1791	IF WS-RETURN-MSG-OFF
1792	SET WS-PROMPT-FOR-ACCT TO TRUE
1793	END-IF
1794	MOVE ZEROES TO CDEMO-ACCT-ID
1795	ACUP-NEW-ACCT-ID
1796	GO TO 1210-EDIT-ACCOUNT-EXIT
1797	END-IF
1798
1799	* Not numeric
1800	* Not 11 characters
1801	MOVE CC-ACCT-ID TO ACUP-NEW-ACCT-ID
1802	IF CC-ACCT-ID IS NOT NUMERIC
1803	OR CC-ACCT-ID-N EQUAL ZEROS
1804	SET INPUT-ERROR TO TRUE
1805	IF WS-RETURN-MSG-OFF
1806	STRING
1807	'Account Number if supplied must be a 11 digit'
1808	' Non-Zero Number'
1809	DELIMITED BY SIZE
1810	INTO WS-RETURN-MSG
1811	END-IF
1812	MOVE ZEROES TO CDEMO-ACCT-ID
1813	GO TO 1210-EDIT-ACCOUNT-EXIT
1814	ELSE
1815	MOVE CC-ACCT-ID TO CDEMO-ACCT-ID
1816	SET FLG-ACCTFILTER-ISVALID TO TRUE
1817	END-IF
1818	.
1819
1820	1210-EDIT-ACCOUNT-EXIT.
1821	EXIT
1822	.
1823
1824	1215-EDIT-MANDATORY.
1825	* Initialize
1826	SET FLG-MANDATORY-NOT-OK TO TRUE
1827
1828	* Not supplied
1829	IF WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1830	EQUAL LOW-VALUES
1831	OR WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1832	EQUAL SPACES
1833	OR FUNCTION LENGTH(FUNCTION TRIM(
1834	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH))) = 0
1835
1836	SET INPUT-ERROR TO TRUE
1837	SET FLG-MANDATORY-BLANK TO TRUE
1838	IF WS-RETURN-MSG-OFF
1839	STRING
1840	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
1841	' must be supplied.'
1842	DELIMITED BY SIZE
1843	INTO WS-RETURN-MSG
1844	END-STRING
1845	END-IF
1846
1847	GO TO 1215-EDIT-MANDATORY-EXIT
1848	END-IF
1849
1850	SET FLG-MANDATORY-ISVALID TO TRUE
1851	.
1852	1215-EDIT-MANDATORY-EXIT.
1853	EXIT
1854	.
1855
1856	1220-EDIT-YESNO.
1857	* Must be Y or N
1858	* SET FLG-YES-NO-NOT-OK TO TRUE
1859	*
1860	* Not supplied
1861	IF WS-EDIT-YES-NO EQUAL LOW-VALUES
1862	OR WS-EDIT-YES-NO EQUAL SPACES
1863	OR WS-EDIT-YES-NO EQUAL ZEROS
1864	SET INPUT-ERROR TO TRUE
1865	SET FLG-YES-NO-BLANK TO TRUE
1866	IF WS-RETURN-MSG-OFF
1867	STRING
1868	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
1869	' must be supplied.'
1870	DELIMITED BY SIZE
1871	INTO WS-RETURN-MSG
1872	END-STRING
1873	END-IF
1874	GO TO 1220-EDIT-YESNO-EXIT
1875	END-IF
1876
1877
1878	IF FLG-YES-NO-ISVALID
1879	CONTINUE
1880	ELSE
1881	SET INPUT-ERROR TO TRUE
1882	SET FLG-YES-NO-NOT-OK TO TRUE
1883	IF WS-RETURN-MSG-OFF
1884	STRING
1885	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
1886	' must be Y or N.'
1887	DELIMITED BY SIZE
1888	INTO WS-RETURN-MSG
1889	END-STRING
1890	END-IF
1891	GO TO 1220-EDIT-YESNO-EXIT
1892	END-IF
1893	.
1894	1220-EDIT-YESNO-EXIT.
1895	EXIT
1896	.
1897
1898	1225-EDIT-ALPHA-REQD.
1899	* Initialize
1900	SET FLG-ALPHA-NOT-OK TO TRUE
1901
1902	* Not supplied
1903	IF WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1904	EQUAL LOW-VALUES
1905	OR WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1906	EQUAL SPACES
1907	OR FUNCTION LENGTH(FUNCTION TRIM(
1908	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH))) = 0
1909
1910	SET INPUT-ERROR TO TRUE
1911	SET FLG-ALPHA-BLANK TO TRUE
1912	IF WS-RETURN-MSG-OFF
1913	STRING
1914	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
1915	' must be supplied.'
1916	DELIMITED BY SIZE
1917	INTO WS-RETURN-MSG
1918	END-STRING
1919	END-IF
1920
1921	GO TO 1225-EDIT-ALPHA-REQD-EXIT
1922	END-IF
1923
1924	* Only Alphabets and space allowed
1925	MOVE LIT-ALL-ALPHA-FROM-X TO LIT-ALL-ALPHA-FROM
1926	INSPECT WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1927	CONVERTING LIT-ALL-ALPHA-FROM
1928	TO LIT-ALPHA-SPACES-TO
1929
1930	IF FUNCTION LENGTH(
1931	FUNCTION TRIM(
1932	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1933	)) = 0
1934	CONTINUE
1935	ELSE
1936	SET INPUT-ERROR TO TRUE
1937	SET FLG-ALPHA-NOT-OK TO TRUE
1938	IF WS-RETURN-MSG-OFF
1939	STRING
1940	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
1941	' can have alphabets only.'
1942	DELIMITED BY SIZE
1943	INTO WS-RETURN-MSG
1944	END-STRING
1945	END-IF
1946	GO TO 1225-EDIT-ALPHA-REQD-EXIT
1947	END-IF
1948
1949	SET FLG-ALPHA-ISVALID TO TRUE
1950	.
1951	1225-EDIT-ALPHA-REQD-EXIT.
1952	EXIT
1953	.
1954
1955	1230-EDIT-ALPHANUM-REQD.
1956	* Initialize
1957	SET FLG-ALPHNANUM-NOT-OK TO TRUE
1958
1959	* Not supplied
1960	IF WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1961	EQUAL LOW-VALUES
1962	OR WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1963	EQUAL SPACES
1964	OR FUNCTION LENGTH(FUNCTION TRIM(
1965	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH))) = 0
1966
1967	SET INPUT-ERROR TO TRUE
1968	SET FLG-ALPHNANUM-BLANK TO TRUE
1969	IF WS-RETURN-MSG-OFF
1970	STRING
1971	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
1972	' must be supplied.'
1973	DELIMITED BY SIZE
1974	INTO WS-RETURN-MSG
1975	END-STRING
1976	END-IF
1977
1978	GO TO 1230-EDIT-ALPHANUM-REQD-EXIT
1979	END-IF
1980
1981	* Only Alphabets,numbers and space allowed
1982	MOVE LIT-ALL-ALPHANUM-FROM-X TO LIT-ALL-ALPHANUM-FROM
1983
1984	INSPECT WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1985	CONVERTING LIT-ALL-ALPHANUM-FROM
1986	TO LIT-ALPHANUM-SPACES-TO
1987
1988	IF FUNCTION LENGTH(
1989	FUNCTION TRIM(
1990	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
1991	)) = 0
1992	CONTINUE
1993	ELSE
1994	SET INPUT-ERROR TO TRUE
1995	SET FLG-ALPHNANUM-NOT-OK TO TRUE
1996	IF WS-RETURN-MSG-OFF
1997	STRING
1998	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
1999	' can have numbers or alphabets only.'
2000	DELIMITED BY SIZE
2001	INTO WS-RETURN-MSG
2002	END-STRING
2003	END-IF
2004	GO TO 1230-EDIT-ALPHANUM-REQD-EXIT
2005	END-IF
2006
2007	SET FLG-ALPHNANUM-ISVALID TO TRUE
2008	.
2009	1230-EDIT-ALPHANUM-REQD-EXIT.
2010	EXIT
2011	.
2012	1235-EDIT-ALPHA-OPT.
2013	* Initialize
2014	SET FLG-ALPHA-NOT-OK TO TRUE
2015
2016	* Not supplied
2017	IF WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2018	EQUAL LOW-VALUES
2019	OR WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2020	EQUAL SPACES
2021	OR FUNCTION LENGTH(FUNCTION TRIM(
2022	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH))) = 0
2023
2024	SET FLG-ALPHA-ISVALID TO TRUE
2025	GO TO 1235-EDIT-ALPHA-OPT-EXIT
2026	ELSE
2027	CONTINUE
2028	END-IF
2029
2030	* Only Alphabets and space allowed
2031	MOVE LIT-ALL-ALPHA-FROM-X TO LIT-ALL-ALPHA-FROM
2032	INSPECT WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2033	CONVERTING LIT-ALL-ALPHA-FROM
2034	TO LIT-ALPHA-SPACES-TO
2035
2036	IF FUNCTION LENGTH(
2037	FUNCTION TRIM(
2038	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2039	)) = 0
2040	CONTINUE
2041	ELSE
2042	SET INPUT-ERROR TO TRUE
2043	SET FLG-ALPHA-NOT-OK TO TRUE
2044	IF WS-RETURN-MSG-OFF
2045	STRING
2046	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2047	' can have alphabets only.'
2048	DELIMITED BY SIZE
2049	INTO WS-RETURN-MSG
2050	END-STRING
2051	END-IF
2052	GO TO 1235-EDIT-ALPHA-OPT-EXIT
2053	END-IF
2054
2055	SET FLG-ALPHA-ISVALID TO TRUE
2056	.
2057	1235-EDIT-ALPHA-OPT-EXIT.
2058	EXIT
2059	.
2060
2061	1240-EDIT-ALPHANUM-OPT.
2062	* Initialize
2063	SET FLG-ALPHNANUM-NOT-OK TO TRUE
2064
2065	* Not supplied, but ok as optional
2066	IF WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2067	EQUAL LOW-VALUES
2068	OR WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2069	EQUAL SPACES
2070	OR FUNCTION LENGTH(FUNCTION TRIM(
2071	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH))) = 0
2072	SET FLG-ALPHNANUM-ISVALID TO TRUE
2073	GO TO 1240-EDIT-ALPHANUM-OPT-EXIT
2074	ELSE
2075	CONTINUE
2076	END-IF
2077
2078	* Only Alphabets and space allowed
2079	MOVE LIT-ALL-ALPHANUM-FROM-X TO LIT-ALL-ALPHANUM-FROM
2080	INSPECT WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2081	CONVERTING LIT-ALL-ALPHANUM-FROM
2082	TO LIT-ALPHANUM-SPACES-TO
2083
2084	IF FUNCTION LENGTH(
2085	FUNCTION TRIM(
2086	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2087	)) = 0
2088	CONTINUE
2089	ELSE
2090	SET INPUT-ERROR TO TRUE
2091	SET FLG-ALPHNANUM-NOT-OK TO TRUE
2092	IF WS-RETURN-MSG-OFF
2093	STRING
2094	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2095	' can have numbers or alphabets only.'
2096	DELIMITED BY SIZE
2097	INTO WS-RETURN-MSG
2098	END-STRING
2099	END-IF
2100	GO TO 1240-EDIT-ALPHANUM-OPT-EXIT
2101	END-IF
2102
2103	SET FLG-ALPHNANUM-ISVALID TO TRUE
2104	.
2105	1240-EDIT-ALPHANUM-OPT-EXIT.
2106	EXIT
2107	.
2108
2109	1245-EDIT-NUM-REQD.
2110	* Initialize
2111	SET FLG-ALPHNANUM-NOT-OK TO TRUE
2112
2113	* Not supplied
2114	IF WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2115	EQUAL LOW-VALUES
2116	OR WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2117	EQUAL SPACES
2118	OR FUNCTION LENGTH(FUNCTION TRIM(
2119	WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH))) = 0
2120
2121	SET INPUT-ERROR TO TRUE
2122	SET FLG-ALPHNANUM-BLANK TO TRUE
2123	IF WS-RETURN-MSG-OFF
2124	STRING
2125	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2126	' must be supplied.'
2127	DELIMITED BY SIZE
2128	INTO WS-RETURN-MSG
2129	END-STRING
2130	END-IF
2131
2132	GO TO 1245-EDIT-NUM-REQD-EXIT
2133	END-IF
2134
2135	* Only all numeric allowed
2136
2137	IF WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH)
2138	IS NUMERIC
2139	CONTINUE
2140	ELSE
2141	SET INPUT-ERROR TO TRUE
2142	SET FLG-ALPHNANUM-NOT-OK TO TRUE
2143	IF WS-RETURN-MSG-OFF
2144	STRING
2145	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2146	' must be all numeric.'
2147	DELIMITED BY SIZE
2148	INTO WS-RETURN-MSG
2149	END-STRING
2150	END-IF
2151	GO TO 1245-EDIT-NUM-REQD-EXIT
2152	END-IF
2153
2154	* Must not be zero
2155
2156	IF FUNCTION NUMVAL(WS-EDIT-ALPHANUM-ONLY(1:
2157	WS-EDIT-ALPHANUM-LENGTH)) = 0
2158	SET INPUT-ERROR TO TRUE
2159	SET FLG-ALPHNANUM-NOT-OK TO TRUE
2160	IF WS-RETURN-MSG-OFF
2161	STRING
2162	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2163	' must not be zero.'
2164	DELIMITED BY SIZE
2165	INTO WS-RETURN-MSG
2166	END-STRING
2167	END-IF
2168	GO TO 1245-EDIT-NUM-REQD-EXIT
2169	ELSE
2170	CONTINUE
2171	END-IF
2172
2173
2174	SET FLG-ALPHNANUM-ISVALID TO TRUE
2175	.
2176	1245-EDIT-NUM-REQD-EXIT.
2177	EXIT
2178	.
2179
2180	1250-EDIT-SIGNED-9V2.
2181	SET FLG-SIGNED-NUMBER-NOT-OK TO TRUE
2182
2183	* Not supplied
2184	IF WS-EDIT-SIGNED-NUMBER-9V2-X EQUAL LOW-VALUES
2185	OR WS-EDIT-SIGNED-NUMBER-9V2-X EQUAL SPACES
2186	SET INPUT-ERROR TO TRUE
2187	SET FLG-SIGNED-NUMBER-BLANK TO TRUE
2188	IF WS-RETURN-MSG-OFF
2189	STRING
2190	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2191	' must be supplied.'
2192	DELIMITED BY SIZE
2193	INTO WS-RETURN-MSG
2194	END-STRING
2195	END-IF
2196	GO TO 1250-EDIT-SIGNED-9V2-EXIT
2197	ELSE
2198	CONTINUE
2199	END-IF
2200
2201	IF FUNCTION TEST-NUMVAL-C(WS-EDIT-SIGNED-NUMBER-9V2-X) = 0
2202	CONTINUE
2203	ELSE
2204	SET INPUT-ERROR TO TRUE
2205	SET FLG-SIGNED-NUMBER-NOT-OK TO TRUE
2206	IF WS-RETURN-MSG-OFF
2207	STRING
2208	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2209	' is not valid'
2210	DELIMITED BY SIZE
2211	INTO WS-RETURN-MSG
2212	END-IF
2213	GO TO 1250-EDIT-SIGNED-9V2-EXIT
2214
2215	END-IF
2216
2217	* If we got here all edits were cleared
2218	SET FLG-SIGNED-NUMBER-ISVALID TO TRUE
2219	.
2220
2221	1250-EDIT-SIGNED-9V2-EXIT.
2222	EXIT
2223	.
2224
2225	1260-EDIT-US-PHONE-NUM.
2226
2227	* The database stores date in X(15) format (999)999-9999
2228	* 1234567890123
2229	* So we take the X(15) input into WS-EDIT-US-PHONE-NUM
2230	* and edit it
2231
2232	SET WS-EDIT-US-PHONE-IS-INVALID TO TRUE
2233	* Not mandatory to enter a phone number
2234	IF (WS-EDIT-US-PHONE-NUMA EQUAL SPACES
2235	OR WS-EDIT-US-PHONE-NUMA EQUAL LOW-VALUES)
2236	AND (WS-EDIT-US-PHONE-NUMB EQUAL SPACES
2237	OR WS-EDIT-US-PHONE-NUMB EQUAL LOW-VALUES)
2238	AND (WS-EDIT-US-PHONE-NUMA EQUAL SPACES
2239	OR WS-EDIT-US-PHONE-NUMC EQUAL LOW-VALUES)
2240	SET WS-EDIT-US-PHONE-IS-VALID TO TRUE
2241	GO TO EDIT-US-PHONE-EXIT
2242	ELSE
2243	CONTINUE
2244	END-IF
2245	.
2246	EDIT-AREA-CODE.
2247	IF WS-EDIT-US-PHONE-NUMA EQUAL SPACES
2248	OR WS-EDIT-US-PHONE-NUMA EQUAL LOW-VALUES
2249	SET INPUT-ERROR TO TRUE
2250	SET FLG-EDIT-US-PHONEA-BLANK TO TRUE
2251	IF WS-RETURN-MSG-OFF
2252	STRING
2253	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2254	': Area code must be supplied.'
2255	DELIMITED BY SIZE
2256	INTO WS-RETURN-MSG
2257	END-STRING
2258	END-IF
2259	GO TO EDIT-US-PHONE-PREFIX
2260	ELSE
2261	CONTINUE
2262	END-IF
2263
2264	IF WS-EDIT-US-PHONE-NUMA IS NUMERIC
2265	CONTINUE
2266	ELSE
2267	SET INPUT-ERROR TO TRUE
2268	SET FLG-EDIT-US-PHONEA-NOT-OK TO TRUE
2269	IF WS-RETURN-MSG-OFF
2270	STRING
2271	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2272	': Area code must be A 3 digit number.'
2273	DELIMITED BY SIZE
2274	INTO WS-RETURN-MSG
2275	END-STRING
2276	END-IF
2277	GO TO EDIT-US-PHONE-PREFIX
2278	END-IF
2279
2280	IF WS-EDIT-US-PHONE-NUMA-N = 0
2281	SET INPUT-ERROR TO TRUE
2282	SET FLG-EDIT-US-PHONEA-NOT-OK TO TRUE
2283	IF WS-RETURN-MSG-OFF
2284	STRING
2285	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2286	': Area code cannot be zero'
2287	DELIMITED BY SIZE
2288	INTO WS-RETURN-MSG
2289	END-STRING
2290	END-IF
2291	GO TO EDIT-US-PHONE-PREFIX
2292	ELSE
2293	CONTINUE
2294	END-IF
2295
2296	MOVE FUNCTION TRIM (WS-EDIT-US-PHONE-NUMA)
2297	TO WS-US-PHONE-AREA-CODE-TO-EDIT
2298	IF VALID-GENERAL-PURP-CODE
2299	CONTINUE
2300	ELSE
2301	SET INPUT-ERROR TO TRUE
2302	SET FLG-EDIT-US-PHONEA-NOT-OK TO TRUE
2303	IF WS-RETURN-MSG-OFF
2304	STRING
2305	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2306	': Not valid North America general purpose area code'
2307	DELIMITED BY SIZE
2308	INTO WS-RETURN-MSG
2309	END-STRING
2310	END-IF
2311	GO TO EDIT-US-PHONE-PREFIX
2312	END-IF
2313
2314	SET FLG-EDIT-US-PHONEA-ISVALID TO TRUE
2315	.
2316	EDIT-US-PHONE-PREFIX.
2317
2318	IF WS-EDIT-US-PHONE-NUMB EQUAL SPACES
2319	OR WS-EDIT-US-PHONE-NUMB EQUAL LOW-VALUES
2320	SET INPUT-ERROR TO TRUE
2321	SET FLG-EDIT-US-PHONEB-BLANK TO TRUE
2322	IF WS-RETURN-MSG-OFF
2323	STRING
2324	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2325	': Prefix code must be supplied.'
2326	DELIMITED BY SIZE
2327	INTO WS-RETURN-MSG
2328	END-STRING
2329	END-IF
2330	GO TO EDIT-US-PHONE-LINENUM
2331	ELSE
2332	CONTINUE
2333	END-IF
2334
2335	IF WS-EDIT-US-PHONE-NUMB IS NUMERIC
2336	CONTINUE
2337	ELSE
2338	SET INPUT-ERROR TO TRUE
2339	SET FLG-EDIT-US-PHONEB-NOT-OK TO TRUE
2340	IF WS-RETURN-MSG-OFF
2341	STRING
2342	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2343	': Prefix code must be A 3 digit number.'
2344	DELIMITED BY SIZE
2345	INTO WS-RETURN-MSG
2346	END-STRING
2347	END-IF
2348	GO TO EDIT-US-PHONE-LINENUM
2349	END-IF
2350
2351	IF WS-EDIT-US-PHONE-NUMB-N = 0
2352	SET INPUT-ERROR TO TRUE
2353	SET FLG-EDIT-US-PHONEB-NOT-OK TO TRUE
2354	IF WS-RETURN-MSG-OFF
2355	STRING
2356	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2357	': Prefix code cannot be zero'
2358	DELIMITED BY SIZE
2359	INTO WS-RETURN-MSG
2360	END-STRING
2361	END-IF
2362	GO TO EDIT-US-PHONE-LINENUM
2363	ELSE
2364	CONTINUE
2365	END-IF
2366
2367	SET FLG-EDIT-US-PHONEB-ISVALID TO TRUE
2368	.
2369
2370	EDIT-US-PHONE-LINENUM.
2371	IF WS-EDIT-US-PHONE-NUMC EQUAL SPACES
2372	OR WS-EDIT-US-PHONE-NUMC EQUAL LOW-VALUES
2373	SET INPUT-ERROR TO TRUE
2374	SET FLG-EDIT-US-PHONEC-BLANK TO TRUE
2375	IF WS-RETURN-MSG-OFF
2376	STRING
2377	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2378	': Line number code must be supplied.'
2379	DELIMITED BY SIZE
2380	INTO WS-RETURN-MSG
2381	END-STRING
2382	END-IF
2383	GO TO EDIT-US-PHONE-EXIT
2384	ELSE
2385	CONTINUE
2386	END-IF
2387
2388	IF WS-EDIT-US-PHONE-NUMC IS NUMERIC
2389	CONTINUE
2390	ELSE
2391	SET INPUT-ERROR TO TRUE
2392	SET FLG-EDIT-US-PHONEC-NOT-OK TO TRUE
2393	IF WS-RETURN-MSG-OFF
2394	STRING
2395	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2396	': Line number code must be A 4 digit number.'
2397	DELIMITED BY SIZE
2398	INTO WS-RETURN-MSG
2399	END-STRING
2400	END-IF
2401	GO TO EDIT-US-PHONE-EXIT
2402	END-IF
2403
2404	IF WS-EDIT-US-PHONE-NUMC-N = 0
2405	SET INPUT-ERROR TO TRUE
2406	SET FLG-EDIT-US-PHONEC-NOT-OK TO TRUE
2407	IF WS-RETURN-MSG-OFF
2408	STRING
2409	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2410	': Line number code cannot be zero'
2411	DELIMITED BY SIZE
2412	INTO WS-RETURN-MSG
2413	END-STRING
2414	END-IF
2415	GO TO EDIT-US-PHONE-EXIT
2416	ELSE
2417	CONTINUE
2418	END-IF
2419
2420
2421	SET FLG-EDIT-US-PHONEC-ISVALID TO TRUE
2422	.
2423
2424	EDIT-US-PHONE-EXIT.
2425	EXIT
2426	.
2427	1260-EDIT-US-PHONE-NUM-EXIT.
2428	EXIT
2429	.
2430
2431	1265-EDIT-US-SSN.
2432	*Format xxx-xx-xxxx
2433	*Part1 :should have 3 digits
2434	*Part2 :should have 2 digits and it should be from 01 to 99
2435	*Part3 should have 4 digits from 0001 to 9999.
2436	******************************************************************
2437	* Edit SSN Part 1
2438	******************************************************************
2439	MOVE 'SSN: First 3 chars' TO WS-EDIT-VARIABLE-NAME
2440	MOVE ACUP-NEW-CUST-SSN-1 TO WS-EDIT-ALPHANUM-ONLY
2441	MOVE 3 TO WS-EDIT-ALPHANUM-LENGTH
2442	PERFORM 1245-EDIT-NUM-REQD
2443	THRU 1245-EDIT-NUM-REQD-EXIT
2444	MOVE WS-EDIT-ALPHANUM-ONLY-FLAGS
2445	TO WS-EDIT-US-SSN-PART1-FLGS
2446
2447	*Part1 :should not be 000, 666, or between 900 and 999
2448	IF FLG-EDIT-US-SSN-PART1-ISVALID
2449	MOVE ACUP-NEW-CUST-SSN-1 TO WS-EDIT-US-SSN-PART1
2450	IF INVALID-SSN-PART1
2451	SET INPUT-ERROR TO TRUE
2452	SET FLG-EDIT-US-SSN-PART1-NOT-OK
2453	TO TRUE
2454	IF WS-RETURN-MSG-OFF
2455	STRING
2456	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2457	': should not be 000, 666, or between 900 and 999'
2458	DELIMITED BY SIZE
2459	INTO WS-RETURN-MSG
2460	END-STRING
2461	ELSE
2462	CONTINUE
2463	END-IF
2464	END-IF
2465
2466	******************************************************************
2467	* Edit SSN Part 2
2468	******************************************************************
2469	MOVE 'SSN 4th & 5th chars' TO WS-EDIT-VARIABLE-NAME
2470	MOVE ACUP-NEW-CUST-SSN-2 TO WS-EDIT-ALPHANUM-ONLY
2471	MOVE 2 TO WS-EDIT-ALPHANUM-LENGTH
2472	PERFORM 1245-EDIT-NUM-REQD
2473	THRU 1245-EDIT-NUM-REQD-EXIT
2474	MOVE WS-EDIT-ALPHANUM-ONLY-FLAGS
2475	TO WS-EDIT-US-SSN-PART2-FLGS
2476
2477
2478	******************************************************************
2479	* Edit SSN Part 3
2480	******************************************************************
2481	MOVE 'SSN Last 4 chars' TO WS-EDIT-VARIABLE-NAME
2482	MOVE ACUP-NEW-CUST-SSN-3 TO WS-EDIT-ALPHANUM-ONLY
2483	MOVE 4 TO WS-EDIT-ALPHANUM-LENGTH
2484	PERFORM 1245-EDIT-NUM-REQD
2485	THRU 1245-EDIT-NUM-REQD-EXIT
2486	MOVE WS-EDIT-ALPHANUM-ONLY-FLAGS
2487	TO WS-EDIT-US-SSN-PART3-FLGS
2488	.
2489	1265-EDIT-US-SSN-EXIT.
2490	EXIT
2491	.
2492
2493	1270-EDIT-US-STATE-CD.
2494	MOVE ACUP-NEW-CUST-ADDR-STATE-CD TO US-STATE-CODE-TO-EDIT
2495	IF VALID-US-STATE-CODE
2496	CONTINUE
2497	ELSE
2498	SET INPUT-ERROR TO TRUE
2499	SET FLG-STATE-NOT-OK TO TRUE
2500	IF WS-RETURN-MSG-OFF
2501	STRING
2502	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2503	': is not a valid state code'
2504	DELIMITED BY SIZE
2505	INTO WS-RETURN-MSG
2506	END-STRING
2507	END-IF
2508	GO TO 1270-EDIT-US-STATE-CD-EXIT
2509	END-IF
2510	.
2511	1270-EDIT-US-STATE-CD-EXIT.
2512	EXIT
2513	.
2514	1275-EDIT-FICO-SCORE.
2515	IF FICO-RANGE-IS-VALID
2516	CONTINUE
2517	ELSE
2518	SET INPUT-ERROR TO TRUE
2519	SET FLG-FICO-SCORE-NOT-OK TO TRUE
2520	IF WS-RETURN-MSG-OFF
2521	STRING
2522	FUNCTION TRIM(WS-EDIT-VARIABLE-NAME)
2523	': should be between 300 and 850'
2524	DELIMITED BY SIZE
2525	INTO WS-RETURN-MSG
2526	END-STRING
2527	END-IF
2528	GO TO 1275-EDIT-FICO-SCORE-EXIT
2529	END-IF
2530	.
2531	1275-EDIT-FICO-SCORE-EXIT.
2532	EXIT
2533	.
2534
2535	*A crude zip code edit based on data from USPS web site
2536	1280-EDIT-US-STATE-ZIP-CD.
2537	STRING ACUP-NEW-CUST-ADDR-STATE-CD
2538	ACUP-NEW-CUST-ADDR-ZIP(1:2)
2539	DELIMITED BY SIZE
2540	INTO US-STATE-AND-FIRST-ZIP2
2541
2542	IF VALID-US-STATE-ZIP-CD2-COMBO
2543	CONTINUE
2544	ELSE
2545	SET INPUT-ERROR TO TRUE
2546	SET FLG-STATE-NOT-OK TO TRUE
2547	SET FLG-ZIPCODE-NOT-OK TO TRUE
2548	IF WS-RETURN-MSG-OFF
2549	STRING
2550	'Invalid zip code for state'
2551	DELIMITED BY SIZE
2552	INTO WS-RETURN-MSG
2553	END-STRING
2554	END-IF
2555	GO TO 1280-EDIT-US-STATE-ZIP-CD-EXIT
2556	END-IF
2557	.
2558	1280-EDIT-US-STATE-ZIP-CD-EXIT.
2559	EXIT
2560	.
2561
2562	2000-DECIDE-ACTION.
2563	EVALUATE TRUE
2564	******************************************************************
2565	* NO DETAILS SHOWN.
2566	* SO GET THEM AND SETUP DETAIL EDIT SCREEN
2567	******************************************************************
2568	WHEN ACUP-DETAILS-NOT-FETCHED
2569	******************************************************************
2570	* CHANGES MADE. BUT USER CANCELS
2571	******************************************************************
2572	WHEN CCARD-AID-PFK12
2573	IF FLG-ACCTFILTER-ISVALID
2574	SET WS-RETURN-MSG-OFF TO TRUE
2575	PERFORM 9000-READ-ACCT
2576	THRU 9000-READ-ACCT-EXIT
2577	IF FOUND-CUST-IN-MASTER
2578	SET ACUP-SHOW-DETAILS TO TRUE
2579	END-IF
2580	END-IF
2581	******************************************************************
2582	* DETAILS SHOWN
2583	* CHECK CHANGES AND ASK CONFIRMATION IF GOOD
2584	******************************************************************
2585	WHEN ACUP-SHOW-DETAILS
2586	IF INPUT-ERROR
2587	OR NO-CHANGES-DETECTED
2588	CONTINUE
2589	ELSE
2590	SET ACUP-CHANGES-OK-NOT-CONFIRMED TO TRUE
2591	END-IF
2592	******************************************************************
2593	* DETAILS SHOWN
2594	* BUT INPUT EDIT ERRORS FOUND
2595	******************************************************************
2596	WHEN ACUP-CHANGES-NOT-OK
2597	CONTINUE
2598	******************************************************************
2599	* DETAILS EDITED , FOUND OK, CONFIRM SAVE REQUESTED
2600	* CONFIRMATION GIVEN.SO SAVE THE CHANGES
2601	******************************************************************
2602	WHEN ACUP-CHANGES-OK-NOT-CONFIRMED
2603	AND CCARD-AID-PFK05
2604	PERFORM 9600-WRITE-PROCESSING
2605	THRU 9600-WRITE-PROCESSING-EXIT
2606	EVALUATE TRUE
2607	WHEN COULD-NOT-LOCK-ACCT-FOR-UPDATE
2608	SET ACUP-CHANGES-OKAYED-LOCK-ERROR TO TRUE
2609	WHEN LOCKED-BUT-UPDATE-FAILED
2610	SET ACUP-CHANGES-OKAYED-BUT-FAILED TO TRUE
2611	WHEN DATA-WAS-CHANGED-BEFORE-UPDATE
2612	SET ACUP-SHOW-DETAILS TO TRUE
2613	WHEN OTHER
2614	SET ACUP-CHANGES-OKAYED-AND-DONE TO TRUE
2615	END-EVALUATE
2616	******************************************************************
2617	* DETAILS EDITED , FOUND OK, CONFIRM SAVE REQUESTED
2618	* CONFIRMATION NOT GIVEN. SO SHOW DETAILS AGAIN
2619	******************************************************************
2620	WHEN ACUP-CHANGES-OK-NOT-CONFIRMED
2621	CONTINUE
2622	******************************************************************
2623	* SHOW CONFIRMATION. GO BACK TO SQUARE 1
2624	******************************************************************
2625	WHEN ACUP-CHANGES-OKAYED-AND-DONE
2626	SET ACUP-SHOW-DETAILS TO TRUE
2627	IF CDEMO-FROM-TRANID EQUAL LOW-VALUES
2628	OR CDEMO-FROM-TRANID EQUAL SPACES
2629	MOVE ZEROES TO CDEMO-ACCT-ID
2630	CDEMO-CARD-NUM
2631	MOVE LOW-VALUES TO CDEMO-ACCT-STATUS
2632	END-IF
2633	WHEN OTHER
2634	MOVE LIT-THISPGM TO ABEND-CULPRIT
2635	MOVE '0001' TO ABEND-CODE
2636	MOVE SPACES TO ABEND-REASON
2637	MOVE 'UNEXPECTED DATA SCENARIO'
2638	TO ABEND-MSG
2639	PERFORM ABEND-ROUTINE
2640	THRU ABEND-ROUTINE-EXIT
2641	END-EVALUATE
2642	.
2643	2000-DECIDE-ACTION-EXIT.
2644	EXIT
2645	.
2646
2647
2648
2649	3000-SEND-MAP.
2650	PERFORM 3100-SCREEN-INIT
2651	THRU 3100-SCREEN-INIT-EXIT
2652	PERFORM 3200-SETUP-SCREEN-VARS
2653	THRU 3200-SETUP-SCREEN-VARS-EXIT
2654	PERFORM 3250-SETUP-INFOMSG
2655	THRU 3250-SETUP-INFOMSG-EXIT
2656	PERFORM 3300-SETUP-SCREEN-ATTRS
2657	THRU 3300-SETUP-SCREEN-ATTRS-EXIT
2658	PERFORM 3390-SETUP-INFOMSG-ATTRS
2659	THRU 3390-SETUP-INFOMSG-ATTRS-EXIT
2660	PERFORM 3400-SEND-SCREEN
2661	THRU 3400-SEND-SCREEN-EXIT
2662	.
2663
2664	3000-SEND-MAP-EXIT.
2665	EXIT
2666	.
2667
2668	3100-SCREEN-INIT.
2669	MOVE LOW-VALUES TO CACTUPAO
2670
2671	MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
2672
2673	MOVE CCDA-TITLE01 TO TITLE01O OF CACTUPAO
2674	MOVE CCDA-TITLE02 TO TITLE02O OF CACTUPAO
2675	MOVE LIT-THISTRANID TO TRNNAMEO OF CACTUPAO
2676	MOVE LIT-THISPGM TO PGMNAMEO OF CACTUPAO
2677
2678	MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
2679
2680	MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
2681	MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
2682	MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
2683
2684	MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF CACTUPAO
2685
2686	MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
2687	MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
2688	MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
2689
2690	MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF CACTUPAO
2691
2692	.
2693
2694	3100-SCREEN-INIT-EXIT.
2695	EXIT
2696	.
2697
2698	3200-SETUP-SCREEN-VARS.
2699	* INITIALIZE SEARCH CRITERIA
2700	IF CDEMO-PGM-ENTER
2701	CONTINUE
2702	ELSE
2703	IF CC-ACCT-ID-N = 0
2704	AND FLG-ACCTFILTER-ISVALID
2705	MOVE LOW-VALUES TO ACCTSIDO OF CACTUPAO
2706	ELSE
2707	MOVE CC-ACCT-ID TO ACCTSIDO OF CACTUPAO
2708	END-IF
2709
2710	EVALUATE TRUE
2711	WHEN ACUP-DETAILS-NOT-FETCHED
2712	WHEN CC-ACCT-ID-N = 0
2713	PERFORM 3201-SHOW-INITIAL-VALUES
2714	THRU 3201-SHOW-INITIAL-VALUES-EXIT
2715	WHEN ACUP-SHOW-DETAILS
2716	PERFORM 3202-SHOW-ORIGINAL-VALUES
2717	THRU 3202-SHOW-ORIGINAL-VALUES-EXIT
2718	WHEN ACUP-CHANGES-MADE
2719	PERFORM 3203-SHOW-UPDATED-VALUES
2720	THRU 3203-SHOW-UPDATED-VALUES-EXIT
2721	WHEN OTHER
2722	PERFORM 3202-SHOW-ORIGINAL-VALUES
2723	THRU 3202-SHOW-ORIGINAL-VALUES-EXIT
2724	END-EVALUATE
2725	END-IF
2726	.
2727	3200-SETUP-SCREEN-VARS-EXIT.
2728	EXIT
2729	.
2730
2731	3201-SHOW-INITIAL-VALUES.
2732	MOVE LOW-VALUES TO ACSTTUSO OF CACTUPAO
2733	ACRDLIMO OF CACTUPAO
2734	*Account Limits
2735	ACURBALO OF CACTUPAO
2736	ACSHLIMO OF CACTUPAO
2737	ACRCYCRO OF CACTUPAO
2738	ACRCYDBO OF CACTUPAO
2739	*Account Dates
2740	OPNYEARO OF CACTUPAO
2741	OPNMONO OF CACTUPAO
2742	OPNDAYO OF CACTUPAO
2743	EXPYEARO OF CACTUPAO
2744	EXPMONO OF CACTUPAO
2745	EXPDAYO OF CACTUPAO
2746	RISYEARO OF CACTUPAO
2747	RISMONO OF CACTUPAO
2748	RISDAYO OF CACTUPAO
2749	AADDGRPO OF CACTUPAO
2750	*Customer data
2751	ACSTNUMO OF CACTUPAO
2752	ACTSSN1O OF CACTUPAO
2753	ACTSSN2O OF CACTUPAO
2754	ACTSSN3O OF CACTUPAO
2755	ACSTFCOO OF CACTUPAO
2756	DOBYEARO OF CACTUPAO
2757	DOBMONO OF CACTUPAO
2758	DOBDAYO OF CACTUPAO
2759	ACSFNAMO OF CACTUPAO
2760	ACSMNAMO OF CACTUPAO
2761	ACSLNAMO OF CACTUPAO
2762	*Customer address and contact info
2763	ACSADL1O OF CACTUPAO
2764	ACSADL2O OF CACTUPAO
2765	ACSCITYO OF CACTUPAO
2766	ACSSTTEO OF CACTUPAO
2767	ACSZIPCO OF CACTUPAO
2768	ACSCTRYO OF CACTUPAO
2769
2770	ACSPH1AO OF CACTUPAO
2771	ACSPH1BO OF CACTUPAO
2772	ACSPH1CO OF CACTUPAO
2773	ACSPH2AO OF CACTUPAO
2774	ACSPH2BO OF CACTUPAO
2775	ACSPH2CO OF CACTUPAO
2776
2777	*Customer other good stuff
2778	ACSGOVTO OF CACTUPAO
2779	ACSEFTCO OF CACTUPAO
2780	ACSPFLGO OF CACTUPAO
2781	.
2782
2783	3201-SHOW-INITIAL-VALUES-EXIT.
2784	EXIT
2785	.
2786
2787	3202-SHOW-ORIGINAL-VALUES.
2788
2789	MOVE LOW-VALUES TO WS-NON-KEY-FLAGS
2790
2791	SET PROMPT-FOR-CHANGES TO TRUE
2792
2793	IF FOUND-ACCT-IN-MASTER
2794	OR FOUND-CUST-IN-MASTER
2795	MOVE ACUP-OLD-ACTIVE-STATUS TO ACSTTUSO OF CACTUPAO
2796
2797	MOVE ACUP-OLD-CURR-BAL-N TO WS-EDIT-CURRENCY-9-2-F
2798	MOVE WS-EDIT-CURRENCY-9-2-F TO ACURBALO OF CACTUPAO
2799
2800	MOVE ACUP-OLD-CREDIT-LIMIT-N TO WS-EDIT-CURRENCY-9-2-F
2801	MOVE WS-EDIT-CURRENCY-9-2-F TO ACRDLIMO OF CACTUPAO
2802
2803	MOVE ACUP-OLD-CASH-CREDIT-LIMIT-N
2804	TO WS-EDIT-CURRENCY-9-2-F
2805	MOVE WS-EDIT-CURRENCY-9-2-F TO ACSHLIMO OF CACTUPAO
2806
2807	MOVE ACUP-OLD-CURR-CYC-CREDIT-N TO WS-EDIT-CURRENCY-9-2-F
2808	MOVE WS-EDIT-CURRENCY-9-2-F TO ACRCYCRO OF CACTUPAO
2809
2810	MOVE ACUP-OLD-CURR-CYC-DEBIT-N TO WS-EDIT-CURRENCY-9-2-F
2811	MOVE WS-EDIT-CURRENCY-9-2-F TO ACRCYDBO OF CACTUPAO
2812
2813	MOVE ACUP-OLD-OPEN-YEAR TO OPNYEARO OF CACTUPAO
2814	MOVE ACUP-OLD-OPEN-MON TO OPNMONO OF CACTUPAO
2815	MOVE ACUP-OLD-OPEN-DAY TO OPNDAYO OF CACTUPAO
2816
2817	MOVE ACUP-OLD-EXP-YEAR TO EXPYEARO OF CACTUPAO
2818	MOVE ACUP-OLD-EXP-MON TO EXPMONO OF CACTUPAO
2819	MOVE ACUP-OLD-EXP-DAY TO EXPDAYO OF CACTUPAO
2820
2821	MOVE ACUP-OLD-REISSUE-YEAR TO RISYEARO OF CACTUPAO
2822	MOVE ACUP-OLD-REISSUE-MON TO RISMONO OF CACTUPAO
2823	MOVE ACUP-OLD-REISSUE-DAY TO RISDAYO OF CACTUPAO
2824	MOVE ACUP-OLD-GROUP-ID TO AADDGRPO OF CACTUPAO
2825	END-IF
2826
2827	IF FOUND-CUST-IN-MASTER
2828	MOVE ACUP-OLD-CUST-ID-X TO ACSTNUMO OF CACTUPAO
2829	MOVE ACUP-OLD-CUST-SSN-X(1:3) TO ACTSSN1O OF CACTUPAO
2830	MOVE ACUP-OLD-CUST-SSN-X(4:2) TO ACTSSN2O OF CACTUPAO
2831	MOVE ACUP-OLD-CUST-SSN-X(6:4) TO ACTSSN3O OF CACTUPAO
2832	MOVE ACUP-OLD-CUST-FICO-SCORE-X TO ACSTFCOO OF CACTUPAO
2833	MOVE ACUP-OLD-CUST-DOB-YEAR TO DOBYEARO OF CACTUPAO
2834	MOVE ACUP-OLD-CUST-DOB-MON TO DOBMONO OF CACTUPAO
2835	MOVE ACUP-OLD-CUST-DOB-DAY TO DOBDAYO OF CACTUPAO
2836	MOVE ACUP-OLD-CUST-FIRST-NAME TO ACSFNAMO OF CACTUPAO
2837	MOVE ACUP-OLD-CUST-MIDDLE-NAME TO ACSMNAMO OF CACTUPAO
2838	MOVE ACUP-OLD-CUST-LAST-NAME TO ACSLNAMO OF CACTUPAO
2839	MOVE ACUP-OLD-CUST-ADDR-LINE-1 TO ACSADL1O OF CACTUPAO
2840	MOVE ACUP-OLD-CUST-ADDR-LINE-2 TO ACSADL2O OF CACTUPAO
2841	MOVE ACUP-OLD-CUST-ADDR-LINE-3 TO ACSCITYO OF CACTUPAO
2842	MOVE ACUP-OLD-CUST-ADDR-STATE-CD TO ACSSTTEO OF CACTUPAO
2843	MOVE ACUP-OLD-CUST-ADDR-ZIP TO ACSZIPCO OF CACTUPAO
2844	MOVE ACUP-OLD-CUST-ADDR-COUNTRY-CD
2845	TO ACSCTRYO OF CACTUPAO
2846	MOVE ACUP-OLD-CUST-PHONE-NUM-1(2:3)
2847	TO ACSPH1AO OF CACTUPAO
2848	MOVE ACUP-OLD-CUST-PHONE-NUM-1(6:3)
2849	TO ACSPH1BO OF CACTUPAO
2850	MOVE ACUP-OLD-CUST-PHONE-NUM-1(10:4)
2851	TO ACSPH1CO OF CACTUPAO
2852	MOVE ACUP-OLD-CUST-PHONE-NUM-2(2:3)
2853	TO ACSPH2AO OF CACTUPAO
2854	MOVE ACUP-OLD-CUST-PHONE-NUM-2(6:3)
2855	TO ACSPH2BO OF CACTUPAO
2856	MOVE ACUP-OLD-CUST-PHONE-NUM-2(10:4)
2857	TO ACSPH2CO OF CACTUPAO
2858	MOVE ACUP-OLD-CUST-GOVT-ISSUED-ID
2859	TO ACSGOVTO OF CACTUPAO
2860	MOVE ACUP-OLD-CUST-EFT-ACCOUNT-ID
2861	TO ACSEFTCO OF CACTUPAO
2862	MOVE ACUP-OLD-CUST-PRI-HOLDER-IND
2863	TO ACSPFLGO OF CACTUPAO
2864	END-IF
2865	.
2866
2867	3202-SHOW-ORIGINAL-VALUES-EXIT.
2868	EXIT
2869	.
2870	3203-SHOW-UPDATED-VALUES.
2871
2872	MOVE ACUP-NEW-ACTIVE-STATUS TO ACSTTUSO OF CACTUPAO
2873
2874	IF FLG-CRED-LIMIT-ISVALID
2875	MOVE ACUP-NEW-CREDIT-LIMIT-N TO WS-EDIT-CURRENCY-9-2-F
2876	MOVE WS-EDIT-CURRENCY-9-2-F TO ACRDLIMO OF CACTUPAO
2877	ELSE
2878	MOVE ACUP-NEW-CREDIT-LIMIT-X TO ACRDLIMO OF CACTUPAO
2879	END-IF
2880
2881	IF FLG-CASH-CREDIT-LIMIT-ISVALID
2882	MOVE ACUP-NEW-CASH-CREDIT-LIMIT-N
2883	TO WS-EDIT-CURRENCY-9-2-F
2884	MOVE WS-EDIT-CURRENCY-9-2-F TO ACSHLIMO OF CACTUPAO
2885	ELSE
2886	MOVE ACUP-NEW-CASH-CREDIT-LIMIT-X
2887	TO ACSHLIMO OF CACTUPAO
2888	END-IF
2889
2890	IF FLG-CURR-BAL-ISVALID
2891	MOVE ACUP-NEW-CURR-BAL-N TO WS-EDIT-CURRENCY-9-2-F
2892	MOVE WS-EDIT-CURRENCY-9-2-F TO ACURBALO OF CACTUPAO
2893	ELSE
2894	MOVE ACUP-NEW-CURR-BAL-X TO ACURBALO OF CACTUPAO
2895	END-IF
2896
2897	IF FLG-CURR-CYC-CREDIT-ISVALID
2898	MOVE ACUP-NEW-CURR-CYC-CREDIT-N TO WS-EDIT-CURRENCY-9-2-F
2899	MOVE WS-EDIT-CURRENCY-9-2-F TO ACRCYCRO OF CACTUPAO
2900	ELSE
2901	MOVE ACUP-NEW-CURR-CYC-CREDIT-X TO ACRCYCRO OF CACTUPAO
2902	END-IF
2903
2904	IF FLG-CURR-CYC-DEBIT-ISVALID
2905	MOVE ACUP-NEW-CURR-CYC-DEBIT-N TO WS-EDIT-CURRENCY-9-2-F
2906	MOVE WS-EDIT-CURRENCY-9-2-F TO ACRCYDBO OF CACTUPAO
2907	ELSE
2908	MOVE ACUP-NEW-CURR-CYC-DEBIT-X TO ACRCYDBO OF CACTUPAO
2909	END-IF
2910
2911	MOVE ACUP-NEW-OPEN-YEAR TO OPNYEARO OF CACTUPAO
2912	MOVE ACUP-NEW-OPEN-MON TO OPNMONO OF CACTUPAO
2913	MOVE ACUP-NEW-OPEN-DAY TO OPNDAYO OF CACTUPAO
2914
2915	MOVE ACUP-NEW-EXP-YEAR TO EXPYEARO OF CACTUPAO
2916	MOVE ACUP-NEW-EXP-MON TO EXPMONO OF CACTUPAO
2917	MOVE ACUP-NEW-EXP-DAY TO EXPDAYO OF CACTUPAO
2918	MOVE ACUP-NEW-REISSUE-YEAR TO RISYEARO OF CACTUPAO
2919	MOVE ACUP-NEW-REISSUE-MON TO RISMONO OF CACTUPAO
2920	MOVE ACUP-NEW-REISSUE-DAY TO RISDAYO OF CACTUPAO
2921	MOVE ACUP-NEW-GROUP-ID TO AADDGRPO OF CACTUPAO
2922	MOVE ACUP-NEW-CUST-ID-X TO ACSTNUMO OF CACTUPAO
2923	MOVE ACUP-NEW-CUST-SSN-1 TO ACTSSN1O OF CACTUPAO
2924	MOVE ACUP-NEW-CUST-SSN-2 TO ACTSSN2O OF CACTUPAO
2925	MOVE ACUP-NEW-CUST-SSN-3 TO ACTSSN3O OF CACTUPAO
2926	MOVE ACUP-NEW-CUST-FICO-SCORE-X TO ACSTFCOO OF CACTUPAO
2927	MOVE ACUP-NEW-CUST-DOB-YEAR TO DOBYEARO OF CACTUPAO
2928	MOVE ACUP-NEW-CUST-DOB-MON TO DOBMONO OF CACTUPAO
2929	MOVE ACUP-NEW-CUST-DOB-DAY TO DOBDAYO OF CACTUPAO
2930	MOVE ACUP-NEW-CUST-FIRST-NAME TO ACSFNAMO OF CACTUPAO
2931	MOVE ACUP-NEW-CUST-MIDDLE-NAME TO ACSMNAMO OF CACTUPAO
2932	MOVE ACUP-NEW-CUST-LAST-NAME TO ACSLNAMO OF CACTUPAO
2933	MOVE ACUP-NEW-CUST-ADDR-LINE-1 TO ACSADL1O OF CACTUPAO
2934	MOVE ACUP-NEW-CUST-ADDR-LINE-2 TO ACSADL2O OF CACTUPAO
2935	MOVE ACUP-NEW-CUST-ADDR-LINE-3 TO ACSCITYO OF CACTUPAO
2936	MOVE ACUP-NEW-CUST-ADDR-STATE-CD TO ACSSTTEO OF CACTUPAO
2937	MOVE ACUP-NEW-CUST-ADDR-ZIP TO ACSZIPCO OF CACTUPAO
2938	MOVE ACUP-NEW-CUST-ADDR-COUNTRY-CD TO ACSCTRYO OF CACTUPAO
2939	MOVE ACUP-NEW-CUST-PHONE-NUM-1A TO ACSPH1AO OF CACTUPAO
2940	MOVE ACUP-NEW-CUST-PHONE-NUM-1B TO ACSPH1BO OF CACTUPAO
2941	MOVE ACUP-NEW-CUST-PHONE-NUM-1C TO ACSPH1CO OF CACTUPAO
2942	MOVE ACUP-NEW-CUST-PHONE-NUM-2A TO ACSPH2AO OF CACTUPAO
2943	MOVE ACUP-NEW-CUST-PHONE-NUM-2B TO ACSPH2BO OF CACTUPAO
2944	MOVE ACUP-NEW-CUST-PHONE-NUM-2C TO ACSPH2CO OF CACTUPAO
2945	MOVE ACUP-NEW-CUST-GOVT-ISSUED-ID TO ACSGOVTO OF CACTUPAO
2946	MOVE ACUP-NEW-CUST-EFT-ACCOUNT-ID TO ACSEFTCO OF CACTUPAO
2947	MOVE ACUP-NEW-CUST-PRI-HOLDER-IND TO ACSPFLGO OF CACTUPAO
2948
2949	.
2950
2951	3203-SHOW-UPDATED-VALUES-EXIT.
2952	EXIT
2953	.
2954
2955	3250-SETUP-INFOMSG.
2956	* SETUP INFORMATION MESSAGE
2957	EVALUATE TRUE
2958	WHEN CDEMO-PGM-ENTER
2959	SET PROMPT-FOR-SEARCH-KEYS TO TRUE
2960	WHEN ACUP-DETAILS-NOT-FETCHED
2961	SET PROMPT-FOR-SEARCH-KEYS TO TRUE
2962	WHEN ACUP-SHOW-DETAILS
2963	SET PROMPT-FOR-CHANGES TO TRUE
2964	WHEN ACUP-CHANGES-NOT-OK
2965	SET PROMPT-FOR-CHANGES TO TRUE
2966	WHEN ACUP-CHANGES-OK-NOT-CONFIRMED
2967	SET PROMPT-FOR-CONFIRMATION TO TRUE
2968	WHEN ACUP-CHANGES-OKAYED-AND-DONE
2969	SET CONFIRM-UPDATE-SUCCESS TO TRUE
2970
2971	WHEN ACUP-CHANGES-OKAYED-LOCK-ERROR
2972	SET INFORM-FAILURE TO TRUE
2973	WHEN ACUP-CHANGES-OKAYED-BUT-FAILED
2974	SET INFORM-FAILURE TO TRUE
2975	WHEN WS-NO-INFO-MESSAGE
2976	SET PROMPT-FOR-SEARCH-KEYS TO TRUE
2977	END-EVALUATE
2978
2979	MOVE WS-INFO-MSG TO INFOMSGO OF CACTUPAO
2980
2981	MOVE WS-RETURN-MSG TO ERRMSGO OF CACTUPAO
2982	.
2983	3250-SETUP-INFOMSG-EXIT.
2984	EXIT
2985	.
2986	3300-SETUP-SCREEN-ATTRS.
2987
2988	* PROTECT ALL FIELDS
2989	PERFORM 3310-PROTECT-ALL-ATTRS
2990	THRU 3310-PROTECT-ALL-ATTRS-EXIT
2991
2992	* UNPROTECT BASED ON CONTEXT
2993	EVALUATE TRUE
2994	WHEN ACUP-DETAILS-NOT-FETCHED
2995	* Make Account Id editable
2996	MOVE DFHBMFSE TO ACCTSIDA OF CACTUPAI
2997	WHEN ACUP-SHOW-DETAILS
2998	WHEN ACUP-CHANGES-NOT-OK
2999	PERFORM 3320-UNPROTECT-FEW-ATTRS
3000	THRU 3320-UNPROTECT-FEW-ATTRS-EXIT
3001	WHEN ACUP-CHANGES-OK-NOT-CONFIRMED
3002	WHEN ACUP-CHANGES-OKAYED-AND-DONE
3003	CONTINUE
3004	WHEN OTHER
3005	MOVE DFHBMFSE TO ACCTSIDA OF CACTUPAI
3006	END-EVALUATE
3007
3008	* POSITION CURSOR - ORDER BASED ON SCREEN LOCATION
3009	EVALUATE TRUE
3010	WHEN FOUND-ACCOUNT-DATA
3011	WHEN NO-CHANGES-DETECTED
3012	MOVE -1 TO ACSTTUSL OF CACTUPAI
3013	WHEN FLG-ACCTFILTER-NOT-OK
3014	WHEN FLG-ACCTFILTER-BLANK
3015	MOVE -1 TO ACCTSIDL OF CACTUPAI
3016	* Account Status
3017	WHEN FLG-ACCT-STATUS-NOT-OK
3018	WHEN FLG-ACCT-STATUS-BLANK
3019	MOVE -1 TO ACSTTUSL OF CACTUPAI
3020	* Open Year
3021	WHEN FLG-OPEN-YEAR-NOT-OK
3022	WHEN FLG-OPEN-YEAR-BLANK
3023	MOVE -1 TO OPNYEARL OF CACTUPAI
3024	* Open Month
3025	WHEN FLG-OPEN-MONTH-NOT-OK
3026	WHEN FLG-OPEN-MONTH-BLANK
3027	MOVE -1 TO OPNMONL OF CACTUPAI
3028	* Open Day
3029	WHEN FLG-OPEN-DAY-NOT-OK
3030	WHEN FLG-OPEN-DAY-BLANK
3031	MOVE -1 TO OPNDAYL OF CACTUPAI
3032	* Credit Limit
3033	WHEN FLG-CRED-LIMIT-NOT-OK
3034	WHEN FLG-CRED-LIMIT-BLANK
3035	MOVE -1 TO ACRDLIML OF CACTUPAI
3036	* Expiry Year
3037	WHEN FLG-EXPIRY-YEAR-NOT-OK
3038	WHEN FLG-EXPIRY-YEAR-BLANK
3039	MOVE -1 TO EXPYEARL OF CACTUPAI
3040	* Expiry Month
3041	WHEN FLG-EXPIRY-MONTH-NOT-OK
3042	WHEN FLG-EXPIRY-MONTH-BLANK
3043	MOVE -1 TO EXPMONL OF CACTUPAI
3044	* Expiry Day
3045	WHEN FLG-EXPIRY-DAY-NOT-OK
3046	WHEN FLG-EXPIRY-DAY-BLANK
3047	MOVE -1 TO EXPDAYL OF CACTUPAI
3048	* Cash credit limit
3049	WHEN FLG-CASH-CREDIT-LIMIT-NOT-OK
3050	WHEN FLG-CASH-CREDIT-LIMIT-BLANK
3051	MOVE -1 TO ACSHLIML OF CACTUPAI
3052	* Reissue Year
3053	WHEN FLG-REISSUE-YEAR-NOT-OK
3054	WHEN FLG-REISSUE-YEAR-BLANK
3055	MOVE -1 TO RISYEARL OF CACTUPAI
3056	* Expiry Month
3057	WHEN FLG-REISSUE-MONTH-NOT-OK
3058	WHEN FLG-REISSUE-MONTH-BLANK
3059	MOVE -1 TO RISMONL OF CACTUPAI
3060	* Expiry Day
3061	WHEN FLG-REISSUE-DAY-NOT-OK
3062	WHEN FLG-REISSUE-DAY-BLANK
3063	MOVE -1 TO RISDAYL OF CACTUPAI
3064
3065	* Current Balance
3066	WHEN FLG-CURR-BAL-NOT-OK
3067	WHEN FLG-CURR-BAL-BLANK
3068	MOVE -1 TO ACURBALL OF CACTUPAI
3069	* Current Cycle Credit
3070	WHEN FLG-CURR-CYC-CREDIT-NOT-OK
3071	WHEN FLG-CURR-CYC-CREDIT-BLANK
3072	MOVE -1 TO ACRCYCRL OF CACTUPAI
3073	* Current Cycle Debit
3074	WHEN FLG-CURR-CYC-DEBIT-NOT-OK
3075	WHEN FLG-CURR-CYC-DEBIT-BLANK
3076	MOVE -1 TO ACRCYDBL OF CACTUPAI
3077	* SSN Part 1
3078	WHEN FLG-EDIT-US-SSN-PART1-NOT-OK
3079	WHEN FLG-EDIT-US-SSN-PART1-BLANK
3080	MOVE -1 TO ACTSSN1L OF CACTUPAI
3081	* SSN Part 2
3082	WHEN FLG-EDIT-US-SSN-PART2-NOT-OK
3083	WHEN FLG-EDIT-US-SSN-PART2-BLANK
3084	MOVE -1 TO ACTSSN2L OF CACTUPAI
3085	* SSN Part 3
3086	WHEN FLG-EDIT-US-SSN-PART3-NOT-OK
3087	WHEN FLG-EDIT-US-SSN-PART3-BLANK
3088	MOVE -1 TO ACTSSN3L OF CACTUPAI
3089	* Date of Birth Year
3090	WHEN FLG-DT-OF-BIRTH-YEAR-NOT-OK
3091	WHEN FLG-DT-OF-BIRTH-YEAR-BLANK
3092	MOVE -1 TO DOBYEARL OF CACTUPAI
3093	* Date of Birth Month
3094	WHEN FLG-DT-OF-BIRTH-MONTH-NOT-OK
3095	WHEN FLG-DT-OF-BIRTH-MONTH-BLANK
3096	MOVE -1 TO DOBMONL OF CACTUPAI
3097	* Date of Birth Day
3098	WHEN FLG-DT-OF-BIRTH-DAY-NOT-OK
3099	WHEN FLG-DT-OF-BIRTH-DAY-BLANK
3100	MOVE -1 TO DOBDAYL OF CACTUPAI
3101	* FICO Score
3102	WHEN FLG-FICO-SCORE-NOT-OK
3103	WHEN FLG-FICO-SCORE-BLANK
3104	MOVE -1 TO ACSTFCOL OF CACTUPAI
3105	* First Name
3106	WHEN FLG-FIRST-NAME-NOT-OK
3107	WHEN FLG-FIRST-NAME-BLANK
3108	MOVE -1 TO ACSFNAML OF CACTUPAI
3109	* Middle Name
3110	WHEN FLG-MIDDLE-NAME-NOT-OK
3111	MOVE -1 TO ACSMNAML OF CACTUPAI
3112	* Last Name
3113	WHEN FLG-LAST-NAME-NOT-OK
3114	WHEN FLG-LAST-NAME-BLANK
3115	MOVE -1 TO ACSLNAML OF CACTUPAI
3116	* Address Line 1
3117	WHEN FLG-ADDRESS-LINE-1-NOT-OK
3118	WHEN FLG-ADDRESS-LINE-1-BLANK
3119	MOVE -1 TO ACSADL1L OF CACTUPAI
3120	* State (appears next to Line 2 on screen before city)
3121	WHEN FLG-STATE-NOT-OK
3122	WHEN FLG-STATE-BLANK
3123	MOVE -1 TO ACSSTTEL OF CACTUPAI
3124	* Address Line 2 has no edits
3125	* Zip code
3126	WHEN FLG-ZIPCODE-NOT-OK
3127	WHEN FLG-ZIPCODE-BLANK
3128	MOVE -1 TO ACSZIPCL OF CACTUPAI
3129	* Address Line 3 (City)
3130	WHEN FLG-CITY-NOT-OK
3131	WHEN FLG-CITY-BLANK
3132	MOVE -1 TO ACSCITYL OF CACTUPAI
3133	* Country edits.
3134	WHEN FLG-COUNTRY-NOT-OK
3135	WHEN FLG-COUNTRY-BLANK
3136	MOVE -1 TO ACSCTRYL OF CACTUPAI
3137	* Phone 1
3138	WHEN FLG-PHONE-NUM-1A-NOT-OK
3139	WHEN FLG-PHONE-NUM-1A-BLANK
3140	MOVE -1 TO ACSPH1AL OF CACTUPAI
3141	WHEN FLG-PHONE-NUM-1B-NOT-OK
3142	WHEN FLG-PHONE-NUM-1B-BLANK
3143	MOVE -1 TO ACSPH1BL OF CACTUPAI
3144	WHEN FLG-PHONE-NUM-1C-NOT-OK
3145	WHEN FLG-PHONE-NUM-1C-BLANK
3146	MOVE -1 TO ACSPH1CL OF CACTUPAI
3147	* Phone 2
3148	WHEN FLG-PHONE-NUM-2A-NOT-OK
3149	WHEN FLG-PHONE-NUM-2A-BLANK
3150	MOVE -1 TO ACSPH2AL OF CACTUPAI
3151	WHEN FLG-PHONE-NUM-2B-NOT-OK
3152	WHEN FLG-PHONE-NUM-2B-BLANK
3153	MOVE -1 TO ACSPH2BL OF CACTUPAI
3154	WHEN FLG-PHONE-NUM-2C-NOT-OK
3155	WHEN FLG-PHONE-NUM-2C-BLANK
3156	MOVE -1 TO ACSPH2CL OF CACTUPAI
3157	* EFT Account Id
3158	WHEN FLG-EFT-ACCOUNT-ID-NOT-OK
3159	WHEN FLG-EFT-ACCOUNT-ID-BLANK
3160	MOVE -1 TO ACSEFTCL OF CACTUPAI
3161	* Primary Card Holder
3162	WHEN FLG-PRI-CARDHOLDER-NOT-OK
3163	WHEN FLG-PRI-CARDHOLDER-BLANK
3164	MOVE -1 TO ACSPFLGL OF CACTUPAI
3165	WHEN OTHER
3166	MOVE -1 TO ACCTSIDL OF CACTUPAI
3167	END-EVALUATE
3168
3169
3170	* SETUP COLOR
3171	IF CDEMO-LAST-MAPSET EQUAL LIT-CCLISTMAPSET
3172	MOVE DFHDFCOL TO ACCTSIDC OF CACTUPAO
3173	END-IF
3174
3175	* Account Filter
3176	IF FLG-ACCTFILTER-NOT-OK
3177	MOVE DFHRED TO ACCTSIDC OF CACTUPAO
3178	END-IF
3179
3180	IF FLG-ACCTFILTER-BLANK
3181	AND CDEMO-PGM-REENTER
3182	MOVE '*' TO ACCTSIDO OF CACTUPAO
3183	MOVE DFHRED TO ACCTSIDC OF CACTUPAO
3184	END-IF
3185
3186	IF ACUP-DETAILS-NOT-FETCHED
3187	OR FLG-ACCTFILTER-BLANK
3188	OR FLG-ACCTFILTER-NOT-OK
3189	GO TO 3300-SETUP-SCREEN-ATTRS-EXIT
3190	ELSE
3191	CONTINUE
3192	END-IF
3193
3194	******************************************************************
3195	* Using Copy replacing to set attribs for remaining vars
3196	* Write specific code only if rules differ
3197	******************************************************************
3198	* IF (FLG-ACCT-STATUS-NOT-OK
3199	* OR FLG-ACCT-STATUS-BLANK)
3200	* AND CDEMO-PGM-REENTER
3201	* MOVE DFHRED TO ACSTTUSC OF CACTUPAO
3202	* IF FLG-ACCT-STATUS-BLANK
3203	* MOVE '*' TO ACSTTUSO OF CACTUPAO
3204	* END-IF
3205	* END-IF
3206
3207	* Account Status
3208	COPY CSSETATY REPLACING
3209	==(TESTVAR1)== BY ==ACCT-STATUS==
3210	==(SCRNVAR2)== BY ==ACSTTUS==
3211	==(MAPNAME3)== BY ==CACTUPA== .
3212
3213	* Open Year
3214	COPY CSSETATY REPLACING
3215	==(TESTVAR1)== BY ==OPEN-YEAR==
3216	==(SCRNVAR2)== BY ==OPNYEAR==
3217	==(MAPNAME3)== BY ==CACTUPA== .
3218
3219	* Open Month
3220	COPY CSSETATY REPLACING
3221	==(TESTVAR1)== BY ==OPEN-MONTH==
3222	==(SCRNVAR2)== BY ==OPNMON==
3223	==(MAPNAME3)== BY ==CACTUPA== .
3224
3225	* Open Day
3226	COPY CSSETATY REPLACING
3227	==(TESTVAR1)== BY ==OPEN-DAY==
3228	==(SCRNVAR2)== BY ==OPNDAY==
3229	==(MAPNAME3)== BY ==CACTUPA== .
3230
3231	* Credit Limit
3232	COPY CSSETATY REPLACING
3233	==(TESTVAR1)== BY ==CRED-LIMIT==
3234	==(SCRNVAR2)== BY ==ACRDLIM==
3235	==(MAPNAME3)== BY ==CACTUPA== .
3236
3237	* Expiry Year
3238	COPY CSSETATY REPLACING
3239	==(TESTVAR1)== BY ==EXPIRY-YEAR==
3240	==(SCRNVAR2)== BY ==EXPYEAR==
3241	==(MAPNAME3)== BY ==CACTUPA== .
3242
3243	* Expiry Month
3244	COPY CSSETATY REPLACING
3245	==(TESTVAR1)== BY ==EXPIRY-MONTH==
3246	==(SCRNVAR2)== BY ==EXPMON==
3247	==(MAPNAME3)== BY ==CACTUPA== .
3248
3249	* Expiry Day
3250	COPY CSSETATY REPLACING
3251	==(TESTVAR1)== BY ==EXPIRY-DAY==
3252	==(SCRNVAR2)== BY ==EXPDAY==
3253	==(MAPNAME3)== BY ==CACTUPA== .
3254
3255	* Cash Credit Limit
3256	COPY CSSETATY REPLACING
3257	==(TESTVAR1)== BY ==CASH-CREDIT-LIMIT==
3258	==(SCRNVAR2)== BY ==ACSHLIM==
3259	==(MAPNAME3)== BY ==CACTUPA== .
3260
3261	* Reissue Year
3262	COPY CSSETATY REPLACING
3263	==(TESTVAR1)== BY ==REISSUE-YEAR==
3264	==(SCRNVAR2)== BY ==RISYEAR==
3265	==(MAPNAME3)== BY ==CACTUPA== .
3266
3267	* Reissue Month
3268	COPY CSSETATY REPLACING
3269	==(TESTVAR1)== BY ==REISSUE-MONTH==
3270	==(SCRNVAR2)== BY ==RISMON==
3271	==(MAPNAME3)== BY ==CACTUPA== .
3272
3273	* Reissue Day
3274	COPY CSSETATY REPLACING
3275	==(TESTVAR1)== BY ==REISSUE-DAY==
3276	==(SCRNVAR2)== BY ==RISDAY==
3277	==(MAPNAME3)== BY ==CACTUPA== .
3278
3279	* Current Balance
3280	COPY CSSETATY REPLACING
3281	==(TESTVAR1)== BY ==CURR-BAL==
3282	==(SCRNVAR2)== BY ==ACURBAL==
3283	==(MAPNAME3)== BY ==CACTUPA== .
3284
3285	* Current Cycle Credit
3286	COPY CSSETATY REPLACING
3287	==(TESTVAR1)== BY ==CURR-CYC-CREDIT==
3288	==(SCRNVAR2)== BY ==ACRCYCR==
3289	==(MAPNAME3)== BY ==CACTUPA== .
3290
3291	* Current Cycle Debit
3292	COPY CSSETATY REPLACING
3293	==(TESTVAR1)== BY ==CURR-CYC-DEBIT==
3294	==(SCRNVAR2)== BY ==ACRCYDB==
3295	==(MAPNAME3)== BY ==CACTUPA== .
3296
3297	* SSN Part 1
3298	COPY CSSETATY REPLACING
3299	==(TESTVAR1)== BY ==EDIT-US-SSN-PART1==
3300	==(SCRNVAR2)== BY ==ACTSSN1==
3301	==(MAPNAME3)== BY ==CACTUPA== .
3302
3303	* SSN Part 2
3304	COPY CSSETATY REPLACING
3305	==(TESTVAR1)== BY ==EDIT-US-SSN-PART2==
3306	==(SCRNVAR2)== BY ==ACTSSN2==
3307	==(MAPNAME3)== BY ==CACTUPA== .
3308
3309	* SSN Part 3
3310	COPY CSSETATY REPLACING
3311	==(TESTVAR1)== BY ==EDIT-US-SSN-PART3==
3312	==(SCRNVAR2)== BY ==ACTSSN3==
3313	==(MAPNAME3)== BY ==CACTUPA== .
3314
3315	* Date of Birth Year
3316	COPY CSSETATY REPLACING
3317	==(TESTVAR1)== BY ==DT-OF-BIRTH-YEAR==
3318	==(SCRNVAR2)== BY ==DOBYEAR==
3319	==(MAPNAME3)== BY ==CACTUPA== .
3320
3321	* Date of Birth Month
3322	COPY CSSETATY REPLACING
3323	==(TESTVAR1)== BY ==DT-OF-BIRTH-MONTH==
3324	==(SCRNVAR2)== BY ==DOBMON==
3325	==(MAPNAME3)== BY ==CACTUPA== .
3326
3327	* Date of Birth Day
3328	COPY CSSETATY REPLACING
3329	==(TESTVAR1)== BY ==DT-OF-BIRTH-DAY==
3330	==(SCRNVAR2)== BY ==DOBDAY==
3331	==(MAPNAME3)== BY ==CACTUPA== .
3332
3333	* FICO Score
3334	COPY CSSETATY REPLACING
3335	==(TESTVAR1)== BY ==FICO-SCORE==
3336	==(SCRNVAR2)== BY ==ACSTFCO==
3337	==(MAPNAME3)== BY ==CACTUPA== .
3338
3339	* First Name
3340	COPY CSSETATY REPLACING
3341	==(TESTVAR1)== BY ==FIRST-NAME==
3342	==(SCRNVAR2)== BY ==ACSFNAM==
3343	==(MAPNAME3)== BY ==CACTUPA== .
3344
3345	* Middle Name (no edits coded)
3346	COPY CSSETATY REPLACING
3347	==(TESTVAR1)== BY ==MIDDLE-NAME==
3348	==(SCRNVAR2)== BY ==ACSMNAM==
3349	==(MAPNAME3)== BY ==CACTUPA== .
3350
3351	* Last Name
3352	COPY CSSETATY REPLACING
3353	==(TESTVAR1)== BY ==LAST-NAME==
3354	==(SCRNVAR2)== BY ==ACSLNAM==
3355	==(MAPNAME3)== BY ==CACTUPA== .
3356
3357	* Address Line 1
3358	COPY CSSETATY REPLACING
3359	==(TESTVAR1)== BY ==ADDRESS-LINE-1==
3360	==(SCRNVAR2)== BY ==ACSADL1==
3361	==(MAPNAME3)== BY ==CACTUPA== .
3362
3363	* State
3364	COPY CSSETATY REPLACING
3365	==(TESTVAR1)== BY ==STATE==
3366	==(SCRNVAR2)== BY ==ACSSTTE==
3367	==(MAPNAME3)== BY ==CACTUPA== .
3368
3369	* Address Line 2 (NO EDITS CODED AS YET)
3370	COPY CSSETATY REPLACING
3371	==(TESTVAR1)== BY ==ADDRESS-LINE-2==
3372	==(SCRNVAR2)== BY ==ACSADL2==
3373	==(MAPNAME3)== BY ==CACTUPA== .
3374
3375	* State
3376	COPY CSSETATY REPLACING
3377	==(TESTVAR1)== BY ==ZIPCODE==
3378	==(SCRNVAR2)== BY ==ACSZIPC==
3379	==(MAPNAME3)== BY ==CACTUPA== .
3380
3381	* City
3382	COPY CSSETATY REPLACING
3383	==(TESTVAR1)== BY ==CITY==
3384	==(SCRNVAR2)== BY ==ACSCITY==
3385	==(MAPNAME3)== BY ==CACTUPA== .
3386
3387	* Country
3388	COPY CSSETATY REPLACING
3389	==(TESTVAR1)== BY ==COUNTRY==
3390	==(SCRNVAR2)== BY ==ACSCTRY==
3391	==(MAPNAME3)== BY ==CACTUPA== .
3392
3393	* Phone 1 Area Code
3394	COPY CSSETATY REPLACING
3395	==(TESTVAR1)== BY ==PHONE-NUM-1A==
3396	==(SCRNVAR2)== BY ==ACSPH1A==
3397	==(MAPNAME3)== BY ==CACTUPA== .
3398
3399	* Phone 1 Prefix
3400	COPY CSSETATY REPLACING
3401	==(TESTVAR1)== BY ==PHONE-NUM-1B==
3402	==(SCRNVAR2)== BY ==ACSPH1B==
3403	==(MAPNAME3)== BY ==CACTUPA== .
3404	* Phone 1 Line number
3405	COPY CSSETATY REPLACING
3406	==(TESTVAR1)== BY ==PHONE-NUM-1C==
3407	==(SCRNVAR2)== BY ==ACSPH1C==
3408	==(MAPNAME3)== BY ==CACTUPA== .
3409
3410	* Phone 2 Area Code
3411	COPY CSSETATY REPLACING
3412	==(TESTVAR1)== BY ==PHONE-NUM-2A==
3413	==(SCRNVAR2)== BY ==ACSPH2A==
3414	==(MAPNAME3)== BY ==CACTUPA== .
3415
3416	* Phone 2 Prefix
3417	COPY CSSETATY REPLACING
3418	==(TESTVAR1)== BY ==PHONE-NUM-2B==
3419	==(SCRNVAR2)== BY ==ACSPH2B==
3420	==(MAPNAME3)== BY ==CACTUPA== .
3421	* Phone 2 Line number
3422	COPY CSSETATY REPLACING
3423	==(TESTVAR1)== BY ==PHONE-NUM-2C==
3424	==(SCRNVAR2)== BY ==ACSPH2C==
3425	==(MAPNAME3)== BY ==CACTUPA== .
3426	* EFT Account Id
3427	COPY CSSETATY REPLACING
3428	==(TESTVAR1)== BY ==PRI-CARDHOLDER==
3429	==(SCRNVAR2)== BY ==ACSPFLG==
3430	==(MAPNAME3)== BY ==CACTUPA== .
3431	* Primary Card Holder
3432	COPY CSSETATY REPLACING
3433	==(TESTVAR1)== BY ==EFT-ACCOUNT-ID==
3434	==(SCRNVAR2)== BY ==ACSEFTC==
3435	==(MAPNAME3)== BY ==CACTUPA== .
3436	.
3437	3300-SETUP-SCREEN-ATTRS-EXIT.
3438	EXIT
3439	.
3440
3441	3310-PROTECT-ALL-ATTRS.
3442	MOVE DFHBMPRF TO ACCTSIDA OF CACTUPAI
3443	ACSTTUSA OF CACTUPAI
3444	*Account Limits
3445	ACRDLIMA OF CACTUPAI
3446	ACSHLIMA OF CACTUPAI
3447	ACURBALA OF CACTUPAI
3448	ACRCYCRA OF CACTUPAI
3449	ACRCYDBA OF CACTUPAI
3450	*Account dates
3451	OPNYEARA OF CACTUPAI
3452	OPNMONA OF CACTUPAI
3453	OPNDAYA OF CACTUPAI
3454	EXPYEARA OF CACTUPAI
3455	EXPMONA OF CACTUPAI
3456	EXPDAYA OF CACTUPAI
3457	RISYEARA OF CACTUPAI
3458	RISMONA OF CACTUPAI
3459	RISDAYA OF CACTUPAI
3460
3461	AADDGRPA OF CACTUPAI
3462	*Customer data
3463	ACSTNUMA OF CACTUPAI
3464	ACTSSN1A OF CACTUPAI
3465	ACTSSN2A OF CACTUPAI
3466	ACTSSN3A OF CACTUPAI
3467	ACSTFCOA OF CACTUPAI
3468	*Date of Birth
3469	DOBYEARA OF CACTUPAI
3470	DOBMONA OF CACTUPAI
3471	DOBDAYA OF CACTUPAI
3472
3473	ACSFNAMA OF CACTUPAI
3474	ACSMNAMA OF CACTUPAI
3475	ACSLNAMA OF CACTUPAI
3476	*Address
3477	ACSADL1A OF CACTUPAI
3478	ACSADL2A OF CACTUPAI
3479	ACSCITYA OF CACTUPAI
3480	ACSSTTEA OF CACTUPAI
3481	ACSZIPCA OF CACTUPAI
3482	ACSCTRYA OF CACTUPAI
3483
3484	ACSPH1AA OF CACTUPAI
3485	ACSPH1BA OF CACTUPAI
3486	ACSPH1CA OF CACTUPAI
3487	ACSPH2AA OF CACTUPAI
3488	ACSPH2BA OF CACTUPAI
3489	ACSPH2CA OF CACTUPAI
3490
3491	ACSGOVTA OF CACTUPAI
3492	ACSEFTCA OF CACTUPAI
3493	ACSPFLGA OF CACTUPAI
3494	INFOMSGA OF CACTUPAI
3495	.
3496	3310-PROTECT-ALL-ATTRS-EXIT.
3497	EXIT
3498	.
3499
3500	3320-UNPROTECT-FEW-ATTRS.
3501
3502	MOVE DFHBMFSE TO ACSTTUSA OF CACTUPAI
3503	*Account Limits
3504	ACRDLIMA OF CACTUPAI
3505	ACSHLIMA OF CACTUPAI
3506	ACURBALA OF CACTUPAI
3507	ACRCYCRA OF CACTUPAI
3508	ACRCYDBA OF CACTUPAI
3509	*Account dates
3510	*Open Date
3511	OPNYEARA OF CACTUPAI
3512	OPNMONA OF CACTUPAI
3513	OPNDAYA OF CACTUPAI
3514	*Expiry date
3515	EXPYEARA OF CACTUPAI
3516	EXPMONA OF CACTUPAI
3517	EXPDAYA OF CACTUPAI
3518	*Reissue date
3519	RISYEARA OF CACTUPAI
3520	RISMONA OF CACTUPAI
3521	RISDAYA OF CACTUPAI
3522	*Date of Birth
3523	DOBYEARA OF CACTUPAI
3524	DOBMONA OF CACTUPAI
3525	DOBDAYA OF CACTUPAI
3526
3527
3528
3529	AADDGRPA OF CACTUPAI
3530	*Customer data
3531	MOVE DFHBMPRF TO ACSTNUMA OF CACTUPAI
3532	MOVE DFHBMFSE TO ACTSSN1A OF CACTUPAI
3533	ACTSSN2A OF CACTUPAI
3534	ACTSSN3A OF CACTUPAI
3535	ACSTFCOA OF CACTUPAI
3536
3537	ACSFNAMA OF CACTUPAI
3538	ACSMNAMA OF CACTUPAI
3539	ACSLNAMA OF CACTUPAI
3540	*Address
3541	ACSADL1A OF CACTUPAI
3542	ACSADL2A OF CACTUPAI
3543	ACSCITYA OF CACTUPAI
3544	ACSSTTEA OF CACTUPAI
3545	ACSZIPCA OF CACTUPAI
3546	*Since most of the edits are USA specific protected country
3547	MOVE DFHBMPRF TO ACSCTRYA OF CACTUPAI
3548
3549	MOVE DFHBMFSE TO ACSPH1AA OF CACTUPAI
3550	ACSPH1BA OF CACTUPAI
3551	ACSPH1CA OF CACTUPAI
3552
3553	MOVE DFHBMFSE TO ACSPH2AA OF CACTUPAI
3554	ACSPH2BA OF CACTUPAI
3555	ACSPH2CA OF CACTUPAI
3556
3557	ACSGOVTA OF CACTUPAI
3558	ACSEFTCA OF CACTUPAI
3559	ACSPFLGA OF CACTUPAI
3560	MOVE DFHBMPRF TO INFOMSGA OF CACTUPAI
3561	.
3562	3320-UNPROTECT-FEW-ATTRS-EXIT.
3563	EXIT
3564	.
3565
3566	3390-SETUP-INFOMSG-ATTRS.
3567	IF WS-NO-INFO-MESSAGE
3568	MOVE DFHBMDAR TO INFOMSGA OF CACTUPAI
3569	ELSE
3570	MOVE DFHBMASB TO INFOMSGA OF CACTUPAI
3571	END-IF
3572
3573	IF ACUP-CHANGES-MADE
3574	AND NOT ACUP-CHANGES-OKAYED-AND-DONE
3575	MOVE DFHBMASB TO FKEY12A OF CACTUPAI
3576	END-IF
3577
3578	IF PROMPT-FOR-CONFIRMATION
3579	MOVE DFHBMASB TO FKEY05A OF CACTUPAI
3580	MOVE DFHBMASB TO FKEY12A OF CACTUPAI
3581	END-IF
3582
3583	.
3584	3390-SETUP-INFOMSG-ATTRS-EXIT.
3585	EXIT
3586	.
3587
3588
3589	3400-SEND-SCREEN.
3590
3591	MOVE LIT-THISMAPSET TO CCARD-NEXT-MAPSET
3592	MOVE LIT-THISMAP TO CCARD-NEXT-MAP
3593
3594	EXEC CICS SEND MAP(CCARD-NEXT-MAP)
3595	MAPSET(CCARD-NEXT-MAPSET)
3596	FROM(CACTUPAO)
3597	CURSOR
3598	ERASE
3599	FREEKB
3600	RESP(WS-RESP-CD)
3601	END-EXEC
3602	.
3603	3400-SEND-SCREEN-EXIT.
3604	EXIT
3605	.
3606
3607
3608	9000-READ-ACCT.
3609
3610	INITIALIZE ACUP-OLD-DETAILS
3611
3612	SET WS-NO-INFO-MESSAGE TO TRUE
3613
3614	MOVE CC-ACCT-ID TO ACUP-OLD-ACCT-ID
3615	WS-CARD-RID-ACCT-ID
3616
3617	PERFORM 9200-GETCARDXREF-BYACCT
3618	THRU 9200-GETCARDXREF-BYACCT-EXIT
3619
3620	IF FLG-ACCTFILTER-NOT-OK
3621	GO TO 9000-READ-ACCT-EXIT
3622	END-IF
3623
3624	PERFORM 9300-GETACCTDATA-BYACCT
3625	THRU 9300-GETACCTDATA-BYACCT-EXIT
3626
3627	IF DID-NOT-FIND-ACCT-IN-ACCTDAT
3628	GO TO 9000-READ-ACCT-EXIT
3629	END-IF
3630
3631	MOVE CDEMO-CUST-ID TO WS-CARD-RID-CUST-ID
3632
3633	PERFORM 9400-GETCUSTDATA-BYCUST
3634	THRU 9400-GETCUSTDATA-BYCUST-EXIT
3635
3636	IF DID-NOT-FIND-CUST-IN-CUSTDAT
3637	GO TO 9000-READ-ACCT-EXIT
3638	END-IF
3639
3640
3641
3642	PERFORM 9500-STORE-FETCHED-DATA
3643	THRU 9500-STORE-FETCHED-DATA-EXIT
3644	.
3645
3646
3647	9000-READ-ACCT-EXIT.
3648	EXIT
3649	.
3650	9200-GETCARDXREF-BYACCT.
3651
3652	* Read the Card file. Access via alternate index ACCTID
3653	*
3654	EXEC CICS READ
3655	DATASET (LIT-CARDXREFNAME-ACCT-PATH)
3656	RIDFLD (WS-CARD-RID-ACCT-ID-X)
3657	KEYLENGTH (LENGTH OF WS-CARD-RID-ACCT-ID-X)
3658	INTO (CARD-XREF-RECORD)
3659	LENGTH (LENGTH OF CARD-XREF-RECORD)
3660	RESP (WS-RESP-CD)
3661	RESP2 (WS-REAS-CD)
3662	END-EXEC
3663
3664	EVALUATE WS-RESP-CD
3665	WHEN DFHRESP(NORMAL)
3666	MOVE XREF-CUST-ID TO CDEMO-CUST-ID
3667	MOVE XREF-CARD-NUM TO CDEMO-CARD-NUM
3668	WHEN DFHRESP(NOTFND)
3669	SET INPUT-ERROR TO TRUE
3670	SET FLG-ACCTFILTER-NOT-OK TO TRUE
3671	IF WS-RETURN-MSG-OFF
3672	MOVE WS-RESP-CD TO ERROR-RESP
3673	MOVE WS-REAS-CD TO ERROR-RESP2
3674	STRING
3675	'Account:'
3676	WS-CARD-RID-ACCT-ID-X
3677	' not found in'
3678	' Cross ref file. Resp:'
3679	ERROR-RESP
3680	' Reas:'
3681	ERROR-RESP2
3682	DELIMITED BY SIZE
3683	INTO WS-RETURN-MSG
3684	END-STRING
3685	END-IF
3686	WHEN OTHER
3687	SET INPUT-ERROR TO TRUE
3688	SET FLG-ACCTFILTER-NOT-OK TO TRUE
3689	MOVE 'READ' TO ERROR-OPNAME
3690	MOVE LIT-CARDXREFNAME-ACCT-PATH TO ERROR-FILE
3691	MOVE WS-RESP-CD TO ERROR-RESP
3692	MOVE WS-REAS-CD TO ERROR-RESP2
3693	MOVE WS-FILE-ERROR-MESSAGE TO WS-RETURN-MSG
3694	* WS-LONG-MSG
3695	* PERFORM SEND-LONG-TEXT
3696	END-EVALUATE
3697	.
3698	9200-GETCARDXREF-BYACCT-EXIT.
3699	EXIT
3700	.
3701	9300-GETACCTDATA-BYACCT.
3702
3703	EXEC CICS READ
3704	DATASET (LIT-ACCTFILENAME)
3705	RIDFLD (WS-CARD-RID-ACCT-ID-X)
3706	KEYLENGTH (LENGTH OF WS-CARD-RID-ACCT-ID-X)
3707	INTO (ACCOUNT-RECORD)
3708	LENGTH (LENGTH OF ACCOUNT-RECORD)
3709	RESP (WS-RESP-CD)
3710	RESP2 (WS-REAS-CD)
3711	END-EXEC
3712
3713	EVALUATE WS-RESP-CD
3714	WHEN DFHRESP(NORMAL)
3715	SET FOUND-ACCT-IN-MASTER TO TRUE
3716	WHEN DFHRESP(NOTFND)
3717	SET INPUT-ERROR TO TRUE
3718	SET FLG-ACCTFILTER-NOT-OK TO TRUE
3719	* SET DID-NOT-FIND-ACCT-IN-ACCTDAT TO TRUE
3720	IF WS-RETURN-MSG-OFF
3721	MOVE WS-RESP-CD TO ERROR-RESP
3722	MOVE WS-REAS-CD TO ERROR-RESP2
3723	STRING
3724	'Account:'
3725	WS-CARD-RID-ACCT-ID-X
3726	' not found in'
3727	' Acct Master file.Resp:'
3728	ERROR-RESP
3729	' Reas:'
3730	ERROR-RESP2
3731	DELIMITED BY SIZE
3732	INTO WS-RETURN-MSG
3733	END-STRING
3734	END-IF
3735	*
3736	WHEN OTHER
3737	SET INPUT-ERROR TO TRUE
3738	SET FLG-ACCTFILTER-NOT-OK TO TRUE
3739	MOVE 'READ' TO ERROR-OPNAME
3740	MOVE LIT-ACCTFILENAME TO ERROR-FILE
3741	MOVE WS-RESP-CD TO ERROR-RESP
3742	MOVE WS-REAS-CD TO ERROR-RESP2
3743	MOVE WS-FILE-ERROR-MESSAGE TO WS-RETURN-MSG
3744	* WS-LONG-MSG
3745	* PERFORM SEND-LONG-TEXT
3746	END-EVALUATE
3747	.
3748	9300-GETACCTDATA-BYACCT-EXIT.
3749	EXIT
3750	.
3751
3752	9400-GETCUSTDATA-BYCUST.
3753	EXEC CICS READ
3754	DATASET (LIT-CUSTFILENAME)
3755	RIDFLD (WS-CARD-RID-CUST-ID-X)
3756	KEYLENGTH (LENGTH OF WS-CARD-RID-CUST-ID-X)
3757	INTO (CUSTOMER-RECORD)
3758	LENGTH (LENGTH OF CUSTOMER-RECORD)
3759	RESP (WS-RESP-CD)
3760	RESP2 (WS-REAS-CD)
3761	END-EXEC
3762
3763	EVALUATE WS-RESP-CD
3764	WHEN DFHRESP(NORMAL)
3765	SET FOUND-CUST-IN-MASTER TO TRUE
3766	WHEN DFHRESP(NOTFND)
3767	SET INPUT-ERROR TO TRUE
3768	SET FLG-CUSTFILTER-NOT-OK TO TRUE
3769	* SET DID-NOT-FIND-CUST-IN-CUSTDAT TO TRUE
3770	MOVE WS-RESP-CD TO ERROR-RESP
3771	MOVE WS-REAS-CD TO ERROR-RESP2
3772	IF WS-RETURN-MSG-OFF
3773	STRING
3774	'CustId:'
3775	WS-CARD-RID-CUST-ID-X
3776	' not found'
3777	' in customer master.Resp: '
3778	ERROR-RESP
3779	' REAS:'
3780	ERROR-RESP2
3781	DELIMITED BY SIZE
3782	INTO WS-RETURN-MSG
3783	END-STRING
3784	END-IF
3785	WHEN OTHER
3786	SET INPUT-ERROR TO TRUE
3787	SET FLG-CUSTFILTER-NOT-OK TO TRUE
3788	MOVE 'READ' TO ERROR-OPNAME
3789	MOVE LIT-CUSTFILENAME TO ERROR-FILE
3790	MOVE WS-RESP-CD TO ERROR-RESP
3791	MOVE WS-REAS-CD TO ERROR-RESP2
3792	MOVE WS-FILE-ERROR-MESSAGE TO WS-RETURN-MSG
3793	* WS-LONG-MSG
3794	* PERFORM SEND-LONG-TEXT
3795	END-EVALUATE
3796	.
3797	9400-GETCUSTDATA-BYCUST-EXIT.
3798	EXIT
3799	.
3800
3801	9500-STORE-FETCHED-DATA.
3802
3803	* Store Context in Commarea
3804	*
3805	MOVE ACCT-ID TO CDEMO-ACCT-ID
3806	MOVE CUST-ID TO CDEMO-CUST-ID
3807	MOVE CUST-FIRST-NAME TO CDEMO-CUST-FNAME
3808	MOVE CUST-MIDDLE-NAME TO CDEMO-CUST-MNAME
3809	MOVE CUST-LAST-NAME TO CDEMO-CUST-LNAME
3810	MOVE ACCT-ACTIVE-STATUS TO CDEMO-ACCT-STATUS
3811	MOVE XREF-CARD-NUM TO CDEMO-CARD-NUM
3812
3813	INITIALIZE ACUP-OLD-DETAILS
3814	******************************************************************
3815	* Account Master data
3816	******************************************************************
3817	MOVE ACCT-ID TO ACUP-OLD-ACCT-ID
3818	* Active Status
3819	MOVE ACCT-ACTIVE-STATUS TO ACUP-OLD-ACTIVE-STATUS
3820	* Current Balance
3821	MOVE ACCT-CURR-BAL TO ACUP-OLD-CURR-BAL-N
3822	* Credit Limit
3823	MOVE ACCT-CREDIT-LIMIT TO ACUP-OLD-CREDIT-LIMIT-N
3824	* Cash Limit
3825	MOVE ACCT-CASH-CREDIT-LIMIT TO ACUP-OLD-CASH-CREDIT-LIMIT-N
3826	* Current Cycle Credit
3827	MOVE ACCT-CURR-CYC-CREDIT TO ACUP-OLD-CURR-CYC-CREDIT-N
3828	* Current Cycle Debit
3829	MOVE ACCT-CURR-CYC-DEBIT TO ACUP-OLD-CURR-CYC-DEBIT-N
3830	* Open date
3831	* MOVE ACCT-OPEN-DATE TO ACUP-OLD-OPEN-DATE
3832	MOVE ACCT-OPEN-DATE(1:4) TO ACUP-OLD-OPEN-YEAR
3833	MOVE ACCT-OPEN-DATE(6:2) TO ACUP-OLD-OPEN-MON
3834	MOVE ACCT-OPEN-DATE(9:2) TO ACUP-OLD-OPEN-DAY
3835	* Expiry date
3836	* MOVE ACCT-EXPIRAION-DATE TO ACUP-OLD-EXPIRAION-DATE
3837	MOVE ACCT-EXPIRAION-DATE(1:4) TO ACUP-OLD-EXP-YEAR
3838	MOVE ACCT-EXPIRAION-DATE(6:2) TO ACUP-OLD-EXP-MON
3839	MOVE ACCT-EXPIRAION-DATE(9:2) TO ACUP-OLD-EXP-DAY
3840
3841	* Reissue date
3842	* MOVE ACCT-REISSUE-DATE TO ACUP-OLD-REISSUE-DATE
3843	MOVE ACCT-REISSUE-DATE(1:4) TO ACUP-OLD-REISSUE-YEAR
3844	MOVE ACCT-REISSUE-DATE(6:2) TO ACUP-OLD-REISSUE-MON
3845	MOVE ACCT-REISSUE-DATE(9:2) TO ACUP-OLD-REISSUE-DAY
3846	* Account Group
3847	MOVE ACCT-GROUP-ID TO ACUP-OLD-GROUP-ID
3848	******************************************************************
3849	* Customer Master data
3850	******************************************************************
3851	*Customer Id (actually not editable)
3852	MOVE CUST-ID TO ACUP-OLD-CUST-ID
3853	*Social Security Number
3854	MOVE CUST-SSN TO ACUP-OLD-CUST-SSN
3855	*Date of birth
3856	* MOVE CUST-DOB-YYYY-MM-DD TO ACUP-OLD-CUST-DOB-YYYY-MM-DD
3857	MOVE CUST-DOB-YYYY-MM-DD(1:4) TO ACUP-OLD-CUST-DOB-YEAR
3858	MOVE CUST-DOB-YYYY-MM-DD(6:2) TO ACUP-OLD-CUST-DOB-MON
3859	MOVE CUST-DOB-YYYY-MM-DD(9:2) TO ACUP-OLD-CUST-DOB-DAY
3860	*FICO
3861	MOVE CUST-FICO-CREDIT-SCORE TO ACUP-OLD-CUST-FICO-SCORE
3862	*First Name
3863	MOVE CUST-FIRST-NAME TO ACUP-OLD-CUST-FIRST-NAME
3864	*Middle Name
3865	MOVE CUST-MIDDLE-NAME TO ACUP-OLD-CUST-MIDDLE-NAME
3866	*Last Name
3867	MOVE CUST-LAST-NAME TO ACUP-OLD-CUST-LAST-NAME
3868	*Address
3869	MOVE CUST-ADDR-LINE-1 TO ACUP-OLD-CUST-ADDR-LINE-1
3870	MOVE CUST-ADDR-LINE-2 TO ACUP-OLD-CUST-ADDR-LINE-2
3871	MOVE CUST-ADDR-LINE-3 TO ACUP-OLD-CUST-ADDR-LINE-3
3872	MOVE CUST-ADDR-STATE-CD TO ACUP-OLD-CUST-ADDR-STATE-CD
3873	MOVE CUST-ADDR-COUNTRY-CD TO
3874	ACUP-OLD-CUST-ADDR-COUNTRY-CD
3875	MOVE CUST-ADDR-ZIP TO ACUP-OLD-CUST-ADDR-ZIP
3876	MOVE CUST-PHONE-NUM-1 TO ACUP-OLD-CUST-PHONE-NUM-1
3877	MOVE CUST-PHONE-NUM-2 TO ACUP-OLD-CUST-PHONE-NUM-2
3878	*Government Id
3879	MOVE CUST-GOVT-ISSUED-ID TO ACUP-OLD-CUST-GOVT-ISSUED-ID
3880	*EFT Code
3881	MOVE CUST-EFT-ACCOUNT-ID TO ACUP-OLD-CUST-EFT-ACCOUNT-ID
3882	*Primary Holder Indicator
3883	MOVE CUST-PRI-CARD-HOLDER-IND TO ACUP-OLD-CUST-PRI-HOLDER-IND
3884	.
3885	9500-STORE-FETCHED-DATA-EXIT.
3886	EXIT
3887	.
3888	9600-WRITE-PROCESSING.
3889
3890	* Read the account file for update
3891
3892	MOVE CC-ACCT-ID TO WS-CARD-RID-ACCT-ID
3893
3894	EXEC CICS READ
3895	FILE (LIT-ACCTFILENAME)
3896	UPDATE
3897	RIDFLD (WS-CARD-RID-ACCT-ID-X)
3898	KEYLENGTH (LENGTH OF WS-CARD-RID-ACCT-ID-X)
3899	INTO (ACCOUNT-RECORD)
3900	LENGTH (LENGTH OF ACCOUNT-RECORD)
3901	RESP (WS-RESP-CD)
3902	RESP2 (WS-REAS-CD)
3903	END-EXEC
3904	*****************************************************************
3905	* Could we lock the account record ?
3906	*****************************************************************
3907	IF WS-RESP-CD EQUAL TO DFHRESP(NORMAL)
3908	CONTINUE
3909	ELSE
3910	SET INPUT-ERROR TO TRUE
3911	IF WS-RETURN-MSG-OFF
3912	SET COULD-NOT-LOCK-ACCT-FOR-UPDATE TO TRUE
3913	END-IF
3914	GO TO 9600-WRITE-PROCESSING-EXIT
3915	END-IF
3916
3917	* Read the customer file for update
3918
3919	MOVE CDEMO-CUST-ID TO WS-CARD-RID-CUST-ID
3920
3921	EXEC CICS READ
3922	FILE (LIT-CUSTFILENAME)
3923	UPDATE
3924	RIDFLD (WS-CARD-RID-CUST-ID-X)
3925	KEYLENGTH (LENGTH OF WS-CARD-RID-CUST-ID-X)
3926	INTO (CUSTOMER-RECORD)
3927	LENGTH (LENGTH OF CUSTOMER-RECORD)
3928	RESP (WS-RESP-CD)
3929	RESP2 (WS-REAS-CD)
3930	END-EXEC
3931	*****************************************************************
3932	* Could we lock the customer record ?
3933	*****************************************************************
3934	IF WS-RESP-CD EQUAL TO DFHRESP(NORMAL)
3935	CONTINUE
3936	ELSE
3937	SET INPUT-ERROR TO TRUE
3938	IF WS-RETURN-MSG-OFF
3939	SET COULD-NOT-LOCK-CUST-FOR-UPDATE TO TRUE
3940	END-IF
3941	GO TO 9600-WRITE-PROCESSING-EXIT
3942	END-IF
3943
3944	*****************************************************************
3945	* Did someone change the record while we were out ?
3946	*****************************************************************
3947	PERFORM 9700-CHECK-CHANGE-IN-REC
3948	THRU 9700-CHECK-CHANGE-IN-REC-EXIT
3949
3950	IF DATA-WAS-CHANGED-BEFORE-UPDATE
3951	GO TO 9600-WRITE-PROCESSING-EXIT
3952	END-IF
3953	*****************************************************************
3954	* Prepare the update
3955	*****************************************************************
3956	INITIALIZE ACCT-UPDATE-RECORD
3957	******************************************************************
3958	* Account Master data
3959	******************************************************************
3960	MOVE ACUP-NEW-ACCT-ID TO ACCT-UPDATE-ID
3961	* Active Status
3962	MOVE ACUP-NEW-ACTIVE-STATUS TO ACCT-UPDATE-ACTIVE-STATUS
3963	* Current Balance
3964	MOVE ACUP-NEW-CURR-BAL-N TO ACCT-UPDATE-CURR-BAL
3965	* Credit Limit
3966	MOVE ACUP-NEW-CREDIT-LIMIT-N TO ACCT-UPDATE-CREDIT-LIMIT
3967	* Cash Limit
3968	MOVE ACUP-NEW-CASH-CREDIT-LIMIT-N
3969	TO ACCT-UPDATE-CASH-CREDIT-LIMIT
3970	* Current Cycle Credit
3971	MOVE ACUP-NEW-CURR-CYC-CREDIT-N
3972	TO ACCT-UPDATE-CURR-CYC-CREDIT
3973	* Current Cycle Debit
3974	MOVE ACUP-NEW-CURR-CYC-DEBIT-N TO ACCT-UPDATE-CURR-CYC-DEBIT
3975	* Open date
3976	STRING ACUP-NEW-OPEN-YEAR
3977	'-'
3978	ACUP-NEW-OPEN-MON
3979	'-'
3980	ACUP-NEW-OPEN-DAY
3981	DELIMITED BY SIZE
3982	INTO ACCT-UPDATE-OPEN-DATE
3983	* Expiry date
3984	STRING ACUP-NEW-EXP-YEAR
3985	'-'
3986	ACUP-NEW-EXP-MON
3987	'-'
3988	ACUP-NEW-EXP-DAY
3989	DELIMITED BY SIZE
3990	INTO ACCT-UPDATE-EXPIRAION-DATE
3991
3992	* Reissue date
3993	MOVE ACCT-REISSUE-DATE TO ACCT-UPDATE-REISSUE-DATE
3994	STRING ACUP-NEW-REISSUE-YEAR
3995	'-'
3996	ACUP-NEW-REISSUE-MON
3997	'-'
3998	ACUP-NEW-REISSUE-DAY
3999	DELIMITED BY SIZE
4000	INTO ACCT-UPDATE-REISSUE-DATE
4001	* Account Group
4002	MOVE ACUP-NEW-GROUP-ID TO ACCT-UPDATE-GROUP-ID
4003
4004	******************************************************************
4005	* Customer data
4006	******************************************************************
4007	INITIALIZE CUST-UPDATE-RECORD
4008
4009	MOVE ACUP-NEW-CUST-ID TO CUST-UPDATE-ID
4010	MOVE ACUP-NEW-CUST-FIRST-NAME
4011	TO CUST-UPDATE-FIRST-NAME
4012	MOVE ACUP-NEW-CUST-MIDDLE-NAME
4013	TO CUST-UPDATE-MIDDLE-NAME
4014	MOVE ACUP-NEW-CUST-LAST-NAME TO CUST-UPDATE-LAST-NAME
4015	MOVE ACUP-NEW-CUST-ADDR-LINE-1
4016	TO CUST-UPDATE-ADDR-LINE-1
4017	MOVE ACUP-NEW-CUST-ADDR-LINE-2
4018	TO CUST-UPDATE-ADDR-LINE-2
4019	MOVE ACUP-NEW-CUST-ADDR-LINE-3
4020	TO CUST-UPDATE-ADDR-LINE-3
4021	MOVE ACUP-NEW-CUST-ADDR-STATE-CD
4022	TO CUST-UPDATE-ADDR-STATE-CD
4023	MOVE ACUP-NEW-CUST-ADDR-COUNTRY-CD
4024	TO CUST-UPDATE-ADDR-COUNTRY-CD
4025	MOVE ACUP-NEW-CUST-ADDR-ZIP TO CUST-UPDATE-ADDR-ZIP
4026
4027	STRING '(',
4028	ACUP-NEW-CUST-PHONE-NUM-1A,
4029	')',
4030	ACUP-NEW-CUST-PHONE-NUM-1B,
4031	'-',
4032	ACUP-NEW-CUST-PHONE-NUM-1C
4033	DELIMITED BY SIZE INTO CUST-UPDATE-PHONE-NUM-1
4034
4035	STRING '(',
4036	ACUP-NEW-CUST-PHONE-NUM-2A,
4037	')',
4038	ACUP-NEW-CUST-PHONE-NUM-2B,
4039	'-',
4040	ACUP-NEW-CUST-PHONE-NUM-2C
4041	DELIMITED BY SIZE INTO CUST-UPDATE-PHONE-NUM-2
4042
4043
4044	MOVE ACUP-NEW-CUST-SSN TO CUST-UPDATE-SSN
4045	MOVE ACUP-NEW-CUST-GOVT-ISSUED-ID
4046	TO CUST-UPDATE-GOVT-ISSUED-ID
4047	STRING ACUP-NEW-CUST-DOB-YEAR
4048	'-'
4049	ACUP-NEW-CUST-DOB-MON
4050	'-'
4051	ACUP-NEW-CUST-DOB-DAY
4052	DELIMITED BY SIZE INTO CUST-UPDATE-DOB-YYYY-MM-DD
4053
4054	MOVE ACUP-NEW-CUST-EFT-ACCOUNT-ID
4055	TO CUST-UPDATE-EFT-ACCOUNT-ID
4056	MOVE ACUP-NEW-CUST-PRI-HOLDER-IND
4057	TO CUST-UPDATE-PRI-CARD-IND
4058	MOVE ACUP-NEW-CUST-FICO-SCORE TO
4059	CUST-UPDATE-FICO-CREDIT-SCORE
4060	*****************************************************************
4061	* Update account *
4062	*****************************************************************
4063
4064
4065	EXEC CICS
4066	REWRITE FILE(LIT-ACCTFILENAME)
4067	FROM(ACCT-UPDATE-RECORD)
4068	LENGTH(LENGTH OF ACCT-UPDATE-RECORD)
4069	RESP (WS-RESP-CD)
4070	RESP2 (WS-REAS-CD)
4071	END-EXEC.
4072	*
4073	*****************************************************************
4074	* Did account update succeed ? *
4075	*****************************************************************
4076	IF WS-RESP-CD EQUAL TO DFHRESP(NORMAL)
4077	CONTINUE
4078	ELSE
4079	SET LOCKED-BUT-UPDATE-FAILED TO TRUE
4080	GO TO 9600-WRITE-PROCESSING-EXIT
4081	END-IF
4082	*****************************************************************
4083	* Update customer *
4084	*****************************************************************
4085	EXEC CICS
4086	REWRITE FILE(LIT-CUSTFILENAME)
4087	FROM(CUST-UPDATE-RECORD)
4088	LENGTH(LENGTH OF CUST-UPDATE-RECORD)
4089	RESP (WS-RESP-CD)
4090	RESP2 (WS-REAS-CD)
4091	END-EXEC.
4092	*****************************************************************
4093	* Did customer update succeed ? *
4094	*****************************************************************
4095	IF WS-RESP-CD EQUAL TO DFHRESP(NORMAL)
4096	CONTINUE
4097	ELSE
4098	SET LOCKED-BUT-UPDATE-FAILED TO TRUE
4099	EXEC CICS
4100	SYNCPOINT ROLLBACK
4101	END-EXEC
4102	GO TO 9600-WRITE-PROCESSING-EXIT
4103	END-IF
4104	.
4105	9600-WRITE-PROCESSING-EXIT.
4106	EXIT
4107	.
4108
4109	9700-CHECK-CHANGE-IN-REC.
4110
4111
4112	******************************************************************
4113	* Account Master data
4114	******************************************************************
4115	IF ACCT-ACTIVE-STATUS EQUAL ACUP-OLD-ACTIVE-STATUS
4116	* Current Balance
4117	AND ACCT-CURR-BAL EQUAL ACUP-OLD-CURR-BAL-N
4118	* Credit Limit
4119	AND ACCT-CREDIT-LIMIT EQUAL ACUP-OLD-CREDIT-LIMIT-N
4120	* Cash Limit
4121	AND ACCT-CASH-CREDIT-LIMIT EQUAL ACUP-OLD-CASH-CREDIT-LIMIT-N
4122	* Current Cycle Credit
4123	AND ACCT-CURR-CYC-CREDIT EQUAL ACUP-OLD-CURR-CYC-CREDIT-N
4124	* Current Cycle Debit
4125	AND ACCT-CURR-CYC-DEBIT EQUAL ACUP-OLD-CURR-CYC-DEBIT-N
4126	* Open date
4127	AND ACCT-OPEN-DATE(1:4) EQUAL ACUP-OLD-OPEN-YEAR
4128	AND ACCT-OPEN-DATE(6:2) EQUAL ACUP-OLD-OPEN-MON
4129	AND ACCT-OPEN-DATE(9:2) EQUAL ACUP-OLD-OPEN-DAY
4130	* Expiry date
4131	AND ACCT-EXPIRAION-DATE(1:4)EQUAL ACUP-OLD-EXP-YEAR
4132	AND ACCT-EXPIRAION-DATE(6:2)EQUAL ACUP-OLD-EXP-MON
4133	AND ACCT-EXPIRAION-DATE(9:2)EQUAL ACUP-OLD-EXP-DAY
4134	* Reissue date
4135	AND ACCT-REISSUE-DATE(1:4) EQUAL ACUP-OLD-REISSUE-YEAR
4136	AND ACCT-REISSUE-DATE(6:2) EQUAL ACUP-OLD-REISSUE-MON
4137	AND ACCT-REISSUE-DATE(9:2) EQUAL ACUP-OLD-REISSUE-DAY
4138	* Account Group
4139	AND FUNCTION LOWER-CASE (ACCT-GROUP-ID) EQUAL
4140	FUNCTION LOWER-CASE (ACUP-OLD-GROUP-ID)
4141	CONTINUE
4142	ELSE
4143	SET DATA-WAS-CHANGED-BEFORE-UPDATE TO TRUE
4144	GO TO 9600-WRITE-PROCESSING-EXIT
4145	END-IF
4146
4147	******************************************************************
4148	* Customer data - Split into 2 IFs for easier reading
4149	* And maybe put logic to update only 1 file if only date
4150	* pertaining to one of them is updated
4151	******************************************************************
4152	IF FUNCTION UPPER-CASE (CUST-FIRST-NAME ) EQUAL
4153	FUNCTION UPPER-CASE (ACUP-OLD-CUST-FIRST-NAME )
4154	AND FUNCTION UPPER-CASE (CUST-MIDDLE-NAME ) EQUAL
4155	FUNCTION UPPER-CASE (ACUP-OLD-CUST-MIDDLE-NAME)
4156	AND FUNCTION UPPER-CASE (CUST-LAST-NAME ) EQUAL
4157	FUNCTION UPPER-CASE (ACUP-OLD-CUST-LAST-NAME )
4158	AND FUNCTION UPPER-CASE (CUST-ADDR-LINE-1 ) EQUAL
4159	FUNCTION UPPER-CASE (ACUP-OLD-CUST-ADDR-LINE-1)
4160	AND FUNCTION UPPER-CASE (CUST-ADDR-LINE-2 ) EQUAL
4161	FUNCTION UPPER-CASE (ACUP-OLD-CUST-ADDR-LINE-2)
4162	AND FUNCTION UPPER-CASE (CUST-ADDR-LINE-3 ) EQUAL
4163	FUNCTION UPPER-CASE (ACUP-OLD-CUST-ADDR-LINE-3)
4164	AND FUNCTION UPPER-CASE (CUST-ADDR-STATE-CD ) EQUAL
4165	FUNCTION UPPER-CASE (ACUP-OLD-CUST-ADDR-STATE-CD)
4166	AND FUNCTION UPPER-CASE (CUST-ADDR-COUNTRY-CD ) EQUAL
4167	FUNCTION UPPER-CASE (ACUP-OLD-CUST-ADDR-COUNTRY-CD )
4168	AND CUST-ADDR-ZIP EQUAL ACUP-OLD-CUST-ADDR-ZIP
4169	AND CUST-PHONE-NUM-1 EQUAL ACUP-OLD-CUST-PHONE-NUM-1
4170	AND CUST-PHONE-NUM-2 EQUAL ACUP-OLD-CUST-PHONE-NUM-2
4171	AND CUST-SSN EQUAL ACUP-OLD-CUST-SSN
4172	AND FUNCTION UPPER-CASE (CUST-GOVT-ISSUED-ID ) EQUAL
4173	FUNCTION UPPER-CASE (ACUP-OLD-CUST-GOVT-ISSUED-ID )
4174	AND CUST-DOB-YYYY-MM-DD (1:4) EQUAL
4175	ACUP-OLD-CUST-DOB-YYYY-MM-DD (1:4)
4176	AND CUST-DOB-YYYY-MM-DD (6:2) EQUAL
4177	ACUP-OLD-CUST-DOB-YYYY-MM-DD (5:2)
4178	AND CUST-DOB-YYYY-MM-DD (9:2) EQUAL
4179	ACUP-OLD-CUST-DOB-YYYY-MM-DD (7:2)
4180
4181	AND CUST-EFT-ACCOUNT-ID EQUAL
4182	ACUP-OLD-CUST-EFT-ACCOUNT-ID
4183	AND CUST-PRI-CARD-HOLDER-IND
4184	EQUAL
4185	ACUP-OLD-CUST-PRI-HOLDER-IND
4186	AND CUST-FICO-CREDIT-SCORE EQUAL ACUP-OLD-CUST-FICO-SCORE
4187	CONTINUE
4188	ELSE
4189	SET DATA-WAS-CHANGED-BEFORE-UPDATE TO TRUE
4190	GO TO 9600-WRITE-PROCESSING-EXIT
4191	END-IF
4192	.
4193	9700-CHECK-CHANGE-IN-REC-EXIT.
4194	EXIT
4195	.
4196	******************************************************************
4197	*Common code to store PFKey
4198	******************************************************************
4199	COPY 'CSSTRPFY'
4200	.
4201
4202
4203	ABEND-ROUTINE.
4204
4205	IF ABEND-MSG EQUAL LOW-VALUES
4206	MOVE 'UNEXPECTED ABEND OCCURRED.' TO ABEND-MSG
4207	END-IF
4208
4209	MOVE LIT-THISPGM TO ABEND-CULPRIT
4210
4211	EXEC CICS SEND
4212	FROM (ABEND-DATA)
4213	LENGTH(LENGTH OF ABEND-DATA)
4214	NOHANDLE
4215	ERASE
4216	END-EXEC
4217
4218	EXEC CICS HANDLE ABEND
4219	CANCEL
4220	END-EXEC
4221
4222	EXEC CICS ABEND
4223	ABCODE('9999')
4224	END-EXEC
4225	.
4226	ABEND-ROUTINE-EXIT.
4227	EXIT
4228	.
4229	******************************************************************
4230	* Common Date Routines
4231	******************************************************************
4232	COPY CSUTLDPY
4233	.
4234	*
4235	* Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:32 CDT
4236	*