MFmainframe-rea
WS carddemo · 26f629ef

cobol · 1702 lines · sha256 c16e40c391c0ad2d · guides at columns 7 and 72app/app-transaction-type-db2/cbl/COTRTUPC.cbl

1000100**************************************** *************************00010000
2000200* Program: COTRTUPC.CBL *00020000
3000300* Layer: Business logic *00030000
4000400* Function: Accept and process TRANSACTION TYPE UPDATE *00040000
5000500******************************************************************00050000
6000600* Copyright Amazon.com, Inc. or its affiliates. 00060000
7000700* All Rights Reserved. 00070000
8000800* 00080000
9000900* Licensed under the Apache License, Version 2.0 (the "License"). 00090000
10001000* You may not use this file except in compliance with the License.00100000
11001100* You may obtain a copy of the License at 00110000
12001200* 00120000
13001300* http://www.apache.org/licenses/LICENSE-2.0 00130000
14001400* 00140000
15001500* Unless required by applicable law or agreed to in writing, 00150000
16001600* software distributed under the License is distributed on an 00160000
17001700* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, 00170000
18001800* either express or implied. See the License for the specific 00180000
19001900* language governing permissions and limitations under the License00190000
20002000******************************************************************00200000
21002100 IDENTIFICATION DIVISION. 00210000
22002200 PROGRAM-ID. 00220000
23002300 COTRTUPC. 00230000
24002400 DATE-WRITTEN. 00240000
25002500 Dec 2022. 00250000
26002600 DATE-COMPILED. 00260000
27002700 Today. 00270000
28002800 00280000
29002900 ENVIRONMENT DIVISION. 00290000
30003000 INPUT-OUTPUT SECTION. 00300000
31003100 00310000
32003200 DATA DIVISION. 00320000
33003300 00330000
34003400 WORKING-STORAGE SECTION. 00340000
35003500 01 WS-MISC-STORAGE. 00350000
36003600******************************************************************00360000
37003700* General CICS related 00370000
38003800******************************************************************00380000
39003900 05 WS-CICS-PROCESSNG-VARS. 00390000
40004000 07 WS-RESP-CD PIC S9(09) COMP 00400000
41004100 VALUE ZEROS. 00410000
42004200 07 WS-REAS-CD PIC S9(09) COMP 00420000
43004300 VALUE ZEROS. 00430000
44004400 07 WS-TRANID PIC X(4) 00440000
45004500 VALUE SPACES. 00450000
46004600 07 WS-UCTRANS PIC X(4) 00460000
47004700 VALUE SPACES. 00470000
48004800******************************************************************00480000
49004900* Input edits 00490000
50005000******************************************************************00500000
51005100* Generic Input Edits 00510000
52005200 05 WS-GENERIC-EDITS. 00520000
53005300 10 WS-EDIT-VARIABLE-NAME PIC X(25). 00530000
54005400 00540000
55005500 10 WS-EDIT-ALPHANUM-ONLY PIC X(256). 00550000
56005600 10 WS-EDIT-ALPHANUM-LENGTH PIC S9(4) COMP-3. 00560000
57005700 00570000
58005800 10 WS-EDIT-ALPHANUM-ONLY-FLAGS PIC X(1). 00580000
59005900 88 FLG-ALPHNANUM-ISVALID VALUE LOW-VALUES. 00590000
60006000 88 FLG-ALPHNANUM-NOT-OK VALUE '0'. 00600000
61006100 88 FLG-ALPHNANUM-BLANK VALUE 'B'. 00610000
62006200 00620000
63006300 00630000
64006400******************************************************************00640000
65006500* Work variables 00650000
66006600******************************************************************00660000
67006700 05 WS-MISC-VARS. 00670000
68006800 10 WS-DISP-SQLCODE PIC ----9. 00680000
69006900 10 WS-STRING-MID PIC 9(3) VALUE 0. 00690000
70007000 10 WS-STRING-LEN PIC 9(3) VALUE 0. 00700000
71007100 10 WS-STRING-OUT PIC X(40). 00710000
72007200 00720000
73007300******************************************************************00730000
74007400* Generic date edit variables CCYYMMDD 00740000
75007500******************************************************************00750000
76007600 COPY 'CSUTLDWY'. 00760000
77007700******************************************************************00770000
78007800 05 WS-DATACHANGED-FLAG PIC X(1). 00780000
79007900 88 NO-CHANGES-FOUND VALUE '0'. 00790000
80008000 88 CHANGE-HAS-OCCURRED VALUE '1'. 00800000
81008100 05 WS-INPUT-FLAG PIC X(1). 00810000
82008200 88 INPUT-OK VALUE '0'. 00820000
83008300 88 INPUT-ERROR VALUE '1'. 00830000
84008400 88 INPUT-PENDING VALUE LOW-VALUES. 00840000
85008500 05 WS-RETURN-FLAG PIC X(1). 00850000
86008600 88 WS-RETURN-FLAG-OFF VALUE LOW-VALUES. 00860000
87008700 88 WS-RETURN-FLAG-ON VALUE '1'. 00870000
88008800 05 WS-PFK-FLAG PIC X(1). 00880000
89008900 88 PFK-VALID VALUE '0'. 00890000
90009000 88 PFK-INVALID VALUE '1'. 00900000
91009100 00910000
92009200* Program specific edits 00920000
93009300* 00930000
94009400 05 WS-EDIT-TTYP-FLAG PIC X(1). 00940000
95009500 88 FLG-TRANFILTER-ISVALID VALUE LOW-VALUES. 00950000
96009600 88 FLG-TRANFILTER-NOT-OK VALUE '0'. 00960000
97009700 88 FLG-TRANFILTER-BLANK VALUE 'B'. 00970000
98009800 00980000
99009900 05 WS-NON-KEY-FLAGS. 00990000
100010000 10 WS-EDIT-DESC-FLAGS PIC X(1). 01000000
101010100 88 FLG-DESCRIPTION-ISVALID VALUE LOW-VALUES. 01010000
102010200 88 FLG-DESCRIPTION-NOT-OK VALUE '0'. 01020000
103010300 88 FLG-DESCRIPTION-BLANK VALUE 'B'. 01030000
104010400******************************************************************01040000
105010500* Output edits 01050000
106010600******************************************************************01060000
107010700 05 CICS-OUTPUT-EDIT-VARS. 01070000
108010800 10 WS-EDIT-DATE-X PIC X(10). 01080000
109010900 10 FILLER REDEFINES WS-EDIT-DATE-X. 01090000
110011000 20 WS-EDIT-DATE-X-YEAR PIC X(4). 01100000
111011100 20 FILLER PIC X(1). 01110000
112011200 20 WS-EDIT-DATE-MONTH PIC X(2). 01120000
113011300 20 FILLER PIC X(1). 01130000
114011400 20 WS-EDIT-DATE-DAY PIC X(2). 01140000
115011500 10 WS-EDIT-DATE-X REDEFINES 01150000
116011600 WS-EDIT-DATE-X PIC 9(10). 01160000
117011700 10 WS-EDIT-CURRENCY-9-2 PIC X(15). 01170000
118011800 10 WS-EDIT-CURRENCY-9-2-F PIC +ZZZ,ZZZ,ZZZ.99. 01180000
119011900 10 WS-EDIT-NUMERIC-2 PIC 9(02). 01190000
120012000 10 WS-EDIT-ALPHANUMERIC-2 PIC X(02). 01200000
121012100 01210000
122012200******************************************************************01220000
123012300* File and data Handling 01230000
124012400******************************************************************01240000
125012500 05 WS-TABLE-READ-FLAGS. 01250000
126012600 10 WS-TRANTYPE-MASTER-READ-FLAG PIC X(1). 01260000
127012700 88 FOUND-TRANTYPE-IN-TABLE VALUE '1'. 01270000
128012800* Alpha variables for editing numerics 01280000
129012900* 01290000
130013000 05 TTYP-UPDATE-RECORD. 01300000
131013100***************************************************************** 01310000
132013200* Data-structure for TRANSACTION TYPE (RECLN 60) 01320000
133013300***************************************************************** 01330000
134013400 15 TTUP-UPDATE-TTYP-TYPE PIC X(02). 01340000
135013500 15 TTUP-UPDATE-TTYP-TYPE-DESC PIC X(50). 01350000
136013600 15 FILLER PIC X(08). 01360000
137013700 01370000
138013800 01380000
139013900******************************************************************01390000
140014000* Output Message Construction 01400000
141014100******************************************************************01410000
142014200 05 WS-INFO-MSG PIC X(40). 01420000
143014300 88 WS-NO-INFO-MESSAGE VALUES 01430000
144014400 SPACES LOW-VALUES. 01440000
145014500 88 FOUND-TRANTYPE-DATA VALUE 01450000
146014600 'Selected transaction type shown above'. 01460000
147014700 88 PROMPT-FOR-SEARCH-KEYS VALUE 01470000
148014800 'Enter transaction type to be maintained'. 01480000
149014900 88 PROMPT-CREATE-NEW-RECORD VALUE 01490000
150015000 'Press F05 to add. F12 to cancel'. 01500000
151015100 88 PROMPT-DELETE-CONFIRM VALUE 01510000
152015200 'Delete this record ? Press F4 to confirm'. 01520000
153015300 88 CONFIRM-DELETE-SUCCESS VALUE 01530000
154015400 'Delete successful.'. 01540000
155015500 88 PROMPT-FOR-CHANGES VALUE 01550000
156015600 'Update transaction type details shown.'. 01560000
157015700 88 PROMPT-FOR-NEWDATA VALUE 01570000
158015800 'Enter new transaction type details.'. 01580000
159015900 01590000
160016000 88 PROMPT-FOR-CONFIRMATION VALUE 01600000
161016100 'Changes validated.Press F5 to save'. 01610000
162016200 88 CONFIRM-UPDATE-SUCCESS VALUE 01620000
163016300 'Changes committed to database'. 01630000
164016400 88 INFORM-FAILURE VALUE 01640000
165016500 'Changes unsuccessful'. 01650000
166016600 01660000
167016700 05 WS-RETURN-MSG PIC X(75). 01670000
168016800 88 WS-RETURN-MSG-OFF VALUE SPACES. 01680000
169016900 88 WS-EXIT-MESSAGE VALUE 01690000
170017000 'PF03 pressed.Exiting '. 01700000
171017100 88 WS-INVALID-KEY VALUE 01710000
172017200 'Invalid Key pressed. '. 01720000
173017300 88 WS-NAME-MUST-BE-ALPHA VALUE 01730000
174017400 'Name can only contain alphabets and spaces'. 01740000
175017500 88 WS-RECORD-NOT-FOUND VALUE 01750000
176017600 'No record found for this key in database' . 01760000
177017700 88 NO-SEARCH-CRITERIA-RECEIVED VALUE 01770000
178017800 'No input received'. 01780000
179017900 88 NO-CHANGES-DETECTED VALUE 01790000
180018000 'No change detected with respect to values fetched.'. 01800000
181018100 88 COULD-NOT-LOCK-REC-FOR-UPDATE VALUE 01810000
182018200 'Could not lock record for update'. 01820000
183018300 88 DATA-WAS-CHANGED-BEFORE-UPDATE VALUE 01830000
184018400 'Record changed by some one else. Please review'. 01840000
185018500 88 WS-UPDATE-WAS-CANCELLED VALUE 01850000
186018600 'Update was cancelled'. 01860000
187018700 88 TABLE-UPDATE-FAILED VALUE 01870000
188018800 'Update of record failed'. 01880000
189018900 88 RECORD-DELETE-FAILED VALUE 01890000
190019000 'Delete of record failed'. 01900000
191019100 88 WS-DELETE-WAS-CANCELLED VALUE 01910000
192019200 'Delete was cancelled'. 01920000
193019300 88 WS-INVALID-KEY-PRESSED VALUE 01930000
194019400 'Invalid key pressed'. 01940000
195019500 88 CODING-TO-BE-DONE VALUE 01950000
196019600 'Looks Good.... so far'. 01960000
197019700******************************************************************01970000
198019800* Literals and Constants 01980000
199019900******************************************************************01990000
200020000 01 WS-LITERALS. 02000000
201020100 05 LIT-THISPGM PIC X(8) 02010000
202020200 VALUE 'COTRTUPC'. 02020000
203020300 05 LIT-THISTRANID PIC X(4) 02030000
204020400 VALUE 'CTTU'. 02040000
205020500 05 LIT-THISMAPSET PIC X(8) 02050000
206020600 VALUE 'COTRTUP '. 02060000
207020700 05 LIT-THISMAP PIC X(7) 02070000
208020800 VALUE 'CTRTUPA'. 02080000
209020900 05 LIT-ADMINPGM PIC X(8) 02090000
210021000 VALUE 'COADM01C'. 02100000
211021100 05 LIT-ADMINTRANID PIC X(4) 02110000
212021200 VALUE 'CA00'. 02120000
213021300 05 LIT-ADMINMAPSET PIC X(7) 02130000
214021400 VALUE 'COADM01'. 02140000
215021500 05 LIT-ADMINMAP PIC X(7) 02150000
216021600 VALUE 'COADM1A'. 02160000
217021700 05 LIT-LISTTPGM PIC X(8) 02170000
218021800 VALUE 'COTRTLIC'. 02180000
219021900 05 LIT-LISTTTRANID PIC X(4) 02190000
220022000 VALUE 'CTLI'. 02200000
221022100 05 LIT-LISTTMAPSET PIC X(7) 02210000
222022200 VALUE 'COTRTLI'. 02220000
223022300 05 LIT-LISTTMAP PIC X(7) 02230000
224022400 VALUE 'CTRTLIA'. 02240000
225022500 02250000
226022600 02260000
227022700******************************************************************02270000
228022800* Literals for use in INSPECT statements 02280000
229022900******************************************************************02290000
230023000 05 LIT-ALL-ALPHANUM-FROM-X. 02300000
231023100 10 LIT-ALL-ALPHA-FROM-X. 02310000
232023200 15 LIT-UPPER PIC X(26) 02320000
233023300 VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. 02330000
234023400 15 LIT-LOWER PIC X(26) 02340000
235023500 VALUE 'abcdefghijklmnopqrstuvwxyz'. 02350000
236023600 10 LIT-NUMBERS PIC X(10) 02360000
237023700 VALUE '0123456789'. 02370000
238023800******************************************************************02380000
239023900*Other common working storage Variables 02390000
240024000******************************************************************02400000
241024100 COPY CVCRD01Y. 02410000
242024200******************************************************************02420000
243024300*Lookups 02430000
244024400******************************************************************02440000
245024500 02450000
246024600******************************************************************02460000
247024700* Variables for use in INSPECT statements 02470000
248024800******************************************************************02480000
249024900 01 LIT-ALL-ALPHA-FROM PIC X(52) VALUE SPACES. 02490000
250025000 01 LIT-ALL-ALPHANUM-FROM PIC X(62) VALUE SPACES. 02500000
251025100 01 LIT-ALL-NUM-FROM PIC X(10) VALUE SPACES. 02510000
252025200 77 LIT-ALPHA-SPACES-TO PIC X(52) VALUE SPACES. 02520000
253025300 77 LIT-ALPHANUM-SPACES-TO PIC X(62) VALUE SPACES. 02530000
254025400 77 LIT-NUM-SPACES-TO PIC X(10) VALUE SPACES. 02540000
255025500 02550000
256025600*IBM SUPPLIED COPYBOOKS 02560000
257025700 COPY DFHBMSCA. 02570000
258025800 COPY DFHAID. 02580000
259025900 02590000
260026000*COMMON COPYBOOKS 02600000
261026100*Screen Titles 02610000
262026200 COPY COTTL01Y. 02620000
263026300 02630000
264026400*Transaction Type Update Screen Layout 02640000
265026500 COPY COTRTUP. 02650000
266026600 02660000
267026700*Current Date 02670000
268026800 COPY CSDAT01Y. 02680000
269026900 02690000
270027000*Common Messages 02700000
271027100 COPY CSMSG01Y. 02710000
272027200 02720000
273027300*Abend Variables 02730000
274027400 COPY CSMSG02Y. 02740000
275027500 02750000
276027600*Signed on user data 02760000
277027700 COPY CSUSR01Y. 02770000
278027800 02780000
279027900******************************************************************02790000
280028000* Relational Database stuff 02800000
281028100******************************************************************02810000
282028200 EXEC SQL 02820000
283028300 INCLUDE SQLCA 02830000
284028400 END-EXEC 02840000
285028500 02850000
286028600 EXEC SQL INCLUDE DCLTRTYP END-EXEC 02860000
287028700 02870000
288028800 EXEC SQL INCLUDE DCLTRCAT END-EXEC 02880000
289028900 02890000
290029000******************************************************************02900000
291029100*Application Commmarea Copybook 02910000
292029200 COPY COCOM01Y. 02920000
293029300 02930000
294029400 01 WS-THIS-PROGCOMMAREA. 02940000
295029500 05 TTUP-UPDATE-SCREEN-DATA. 02950000
296029600 10 TTUP-CHANGE-ACTION PIC X(1) 02960000
297029700 VALUE LOW-VALUES.02970000
298029800 88 TTUP-DETAILS-NOT-FETCHED VALUES 02980000
299029900 LOW-VALUES, 02990000
300030000 SPACES. 03000000
301030100 88 TTUP-INVALID-SEARCH-KEYS VALUE 'K'. 03010000
302030200 88 TTUP-DETAILS-NOT-FOUND VALUE 'X'. 03020000
303030300 88 TTUP-SHOW-DETAILS VALUE 'S'. 03030000
304030400* 03040000
305030500 88 TTUP-CREATE-NEW-RECORD VALUE 'R'. 03050000
306030600 88 TTUP-REVIEW-NEW-RECORD VALUE 'V'. 03060000
307030700 88 TTUP-DELETE-IN-PROGRESS VALUES '9' 03070000
308030800 , '8', '7' 03080000
309030900 , '6'. 03090000
310031000 88 TTUP-CONFIRM-DELETE VALUE '9'. 03100000
311031100 88 TTUP-START-DELETE VALUE '8'. 03110000
312031200 88 TTUP-DELETE-DONE VALUE '7'. 03120000
313031300 88 TTUP-DELETE-FAILED VALUE '6'. 03130000
314031400*** 03140000
315031500 88 TTUP-CHANGES-MADE VALUES 'E', 'N' 03150000
316031600 , 'L' 03160000
317031700 , 'F'. 03170000
318031800 88 TTUP-CHANGES-NOT-OK VALUE 'E'. 03180000
319031900 88 TTUP-CHANGES-OK-NOT-CONFIRMED VALUE 'N'. 03190000
320032000 03200000
321032100*** 03210000
322032200 88 TTUP-CHANGES-FAILED VALUES 'L', 'F'. 03220000
323032300 88 TTUP-CHANGES-OKAYED-LOCK-ERROR VALUE 'L'. 03230000
324032400 88 TTUP-CHANGES-OKAYED-BUT-FAILED VALUE 'F'. 03240000
325032500 03250000
326032600 88 TTUP-CHANGES-OKAYED-AND-DONE VALUE 'C'. 03260000
327032700 88 TTUP-CHANGES-BACKED-OUT VALUE 'B'. 03270000
328032800 05 TTUP-OLD-DETAILS. 03280000
329032900 10 TTUP-OLD-TTYP-DATA. 03290000
330033000 15 TTUP-OLD-TTYP-TYPE PIC X(02). 03300000
331033100 15 TTUP-OLD-TTYP-TYPE-DESC PIC X(50). 03310000
332033200 05 TTUP-NEW-DETAILS. 03320000
333033300 10 TTUP-NEW-TTYP-DATA. 03330000
334033400 15 TTUP-NEW-TTYP-TYPE PIC X(02). 03340000
335033500 15 TTUP-NEW-TTYP-TYPE-DESC PIC X(50). 03350000
336033600 01 WS-COMMAREA PIC X(2000). 03360000
337033700 03370000
338033800 03380000
339033900 LINKAGE SECTION. 03390000
340034000 01 DFHCOMMAREA. 03400000
341034100 05 FILLER PIC X(1) 03410000
342034200 OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN. 03420000
343034300 03430000
344034400 PROCEDURE DIVISION. 03440000
345034500 0000-MAIN. 03450000
346034600 03460000
347034700 03470000
348034800 EXEC CICS HANDLE ABEND 03480000
349034900 LABEL(ABEND-ROUTINE) 03490000
350035000 END-EXEC 03500000
351035100 03510000
352035200 INITIALIZE CC-WORK-AREA 03520000
353035300 WS-MISC-STORAGE 03530000
354035400 WS-COMMAREA 03540000
355035500***************************************************************** 03550000
356035600* Store our context 03560000
357035700***************************************************************** 03570000
358035800 MOVE LIT-THISTRANID TO WS-TRANID 03580000
359035900***************************************************************** 03590000
360036000* Ensure error message is cleared * 03600000
361036100***************************************************************** 03610000
362036200 SET WS-RETURN-MSG-OFF TO TRUE 03620000
363036300***************************************************************** 03630000
364036400* Store passed data if any * 03640000
365036500***************************************************************** 03650000
366036600 IF EIBCALEN IS EQUAL TO 0 03660000
367036700 OR (CDEMO-FROM-PROGRAM = LIT-ADMINPGM 03670000
368036800 AND NOT CDEMO-PGM-REENTER) 03680000
369036900 OR (CDEMO-FROM-PROGRAM = LIT-LISTTPGM 03690000
370037000 AND NOT CDEMO-PGM-REENTER) 03700000
371037100 INITIALIZE CARDDEMO-COMMAREA 03710000
372037200 WS-THIS-PROGCOMMAREA 03720000
373037300 SET CDEMO-PGM-ENTER TO TRUE 03730000
374037400 SET TTUP-DETAILS-NOT-FETCHED TO TRUE 03740000
375037500 ELSE 03750000
376037600 MOVE DFHCOMMAREA (1:LENGTH OF CARDDEMO-COMMAREA) TO 03760000
377037700 CARDDEMO-COMMAREA 03770000
378037800 MOVE DFHCOMMAREA(LENGTH OF CARDDEMO-COMMAREA + 1: 03780000
379037900 LENGTH OF WS-THIS-PROGCOMMAREA ) TO 03790000
380038000 WS-THIS-PROGCOMMAREA 03800000
381038100 END-IF 03810000
382038200***************************************************************** 03820000
383038300* Store the Mapped PF Key 03830000
384038400* Remap PFkeys as needed. 03840000
385038500***************************************************************** 03850000
386038600 PERFORM YYYY-STORE-PFKEY 03860000
387038700 THRU YYYY-STORE-PFKEY-EXIT 03870000
388038800 03880000
389038900***************************************************************** 03890000
390039000* Check the AID to see if its valid at this point * 03900000
391039100* Change the key to some valid value if possible 03910000
392039200* F3 - Exit 03920000
393039300* Enter show screen again 03930000
394039400* F4 - Delete 03940000
395039500* F5 - Save 03950000
396039600* F12 - Cancel 03960000
397039700***************************************************************** 03970000
398039800 SET PFK-INVALID TO TRUE 03980000
399039900 03990000
400040000 PERFORM 0001-CHECK-PFKEYS 04000000
401040100 THRU 0001-CHECK-PFKEYS-EXIT 04010000
402040200***************************************************************** 04020000
403040300* Simulate initial entry if the following flags are set 04030000
404040400***************************************************************** 04040000
405040500 EVALUATE TRUE 04050000
406040600 WHEN CCARD-AID-PFK12 04060000
407040700 AND (TTUP-SHOW-DETAILS 04070000
408040800 OR TTUP-CREATE-NEW-RECORD 04080000
409040900 OR TTUP-DETAILS-NOT-FOUND) 04090000
410041000 WHEN TTUP-CHANGES-OKAYED-AND-DONE 04100000
411041100 WHEN TTUP-CHANGES-FAILED 04110000
412041200 WHEN TTUP-CHANGES-BACKED-OUT 04120000
413041300 AND (TTUP-OLD-DETAILS EQUAL LOW-VALUES 04130000
414041400 OR TTUP-OLD-DETAILS EQUAL SPACES) 04140000
415041500 WHEN TTUP-DELETE-DONE 04150000
416041600 WHEN TTUP-DELETE-FAILED 04160000
417041700 SET CDEMO-PGM-ENTER TO TRUE 04170000
418041800 SET TTUP-DETAILS-NOT-FETCHED TO TRUE 04180000
419041900 END-EVALUATE 04190000
420042000***************************************************************** 04200000
421042100* Decide what to do based on PF KEY PRESSED AND CONTEXT 04210000
422042200***************************************************************** 04220000
423042300 EVALUATE TRUE 04230000
424042400******************************************************************04240000
425042500* USER PRESSES PF03 TO EXIT 04250000
426042600* OR USER IS DONE WITH UPDATE 04260000
427042700* XCTL TO CALLING PROGRAM OR MAIN MENU 04270000
428042800******************************************************************04280000
429042900 WHEN CCARD-AID-PFK03 04290000
430043000 04300000
431043100 IF CDEMO-FROM-TRANID EQUAL LOW-VALUES 04310000
432043200 OR CDEMO-FROM-TRANID EQUAL SPACES 04320000
433043300 MOVE LIT-ADMINTRANID TO CDEMO-TO-TRANID 04330000
434043400 ELSE 04340000
435043500 MOVE CDEMO-FROM-TRANID TO CDEMO-TO-TRANID 04350000
436043600 END-IF 04360000
437043700 04370000
438043800 IF CDEMO-FROM-PROGRAM EQUAL LOW-VALUES 04380000
439043900 OR CDEMO-FROM-PROGRAM EQUAL SPACES 04390000
440044000 MOVE LIT-ADMINPGM TO CDEMO-TO-PROGRAM 04400000
441044100 ELSE 04410000
442044200 MOVE CDEMO-FROM-PROGRAM TO CDEMO-TO-PROGRAM 04420000
443044300 END-IF 04430000
444044400 04440000
445044500 MOVE LIT-THISTRANID TO CDEMO-FROM-TRANID 04450000
446044600 MOVE LIT-THISPGM TO CDEMO-FROM-PROGRAM 04460000
447044700 04470000
448044800 SET CDEMO-USRTYP-ADMIN TO TRUE 04480000
449044900 SET CDEMO-PGM-ENTER TO TRUE 04490000
450045000 MOVE LIT-THISMAPSET TO CDEMO-LAST-MAPSET 04500000
451045100 MOVE LIT-THISMAP TO CDEMO-LAST-MAP 04510000
452045200 04520000
453045300 EXEC CICS 04530000
454045400 SYNCPOINT 04540000
455045500 END-EXEC 04550000
456045600 04560000
457045700 EXEC CICS XCTL 04570000
458045800 PROGRAM (CDEMO-TO-PROGRAM) 04580000
459045900 COMMAREA(CARDDEMO-COMMAREA) 04590000
460046000 END-EXEC 04600000
461046100******************************************************************04610000
462046200* CLEAR SCREEN, CLEAR SAVED CONTEXT 04620000
463046300* ASK USER FOR SEARCH KEYS 04630000
464046400******************************************************************04640000
465046500 WHEN NOT CDEMO-PGM-REENTER 04650000
466046600 AND CDEMO-FROM-PROGRAM EQUAL LIT-ADMINPGM 04660000
467046700 WHEN NOT CDEMO-PGM-REENTER 04670000
468046800 AND CDEMO-FROM-PROGRAM EQUAL LIT-LISTTPGM 04680000
469046900 WHEN CDEMO-PGM-ENTER 04690000
470047000 AND TTUP-DETAILS-NOT-FETCHED 04700000
471047100 INITIALIZE WS-THIS-PROGCOMMAREA 04710000
472047200 WS-MISC-STORAGE 04720000
473047300 CDEMO-ACCT-ID 04730000
474047400 PERFORM 3000-SEND-MAP THRU 04740000
475047500 3000-SEND-MAP-EXIT 04750000
476047600 SET CDEMO-PGM-REENTER TO TRUE 04760000
477047700 SET TTUP-DETAILS-NOT-FETCHED TO TRUE 04770000
478047800 GO TO COMMON-RETURN 04780000
479047900******************************************************************04790000
480048000* USER PRESSED F04 AFTER BEING ASKED TO VERIFY DELETE 04800000
481048100******************************************************************04810000
482048200 WHEN CCARD-AID-PFK04 04820000
483048300 AND TTUP-CONFIRM-DELETE 04830000
484048400 SET TTUP-START-DELETE TO TRUE 04840000
485048500 PERFORM 9800-DELETE-PROCESSING 04850000
486048600 THRU 9800-DELETE-PROCESSING-EXIT 04860000
487048700 PERFORM 3000-SEND-MAP THRU 04870000
488048800 3000-SEND-MAP-EXIT 04880000
489048900 GO TO COMMON-RETURN 04890000
490049000******************************************************************04900000
491049100* USER PRESSED F04.ASK FOR DELETE CONFIRMATION 04910000
492049200******************************************************************04920000
493049300 WHEN CCARD-AID-PFK04 04930000
494049400 AND TTUP-SHOW-DETAILS 04940000
495049500 SET TTUP-CONFIRM-DELETE TO TRUE 04950000
496049600 PERFORM 3000-SEND-MAP THRU 04960000
497049700 3000-SEND-MAP-EXIT 04970000
498049800 GO TO COMMON-RETURN 04980000
499049900******************************************************************04990000
500050000* USER PRESSED F05. WHEN NO RECORD WAS FOUND. 05000000
501050100* ASK TO CONFIRM NEW RECORD CREATION 05010000
502050200******************************************************************05020000
503050300 WHEN CCARD-AID-PFK05 05030000
504050400 AND TTUP-DETAILS-NOT-FOUND 05040000
505050500 SET TTUP-CREATE-NEW-RECORD TO TRUE 05050000
506050600 PERFORM 3000-SEND-MAP THRU 05060000
507050700 3000-SEND-MAP-EXIT 05070000
508050800 GO TO COMMON-RETURN 05080000
509050900******************************************************************05090000
510051000* USER PRESSED F05 AND CONFIRMED THAT CHANGES CAN BE SAVED 05100000
511051100* EDITS HAVE PASSED 05110000
512051200* SO SAVE THE CHANGES 05120000
513051300******************************************************************05130000
514051400 WHEN CCARD-AID-PFK05 05140000
515051500 AND TTUP-CHANGES-OK-NOT-CONFIRMED 05150000
516051600 PERFORM 9600-WRITE-PROCESSING 05160000
517051700 THRU 9600-WRITE-PROCESSING-EXIT 05170000
518051800 PERFORM 3000-SEND-MAP 05180000
519051900 THRU 3000-SEND-MAP-EXIT 05190000
520052000 GO TO COMMON-RETURN 05200000
521052100******************************************************************05210000
522052200* USER PRESSED F12. CANCEL THE ACTION 05220000
523052300******************************************************************05230000
524052400 WHEN CCARD-AID-PFK12 05240000
525052500 AND (TTUP-CHANGES-OK-NOT-CONFIRMED 05250000
526052600 OR TTUP-CONFIRM-DELETE 05260000
527052700 OR TTUP-SHOW-DETAILS) 05270000
528052800 SET FOUND-TRANTYPE-IN-TABLE TO TRUE 05280000
529052900 PERFORM 2000-DECIDE-ACTION 05290000
530053000 THRU 2000-DECIDE-ACTION-EXIT 05300000
531053100 PERFORM 3000-SEND-MAP 05310000
532053200 THRU 3000-SEND-MAP-EXIT 05320000
533053300 GO TO COMMON-RETURN 05330000
534053400******************************************************************05340000
535053500* CHECK THE USER INPUTS 05350000
536053600* DECIDE WHAT TO DO 05360000
537053700* PRESENT NEXT STEPS TO USER 05370000
538053800******************************************************************05380000
539053900 WHEN WS-INVALID-KEY-PRESSED 05390000
540054000 PERFORM 3000-SEND-MAP 05400000
541054100 THRU 3000-SEND-MAP-EXIT 05410000
542054200 GO TO COMMON-RETURN 05420000
543054300******************************************************************05430000
544054400* CHECK THE USER INPUTS 05440000
545054500* DECIDE WHAT TO DO 05450000
546054600* PRESENT NEXT STEPS TO USER 05460000
547054700******************************************************************05470000
548054800 WHEN OTHER 05480000
549054900 PERFORM 1000-PROCESS-INPUTS 05490000
550055000 THRU 1000-PROCESS-INPUTS-EXIT 05500000
551055100 PERFORM 2000-DECIDE-ACTION 05510000
552055200 THRU 2000-DECIDE-ACTION-EXIT 05520000
553055300 PERFORM 3000-SEND-MAP 05530000
554055400 THRU 3000-SEND-MAP-EXIT 05540000
555055500 GO TO COMMON-RETURN 05550000
556055600 END-EVALUATE 05560000
557055700 . 05570000
558055800 05580000
559055900 COMMON-RETURN. 05590000
560056000 MOVE WS-RETURN-MSG TO CCARD-ERROR-MSG 05600000
561056100 05610000
562056200 MOVE CARDDEMO-COMMAREA TO WS-COMMAREA 05620000
563056300 MOVE WS-THIS-PROGCOMMAREA TO 05630000
564056400 WS-COMMAREA(LENGTH OF CARDDEMO-COMMAREA + 1: 05640000
565056500 LENGTH OF WS-THIS-PROGCOMMAREA ) 05650000
566056600 05660000
567056700 EXEC CICS RETURN 05670000
568056800 TRANSID (LIT-THISTRANID) 05680000
569056900 COMMAREA (WS-COMMAREA) 05690000
570057000 LENGTH(LENGTH OF WS-COMMAREA) 05700000
571057100 END-EXEC 05710000
572057200 . 05720000
573057300 0000-MAIN-EXIT. 05730000
574057400 EXIT 05740000
575057500 . 05750000
576057600 05760000
577057700 0001-CHECK-PFKEYS. 05770000
578057800 05780000
579057900* Should mirror logic in PFKey attribut para 05790000
580058000* 3391-PFKEY-ATTRS 05800000
581058100 05810000
582058200 IF (CCARD-AID-PFK03) 05820000
583058300 OR (CCARD-AID-ENTER AND NOT TTUP-CONFIRM-DELETE) 05830000
584058400 OR (CCARD-AID-PFK04 AND (TTUP-SHOW-DETAILS 05840000
585058500 OR TTUP-CONFIRM-DELETE ) 05850000
586058600 ) 05860000
587058700 05870000
588058800 OR (CCARD-AID-PFK05 AND ( 05880000
589058900 TTUP-CHANGES-OK-NOT-CONFIRMED 05890000
590059000 OR TTUP-DETAILS-NOT-FOUND 05900000
591059100 OR TTUP-DELETE-IN-PROGRESS 05910000
592059200 ) 05920000
593059300 ) 05930000
594059400 OR (CCARD-AID-PFK12 AND ( 05940000
595059500 TTUP-CHANGES-OK-NOT-CONFIRMED 05950000
596059600 OR TTUP-SHOW-DETAILS 05960000
597059700 OR TTUP-DETAILS-NOT-FOUND 05970000
598059800 OR TTUP-CONFIRM-DELETE 05980000
599059900 OR TTUP-CREATE-NEW-RECORD 05990000
600060000 ) 06000000
601060100 ) 06010000
602060200 SET PFK-VALID TO TRUE 06020000
603060300 ELSE 06030000
604060400 SET PFK-INVALID TO TRUE 06040000
605060500 IF WS-RETURN-MSG-OFF 06050000
606060600 SET WS-INVALID-KEY-PRESSED TO TRUE 06060000
607060700 END-IF 06070000
608060800 END-IF 06080000
609060900 06090000
610061000 06100000
611061100* IF PFK-INVALID 06110000
612061200* SET WS-INVALID-KEY TO TRUE 06120000
613061300* SET CCARD-AID-ENTER TO TRUE 06130000
614061400* ELSE 06140000
615061500* CONTINUE 06150000
616061600* END-IF 06160000
617061700 06170000
618061800 . 06180000
619061900 06190000
620062000 06200000
621062100 0001-CHECK-PFKEYS-EXIT. 06210000
622062200 EXIT 06220000
623062300 . 06230000
624062400 06240000
625062500 1000-PROCESS-INPUTS. 06250000
626062600 PERFORM 1100-RECEIVE-MAP 06260000
627062700 THRU 1100-RECEIVE-MAP-EXIT 06270000
628062800 PERFORM 1150-STORE-MAP-IN-NEW 06280000
629062900 THRU 1150-STORE-MAP-IN-NEW-EXIT 06290000
630063000 PERFORM 1200-EDIT-MAP-INPUTS 06300000
631063100 THRU 1200-EDIT-MAP-INPUTS-EXIT 06310000
632063200 MOVE WS-RETURN-MSG TO CCARD-ERROR-MSG 06320000
633063300 MOVE LIT-THISPGM TO CCARD-NEXT-PROG 06330000
634063400 MOVE LIT-THISMAPSET TO CCARD-NEXT-MAPSET 06340000
635063500 MOVE LIT-THISMAP TO CCARD-NEXT-MAP 06350000
636063600 . 06360000
637063700* 06370000
638063800 1000-PROCESS-INPUTS-EXIT. 06380000
639063900 EXIT 06390000
640064000 . 06400000
641064100 1100-RECEIVE-MAP. 06410000
642064200 EXEC CICS RECEIVE MAP(LIT-THISMAP) 06420000
643064300 MAPSET(LIT-THISMAPSET) 06430000
644064400 INTO(CTRTUPAI) 06440000
645064500 RESP(WS-RESP-CD) 06450000
646064600 RESP2(WS-REAS-CD) 06460000
647064700 END-EXEC 06470000
648064800 . 06480000
649064900 1100-RECEIVE-MAP-EXIT. 06490000
650065000 EXIT. 06500000
651065100 06510000
652065200 1150-STORE-MAP-IN-NEW. 06520000
653065300 06530000
654065400 IF TTUP-DETAILS-NOT-FOUND 06540000
655065500 AND NOT CCARD-AID-PFK05 06550000
656065600 AND FUNCTION TRIM(TRTYPCDI OF CTRTUPAI) 06560000
657065700 = TTUP-NEW-TTYP-TYPE 06570000
658065800 GO TO 1150-STORE-MAP-IN-NEW-EXIT 06580000
659065900 ELSE 06590000
660066000 CONTINUE 06600000
661066100 END-IF 06610000
662066200 06620000
663066300 INITIALIZE TTUP-NEW-DETAILS 06630000
664066400******************************************************************06640000
665066500* Transaction Type 06650000
666066600******************************************************************06660000
667066700 IF TRTYPCDI OF CTRTUPAI = '*' 06670000
668066800 OR TRTYPCDI OF CTRTUPAI = SPACES 06680000
669066900 MOVE LOW-VALUES TO TTUP-NEW-TTYP-TYPE 06690000
670067000 ELSE 06700000
671067100 MOVE FUNCTION TRIM(TRTYPCDI OF CTRTUPAI) 06710000
672067200 TO TTUP-NEW-TTYP-TYPE 06720000
673067300 END-IF 06730000
674067400 06740000
675067500******************************************************************06750000
676067600* Transaction Desc 06760000
677067700******************************************************************06770000
678067800 IF TRTYDSCI OF CTRTUPAI = '*' 06780000
679067900 OR TRTYDSCI OF CTRTUPAI = SPACES 06790000
680068000 MOVE LOW-VALUES TO TTUP-NEW-TTYP-TYPE-DESC 06800000
681068100 ELSE 06810000
682068200 MOVE FUNCTION TRIM(TRTYDSCI OF CTRTUPAI) 06820000
683068300 TO TTUP-NEW-TTYP-TYPE-DESC 06830000
684068400 END-IF 06840000
685068500 . 06850000
686068600 1150-STORE-MAP-IN-NEW-EXIT. 06860000
687068700 EXIT 06870000
688068800 . 06880000
689068900 1200-EDIT-MAP-INPUTS. 06890000
690069000 SET INPUT-OK TO TRUE 06900000
691069100******************************************************************06910000
692069200* VALIDATE THE SEARCH KEYS 06920000
693069300******************************************************************06930000
694069400* The key was not in database. User sent the same key. So 06940000
695069500* dont edit again. Set tran filter to valid and skip 06950000
696069600* rest of edits 06960000
697069700* 06970000
698069800 IF TTUP-DETAILS-NOT-FOUND 06980000
699069900 AND FUNCTION TRIM(TRTYPCDI OF CTRTUPAI) 06990000
700070000 = TTUP-NEW-TTYP-TYPE 07000000
701070100 IF CCARD-AID-PFK05 07010000
702070200 CONTINUE 07020000
703070300 ELSE 07030000
704070400 SET TTUP-DETAILS-NOT-FETCHED TO TRUE 07040000
705070500 END-IF 07050000
706070600 SET FLG-TRANFILTER-ISVALID TO TRUE 07060000
707070700 GO TO 1200-EDIT-MAP-INPUTS-EXIT 07070000
708070800 ELSE 07080000
709070900 CONTINUE 07090000
710071000 END-IF 07100000
711071100 07110000
712071200 IF TTUP-CREATE-NEW-RECORD 07120000
713071300 OR TTUP-CHANGES-OK-NOT-CONFIRMED 07130000
714071400 CONTINUE 07140000
715071500 ELSE 07150000
716071600 PERFORM 1210-EDIT-TRANTYPE 07160000
717071700 THRU 1210-EDIT-TRANTYPE-EXIT 07170000
718071800 07180000
719071900* IF THE SEARCH CONDITIONS HAVE PROBLEMS FLAG THEM 07190000
720072000 IF FLG-TRANFILTER-BLANK 07200000
721072100 IF WS-RETURN-MSG-OFF 07210000
722072200 SET NO-SEARCH-CRITERIA-RECEIVED TO TRUE 07220000
723072300 END-IF 07230000
724072400 SET TTUP-DETAILS-NOT-FETCHED TO TRUE 07240000
725072500 GO TO 1200-EDIT-MAP-INPUTS-EXIT 07250000
726072600 END-IF 07260000
727072700 07270000
728072800 IF FLG-TRANFILTER-NOT-OK 07280000
729072900 SET TTUP-INVALID-SEARCH-KEYS TO TRUE 07290000
730073000 SET TTUP-DETAILS-NOT-FETCHED TO TRUE 07300000
731073100 GO TO 1200-EDIT-MAP-INPUTS-EXIT 07310000
732073200 END-IF 07320000
733073300 07330000
734073400 IF TTUP-DETAILS-NOT-FETCHED 07340000
735073500 GO TO 1200-EDIT-MAP-INPUTS-EXIT 07350000
736073600 END-IF 07360000
737073700 END-IF 07370000
738073800******************************************************************07380000
739073900* SEARCH KEYS ALREADY VALIDATED. CHECK OTHER INPUTS 07390000
740074000******************************************************************07400000
741074100 SET FLG-TRANFILTER-ISVALID TO TRUE 07410000
742074200* 07420000
743074300 PERFORM 1205-COMPARE-OLD-NEW 07430000
744074400 THRU 1205-COMPARE-OLD-NEW-EXIT 07440000
745074500 07450000
746074600 IF NO-CHANGES-FOUND 07460000
747074700 OR TTUP-CHANGES-OK-NOT-CONFIRMED 07470000
748074800 OR TTUP-CHANGES-OKAYED-AND-DONE 07480000
749074900 MOVE LOW-VALUES TO WS-NON-KEY-FLAGS 07490000
750075000 GO TO 1200-EDIT-MAP-INPUTS-EXIT 07500000
751075100 END-IF 07510000
752075200 07520000
753075300 SET TTUP-CHANGES-NOT-OK TO TRUE 07530000
754075400 07540000
755075500******************************************************************07550000
756075600* Edit Description 07560000
757075700******************************************************************07570000
758075800 MOVE 'Transaction Desc' TO WS-EDIT-VARIABLE-NAME 07580000
759075900 MOVE TTUP-NEW-TTYP-TYPE-DESC TO WS-EDIT-ALPHANUM-ONLY 07590000
760076000 MOVE 50 TO WS-EDIT-ALPHANUM-LENGTH 07600000
761076100 PERFORM 1230-EDIT-ALPHANUM-REQD 07610000
762076200 THRU 1230-EDIT-ALPHANUM-REQD-EXIT 07620000
763076300 MOVE WS-EDIT-ALPHANUM-ONLY-FLAGS 07630000
764076400 TO WS-EDIT-DESC-FLAGS 07640000
765076500 07650000
766076600* Cross field edits begin here 07660000
767076700* 07670000
768076800* No cross edits in this program so far 07680000
769076900 07690000
770077000* Set green light for confirmation if no errors found 07700000
771077100 07710000
772077200 IF INPUT-ERROR 07720000
773077300 CONTINUE 07730000
774077400 ELSE 07740000
775077500 SET TTUP-CHANGES-OK-NOT-CONFIRMED TO TRUE 07750000
776077600 END-IF 07760000
777077700 . 07770000
778077800 07780000
779077900 1200-EDIT-MAP-INPUTS-EXIT. 07790000
780078000 EXIT 07800000
781078100 . 07810000
782078200 07820000
783078300 1205-COMPARE-OLD-NEW. 07830000
784078400 SET NO-CHANGES-FOUND TO TRUE 07840000
785078500 07850000
786078600 IF FUNCTION UPPER-CASE ( 07860000
787078700 TTUP-NEW-TTYP-TYPE) = 07870000
788078800 FUNCTION UPPER-CASE ( 07880000
789078900 TTUP-OLD-TTYP-TYPE) 07890000
790079000 AND FUNCTION UPPER-CASE ( 07900000
791079100 FUNCTION TRIM (TTUP-NEW-TTYP-TYPE-DESC))= 07910000
792079200 FUNCTION UPPER-CASE ( 07920000
793079300 FUNCTION TRIM (TTUP-OLD-TTYP-TYPE-DESC)) 07930000
794079400 AND FUNCTION LENGTH ( 07940000
795079500 FUNCTION TRIM (TTUP-NEW-TTYP-TYPE-DESC))= 07950000
796079600 FUNCTION LENGTH ( 07960000
797079700 FUNCTION TRIM (TTUP-OLD-TTYP-TYPE-DESC)) 07970000
798079800 07980000
799079900 IF WS-RETURN-MSG-OFF 07990000
800080000 SET NO-CHANGES-DETECTED TO TRUE 08000000
801080100 ELSE 08010000
802080200 CONTINUE 08020000
803080300 END-IF 08030000
804080400 ELSE 08040000
805080500 IF WS-RETURN-MSG-OFF 08050000
806080600 SET CHANGE-HAS-OCCURRED TO TRUE 08060000
807080700 ELSE 08070000
808080800 CONTINUE 08080000
809080900 END-IF 08090000
810081000 GO TO 1205-COMPARE-OLD-NEW-EXIT 08100000
811081100 END-IF 08110000
812081200 . 08120000
813081300 08130000
814081400 1205-COMPARE-OLD-NEW-EXIT. 08140000
815081500 EXIT 08150000
816081600 . 08160000
817081700 08170000
818081800 08180000
819081900* 08190000
820082000 1210-EDIT-TRANTYPE. 08200000
821082100 SET FLG-TRANFILTER-NOT-OK TO TRUE 08210000
822082200 08220000
823082300******************************************************************08230000
824082400* Edit Tran Type code 08240000
825082500******************************************************************08250000
826082600 MOVE 'Tran Type code' TO WS-EDIT-VARIABLE-NAME 08260000
827082700 MOVE TTUP-NEW-TTYP-TYPE TO WS-EDIT-ALPHANUM-ONLY 08270000
828082800 MOVE 2 TO WS-EDIT-ALPHANUM-LENGTH 08280000
829082900 PERFORM 1245-EDIT-NUM-REQD 08290000
830083000 THRU 1245-EDIT-NUM-REQD-EXIT 08300000
831083100 MOVE WS-EDIT-ALPHANUM-ONLY-FLAGS 08310000
832083200 TO WS-EDIT-TTYP-FLAG 08320000
833083300 08330000
834083400 IF FLG-TRANFILTER-ISVALID 08340000
835083500 COMPUTE WS-EDIT-NUMERIC-2 08350000
836083600 = FUNCTION NUMVAL(TTUP-NEW-TTYP-TYPE) 08360000
837083700 END-COMPUTE 08370000
838083800 MOVE WS-EDIT-NUMERIC-2 TO WS-EDIT-ALPHANUMERIC-2 08380000
839083900 INSPECT WS-EDIT-ALPHANUMERIC-2 08390000
840084000 REPLACING ALL SPACES BY ZEROS 08400000
841084100 MOVE WS-EDIT-ALPHANUMERIC-2 TO TTUP-NEW-TTYP-TYPE 08410000
842084200 END-IF 08420000
843084300 . 08430000
844084400 08440000
845084500 1210-EDIT-TRANTYPE-EXIT. 08450000
846084600 EXIT 08460000
847084700 . 08470000
848084800 08480000
849084900 1230-EDIT-ALPHANUM-REQD. 08490000
850085000* Initialize 08500000
851085100 SET FLG-ALPHNANUM-NOT-OK TO TRUE 08510000
852085200 08520000
853085300* Not supplied 08530000
854085400 IF WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH) 08540000
855085500 EQUAL LOW-VALUES 08550000
856085600 OR WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH) 08560000
857085700 EQUAL SPACES 08570000
858085800 OR FUNCTION LENGTH(FUNCTION TRIM( 08580000
859085900 WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH))) = 0 08590000
860086000 08600000
861086100 SET INPUT-ERROR TO TRUE 08610000
862086200 SET FLG-ALPHNANUM-BLANK TO TRUE 08620000
863086300 IF WS-RETURN-MSG-OFF 08630000
864086400 STRING 08640000
865086500 FUNCTION TRIM(WS-EDIT-VARIABLE-NAME) 08650000
866086600 ' must be supplied.' 08660000
867086700 DELIMITED BY SIZE 08670000
868086800 INTO WS-RETURN-MSG 08680000
869086900 END-STRING 08690000
870087000 END-IF 08700000
871087100 08710000
872087200 GO TO 1230-EDIT-ALPHANUM-REQD-EXIT 08720000
873087300 END-IF 08730000
874087400 08740000
875087500* Only Alphabets,numbers and space allowed 08750000
876087600 MOVE LIT-ALL-ALPHANUM-FROM-X TO LIT-ALL-ALPHANUM-FROM 08760000
877087700 08770000
878087800 INSPECT WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH) 08780000
879087900 CONVERTING LIT-ALL-ALPHANUM-FROM 08790000
880088000 TO LIT-ALPHANUM-SPACES-TO 08800000
881088100 08810000
882088200 IF FUNCTION LENGTH( 08820000
883088300 FUNCTION TRIM( 08830000
884088400 WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH) 08840000
885088500 )) = 0 08850000
886088600 CONTINUE 08860000
887088700 ELSE 08870000
888088800 SET INPUT-ERROR TO TRUE 08880000
889088900 SET FLG-ALPHNANUM-NOT-OK TO TRUE 08890000
890089000 IF WS-RETURN-MSG-OFF 08900000
891089100 STRING 08910000
892089200 FUNCTION TRIM(WS-EDIT-VARIABLE-NAME) 08920000
893089300 ' can have numbers or alphabets only.' 08930000
894089400 DELIMITED BY SIZE 08940000
895089500 INTO WS-RETURN-MSG 08950000
896089600 END-STRING 08960000
897089700 END-IF 08970000
898089800 GO TO 1230-EDIT-ALPHANUM-REQD-EXIT 08980000
899089900 END-IF 08990000
900090000 09000000
901090100 SET FLG-ALPHNANUM-ISVALID TO TRUE 09010000
902090200 . 09020000
903090300 1230-EDIT-ALPHANUM-REQD-EXIT. 09030000
904090400 EXIT 09040000
905090500 . 09050000
906090600 09060000
907090700 1245-EDIT-NUM-REQD. 09070000
908090800* Initialize 09080000
909090900 SET FLG-ALPHNANUM-NOT-OK TO TRUE 09090000
910091000 09100000
911091100* Not supplied 09110000
912091200 IF WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH) 09120000
913091300 EQUAL LOW-VALUES 09130000
914091400 OR WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH) 09140000
915091500 EQUAL SPACES 09150000
916091600 OR FUNCTION LENGTH(FUNCTION TRIM( 09160000
917091700 WS-EDIT-ALPHANUM-ONLY(1:WS-EDIT-ALPHANUM-LENGTH))) = 0 09170000
918091800 09180000
919091900 SET INPUT-ERROR TO TRUE 09190000
920092000 SET FLG-ALPHNANUM-BLANK TO TRUE 09200000
921092100 IF WS-RETURN-MSG-OFF 09210000
922092200 STRING 09220000
923092300 FUNCTION TRIM(WS-EDIT-VARIABLE-NAME) 09230000
924092400 ' must be supplied.' 09240000
925092500 DELIMITED BY SIZE 09250000
926092600 INTO WS-RETURN-MSG 09260000
927092700 END-STRING 09270000
928092800 END-IF 09280000
929092900 GO TO 1245-EDIT-NUM-REQD-EXIT 09290000
930093000 END-IF 09300000
931093100 09310000
932093200* Only all numeric allowed 09320000
933093300 09330000
934093400 IF FUNCTION TEST-NUMVAL(WS-EDIT-ALPHANUM-ONLY(1: 09340000
935093500 WS-EDIT-ALPHANUM-LENGTH)) = 0 09350000
936093600 CONTINUE 09360000
937093700 ELSE 09370000
938093800 SET INPUT-ERROR TO TRUE 09380000
939093900 SET FLG-ALPHNANUM-NOT-OK TO TRUE 09390000
940094000 IF WS-RETURN-MSG-OFF 09400000
941094100 STRING 09410000
942094200 FUNCTION TRIM(WS-EDIT-VARIABLE-NAME) 09420000
943094300 ' must be numeric.' 09430000
944094400 DELIMITED BY SIZE 09440000
945094500 INTO WS-RETURN-MSG 09450000
946094600 END-STRING 09460000
947094700 END-IF 09470000
948094800 GO TO 1245-EDIT-NUM-REQD-EXIT 09480000
949094900 END-IF 09490000
950095000* 09500000
951095100 09510000
952095200* Must not be zero 09520000
953095300 09530000
954095400 IF FUNCTION NUMVAL(WS-EDIT-ALPHANUM-ONLY(1: 09540000
955095500 WS-EDIT-ALPHANUM-LENGTH)) = 0 09550000
956095600 SET INPUT-ERROR TO TRUE 09560000
957095700 SET FLG-ALPHNANUM-NOT-OK TO TRUE 09570000
958095800 IF WS-RETURN-MSG-OFF 09580000
959095900 STRING 09590000
960096000 FUNCTION TRIM(WS-EDIT-VARIABLE-NAME) 09600000
961096100 ' must not be zero.' 09610000
962096200 DELIMITED BY SIZE 09620000
963096300 INTO WS-RETURN-MSG 09630000
964096400 END-STRING 09640000
965096500 END-IF 09650000
966096600 GO TO 1245-EDIT-NUM-REQD-EXIT 09660000
967096700 ELSE 09670000
968096800 CONTINUE 09680000
969096900 END-IF 09690000
970097000 09700000
971097100 09710000
972097200 SET FLG-ALPHNANUM-ISVALID TO TRUE 09720000
973097300 . 09730000
974097400 1245-EDIT-NUM-REQD-EXIT. 09740000
975097500 EXIT 09750000
976097600 . 09760000
977097700 09770000
978097800 2000-DECIDE-ACTION. 09780000
979097900 EVALUATE TRUE 09790000
980098000******************************************************************09800000
981098100* NO DETAILS SHOWN. 09810000
982098200* SO GET THEM AND SETUP DETAIL EDIT SCREEN 09820000
983098300******************************************************************09830000
984098400 WHEN TTUP-DETAILS-NOT-FETCHED 09840000
985098500******************************************************************09850000
986098600* CHANGES MADE. BUT USER CANCELS 09860000
987098700******************************************************************09870000
988098800 WHEN CCARD-AID-PFK12 09880000
989098900 IF FLG-TRANFILTER-ISVALID 09890000
990099000 SET WS-RETURN-MSG-OFF TO TRUE 09900000
991099100 PERFORM 9000-READ-TRANTYPE 09910000
992099200 THRU 9000-READ-TRANTYPE-EXIT 09920000
993099300 IF FOUND-TRANTYPE-IN-TABLE 09930000
994099400 SET TTUP-SHOW-DETAILS TO TRUE 09940000
995099500 ELSE 09950000
996099600 SET TTUP-DETAILS-NOT-FOUND TO TRUE 09960000
997099700 END-IF 09970000
998099800 ELSE 09980000
999099900 EVALUATE TRUE 09990000
1000100000 WHEN TTUP-CONFIRM-DELETE 10000000
1001100100 SET WS-DELETE-WAS-CANCELLED TO TRUE 10010000
1002100200 SET TTUP-DETAILS-NOT-FETCHED TO TRUE 10020000
1003100300 WHEN TTUP-CHANGES-OK-NOT-CONFIRMED 10030000
1004100400 SET WS-UPDATE-WAS-CANCELLED TO TRUE 10040000
1005100500 SET TTUP-CHANGES-BACKED-OUT TO TRUE 10050000
1006100600 WHEN OTHER 10060000
1007100700 SET TTUP-DETAILS-NOT-FETCHED TO TRUE 10070000
1008100800 END-EVALUATE 10080000
1009100900 10090000
1010101000 END-IF 10100000
1011101100******************************************************************10110000
1012101200* DETAILS SHOWN 10120000
1013101300* BUT USER PRESSES F4 FOR DELETE 10130000
1014101400* ASK THE USER TO CONFIRM THE DELETE 10140000
1015101500******************************************************************10150000
1016101600 WHEN TTUP-CONFIRM-DELETE 10160000
1017101700 AND CCARD-AID-PFK12 10170000
1018101800 SET TTUP-CONFIRM-DELETE TO TRUE 10180000
1019101900******************************************************************10190000
1020102000* DETAILS SHOWN 10200000
1021102100* CHECK CHANGES AND ASK CONFIRMATION IF GOOD 10210000
1022102200******************************************************************10220000
1023102300 WHEN TTUP-SHOW-DETAILS 10230000
1024102400 IF INPUT-ERROR 10240000
1025102500 OR NO-CHANGES-DETECTED 10250000
1026102600 OR WS-INVALID-KEY 10260000
1027102700 CONTINUE 10270000
1028102800 ELSE 10280000
1029102900 SET TTUP-CHANGES-OK-NOT-CONFIRMED TO TRUE 10290000
1030103000 END-IF 10300000
1031103100******************************************************************10310000
1032103200* DETAILS SHOWN 10320000
1033103300* BUT INPUT EDIT ERRORS FOUND 10330000
1034103400******************************************************************10340000
1035103500 WHEN TTUP-CHANGES-NOT-OK 10350000
1036103600 CONTINUE 10360000
1037103700******************************************************************10370000
1038103800* CHANGES BACKED OUT 10380000
1039103900* GO BACK TO CHANGES NOT OK STATE 10390000
1040104000******************************************************************10400000
1041104100 WHEN TTUP-CHANGES-BACKED-OUT 10410000
1042104200 SET TTUP-CHANGES-NOT-OK TO TRUE 10420000
1043104300******************************************************************10430000
1044104400* PROBLEMS FOUND IN SEARCH KEYS 10440000
1045104500******************************************************************10450000
1046104600 WHEN TTUP-INVALID-SEARCH-KEYS 10460000
1047104700 CONTINUE 10470000
1048104800******************************************************************10480000
1049104900* SEARCH KEY WAS VALID. 10490000
1050105000* BUT DATA WAS NOT FOUND IN TABLE 10500000
1051105100* CUSTOMER DECIDES TO CONTINUE AND ADD RECORD 10510000
1052105200******************************************************************10520000
1053105300 WHEN CCARD-AID-PFK05 10530000
1054105400 AND TTUP-DETAILS-NOT-FOUND 10540000
1055105500 SET TTUP-CREATE-NEW-RECORD TO TRUE 10550000
1056105600******************************************************************10560000
1057105700* DETAILS EDITED , FOUND OK, CONFIRM SAVE REQUESTED 10570000
1058105800* CONFIRMATION NOT GIVEN. SO SHOW DETAILS AGAIN 10580000
1059105900******************************************************************10590000
1060106000 WHEN TTUP-CHANGES-OK-NOT-CONFIRMED 10600000
1061106100 CONTINUE 10610000
1062106200******************************************************************10620000
1063106300* SHOW CONFIRMATION. GO BACK TO SQUARE 1 10630000
1064106400******************************************************************10640000
1065106500 WHEN TTUP-CHANGES-OKAYED-AND-DONE 10650000
1066106600 SET TTUP-SHOW-DETAILS TO TRUE 10660000
1067106700 IF CDEMO-FROM-TRANID EQUAL LOW-VALUES 10670000
1068106800 OR CDEMO-FROM-TRANID EQUAL SPACES 10680000
1069106900 MOVE ZEROES TO CDEMO-ACCT-ID 10690000
1070107000 CDEMO-CARD-NUM 10700000
1071107100 MOVE LOW-VALUES TO CDEMO-ACCT-STATUS 10710000
1072107200 END-IF 10720000
1073107300 WHEN OTHER 10730000
1074107400 MOVE LIT-THISPGM TO ABEND-CULPRIT 10740000
1075107500 MOVE '0001' TO ABEND-CODE 10750000
1076107600 MOVE SPACES TO ABEND-REASON 10760000
1077107700 MOVE 'UNEXPECTED DATA SCENARIO' 10770000
1078107800 TO ABEND-MSG 10780000
1079107900 PERFORM ABEND-ROUTINE 10790000
1080108000 THRU ABEND-ROUTINE-EXIT 10800000
1081108100 END-EVALUATE 10810000
1082108200 . 10820000
1083108300 2000-DECIDE-ACTION-EXIT. 10830000
1084108400 EXIT 10840000
1085108500 . 10850000
1086108600 10860000
1087108700 10870000
1088108800 10880000
1089108900 3000-SEND-MAP. 10890000
1090109000 PERFORM 3100-SCREEN-INIT 10900000
1091109100 THRU 3100-SCREEN-INIT-EXIT 10910000
1092109200 PERFORM 3200-SETUP-SCREEN-VARS 10920000
1093109300 THRU 3200-SETUP-SCREEN-VARS-EXIT 10930000
1094109400 PERFORM 3250-SETUP-INFOMSG 10940000
1095109500 THRU 3250-SETUP-INFOMSG-EXIT 10950000
1096109600 PERFORM 3300-SETUP-SCREEN-ATTRS 10960000
1097109700 THRU 3300-SETUP-SCREEN-ATTRS-EXIT 10970000
1098109800 PERFORM 3390-SETUP-INFOMSG-ATTRS 10980000
1099109900 THRU 3390-SETUP-INFOMSG-ATTRS-EXIT 10990000
1100110000 PERFORM 3391-SETUP-PFKEY-ATTRS 11000000
1101110100 THRU 3391-SETUP-PFKEY-ATTRS-EXIT 11010000
1102110200 PERFORM 3400-SEND-SCREEN 11020000
1103110300 THRU 3400-SEND-SCREEN-EXIT 11030000
1104110400 . 11040000
1105110500 11050000
1106110600 3000-SEND-MAP-EXIT. 11060000
1107110700 EXIT 11070000
1108110800 . 11080000
1109110900 11090000
1110111000 3100-SCREEN-INIT. 11100000
1111111100 MOVE LOW-VALUES TO CTRTUPAO 11110000
1112111200 11120000
1113111300 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA 11130000
1114111400 11140000
1115111500 MOVE CCDA-TITLE01 TO TITLE01O OF CTRTUPAO 11150000
1116111600 MOVE CCDA-TITLE02 TO TITLE02O OF CTRTUPAO 11160000
1117111700 MOVE LIT-THISTRANID TO TRNNAMEO OF CTRTUPAO 11170000
1118111800 MOVE LIT-THISPGM TO PGMNAMEO OF CTRTUPAO 11180000
1119111900 11190000
1120112000 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA 11200000
1121112100 11210000
1122112200 MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM 11220000
1123112300 MOVE WS-CURDATE-DAY TO WS-CURDATE-DD 11230000
1124112400 MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY 11240000
1125112500 11250000
1126112600 MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF CTRTUPAO 11260000
1127112700 11270000
1128112800 MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH 11280000
1129112900 MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM 11290000
1130113000 MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS 11300000
1131113100 11310000
1132113200 MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF CTRTUPAO 11320000
1133113300 11330000
1134113400 . 11340000
1135113500 11350000
1136113600 3100-SCREEN-INIT-EXIT. 11360000
1137113700 EXIT 11370000
1138113800 . 11380000
1139113900 11390000
1140114000 3200-SETUP-SCREEN-VARS. 11400000
1141114100* INITIALIZE SEARCH CRITERIA 11410000
1142114200 IF CDEMO-PGM-ENTER 11420000
1143114300 CONTINUE 11430000
1144114400 ELSE 11440000
1145114500 EVALUATE TRUE 11450000
1146114600 WHEN TTUP-DETAILS-NOT-FETCHED 11460000
1147114700 PERFORM 3201-SHOW-INITIAL-VALUES 11470000
1148114800 THRU 3201-SHOW-INITIAL-VALUES-EXIT 11480000
1149114900 WHEN TTUP-SHOW-DETAILS 11490000
1150115000 WHEN TTUP-CONFIRM-DELETE 11500000
1151115100 WHEN TTUP-DELETE-FAILED 11510000
1152115200 WHEN TTUP-DELETE-DONE 11520000
1153115300 WHEN TTUP-CHANGES-BACKED-OUT 11530000
1154115400 INITIALIZE TTUP-NEW-DETAILS 11540000
1155115500 PERFORM 3202-SHOW-ORIGINAL-VALUES 11550000
1156115600 THRU 3202-SHOW-ORIGINAL-VALUES-EXIT 11560000
1157115700 WHEN TTUP-CHANGES-MADE 11570000
1158115800 WHEN TTUP-CHANGES-NOT-OK 11580000
1159115900 WHEN TTUP-DETAILS-NOT-FOUND 11590000
1160116000 WHEN TTUP-INVALID-SEARCH-KEYS 11600000
1161116100 WHEN TTUP-CREATE-NEW-RECORD 11610000
1162116200 WHEN TTUP-CHANGES-OKAYED-AND-DONE 11620000
1163116300 PERFORM 3203-SHOW-UPDATED-VALUES 11630000
1164116400 THRU 3203-SHOW-UPDATED-VALUES-EXIT 11640000
1165116500 WHEN OTHER 11650000
1166116600 INITIALIZE TTUP-NEW-DETAILS 11660000
1167116700 PERFORM 3202-SHOW-ORIGINAL-VALUES 11670000
1168116800 THRU 3202-SHOW-ORIGINAL-VALUES-EXIT 11680000
1169116900 END-EVALUATE 11690000
1170117000 END-IF 11700000
1171117100 . 11710000
1172117200 3200-SETUP-SCREEN-VARS-EXIT. 11720000
1173117300 EXIT 11730000
1174117400 . 11740000
1175117500 11750000
1176117600 3201-SHOW-INITIAL-VALUES. 11760000
1177117700 MOVE LOW-VALUES TO TRTYPCDO OF CTRTUPAO 11770000
1178117800 TRTYPCDO OF CTRTUPAO 11780000
1179117900 . 11790000
1180118000 11800000
1181118100 3201-SHOW-INITIAL-VALUES-EXIT. 11810000
1182118200 EXIT 11820000
1183118300 . 11830000
1184118400 11840000
1185118500 3202-SHOW-ORIGINAL-VALUES. 11850000
1186118600 11860000
1187118700 MOVE LOW-VALUES TO WS-NON-KEY-FLAGS 11870000
1188118800 11880000
1189118900 MOVE TTUP-OLD-TTYP-TYPE TO TRTYPCDO OF CTRTUPAO 11890000
1190119000 MOVE TTUP-OLD-TTYP-TYPE-DESC TO TRTYDSCO OF CTRTUPAO 11900000
1191119100 11910000
1192119200 . 11920000
1193119300 11930000
1194119400 3202-SHOW-ORIGINAL-VALUES-EXIT. 11940000
1195119500 EXIT 11950000
1196119600 . 11960000
1197119700 3203-SHOW-UPDATED-VALUES. 11970000
1198119800 11980000
1199119900 MOVE TTUP-NEW-TTYP-TYPE TO TRTYPCDO OF CTRTUPAO 11990000
1200120000 MOVE TTUP-NEW-TTYP-TYPE-DESC TO TRTYDSCO OF CTRTUPAO 12000000
1201120100 . 12010000
1202120200 12020000
1203120300 3203-SHOW-UPDATED-VALUES-EXIT. 12030000
1204120400 EXIT 12040000
1205120500 . 12050000
1206120600 12060000
1207120700 12070000
1208120800 12080000
1209120900 12090000
1210121000 3250-SETUP-INFOMSG. 12100000
1211121100* SETUP INFORMATION MESSAGE 12110000
1212121200 12120000
1213121300 EVALUATE TRUE 12130000
1214121400 WHEN CDEMO-PGM-ENTER 12140000
1215121500 SET PROMPT-FOR-SEARCH-KEYS TO TRUE 12150000
1216121600 WHEN TTUP-DETAILS-NOT-FETCHED 12160000
1217121700 WHEN TTUP-INVALID-SEARCH-KEYS 12170000
1218121800 SET PROMPT-FOR-SEARCH-KEYS TO TRUE 12180000
1219121900 WHEN TTUP-DETAILS-NOT-FOUND 12190000
1220122000 SET PROMPT-CREATE-NEW-RECORD TO TRUE 12200000
1221122100 WHEN TTUP-SHOW-DETAILS 12210000
1222122200 WHEN TTUP-CHANGES-BACKED-OUT 12220000
1223122300 AND (TTUP-OLD-TTYP-TYPE = LOW-VALUES 12230000
1224122400 OR TTUP-OLD-TTYP-TYPE = SPACES) 12240000
1225122500 SET PROMPT-FOR-SEARCH-KEYS TO TRUE 12250000
1226122600 WHEN TTUP-CHANGES-BACKED-OUT 12260000
1227122700 WHEN TTUP-CHANGES-NOT-OK 12270000
1228122800 SET PROMPT-FOR-CHANGES TO TRUE 12280000
1229122900 WHEN TTUP-CONFIRM-DELETE 12290000
1230123000 SET PROMPT-DELETE-CONFIRM TO TRUE 12300000
1231123100 WHEN TTUP-DELETE-FAILED 12310000
1232123200 SET INFORM-FAILURE TO TRUE 12320000
1233123300 WHEN TTUP-DELETE-DONE 12330000
1234123400 SET CONFIRM-DELETE-SUCCESS TO TRUE 12340000
1235123500 WHEN TTUP-CREATE-NEW-RECORD 12350000
1236123600 SET PROMPT-FOR-NEWDATA TO TRUE 12360000
1237123700 WHEN TTUP-CHANGES-OK-NOT-CONFIRMED 12370000
1238123800 SET PROMPT-FOR-CONFIRMATION TO TRUE 12380000
1239123900 WHEN TTUP-CHANGES-OKAYED-AND-DONE 12390000
1240124000 SET CONFIRM-UPDATE-SUCCESS TO TRUE 12400000
1241124100 WHEN TTUP-CHANGES-OKAYED-LOCK-ERROR 12410000
1242124200 SET INFORM-FAILURE TO TRUE 12420000
1243124300 WHEN TTUP-CHANGES-OKAYED-BUT-FAILED 12430000
1244124400 SET INFORM-FAILURE TO TRUE 12440000
1245124500 WHEN WS-NO-INFO-MESSAGE 12450000
1246124600 SET PROMPT-FOR-SEARCH-KEYS TO TRUE 12460000
1247124700 END-EVALUATE 12470000
1248124800 12480000
1249124900* Center justify the text 12490000
1250125000* 12500000
1251125100 COMPUTE WS-STRING-LEN = 12510000
1252125200 FUNCTION LENGTH( 12520000
1253125300 FUNCTION TRIM(WS-INFO-MSG) 12530000
1254125400 ) 12540000
1255125500 COMPUTE WS-STRING-MID = 12550000
1256125600 (FUNCTION LENGTH(WS-INFO-MSG) 12560000
1257125700 - WS-STRING-LEN) / 2 + 1 12570000
1258125800 MOVE WS-INFO-MSG(1:WS-STRING-LEN) 12580000
1259125900 TO WS-STRING-OUT(WS-STRING-MID: 12590000
1260126000 WS-STRING-LEN) 12600000
1261126100 12610000
1262126200 MOVE WS-STRING-OUT TO INFOMSGO OF CTRTUPAO 12620000
1263126300 12630000
1264126400 MOVE WS-RETURN-MSG TO ERRMSGO OF CTRTUPAO 12640000
1265126500 . 12650000
1266126600 3250-SETUP-INFOMSG-EXIT. 12660000
1267126700 EXIT 12670000
1268126800 . 12680000
1269126900 3300-SETUP-SCREEN-ATTRS. 12690000
1270127000 12700000
1271127100* PROTECT ALL FIELDS 12710000
1272127200 PERFORM 3310-PROTECT-ALL-ATTRS 12720000
1273127300 THRU 3310-PROTECT-ALL-ATTRS-EXIT 12730000
1274127400 12740000
1275127500* UNPROTECT BASED ON CONTEXT 12750000
1276127600 EVALUATE TRUE 12760000
1277127700 WHEN TTUP-DETAILS-NOT-FETCHED 12770000
1278127800 WHEN TTUP-INVALID-SEARCH-KEYS 12780000
1279127900 WHEN TTUP-DETAILS-NOT-FOUND 12790000
1280128000 WHEN TTUP-CHANGES-BACKED-OUT 12800000
1281128100 AND (TTUP-OLD-TTYP-TYPE = LOW-VALUES 12810000
1282128200 OR TTUP-OLD-TTYP-TYPE = SPACES) 12820000
1283128300* Make Search Keys editable 12830000
1284128400 MOVE DFHBMFSE TO TRTYPCDA OF CTRTUPAI 12840000
1285128500 WHEN TTUP-SHOW-DETAILS 12850000
1286128600 WHEN TTUP-CHANGES-NOT-OK 12860000
1287128700 WHEN TTUP-CREATE-NEW-RECORD 12870000
1288128800 WHEN TTUP-CHANGES-BACKED-OUT 12880000
1289128900 PERFORM 3320-UNPROTECT-FEW-ATTRS 12890000
1290129000 THRU 3320-UNPROTECT-FEW-ATTRS-EXIT 12900000
1291129100 WHEN TTUP-CHANGES-OK-NOT-CONFIRMED 12910000
1292129200 WHEN TTUP-CHANGES-OKAYED-AND-DONE 12920000
1293129300 WHEN TTUP-DELETE-IN-PROGRESS 12930000
1294129400* Keep all fields protected 12940000
1295129500 CONTINUE 12950000
1296129600 WHEN OTHER 12960000
1297129700 MOVE DFHBMFSE TO TRTYPCDA OF CTRTUPAI 12970000
1298129800 END-EVALUATE 12980000
1299129900 12990000
1300130000******************************************************************13000000
1301130100* POSITION CURSOR - ORDER BASED ON SCREEN LOCATION 13010000
1302130200******************************************************************13020000
1303130300 EVALUATE TRUE 13030000
1304130400 WHEN TTUP-DETAILS-NOT-FETCHED 13040000
1305130500 WHEN TTUP-DETAILS-NOT-FOUND 13050000
1306130600 WHEN TTUP-INVALID-SEARCH-KEYS 13060000
1307130700 WHEN FLG-TRANFILTER-NOT-OK 13070000
1308130800 WHEN FLG-TRANFILTER-BLANK 13080000
1309130900 WHEN TTUP-CHANGES-OKAYED-AND-DONE 13090000
1310131000 WHEN TTUP-CHANGES-BACKED-OUT 13100000
1311131100 AND (TTUP-OLD-TTYP-TYPE = LOW-VALUES 13110000
1312131200 OR TTUP-OLD-TTYP-TYPE = SPACES) 13120000
1313131300 MOVE -1 TO TRTYPCDL OF CTRTUPAI 13130000
1314131400* Description 13140000
1315131500 WHEN TTUP-CREATE-NEW-RECORD 13150000
1316131600 WHEN NO-CHANGES-DETECTED 13160000
1317131700 WHEN FLG-DESCRIPTION-NOT-OK 13170000
1318131800 WHEN FLG-DESCRIPTION-BLANK 13180000
1319131900 WHEN TTUP-CHANGES-MADE 13190000
1320132000 WHEN TTUP-CHANGES-BACKED-OUT 13200000
1321132100 WHEN TTUP-SHOW-DETAILS 13210000
1322132200 MOVE -1 TO TRTYDSCL OF CTRTUPAI 13220000
1323132300 WHEN OTHER 13230000
1324132400 MOVE -1 TO TRTYPCDL OF CTRTUPAI 13240000
1325132500 END-EVALUATE 13250000
1326132600 13260000
1327132700******************************************************************13270000
1328132800* SETUP COLOR 13280000
1329132900******************************************************************13290000
1330133000* Transaction Type code filer 13300000
1331133100 IF FLG-TRANFILTER-NOT-OK 13310000
1332133200 OR TTUP-DELETE-FAILED 13320000
1333133300 MOVE DFHRED TO TRTYPCDC OF CTRTUPAO 13330000
1334133400 END-IF 13340000
1335133500 13350000
1336133600 IF FLG-TRANFILTER-BLANK 13360000
1337133700 AND CDEMO-PGM-REENTER 13370000
1338133800 MOVE '*' TO TRTYPCDO OF CTRTUPAO 13380000
1339133900 MOVE DFHRED TO TRTYPCDC OF CTRTUPAO 13390000
1340134000 END-IF 13400000
1341134100 13410000
1342134200 IF TTUP-DETAILS-NOT-FETCHED 13420000
1343134300 OR TTUP-DETAILS-NOT-FOUND 13430000
1344134400 OR TTUP-INVALID-SEARCH-KEYS 13440000
1345134500 OR FLG-TRANFILTER-BLANK 13450000
1346134600 OR FLG-TRANFILTER-NOT-OK 13460000
1347134700 GO TO 3300-SETUP-SCREEN-ATTRS-EXIT 13470000
1348134800 ELSE 13480000
1349134900 CONTINUE 13490000
1350135000 END-IF 13500000
1351135100 13510000
1352135200******************************************************************13520000
1353135300* Using Copy replacing to set attribs for remaining vars 13530000
1354135400* Write specific code only if rules differ 13540000
1355135500******************************************************************13550000
1356135600 13560000
1357135700* Transaction Description Status 13570000
1358135800 COPY CSSETATY REPLACING 13580000
1359135900 ==(TESTVAR1)== BY ==DESCRIPTION== 13590000
1360136000 ==(SCRNVAR2)== BY ==TRTYDSC== 13600000
1361136100 ==(MAPNAME3)== BY ==CTRTUPA== . 13610000
1362136200 13620000
1363136300 . 13630000
1364136400 3300-SETUP-SCREEN-ATTRS-EXIT. 13640000
1365136500 EXIT 13650000
1366136600 . 13660000
1367136700 13670000
1368136800 3310-PROTECT-ALL-ATTRS. 13680000
1369136900 MOVE DFHBMPRF TO TRTYPCDA OF CTRTUPAI 13690000
1370137000 TRTYDSCA OF CTRTUPAI 13700000
1371137100 INFOMSGA OF CTRTUPAI 13710000
1372137200 . 13720000
1373137300 3310-PROTECT-ALL-ATTRS-EXIT. 13730000
1374137400 EXIT 13740000
1375137500 . 13750000
1376137600 13760000
1377137700 3320-UNPROTECT-FEW-ATTRS. 13770000
1378137800 13780000
1379137900 MOVE DFHBMFSE TO TRTYDSCA OF CTRTUPAI 13790000
1380138000 MOVE DFHBMPRF TO INFOMSGA OF CTRTUPAI 13800000
1381138100 . 13810000
1382138200 3320-UNPROTECT-FEW-ATTRS-EXIT. 13820000
1383138300 EXIT 13830000
1384138400 . 13840000
1385138500 13850000
1386138600 3390-SETUP-INFOMSG-ATTRS. 13860000
1387138700 IF WS-NO-INFO-MESSAGE 13870000
1388138800 MOVE DFHBMDAR TO INFOMSGA OF CTRTUPAI 13880000
1389138900 ELSE 13890000
1390139000 MOVE DFHBMASB TO INFOMSGA OF CTRTUPAI 13900000
1391139100 END-IF 13910000
1392139200 . 13920000
1393139300 3390-SETUP-INFOMSG-ATTRS-EXIT. 13930000
1394139400 EXIT 13940000
1395139500 . 13950000
1396139600 13960000
1397139700 3391-SETUP-PFKEY-ATTRS. 13970000
1398139800* Should reflect in 0001-CHECK-PFKEYS 13980000
1399139900* Enter key 13990000
1400140000 IF TTUP-CONFIRM-DELETE 14000000
1401140100 MOVE DFHBMDAR TO FKEYSA OF CTRTUPAI 14010000
1402140200 ELSE 14020000
1403140300 MOVE DFHBMASB TO FKEYSA OF CTRTUPAI 14030000
1404140400 END-IF 14040000
1405140500* F4 14050000
1406140600 IF TTUP-SHOW-DETAILS 14060000
1407140700 OR TTUP-CONFIRM-DELETE 14070000
1408140800 MOVE DFHBMASB TO FKEY04A OF CTRTUPAI 14080000
1409140900 END-IF 14090000
1410141000* F5 14100000
1411141100 IF TTUP-CHANGES-OK-NOT-CONFIRMED 14110000
1412141200 OR TTUP-DETAILS-NOT-FOUND 14120000
1413141300 MOVE DFHBMASB TO FKEY05A OF CTRTUPAI 14130000
1414141400 END-IF 14140000
1415141500* F12 14150000
1416141600 IF TTUP-CHANGES-OK-NOT-CONFIRMED 14160000
1417141700 OR TTUP-SHOW-DETAILS 14170000
1418141800 OR TTUP-DETAILS-NOT-FOUND 14180000
1419141900 OR TTUP-CONFIRM-DELETE 14190000
1420142000 OR TTUP-CREATE-NEW-RECORD 14200000
1421142100 MOVE DFHBMASB TO FKEY12A OF CTRTUPAI 14210000
1422142200 END-IF 14220000
1423142300 . 14230000
1424142400 3391-SETUP-PFKEY-ATTRS-EXIT. 14240000
1425142500 EXIT 14250000
1426142600 . 14260000
1427142700 14270000
1428142800 3400-SEND-SCREEN. 14280000
1429142900 14290000
1430143000 MOVE LIT-THISMAPSET TO CCARD-NEXT-MAPSET 14300000
1431143100 MOVE LIT-THISMAP TO CCARD-NEXT-MAP 14310000
1432143200 14320000
1433143300 EXEC CICS SEND MAP(CCARD-NEXT-MAP) 14330000
1434143400 MAPSET(CCARD-NEXT-MAPSET) 14340000
1435143500 FROM(CTRTUPAO) 14350000
1436143600 CURSOR 14360000
1437143700 ERASE 14370000
1438143800 FREEKB 14380000
1439143900 RESP(WS-RESP-CD) 14390000
1440144000 END-EXEC 14400000
1441144100 . 14410000
1442144200 3400-SEND-SCREEN-EXIT. 14420000
1443144300 EXIT 14430000
1444144400 . 14440000
1445144500 14450000
1446144600 14460000
1447144700 9000-READ-TRANTYPE. 14470000
1448144800 14480000
1449144900 INITIALIZE TTUP-OLD-DETAILS 14490000
1450145000 14500000
1451145100 SET WS-NO-INFO-MESSAGE TO TRUE 14510000
1452145200 14520000
1453145300 PERFORM 9100-GET-TRANSACTION-TYPE 14530000
1454145400 THRU 9100-GET-TRANSACTION-TYPE-EXIT 14540000
1455145500 14550000
1456145600 IF FLG-TRANFILTER-NOT-OK 14560000
1457145700 GO TO 9000-READ-TRANTYPE-EXIT 14570000
1458145800 END-IF 14580000
1459145900 14590000
1460146000 14600000
1461146100 PERFORM 9500-STORE-FETCHED-DATA 14610000
1462146200 THRU 9500-STORE-FETCHED-DATA-EXIT 14620000
1463146300 . 14630000
1464146400 14640000
1465146500 14650000
1466146600 9000-READ-TRANTYPE-EXIT. 14660000
1467146700 EXIT 14670000
1468146800 . 14680000
1469146900 9100-GET-TRANSACTION-TYPE. 14690000
1470147000 14700000
1471147100* Read the Card file. Access via alternate index ACCTID 14710000
1472147200* 14720000
1473147300 MOVE TTUP-NEW-TTYP-TYPE TO DCL-TR-TYPE 14730000
1474147400 14740000
1475147500 EXEC SQL 14750000
1476147600 SELECT TR_TYPE 14760000
1477147700 ,TR_DESCRIPTION 14770000
1478147800 INTO :DCL-TR-TYPE 14780000
1479147900 ,:DCL-TR-DESCRIPTION 14790000
1480148000 FROM CARDDEMO.TRANSACTION_TYPE 14800000
1481148100 WHERE TR_TYPE = :DCL-TR-TYPE 14810000
1482148200 END-EXEC 14820000
1483148300 14830000
1484148400 MOVE SQLCODE TO WS-DISP-SQLCODE 14840000
1485148500 14850000
1486148600 EVALUATE TRUE 14860000
1487148700 WHEN SQLCODE = ZERO 14870000
1488148800 SET FOUND-TRANTYPE-IN-TABLE TO TRUE 14880000
1489148900 WHEN SQLCODE = +100 14890000
1490149000 SET INPUT-ERROR TO TRUE 14900000
1491149100 SET FLG-TRANFILTER-NOT-OK TO TRUE 14910000
1492149200 IF WS-RETURN-MSG-OFF 14920000
1493149300 SET WS-RECORD-NOT-FOUND TO TRUE 14930000
1494149400 END-IF 14940000
1495149500 WHEN SQLCODE < 0 14950000
1496149600 SET INPUT-ERROR TO TRUE 14960000
1497149700 SET FLG-TRANFILTER-NOT-OK TO TRUE 14970000
1498149800 IF WS-RETURN-MSG-OFF 14980000
1499149900 STRING 14990000
1500150000 'Error accessing:' 15000000
1501150100 ' TRANSACTION_TYPE table. SQLCODE:' 15010000
1502150200 WS-DISP-SQLCODE 15020000
1503150300 ':' 15030000
1504150400 SQLERRM OF SQLCA 15040000
1505150500 DELIMITED BY SIZE 15050000
1506150600 INTO WS-RETURN-MSG 15060000
1507150700 END-STRING 15070000
1508150800 END-IF 15080000
1509150900 END-EVALUATE 15090000
1510151000 EXIT 15100000
1511151100 . 15110000
1512151200 9100-GET-TRANSACTION-TYPE-EXIT. 15120000
1513151300 EXIT 15130000
1514151400 . 15140000
1515151500 15150000
1516151600 15160000
1517151700 9500-STORE-FETCHED-DATA. 15170000
1518151800 15180000
1519151900 INITIALIZE TTUP-OLD-DETAILS 15190000
1520152000******************************************************************15200000
1521152100* Transaction Type data 15210000
1522152200******************************************************************15220000
1523152300 MOVE DCL-TR-TYPE TO TTUP-OLD-TTYP-TYPE 15230000
1524152400 MOVE DCL-TR-DESCRIPTION-TEXT(1: DCL-TR-DESCRIPTION-LEN) 15240000
1525152500 TO TTUP-OLD-TTYP-TYPE-DESC 15250000
1526152600 15260000
1527152700 . 15270000
1528152800 9500-STORE-FETCHED-DATA-EXIT. 15280000
1529152900 EXIT 15290000
1530153000 . 15300000
1531153100 9600-WRITE-PROCESSING. 15310000
1532153200 15320000
1533153300***************************************************************** 15330000
1534153400* Update Transaction Type * 15340000
1535153500***************************************************************** 15350000
1536153600* Issue Update 15360000
1537153700* 15370000
1538153800 MOVE TTUP-NEW-TTYP-TYPE TO DCL-TR-TYPE 15380000
1539153900 MOVE FUNCTION TRIM(TTUP-NEW-TTYP-TYPE-DESC) 15390000
1540154000 TO DCL-TR-DESCRIPTION-TEXT 15400000
1541154100 COMPUTE DCL-TR-DESCRIPTION-LEN 15410000
1542154200 = FUNCTION LENGTH(TTUP-NEW-TTYP-TYPE-DESC) 15420000
1543154300 15430000
1544154400 EXEC SQL 15440000
1545154500 UPDATE CARDDEMO.TRANSACTION_TYPE 15450000
1546154600 SET TR_DESCRIPTION = :DCL-TR-DESCRIPTION 15460000
1547154700 WHERE TR_TYPE = :DCL-TR-TYPE 15470000
1548154800 END-EXEC 15480000
1549154900 15490000
1550155000***************************************************************** 15500000
1551155100* Did Transaction Type update succeed ? * 15510000
1552155200***************************************************************** 15520000
1553155300 MOVE SQLCODE TO WS-DISP-SQLCODE 15530000
1554155400 15540000
1555155500 EVALUATE TRUE 15550000
1556155600 WHEN SQLCODE = ZERO 15560000
1557155700 EXEC CICS SYNCPOINT END-EXEC 15570000
1558155800 WHEN SQLCODE = +100 15580000
1559155900 PERFORM 9700-INSERT-RECORD 15590000
1560156000 THRU 9700-INSERT-RECORD-EXIT 15600000
1561156100 WHEN SQLCODE = -911 15610000
1562156200 SET INPUT-ERROR TO TRUE 15620000
1563156300 IF WS-RETURN-MSG-OFF 15630000
1564156400 SET COULD-NOT-LOCK-REC-FOR-UPDATE 15640000
1565156500 TO TRUE 15650000
1566156600 END-IF 15660000
1567156700 WHEN SQLCODE < 0 15670000
1568156800 SET TABLE-UPDATE-FAILED TO TRUE 15680000
1569156900 STRING 15690000
1570157000 'Error updating:' 15700000
1571157100 ' TRANSACTION_TYPE Table. SQLCODE:' 15710000
1572157200 WS-DISP-SQLCODE 15720000
1573157300 ':' 15730000
1574157400 SQLERRM OF SQLCA 15740000
1575157500 DELIMITED BY SIZE 15750000
1576157600 INTO WS-RETURN-MSG 15760000
1577157700 END-STRING 15770000
1578157800 END-EVALUATE 15780000
1579157900 15790000
1580158000 EVALUATE TRUE 15800000
1581158100 WHEN COULD-NOT-LOCK-REC-FOR-UPDATE 15810000
1582158200 SET TTUP-CHANGES-OKAYED-LOCK-ERROR TO TRUE 15820000
1583158300 WHEN TABLE-UPDATE-FAILED 15830000
1584158400 SET TTUP-CHANGES-OKAYED-BUT-FAILED TO TRUE 15840000
1585158500 WHEN DATA-WAS-CHANGED-BEFORE-UPDATE 15850000
1586158600 SET TTUP-SHOW-DETAILS TO TRUE 15860000
1587158700 WHEN OTHER 15870000
1588158800 SET TTUP-CHANGES-OKAYED-AND-DONE TO TRUE 15880000
1589158900 END-EVALUATE 15890000
1590159000 15900000
1591159100 EXIT 15910000
1592159200 . 15920000
1593159300 9600-WRITE-PROCESSING-EXIT. 15930000
1594159400 EXIT 15940000
1595159500 . 15950000
1596159600 9700-INSERT-RECORD. 15960000
1597159700 EXEC SQL 15970000
1598159800 INSERT INTO CARDDEMO.TRANSACTION_TYPE 15980000
1599159900 (TR_TYPE, TR_DESCRIPTION) 15990000
1600160000 VALUES ( :DCL-TR-TYPE 16000000
1601160100 ,:DCL-TR-DESCRIPTION) 16010000
1602160200 END-EXEC 16020000
1603160300 16030000
1604160400 EVALUATE TRUE 16040000
1605160500 WHEN SQLCODE = ZERO 16050000
1606160600 EXEC CICS SYNCPOINT END-EXEC 16060000
1607160700 WHEN OTHER 16070000
1608160800 SET TABLE-UPDATE-FAILED TO TRUE 16080000
1609160900 STRING 16090000
1610161000 'Error inserting record into:' 16100000
1611161100 ' TRANSACTION_TYPE Table. SQLCODE:' 16110000
1612161200 WS-DISP-SQLCODE 16120000
1613161300 ':' 16130000
1614161400 SQLERRM OF SQLCA 16140000
1615161500 DELIMITED BY SIZE 16150000
1616161600 INTO WS-RETURN-MSG 16160000
1617161700 END-STRING 16170000
1618161800 GO TO 9700-INSERT-RECORD-EXIT 16180000
1619161900 END-EVALUATE 16190000
1620162000 . 16200000
1621162100 9700-INSERT-RECORD-EXIT. 16210000
1622162200 EXIT 16220000
1623162300 . 16230000
1624162400 9800-DELETE-PROCESSING. 16240000
1625162500 MOVE TTUP-OLD-TTYP-TYPE TO DCL-TR-TYPE 16250000
1626162600 16260000
1627162700 EXEC SQL 16270000
1628162800 DELETE FROM CARDDEMO.TRANSACTION_TYPE 16280000
1629162900 WHERE TR_TYPE = :DCL-TR-TYPE 16290000
1630163000 END-EXEC 16300000
1631163100 16310000
1632163200 MOVE SQLCODE TO WS-DISP-SQLCODE 16320000
1633163300 16330000
1634163400 EVALUATE TRUE 16340000
1635163500 WHEN SQLCODE = ZERO 16350000
1636163600 SET TTUP-DELETE-DONE TO TRUE 16360000
1637163700 EXEC CICS SYNCPOINT END-EXEC 16370000
1638163800 WHEN SQLCODE = -532 16380000
1639163900 SET RECORD-DELETE-FAILED TO TRUE 16390000
1640164000 STRING 16400000
1641164100 'Please delete associated child records first:' 16410000
1642164200 'SQLCODE :' 16420000
1643164300 WS-DISP-SQLCODE 16430000
1644164400 ':' 16440000
1645164500 SQLERRM OF SQLCA 16450000
1646164600 SQLERRM OF SQLCA 16460000
1647164700 DELIMITED BY SIZE 16470000
1648164800 INTO WS-RETURN-MSG 16480000
1649164900 END-STRING 16490000
1650165000 WHEN OTHER 16500000
1651165100 SET RECORD-DELETE-FAILED TO TRUE 16510000
1652165200 SET TTUP-DELETE-FAILED TO TRUE 16520000
1653165300 STRING 16530000
1654165400 'Delete failed with message:' 16540000
1655165500 'SQLCODE :' 16550000
1656165600 WS-DISP-SQLCODE 16560000
1657165700 ':' 16570000
1658165800 SQLERRM OF SQLCA 16580000
1659165900 DELIMITED BY SIZE 16590000
1660166000 INTO WS-RETURN-MSG 16600000
1661166100 END-STRING 16610000
1662166200 END-EVALUATE 16620000
1663166300 . 16630000
1664166400 9800-DELETE-PROCESSING-EXIT. 16640000
1665166500 EXIT 16650000
1666166600 . 16660000
1667166700 16670000
1668166800******************************************************************16680000
1669166900*Common code to store PFKey 16690000
1670167000******************************************************************16700000
1671167100 COPY 'CSSTRPFY' 16710000
1672167200 . 16720000
1673167300 16730000
1674167400 16740000
1675167500 ABEND-ROUTINE. 16750000
1676167600 16760000
1677167700 IF ABEND-MSG EQUAL LOW-VALUES 16770000
1678167800 MOVE 'UNEXPECTED ABEND OCCURRED.' TO ABEND-MSG 16780000
1679167900 END-IF 16790000
1680168000 16800000
1681168100 MOVE LIT-THISPGM TO ABEND-CULPRIT 16810000
1682168200 MOVE '9999' TO ABEND-CODE 16820000
1683168300 16830000
1684168400 EXEC CICS SEND 16840000
1685168500 FROM (ABEND-DATA) 16850000
1686168600 LENGTH(LENGTH OF ABEND-DATA) 16860000
1687168700 NOHANDLE 16870000
1688168800 ERASE 16880000
1689168900 END-EXEC 16890000
1690169000 16900000
1691169100 EXEC CICS HANDLE ABEND 16910000
1692169200 CANCEL 16920000
1693169300 END-EXEC 16930000
1694169400 16940000
1695169500 EXEC CICS ABEND 16950000
1696169600 ABCODE(ABEND-CODE) 16960000
1697169700 END-EXEC 16970000
1698169800 . 16980000
1699169900 ABEND-ROUTINE-EXIT. 16990000
1700170000 EXIT 17000000
1701170100 . 17010000
1702170200 17020000