MFmainframe-rea
WS carddemo · 26f629ef

Converted program · 83 lines of TypeScript from 288 lines of COBOL · 83 COBOL lines cited (29%)COADM01C

Run it on the 3270 →Analysis →All programs

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

1/**
2 * COADM01C — administrator menu (transaction CA00).
3 * Converted from app/cbl/COADM01C.cbl; screen COADM01/COADM1A; options from COADM02Y.
4 */
5import type { Cics, Program } from "../runtime/cics.js";
6import type { SymbolicMap } from "../runtime/screen.js";
7import { CDEMO_ADMIN_OPTIONS, menuOption } from "./common.js";
8import { CCDA_MSG_INVALID_KEY, returnToSignonScreen, sendMenuScreen, type MenuState } from "./menu.js";
9
10const WS_PGMNAME = "COADM01C";
11const WS_TRANID = "CA00";
12
13export const COADM01C: Program = {
14 name: WS_PGMNAME,
15 source: "app/cbl/COADM01C.cbl",
16 run(ctx: Cics) {
17 const ws: MenuState = { message: "", errFlg: "N" };
18 let out = ctx.map("COADM01", "COADM1A");
19 const send = () => sendMenuScreen(ctx, out, WS_TRANID, WS_PGMNAME, CDEMO_ADMIN_OPTIONS, ws);
20
21 // EXEC CICS HANDLE CONDITION PGMIDERR(PGMIDERR-ERR-PARA) (COADM01C.cbl:77-79)
22 ctx.handleCondition("PGMIDERR", () => {
23 // PGMIDERR-ERR-PARA (COADM01C.cbl:268-280)
24 out.color("ERRMSG", "GREEN");
25 ws.message = "This option is not installed ...";
26 send();
27 ctx.return(WS_TRANID, ctx.area());
28 });
29
30 // MAIN-PARA (COADM01C.cbl:75-113)
31 out.set("ERRMSG", "");
32 if (ctx.eib.calen === 0) {
33 ctx.area().fromProgram = "COSGN00C";
34 returnToSignonScreen(ctx);
35 }
36 const area = ctx.area();
37 if (area.pgmContext !== 1) {
38 area.pgmContext = 1;
39 out.clear();
40 send();
41 } else {
42 out = ctx.receiveMap("COADM01", "COADM1A").map;
43 switch (ctx.eib.aid) {
44 case "ENTER":
45 processEnterKey(ctx, out, ws, send);
46 break;
47 case "PF3":
48 area.toProgram = "COSGN00C";
49 returnToSignonScreen(ctx);
50 // falls through: XCTL does not return
51 default:
52 ws.errFlg = "Y";
53 ws.message = CCDA_MSG_INVALID_KEY;
54 send();
55 }
56 }
57 ctx.return(WS_TRANID, area);
58 },
59};
60
61/** PROCESS-ENTER-KEY (COADM01C.cbl:118-148) */
62function processEnterKey(ctx: Cics, out: SymbolicMap, ws: MenuState, send: () => void): void {
63 const area = ctx.area();
64 const { text, value } = menuOption(out.get("OPTION"), 2);
65 const option = value ?? 0;
66 out.set("OPTION", text);
67 if (value === null || option > CDEMO_ADMIN_OPTIONS.length || option === 0) {
68 ws.errFlg = "Y";
69 ws.message = "Please enter a valid option number...";
70 send();
71 }
72 if (ws.errFlg === "Y") return;
73 const chosen = CDEMO_ADMIN_OPTIONS[option - 1]!;
74 if (!chosen.pgmname.startsWith("DUMMY")) {
75 area.fromTranid = WS_TRANID;
76 area.fromProgram = WS_PGMNAME;
77 area.pgmContext = 0;
78 ctx.xctl(chosen.pgmname, area);
79 }
80 out.color("ERRMSG", "GREEN");
81 ws.message = "This option is not installed ...";
82 send();
83}

COBOL app/cbl/COADM01C.cbl

1 ******************************************************************
2 * Program : COADM01C.CBL
3 * Application : CardDemo
4 * Type : CICS COBOL Program
5 * Function : Admin Menu for Admin 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. COADM01C.
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 'COADM01C'.
37 05 WS-TRANID PIC X(04) VALUE 'CA00'.
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-ADMIN-OPT-TXT PIC X(40) VALUE SPACES.
49
50 COPY COCOM01Y.
51 COPY COADM02Y.
52
53 COPY COADM01.
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 EXEC CICS
78 HANDLE CONDITION PGMIDERR(PGMIDERR-ERR-PARA)
79 END-EXEC
80
81 SET ERR-FLG-OFF TO TRUE
82
83 MOVE SPACES TO WS-MESSAGE
84 ERRMSGO OF COADM1AO
85
86 IF EIBCALEN = 0
87 MOVE 'COSGN00C' TO CDEMO-FROM-PROGRAM
88 PERFORM RETURN-TO-SIGNON-SCREEN
89 ELSE
90 MOVE DFHCOMMAREA(1:EIBCALEN) TO CARDDEMO-COMMAREA
91 IF NOT CDEMO-PGM-REENTER
92 SET CDEMO-PGM-REENTER TO TRUE
93 MOVE LOW-VALUES TO COADM1AO
94 PERFORM SEND-MENU-SCREEN
95 ELSE
96 PERFORM RECEIVE-MENU-SCREEN
97 EVALUATE EIBAID
98 WHEN DFHENTER
99 PERFORM PROCESS-ENTER-KEY
100 WHEN DFHPF3
101 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
102 PERFORM RETURN-TO-SIGNON-SCREEN
103 WHEN OTHER
104 MOVE 'Y' TO WS-ERR-FLG
105 MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE
106 PERFORM SEND-MENU-SCREEN
107 END-EVALUATE
108 END-IF
109 END-IF
110
111 EXEC CICS RETURN
112 TRANSID (WS-TRANID)
113 COMMAREA (CARDDEMO-COMMAREA)
114 END-EXEC.
115
116 *----------------------------------------------------------------*
117 * PROCESS-ENTER-KEY
118 *----------------------------------------------------------------*
119 PROCESS-ENTER-KEY.
120
121 PERFORM VARYING WS-IDX
122 FROM LENGTH OF OPTIONI OF COADM1AI BY -1 UNTIL
123 OPTIONI OF COADM1AI(WS-IDX:1) NOT = SPACES OR
124 WS-IDX = 1
125 END-PERFORM
126 MOVE OPTIONI OF COADM1AI(1:WS-IDX) TO WS-OPTION-X
127 INSPECT WS-OPTION-X REPLACING ALL ' ' BY '0'
128 MOVE WS-OPTION-X TO WS-OPTION
129 MOVE WS-OPTION TO OPTIONO OF COADM1AO
130
131 IF WS-OPTION IS NOT NUMERIC OR
132 WS-OPTION > CDEMO-ADMIN-OPT-COUNT OR
133 WS-OPTION = ZEROS
134 MOVE 'Y' TO WS-ERR-FLG
135 MOVE 'Please enter a valid option number...' TO
136 WS-MESSAGE
137 PERFORM SEND-MENU-SCREEN
138 END-IF
139
140 IF NOT ERR-FLG-ON
141 IF CDEMO-ADMIN-OPT-PGMNAME(WS-OPTION)(1:5) NOT = 'DUMMY'
142 MOVE WS-TRANID TO CDEMO-FROM-TRANID
143 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
144 MOVE ZEROS TO CDEMO-PGM-CONTEXT
145 EXEC CICS
146 XCTL PROGRAM(CDEMO-ADMIN-OPT-PGMNAME(WS-OPTION))
147 COMMAREA(CARDDEMO-COMMAREA)
148 END-EXEC
149 END-IF
150 MOVE SPACES TO WS-MESSAGE
151 MOVE DFHGREEN TO ERRMSGC OF COADM1AO
152 STRING 'This option ' DELIMITED BY SIZE
153 * CDEMO-ADMIN-OPT-NAME(WS-OPTION)
154 * DELIMITED BY SIZE
155 'is not installed ...' DELIMITED BY SIZE
156 INTO WS-MESSAGE
157 PERFORM SEND-MENU-SCREEN
158 END-IF.
159
160 *----------------------------------------------------------------*
161 * RETURN-TO-SIGNON-SCREEN
162 *----------------------------------------------------------------*
163 RETURN-TO-SIGNON-SCREEN.
164
165 IF CDEMO-TO-PROGRAM = LOW-VALUES OR SPACES
166 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
167 END-IF
168 EXEC CICS
169 XCTL PROGRAM(CDEMO-TO-PROGRAM)
170 END-EXEC.
171
172 *----------------------------------------------------------------*
173 * SEND-MENU-SCREEN
174 *----------------------------------------------------------------*
175 SEND-MENU-SCREEN.
176
177 PERFORM POPULATE-HEADER-INFO
178 PERFORM BUILD-MENU-OPTIONS
179
180 MOVE WS-MESSAGE TO ERRMSGO OF COADM1AO
181
182 EXEC CICS SEND
183 MAP('COADM1A')
184 MAPSET('COADM01')
185 FROM(COADM1AO)
186 ERASE
187 END-EXEC.
188
189 *----------------------------------------------------------------*
190 * RECEIVE-MENU-SCREEN
191 *----------------------------------------------------------------*
192 RECEIVE-MENU-SCREEN.
193
194 EXEC CICS RECEIVE
195 MAP('COADM1A')
196 MAPSET('COADM01')
197 INTO(COADM1AI)
198 RESP(WS-RESP-CD)
199 RESP2(WS-REAS-CD)
200 END-EXEC.
201
202 *----------------------------------------------------------------*
203 * POPULATE-HEADER-INFO
204 *----------------------------------------------------------------*
205 POPULATE-HEADER-INFO.
206
207 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
208
209 MOVE CCDA-TITLE01 TO TITLE01O OF COADM1AO
210 MOVE CCDA-TITLE02 TO TITLE02O OF COADM1AO
211 MOVE WS-TRANID TO TRNNAMEO OF COADM1AO
212 MOVE WS-PGMNAME TO PGMNAMEO OF COADM1AO
213
214 MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
215 MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
216 MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
217
218 MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF COADM1AO
219
220 MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
221 MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
222 MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
223
224 MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF COADM1AO.
225
226 *----------------------------------------------------------------*
227 * BUILD-MENU-OPTIONS
228 *----------------------------------------------------------------*
229 BUILD-MENU-OPTIONS.
230
231 PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL
232 WS-IDX > CDEMO-ADMIN-OPT-COUNT
233
234 MOVE SPACES TO WS-ADMIN-OPT-TXT
235
236 STRING CDEMO-ADMIN-OPT-NUM(WS-IDX) DELIMITED BY SIZE
237 '. ' DELIMITED BY SIZE
238 CDEMO-ADMIN-OPT-NAME(WS-IDX) DELIMITED BY SIZE
239 INTO WS-ADMIN-OPT-TXT
240
241 EVALUATE WS-IDX
242 WHEN 1
243 MOVE WS-ADMIN-OPT-TXT TO OPTN001O
244 WHEN 2
245 MOVE WS-ADMIN-OPT-TXT TO OPTN002O
246 WHEN 3
247 MOVE WS-ADMIN-OPT-TXT TO OPTN003O
248 WHEN 4
249 MOVE WS-ADMIN-OPT-TXT TO OPTN004O
250 WHEN 5
251 MOVE WS-ADMIN-OPT-TXT TO OPTN005O
252 WHEN 6
253 MOVE WS-ADMIN-OPT-TXT TO OPTN006O
254 WHEN 7
255 MOVE WS-ADMIN-OPT-TXT TO OPTN007O
256 WHEN 8
257 MOVE WS-ADMIN-OPT-TXT TO OPTN008O
258 WHEN 9
259 MOVE WS-ADMIN-OPT-TXT TO OPTN009O
260 WHEN 10
261 MOVE WS-ADMIN-OPT-TXT TO OPTN010O
262 WHEN OTHER
263 CONTINUE
264 END-EVALUATE
265
266 END-PERFORM.
267 *----------------------------------------------------------------*
268 * PGMIDERROR HANDLE-MISSING MENU OPTIONS
269 *----------------------------------------------------------------*
270 PGMIDERR-ERR-PARA.
271 MOVE SPACES TO WS-MESSAGE
272 MOVE DFHGREEN TO ERRMSGC OF COADM1AO
273 STRING 'This option ' DELIMITED BY SIZE
274 * CDEMO-ADMIN-OPT-NAME(WS-OPTION)
275 * DELIMITED BY SIZE
276 'is not installed ...' DELIMITED BY SIZE
277 INTO WS-MESSAGE
278
279 PERFORM SEND-MENU-SCREEN
280 EXEC CICS RETURN
281 TRANSID (WS-TRANID)
282 COMMAREA (CARDDEMO-COMMAREA)
283 END-EXEC.
284 .
285
286 *
287 * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:32 CDT
288 *