MFmainframe-rea
WS carddemo · 26f629ef

Converted program · 176 lines of TypeScript from 330 lines of COBOL · 205 COBOL lines cited (62%)COTRN01C

Run it on the 3270 →Analysis →All programs

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

1/**
2 * COTRN01C — view one transaction from TRANSACT (transaction CT01).
3 * Converted from app/cbl/COTRN01C.cbl; screen COTRN01/COTRN1A; file TRANSACT.
4 */
5import { digits, editNumber, isBlank } from "../runtime/cobol.js";
6import { RESP, type Cics, type Program } from "../runtime/cics.js";
7import type { SymbolicMap } from "../runtime/screen.js";
8import type { TranRecord } from "../generated/records.js";
9import { CCDA_MSG_INVALID_KEY, populateHeaderInfo } from "./common.js";
10import { ctInfo, fieldI } from "./transactions-lib.js";
11
12const WS_PGMNAME = "COTRN01C";
13const WS_TRANID = "CT01";
14const WS_TRANSACT_FILE = "TRANSACT";
15
16/** WS-VARIABLES (COTRN01C.cbl:35-50) */
17interface Ws {
18 message: string;
19 errFlg: string;
20 usrModified: string;
21 tranId: string;
22 tran: TranRecord | undefined;
23}
24
25type Ctx = { ctx: Cics; out: SymbolicMap; ws: Ws };
26
27/** Display fields cleared by PROCESS-ENTER-KEY / INITIALIZE-ALL-FIELDS. */
28const VIEW_FIELDS = ["TRNID", "CARDNUM", "TTYPCD", "TCATCD", "TRNSRC", "TRNAMT", "TDESC", "TORIGDT", "TPROCDT", "MID", "MNAME", "MCITY", "MZIP"];
29
30export const COTRN01C: Program = {
31 name: WS_PGMNAME,
32 source: "app/cbl/COTRN01C.cbl",
33 run(ctx: Cics) {
34 const ws: Ws = { message: "", errFlg: "N", usrModified: "N", tranId: "", tran: undefined };
35 const c: Ctx = { ctx, out: ctx.map("COTRN01", "COTRN1A"), ws };
36
37 // MAIN-PARA (COTRN01C.cbl:86-139)
38 ws.errFlg = "N";
39 ws.usrModified = "N";
40 ws.message = "";
41 c.out.set("ERRMSG", "");
42
43 if (ctx.eib.calen === 0) {
44 ctx.area().toProgram = "COSGN00C";
45 returnToPrevScreen(c);
46 }
47 const area = ctx.area();
48 const info = ctInfo(ctx); // CDEMO-CT01-INFO = the bytes COTRN00C left in CDEMO-CT00-INFO
49 if (area.pgmContext !== 1) {
50 area.pgmContext = 1;
51 c.out.clear();
52 c.out.cursor("TRNIDIN");
53 if (!isBlank(info.trnSelected)) {
54 c.out.set("TRNIDIN", info.trnSelected);
55 processEnterKey(c);
56 }
57 sendTrnviewScreen(c);
58 } else {
59 receiveTrnviewScreen(c);
60 switch (ctx.eib.aid) {
61 case "ENTER":
62 processEnterKey(c);
63 break;
64 case "PF3":
65 area.toProgram = isBlank(area.fromProgram) ? "COMEN01C" : area.fromProgram;
66 returnToPrevScreen(c);
67 // falls through: XCTL does not return
68 case "PF4":
69 clearCurrentScreen(c);
70 break;
71 case "PF5":
72 area.toProgram = "COTRN00C";
73 returnToPrevScreen(c);
74 // falls through: XCTL does not return
75 default:
76 ws.errFlg = "Y";
77 ws.message = CCDA_MSG_INVALID_KEY;
78 sendTrnviewScreen(c);
79 }
80 }
81 ctx.return(WS_TRANID, area);
82 },
83};
84
85/** PROCESS-ENTER-KEY (COTRN01C.cbl:144-192) */
86function processEnterKey(c: Ctx): void {
87 const { out, ws } = c;
88 const trnidin = fieldI(out, "TRNIDIN");
89 if (isBlank(trnidin)) {
90 ws.errFlg = "Y";
91 ws.message = "Tran ID can NOT be empty...";
92 out.cursor("TRNIDIN");
93 sendTrnviewScreen(c);
94 } else {
95 out.cursor("TRNIDIN");
96 }
97
98 if (ws.errFlg !== "Y") {
99 for (const f of VIEW_FIELDS) out.set(f, " ");
100 ws.tranId = trnidin;
101 readTransactFile(c);
102 }
103
104 if (ws.errFlg !== "Y") {
105 const tran = ws.tran!;
106 out.set("TRNID", tran.tranId);
107 out.set("CARDNUM", tran.tranCardNum);
108 out.set("TTYPCD", tran.tranTypeCd);
109 out.set("TCATCD", digits(tran.tranCatCd, 4));
110 out.set("TRNSRC", tran.tranSource);
111 out.set("TRNAMT", editNumber(tran.tranAmt, "+99999999.99")); // WS-TRAN-AMT
112 out.set("TDESC", tran.tranDesc);
113 out.set("TORIGDT", tran.tranOrigTs);
114 out.set("TPROCDT", tran.tranProcTs);
115 out.set("MID", digits(tran.tranMerchantId, 9));
116 out.set("MNAME", tran.tranMerchantName);
117 out.set("MCITY", tran.tranMerchantCity);
118 out.set("MZIP", tran.tranMerchantZip);
119 sendTrnviewScreen(c);
120 }
121}
122
123/** RETURN-TO-PREV-SCREEN (COTRN01C.cbl:197-208) */
124function returnToPrevScreen(c: Ctx): never {
125 const area = c.ctx.area();
126 if (isBlank(area.toProgram)) area.toProgram = "COSGN00C";
127 area.fromTranid = WS_TRANID;
128 area.fromProgram = WS_PGMNAME;
129 area.pgmContext = 0;
130 c.ctx.xctl(area.toProgram, area);
131}
132
133/** SEND-TRNVIEW-SCREEN (COTRN01C.cbl:213-225) */
134function sendTrnviewScreen(c: Ctx): void {
135 populateHeaderInfo(c.ctx, c.out, WS_TRANID, WS_PGMNAME);
136 c.out.set("ERRMSG", c.ws.message);
137 c.ctx.sendMap(c.out, { erase: true, cursor: true });
138}
139
140/** RECEIVE-TRNVIEW-SCREEN (COTRN01C.cbl:230-238) */
141function receiveTrnviewScreen(c: Ctx): void {
142 c.out = c.ctx.receiveMap("COTRN01", "COTRN1A").map;
143}
144
145/** READ-TRANSACT-FILE (COTRN01C.cbl:267-296) — READ ... UPDATE, never rewritten. */
146function readTransactFile(c: Ctx): void {
147 const { ctx, out, ws } = c;
148 const { resp, record } = ctx.read<TranRecord>(WS_TRANSACT_FILE, ws.tranId, { update: true });
149 if (resp === RESP.NORMAL) {
150 ws.tran = record;
151 } else if (resp === RESP.NOTFND) {
152 ws.errFlg = "Y";
153 ws.message = "Transaction ID NOT found...";
154 out.cursor("TRNIDIN");
155 sendTrnviewScreen(c);
156 } else {
157 ws.errFlg = "Y";
158 ws.message = "Unable to lookup Transaction...";
159 out.cursor("TRNIDIN");
160 sendTrnviewScreen(c);
161 }
162}
163
164/** CLEAR-CURRENT-SCREEN (COTRN01C.cbl:301-304) */
165function clearCurrentScreen(c: Ctx): void {
166 initializeAllFields(c);
167 sendTrnviewScreen(c);
168}
169
170/** INITIALIZE-ALL-FIELDS (COTRN01C.cbl:309-326) */
171function initializeAllFields(c: Ctx): void {
172 c.out.cursor("TRNIDIN");
173 c.out.set("TRNIDIN", " ");
174 for (const f of VIEW_FIELDS) c.out.set(f, " ");
175 c.ws.message = "";
176}

COBOL app/cbl/COTRN01C.cbl

1 ******************************************************************
2 * Program : COTRN01C.CBL
3 * Application : CardDemo
4 * Type : CICS COBOL Program
5 * Function : View a Transaction from TRANSACT file
6 ******************************************************************
7 * Copyright Amazon.com, Inc. or its affiliates.
8 * All Rights Reserved.
9 *
10 * Licensed under the Apache License, Version 2.0 (the "License").
11 * You may not use this file except in compliance with the License.
12 * You may obtain a copy of the License at
13 *
14 * http://www.apache.org/licenses/LICENSE-2.0
15 *
16 * Unless required by applicable law or agreed to in writing,
17 * software distributed under the License is distributed on an
18 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
19 * either express or implied. See the License for the specific
20 * language governing permissions and limitations under the License
21 ******************************************************************
22 IDENTIFICATION DIVISION.
23 PROGRAM-ID. COTRN01C.
24 AUTHOR. AWS.
25
26 ENVIRONMENT DIVISION.
27 CONFIGURATION SECTION.
28
29 DATA DIVISION.
30 *----------------------------------------------------------------*
31 * WORKING STORAGE SECTION
32 *----------------------------------------------------------------*
33 WORKING-STORAGE SECTION.
34
35 01 WS-VARIABLES.
36 05 WS-PGMNAME PIC X(08) VALUE 'COTRN01C'.
37 05 WS-TRANID PIC X(04) VALUE 'CT01'.
38 05 WS-MESSAGE PIC X(80) VALUE SPACES.
39 05 WS-TRANSACT-FILE PIC X(08) VALUE 'TRANSACT'.
40 05 WS-ERR-FLG PIC X(01) VALUE 'N'.
41 88 ERR-FLG-ON VALUE 'Y'.
42 88 ERR-FLG-OFF VALUE 'N'.
43 05 WS-RESP-CD PIC S9(09) COMP VALUE ZEROS.
44 05 WS-REAS-CD PIC S9(09) COMP VALUE ZEROS.
45 05 WS-USR-MODIFIED PIC X(01) VALUE 'N'.
46 88 USR-MODIFIED-YES VALUE 'Y'.
47 88 USR-MODIFIED-NO VALUE 'N'.
48
49 05 WS-TRAN-AMT PIC +99999999.99.
50 05 WS-TRAN-DATE PIC X(08) VALUE '00/00/00'.
51
52 COPY COCOM01Y.
53 05 CDEMO-CT01-INFO.
54 10 CDEMO-CT01-TRNID-FIRST PIC X(16).
55 10 CDEMO-CT01-TRNID-LAST PIC X(16).
56 10 CDEMO-CT01-PAGE-NUM PIC 9(08).
57 10 CDEMO-CT01-NEXT-PAGE-FLG PIC X(01) VALUE 'N'.
58 88 NEXT-PAGE-YES VALUE 'Y'.
59 88 NEXT-PAGE-NO VALUE 'N'.
60 10 CDEMO-CT01-TRN-SEL-FLG PIC X(01).
61 10 CDEMO-CT01-TRN-SELECTED PIC X(16).
62
63 COPY COTRN01.
64
65 COPY COTTL01Y.
66 COPY CSDAT01Y.
67 COPY CSMSG01Y.
68
69 COPY CVTRA05Y.
70
71 COPY DFHAID.
72 COPY DFHBMSCA.
73
74 *----------------------------------------------------------------*
75 * LINKAGE SECTION
76 *----------------------------------------------------------------*
77 LINKAGE SECTION.
78 01 DFHCOMMAREA.
79 05 LK-COMMAREA PIC X(01)
80 OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
81
82 *----------------------------------------------------------------*
83 * PROCEDURE DIVISION
84 *----------------------------------------------------------------*
85 PROCEDURE DIVISION.
86 MAIN-PARA.
87
88 SET ERR-FLG-OFF TO TRUE
89 SET USR-MODIFIED-NO TO TRUE
90
91 MOVE SPACES TO WS-MESSAGE
92 ERRMSGO OF COTRN1AO
93
94 IF EIBCALEN = 0
95 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
96 PERFORM RETURN-TO-PREV-SCREEN
97 ELSE
98 MOVE DFHCOMMAREA(1:EIBCALEN) TO CARDDEMO-COMMAREA
99 IF NOT CDEMO-PGM-REENTER
100 SET CDEMO-PGM-REENTER TO TRUE
101 MOVE LOW-VALUES TO COTRN1AO
102 MOVE -1 TO TRNIDINL OF COTRN1AI
103 IF CDEMO-CT01-TRN-SELECTED NOT =
104 SPACES AND LOW-VALUES
105 MOVE CDEMO-CT01-TRN-SELECTED TO
106 TRNIDINI OF COTRN1AI
107 PERFORM PROCESS-ENTER-KEY
108 END-IF
109 PERFORM SEND-TRNVIEW-SCREEN
110 ELSE
111 PERFORM RECEIVE-TRNVIEW-SCREEN
112 EVALUATE EIBAID
113 WHEN DFHENTER
114 PERFORM PROCESS-ENTER-KEY
115 WHEN DFHPF3
116 IF CDEMO-FROM-PROGRAM = SPACES OR LOW-VALUES
117 MOVE 'COMEN01C' TO CDEMO-TO-PROGRAM
118 ELSE
119 MOVE CDEMO-FROM-PROGRAM TO
120 CDEMO-TO-PROGRAM
121 END-IF
122 PERFORM RETURN-TO-PREV-SCREEN
123 WHEN DFHPF4
124 PERFORM CLEAR-CURRENT-SCREEN
125 WHEN DFHPF5
126 MOVE 'COTRN00C' TO CDEMO-TO-PROGRAM
127 PERFORM RETURN-TO-PREV-SCREEN
128 WHEN OTHER
129 MOVE 'Y' TO WS-ERR-FLG
130 MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE
131 PERFORM SEND-TRNVIEW-SCREEN
132 END-EVALUATE
133 END-IF
134 END-IF
135
136 EXEC CICS RETURN
137 TRANSID (WS-TRANID)
138 COMMAREA (CARDDEMO-COMMAREA)
139 END-EXEC.
140
141 *----------------------------------------------------------------*
142 * PROCESS-ENTER-KEY
143 *----------------------------------------------------------------*
144 PROCESS-ENTER-KEY.
145
146 EVALUATE TRUE
147 WHEN TRNIDINI OF COTRN1AI = SPACES OR LOW-VALUES
148 MOVE 'Y' TO WS-ERR-FLG
149 MOVE 'Tran ID can NOT be empty...' TO
150 WS-MESSAGE
151 MOVE -1 TO TRNIDINL OF COTRN1AI
152 PERFORM SEND-TRNVIEW-SCREEN
153 WHEN OTHER
154 MOVE -1 TO TRNIDINL OF COTRN1AI
155 CONTINUE
156 END-EVALUATE
157
158 IF NOT ERR-FLG-ON
159 MOVE SPACES TO TRNIDI OF COTRN1AI
160 CARDNUMI OF COTRN1AI
161 TTYPCDI OF COTRN1AI
162 TCATCDI OF COTRN1AI
163 TRNSRCI OF COTRN1AI
164 TRNAMTI OF COTRN1AI
165 TDESCI OF COTRN1AI
166 TORIGDTI OF COTRN1AI
167 TPROCDTI OF COTRN1AI
168 MIDI OF COTRN1AI
169 MNAMEI OF COTRN1AI
170 MCITYI OF COTRN1AI
171 MZIPI OF COTRN1AI
172 MOVE TRNIDINI OF COTRN1AI TO TRAN-ID
173 PERFORM READ-TRANSACT-FILE
174 END-IF.
175
176 IF NOT ERR-FLG-ON
177 MOVE TRAN-AMT TO WS-TRAN-AMT
178 MOVE TRAN-ID TO TRNIDI OF COTRN1AI
179 MOVE TRAN-CARD-NUM TO CARDNUMI OF COTRN1AI
180 MOVE TRAN-TYPE-CD TO TTYPCDI OF COTRN1AI
181 MOVE TRAN-CAT-CD TO TCATCDI OF COTRN1AI
182 MOVE TRAN-SOURCE TO TRNSRCI OF COTRN1AI
183 MOVE WS-TRAN-AMT TO TRNAMTI OF COTRN1AI
184 MOVE TRAN-DESC TO TDESCI OF COTRN1AI
185 MOVE TRAN-ORIG-TS TO TORIGDTI OF COTRN1AI
186 MOVE TRAN-PROC-TS TO TPROCDTI OF COTRN1AI
187 MOVE TRAN-MERCHANT-ID TO MIDI OF COTRN1AI
188 MOVE TRAN-MERCHANT-NAME TO MNAMEI OF COTRN1AI
189 MOVE TRAN-MERCHANT-CITY TO MCITYI OF COTRN1AI
190 MOVE TRAN-MERCHANT-ZIP TO MZIPI OF COTRN1AI
191 PERFORM SEND-TRNVIEW-SCREEN
192 END-IF.
193
194 *----------------------------------------------------------------*
195 * RETURN-TO-PREV-SCREEN
196 *----------------------------------------------------------------*
197 RETURN-TO-PREV-SCREEN.
198
199 IF CDEMO-TO-PROGRAM = LOW-VALUES OR SPACES
200 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
201 END-IF
202 MOVE WS-TRANID TO CDEMO-FROM-TRANID
203 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
204 MOVE ZEROS TO CDEMO-PGM-CONTEXT
205 EXEC CICS
206 XCTL PROGRAM(CDEMO-TO-PROGRAM)
207 COMMAREA(CARDDEMO-COMMAREA)
208 END-EXEC.
209
210 *----------------------------------------------------------------*
211 * SEND-TRNVIEW-SCREEN
212 *----------------------------------------------------------------*
213 SEND-TRNVIEW-SCREEN.
214
215 PERFORM POPULATE-HEADER-INFO
216
217 MOVE WS-MESSAGE TO ERRMSGO OF COTRN1AO
218
219 EXEC CICS SEND
220 MAP('COTRN1A')
221 MAPSET('COTRN01')
222 FROM(COTRN1AO)
223 ERASE
224 CURSOR
225 END-EXEC.
226
227 *----------------------------------------------------------------*
228 * RECEIVE-TRNVIEW-SCREEN
229 *----------------------------------------------------------------*
230 RECEIVE-TRNVIEW-SCREEN.
231
232 EXEC CICS RECEIVE
233 MAP('COTRN1A')
234 MAPSET('COTRN01')
235 INTO(COTRN1AI)
236 RESP(WS-RESP-CD)
237 RESP2(WS-REAS-CD)
238 END-EXEC.
239
240 *----------------------------------------------------------------*
241 * POPULATE-HEADER-INFO
242 *----------------------------------------------------------------*
243 POPULATE-HEADER-INFO.
244
245 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
246
247 MOVE CCDA-TITLE01 TO TITLE01O OF COTRN1AO
248 MOVE CCDA-TITLE02 TO TITLE02O OF COTRN1AO
249 MOVE WS-TRANID TO TRNNAMEO OF COTRN1AO
250 MOVE WS-PGMNAME TO PGMNAMEO OF COTRN1AO
251
252 MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
253 MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
254 MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
255
256 MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF COTRN1AO
257
258 MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
259 MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
260 MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
261
262 MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF COTRN1AO.
263
264 *----------------------------------------------------------------*
265 * READ-TRANSACT-FILE
266 *----------------------------------------------------------------*
267 READ-TRANSACT-FILE.
268
269 EXEC CICS READ
270 DATASET (WS-TRANSACT-FILE)
271 INTO (TRAN-RECORD)
272 LENGTH (LENGTH OF TRAN-RECORD)
273 RIDFLD (TRAN-ID)
274 KEYLENGTH (LENGTH OF TRAN-ID)
275 UPDATE
276 RESP (WS-RESP-CD)
277 RESP2 (WS-REAS-CD)
278 END-EXEC.
279
280 EVALUATE WS-RESP-CD
281 WHEN DFHRESP(NORMAL)
282 CONTINUE
283 WHEN DFHRESP(NOTFND)
284 MOVE 'Y' TO WS-ERR-FLG
285 MOVE 'Transaction ID NOT found...' TO
286 WS-MESSAGE
287 MOVE -1 TO TRNIDINL OF COTRN1AI
288 PERFORM SEND-TRNVIEW-SCREEN
289 WHEN OTHER
290 DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
291 MOVE 'Y' TO WS-ERR-FLG
292 MOVE 'Unable to lookup Transaction...' TO
293 WS-MESSAGE
294 MOVE -1 TO TRNIDINL OF COTRN1AI
295 PERFORM SEND-TRNVIEW-SCREEN
296 END-EVALUATE.
297
298 *----------------------------------------------------------------*
299 * CLEAR-CURRENT-SCREEN
300 *----------------------------------------------------------------*
301 CLEAR-CURRENT-SCREEN.
302
303 PERFORM INITIALIZE-ALL-FIELDS.
304 PERFORM SEND-TRNVIEW-SCREEN.
305
306 *----------------------------------------------------------------*
307 * INITIALIZE-ALL-FIELDS
308 *----------------------------------------------------------------*
309 INITIALIZE-ALL-FIELDS.
310
311 MOVE -1 TO TRNIDINL OF COTRN1AI
312 MOVE SPACES TO TRNIDINI OF COTRN1AI
313 TRNIDI OF COTRN1AI
314 CARDNUMI OF COTRN1AI
315 TTYPCDI OF COTRN1AI
316 TCATCDI OF COTRN1AI
317 TRNSRCI OF COTRN1AI
318 TRNAMTI OF COTRN1AI
319 TDESCI OF COTRN1AI
320 TORIGDTI OF COTRN1AI
321 TPROCDTI OF COTRN1AI
322 MIDI OF COTRN1AI
323 MNAMEI OF COTRN1AI
324 MCITYI OF COTRN1AI
325 MZIPI OF COTRN1AI
326 WS-MESSAGE.
327
328 *
329 * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:34 CDT
330 *