MFmainframe-rea
WS carddemo · 26f629ef

Converted program · 95 lines of TypeScript from 308 lines of COBOL · 113 COBOL lines cited (37%)COMEN01C

Run it on the 3270 →Analysis →All programs

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

1/**
2 * COMEN01C — main menu for regular users (transaction CM00).
3 * Converted from app/cbl/COMEN01C.cbl; screen COMEN01/COMEN1A; options from COMEN02Y.
4 */
5import { RESP, type Cics, type Program } from "../runtime/cics.js";
6import type { SymbolicMap } from "../runtime/screen.js";
7import { CDEMO_MENU_OPTIONS, menuOption } from "./common.js";
8import { CCDA_MSG_INVALID_KEY, returnToSignonScreen, sendMenuScreen, type MenuState } from "./menu.js";
9
10const WS_PGMNAME = "COMEN01C";
11const WS_TRANID = "CM00";
12
13export const COMEN01C: Program = {
14 name: WS_PGMNAME,
15 source: "app/cbl/COMEN01C.cbl",
16 run(ctx: Cics) {
17 const ws: MenuState = { message: "", errFlg: "N" };
18 let out = ctx.map("COMEN01", "COMEN1A");
19 const send = () => sendMenuScreen(ctx, out, WS_TRANID, WS_PGMNAME, CDEMO_MENU_OPTIONS, ws);
20
21 // MAIN-PARA (COMEN01C.cbl:75-110)
22 out.set("ERRMSG", "");
23 if (ctx.eib.calen === 0) {
24 ctx.area().fromProgram = "COSGN00C";
25 returnToSignonScreen(ctx);
26 }
27 const area = ctx.area();
28 if (area.pgmContext !== 1) {
29 area.pgmContext = 1; // SET CDEMO-PGM-REENTER TO TRUE
30 out.clear();
31 send();
32 } else {
33 // RECEIVE-MENU-SCREEN: the I and O maps share storage, so the received map is sent back.
34 out = ctx.receiveMap("COMEN01", "COMEN1A").map;
35 switch (ctx.eib.aid) {
36 case "ENTER":
37 processEnterKey(ctx, out, ws, send);
38 break;
39 case "PF3":
40 area.toProgram = "COSGN00C";
41 returnToSignonScreen(ctx);
42 // falls through: XCTL does not return
43 default:
44 ws.errFlg = "Y";
45 ws.message = CCDA_MSG_INVALID_KEY;
46 send();
47 }
48 }
49 ctx.return(WS_TRANID, area);
50 },
51};
52
53/** PROCESS-ENTER-KEY (COMEN01C.cbl:115-191) */
54function processEnterKey(ctx: Cics, out: SymbolicMap, ws: MenuState, send: () => void): void {
55 const area = ctx.area();
56 const { text, value } = menuOption(out.get("OPTION"), 2);
57 const option = value ?? 0;
58 out.set("OPTION", text);
59 if (value === null || option > CDEMO_MENU_OPTIONS.length || option === 0) {
60 ws.errFlg = "Y";
61 ws.message = "Please enter a valid option number...";
62 send();
63 }
64 const chosen = CDEMO_MENU_OPTIONS[option - 1];
65 // A regular user may not pick an admin-only option (none are marked 'A' in COMEN02Y).
66 if (area.userType === "U" && chosen?.usrtype === "A") {
67 ws.errFlg = "Y";
68 ws.message = "No access - Admin Only option... ";
69 send();
70 }
71 if (ws.errFlg === "Y" || !chosen) return;
72
73 if (chosen.pgmname === "COPAUS0C") {
74 // EXEC CICS INQUIRE PROGRAM(...) NOHANDLE: optional IMS/MQ sub-application.
75 if (ctx.inquireProgram(chosen.pgmname) === RESP.NORMAL) {
76 area.fromTranid = WS_TRANID;
77 area.fromProgram = WS_PGMNAME;
78 area.pgmContext = 0;
79 ctx.xctl(chosen.pgmname, area);
80 } else {
81 out.color("ERRMSG", "RED");
82 // STRING 'This option ' CDEMO-MENU-OPT-NAME DELIMITED BY ' ' ' is not installed...'
83 ws.message = `This option ${chosen.name} is not installed...`;
84 }
85 } else if (chosen.pgmname.startsWith("DUMMY")) {
86 out.color("ERRMSG", "GREEN");
87 ws.message = `This option ${chosen.name.split(" ")[0]}is coming soon ...`;
88 } else {
89 area.fromTranid = WS_TRANID;
90 area.fromProgram = WS_PGMNAME;
91 area.pgmContext = 0;
92 ctx.xctl(chosen.pgmname, area);
93 }
94 send();
95}

COBOL app/cbl/COMEN01C.cbl

1 ******************************************************************
2 * Program : COMEN01C.CBL
3 * Application : CardDemo
4 * Type : CICS COBOL Program
5 * Function : Main Menu for the Regular users
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. COMEN01C.
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 'COMEN01C'.
37 05 WS-TRANID PIC X(04) VALUE 'CM00'.
38 05 WS-MESSAGE PIC X(80) VALUE SPACES.
39 05 WS-USRSEC-FILE PIC X(08) VALUE 'USRSEC '.
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-OPTION-X PIC X(02) JUST RIGHT.
46 05 WS-OPTION PIC 9(02) VALUE 0.
47 05 WS-IDX PIC S9(04) COMP VALUE ZEROS.
48 05 WS-MENU-OPT-TXT PIC X(40) VALUE SPACES.
49
50 COPY COCOM01Y.
51 COPY COMEN02Y.
52
53 COPY COMEN01.
54
55 COPY COTTL01Y.
56 COPY CSDAT01Y.
57 COPY CSMSG01Y.
58 COPY CSUSR01Y.
59
60 COPY DFHAID.
61 COPY DFHBMSCA.
62
63 *----------------------------------------------------------------*
64 * LINKAGE SECTION
65 *----------------------------------------------------------------*
66 LINKAGE SECTION.
67 01 DFHCOMMAREA.
68 05 LK-COMMAREA PIC X(01)
69 OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
70
71 *----------------------------------------------------------------*
72 * PROCEDURE DIVISION
73 *----------------------------------------------------------------*
74 PROCEDURE DIVISION.
75 MAIN-PARA.
76
77 SET ERR-FLG-OFF TO TRUE
78
79 MOVE SPACES TO WS-MESSAGE
80 ERRMSGO OF COMEN1AO
81
82 IF EIBCALEN = 0
83 MOVE 'COSGN00C' TO CDEMO-FROM-PROGRAM
84 PERFORM RETURN-TO-SIGNON-SCREEN
85 ELSE
86 MOVE DFHCOMMAREA(1:EIBCALEN) TO CARDDEMO-COMMAREA
87 IF NOT CDEMO-PGM-REENTER
88 SET CDEMO-PGM-REENTER TO TRUE
89 MOVE LOW-VALUES TO COMEN1AO
90 PERFORM SEND-MENU-SCREEN
91 ELSE
92 PERFORM RECEIVE-MENU-SCREEN
93 EVALUATE EIBAID
94 WHEN DFHENTER
95 PERFORM PROCESS-ENTER-KEY
96 WHEN DFHPF3
97 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
98 PERFORM RETURN-TO-SIGNON-SCREEN
99 WHEN OTHER
100 MOVE 'Y' TO WS-ERR-FLG
101 MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE
102 PERFORM SEND-MENU-SCREEN
103 END-EVALUATE
104 END-IF
105 END-IF
106
107 EXEC CICS RETURN
108 TRANSID (WS-TRANID)
109 COMMAREA (CARDDEMO-COMMAREA)
110 END-EXEC.
111
112 *----------------------------------------------------------------*
113 * PROCESS-ENTER-KEY
114 *----------------------------------------------------------------*
115 PROCESS-ENTER-KEY.
116
117 PERFORM VARYING WS-IDX
118 FROM LENGTH OF OPTIONI OF COMEN1AI BY -1 UNTIL
119 OPTIONI OF COMEN1AI(WS-IDX:1) NOT = SPACES OR
120 WS-IDX = 1
121 END-PERFORM
122 MOVE OPTIONI OF COMEN1AI(1:WS-IDX) TO WS-OPTION-X
123 INSPECT WS-OPTION-X REPLACING ALL ' ' BY '0'
124 MOVE WS-OPTION-X TO WS-OPTION
125 MOVE WS-OPTION TO OPTIONO OF COMEN1AO
126
127 IF WS-OPTION IS NOT NUMERIC OR
128 WS-OPTION > CDEMO-MENU-OPT-COUNT OR
129 WS-OPTION = ZEROS
130 MOVE 'Y' TO WS-ERR-FLG
131 MOVE 'Please enter a valid option number...' TO
132 WS-MESSAGE
133 PERFORM SEND-MENU-SCREEN
134 END-IF
135
136 IF CDEMO-USRTYP-USER AND
137 CDEMO-MENU-OPT-USRTYPE(WS-OPTION) = 'A'
138 SET ERR-FLG-ON TO TRUE
139 MOVE SPACES TO WS-MESSAGE
140 MOVE 'No access - Admin Only option... ' TO
141 WS-MESSAGE
142 PERFORM SEND-MENU-SCREEN
143 END-IF
144
145 IF NOT ERR-FLG-ON
146 EVALUATE TRUE
147 WHEN CDEMO-MENU-OPT-PGMNAME(WS-OPTION) = 'COPAUS0C'
148 EXEC CICS INQUIRE
149 PROGRAM(CDEMO-MENU-OPT-PGMNAME(WS-OPTION))
150 NOHANDLE
151 END-EXEC
152 IF EIBRESP = DFHRESP(NORMAL)
153 MOVE WS-TRANID TO CDEMO-FROM-TRANID
154 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
155 MOVE ZEROS TO CDEMO-PGM-CONTEXT
156 EXEC CICS XCTL
157 PROGRAM(CDEMO-MENU-OPT-PGMNAME(WS-OPTION))
158 COMMAREA(CARDDEMO-COMMAREA)
159 END-EXEC
160 ELSE
161 MOVE SPACES TO WS-MESSAGE
162 MOVE DFHRED TO ERRMSGC OF COMEN1AO
163 STRING 'This option ' DELIMITED BY SIZE
164 CDEMO-MENU-OPT-NAME(WS-OPTION)
165 DELIMITED BY ' '
166 ' is not installed...' DELIMITED BY SIZE
167 INTO WS-MESSAGE
168 END-IF
169 WHEN CDEMO-MENU-OPT-PGMNAME(WS-OPTION)(1:5) = 'DUMMY'
170 MOVE SPACES TO WS-MESSAGE
171 MOVE DFHGREEN TO ERRMSGC OF COMEN1AO
172 STRING 'This option ' DELIMITED BY SIZE
173 CDEMO-MENU-OPT-NAME(WS-OPTION)
174 DELIMITED BY SPACE
175 'is coming soon ...' DELIMITED BY SIZE
176 INTO WS-MESSAGE
177 WHEN OTHER
178 MOVE WS-TRANID TO CDEMO-FROM-TRANID
179 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
180 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
181 * MOVE WS-USER-ID TO CDEMO-USER-ID
182 * MOVE SEC-USR-TYPE TO CDEMO-USER-TYPE
183 MOVE ZEROS TO CDEMO-PGM-CONTEXT
184 EXEC CICS
185 XCTL PROGRAM(CDEMO-MENU-OPT-PGMNAME(WS-OPTION))
186 COMMAREA(CARDDEMO-COMMAREA)
187 END-EXEC
188 END-EVALUATE
189
190 PERFORM SEND-MENU-SCREEN
191 END-IF.
192
193 *----------------------------------------------------------------*
194 * RETURN-TO-SIGNON-SCREEN
195 *----------------------------------------------------------------*
196 RETURN-TO-SIGNON-SCREEN.
197
198 IF CDEMO-TO-PROGRAM = LOW-VALUES OR SPACES
199 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
200 END-IF
201 EXEC CICS
202 XCTL PROGRAM(CDEMO-TO-PROGRAM)
203 END-EXEC.
204
205 *----------------------------------------------------------------*
206 * SEND-MENU-SCREEN
207 *----------------------------------------------------------------*
208 SEND-MENU-SCREEN.
209
210 PERFORM POPULATE-HEADER-INFO
211 PERFORM BUILD-MENU-OPTIONS
212
213 MOVE WS-MESSAGE TO ERRMSGO OF COMEN1AO
214
215 EXEC CICS SEND
216 MAP('COMEN1A')
217 MAPSET('COMEN01')
218 FROM(COMEN1AO)
219 ERASE
220 END-EXEC.
221
222 *----------------------------------------------------------------*
223 * RECEIVE-MENU-SCREEN
224 *----------------------------------------------------------------*
225 RECEIVE-MENU-SCREEN.
226
227 EXEC CICS RECEIVE
228 MAP('COMEN1A')
229 MAPSET('COMEN01')
230 INTO(COMEN1AI)
231 RESP(WS-RESP-CD)
232 RESP2(WS-REAS-CD)
233 END-EXEC.
234
235 *----------------------------------------------------------------*
236 * POPULATE-HEADER-INFO
237 *----------------------------------------------------------------*
238 POPULATE-HEADER-INFO.
239
240 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
241
242 MOVE CCDA-TITLE01 TO TITLE01O OF COMEN1AO
243 MOVE CCDA-TITLE02 TO TITLE02O OF COMEN1AO
244 MOVE WS-TRANID TO TRNNAMEO OF COMEN1AO
245 MOVE WS-PGMNAME TO PGMNAMEO OF COMEN1AO
246
247 MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
248 MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
249 MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
250
251 MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF COMEN1AO
252
253 MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
254 MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
255 MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
256
257 MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF COMEN1AO.
258
259 *----------------------------------------------------------------*
260 * BUILD-MENU-OPTIONS
261 *----------------------------------------------------------------*
262 BUILD-MENU-OPTIONS.
263
264 PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL
265 WS-IDX > CDEMO-MENU-OPT-COUNT
266
267 MOVE SPACES TO WS-MENU-OPT-TXT
268
269 STRING CDEMO-MENU-OPT-NUM(WS-IDX) DELIMITED BY SIZE
270 '. ' DELIMITED BY SIZE
271 CDEMO-MENU-OPT-NAME(WS-IDX) DELIMITED BY SIZE
272 INTO WS-MENU-OPT-TXT
273
274 EVALUATE WS-IDX
275 WHEN 1
276 MOVE WS-MENU-OPT-TXT TO OPTN001O
277 WHEN 2
278 MOVE WS-MENU-OPT-TXT TO OPTN002O
279 WHEN 3
280 MOVE WS-MENU-OPT-TXT TO OPTN003O
281 WHEN 4
282 MOVE WS-MENU-OPT-TXT TO OPTN004O
283 WHEN 5
284 MOVE WS-MENU-OPT-TXT TO OPTN005O
285 WHEN 6
286 MOVE WS-MENU-OPT-TXT TO OPTN006O
287 WHEN 7
288 MOVE WS-MENU-OPT-TXT TO OPTN007O
289 WHEN 8
290 MOVE WS-MENU-OPT-TXT TO OPTN008O
291 WHEN 9
292 MOVE WS-MENU-OPT-TXT TO OPTN009O
293 WHEN 10
294 MOVE WS-MENU-OPT-TXT TO OPTN010O
295 WHEN 11
296 MOVE WS-MENU-OPT-TXT TO OPTN011O
297 WHEN 12
298 MOVE WS-MENU-OPT-TXT TO OPTN012O
299 WHEN OTHER
300 CONTINUE
301 END-EVALUATE
302
303 END-PERFORM.
304
305
306 *
307 * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:33 CDT
308 *