MFmainframe-rea
WS carddemo · 26f629ef

Converted program · 259 lines of TypeScript from 414 lines of COBOL · 271 COBOL lines cited (65%)COUSR02C

Run it on the 3270 →Analysis →All programs

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

1/**
2 * COUSR02C — update a user in USRSEC (transaction CU02).
3 * Converted from app/cbl/COUSR02C.cbl; screen COUSR02/COUSR2A; file USRSEC.
4 */
5import { alnum, isBlank } from "../runtime/cobol.js";
6import { RESP, type Cics, type Program } from "../runtime/cics.js";
7import type { SymbolicMap } from "../runtime/screen.js";
8import type { SecUserData } from "../generated/records.js";
9import { CCDA_MSG_INVALID_KEY, populateHeaderInfo } from "./common.js";
10import { cuInfo, delimitedBySpace, returnToPrevScreen, WS_USRSEC_FILE } from "./users-lib.js";
11
12const WS_PGMNAME = "COUSR02C";
13const WS_TRANID = "CU02";
14
15/** WS-VARIABLES (COUSR02C.cbl:35-47) plus SEC-USER-DATA (CSUSR01Y). */
16interface Ws {
17 message: string;
18 errFlg: string;
19 respCd: number;
20 usrModified: string;
21 /**
22 * SEC-USER-DATA. Working storage without VALUE: LOW-VALUES until a READ fills it
23 * (a READ that ends NOTFND leaves the INTO area untouched).
24 */
25 rec: SecUserData;
26 /** A READ ... UPDATE succeeded in this task (REWRITE needs one, else INVREQ). */
27 held: boolean;
28}
29
30export const COUSR02C: Program = {
31 name: WS_PGMNAME,
32 source: "app/cbl/COUSR02C.cbl",
33 run(ctx: Cics) {
34 const ws: Ws = {
35 message: "",
36 errFlg: "N",
37 respCd: 0,
38 usrModified: "N",
39 rec: { secUsrId: "", secUsrFname: "", secUsrLname: "", secUsrPwd: "", secUsrType: "", secUsrFiller: "" },
40 held: false,
41 };
42 let out = ctx.map("COUSR02", "COUSR2A");
43
44 // MAIN-PARA (COUSR02C.cbl:82-138)
45 ws.errFlg = "N";
46 ws.usrModified = "N";
47 ws.message = "";
48 out.set("ERRMSG", "");
49
50 if (ctx.eib.calen === 0) {
51 ctx.area().toProgram = "COSGN00C";
52 returnToPrevScreen(ctx, WS_TRANID, WS_PGMNAME);
53 }
54 const area = ctx.area();
55 const info = cuInfo(ctx);
56 if (area.pgmContext !== 1) {
57 area.pgmContext = 1;
58 out.clear();
59 out.cursor("USRIDIN");
60 // CDEMO-CU02-USR-SELECTED overlays CDEMO-CU00-USR-SELECTED set by COUSR00C.
61 if (!isBlank(info.usrSelected)) {
62 out.set("USRIDIN", info.usrSelected);
63 processEnterKey(ctx, out, ws);
64 }
65 sendUsrupdScreen(ctx, out, ws);
66 } else {
67 out = receiveUsrupdScreen(ctx, ws);
68 switch (ctx.eib.aid) {
69 case "ENTER":
70 processEnterKey(ctx, out, ws);
71 break;
72 case "PF3":
73 // PF3 = "Save & Exit": UPDATE-USER-INFO runs, then the XCTL happens whatever it said.
74 updateUserInfo(ctx, out, ws);
75 area.toProgram = isBlank(area.fromProgram) ? "COADM01C" : area.fromProgram;
76 returnToPrevScreen(ctx, WS_TRANID, WS_PGMNAME);
77 // falls through: XCTL does not return
78 case "PF4":
79 clearCurrentScreen(ctx, out, ws);
80 break;
81 case "PF5":
82 updateUserInfo(ctx, out, ws);
83 break;
84 case "PF12":
85 area.toProgram = "COADM01C";
86 returnToPrevScreen(ctx, WS_TRANID, WS_PGMNAME);
87 // falls through: XCTL does not return
88 default:
89 ws.errFlg = "Y";
90 ws.message = CCDA_MSG_INVALID_KEY;
91 sendUsrupdScreen(ctx, out, ws);
92 }
93 }
94 ctx.return(WS_TRANID, area);
95 },
96};
97
98/** PROCESS-ENTER-KEY (COUSR02C.cbl:143-172) */
99function processEnterKey(ctx: Cics, out: SymbolicMap, ws: Ws): void {
100 if (isBlank(out.get("USRIDIN"))) {
101 ws.errFlg = "Y";
102 ws.message = "User ID can NOT be empty...";
103 out.cursor("USRIDIN");
104 sendUsrupdScreen(ctx, out, ws);
105 } else {
106 out.cursor("USRIDIN");
107 }
108
109 if (ws.errFlg !== "Y") {
110 for (const f of ["FNAME", "LNAME", "PASSWD", "USRTYPE"]) out.set(f, " ".repeat(20));
111 ws.rec.secUsrId = alnum(out.get("USRIDIN"), 8);
112 readUserSecFile(ctx, out, ws);
113 }
114
115 if (ws.errFlg !== "Y") {
116 out.set("FNAME", ws.rec.secUsrFname);
117 out.set("LNAME", ws.rec.secUsrLname);
118 out.set("PASSWD", ws.rec.secUsrPwd);
119 out.set("USRTYPE", ws.rec.secUsrType);
120 sendUsrupdScreen(ctx, out, ws);
121 }
122}
123
124/** UPDATE-USER-INFO (COUSR02C.cbl:177-245) */
125function updateUserInfo(ctx: Cics, out: SymbolicMap, ws: Ws): void {
126 const required: [field: string, message: string][] = [
127 ["USRIDIN", "User ID can NOT be empty..."],
128 ["FNAME", "First Name can NOT be empty..."],
129 ["LNAME", "Last Name can NOT be empty..."],
130 ["PASSWD", "Password can NOT be empty..."],
131 ["USRTYPE", "User Type can NOT be empty..."],
132 ];
133 const missing = required.find(([field]) => isBlank(out.get(field)));
134 if (missing) {
135 ws.errFlg = "Y";
136 ws.message = missing[1];
137 out.cursor(missing[0]);
138 sendUsrupdScreen(ctx, out, ws);
139 } else {
140 out.cursor("FNAME");
141 }
142
143 if (ws.errFlg === "Y") return;
144
145 ws.rec.secUsrId = alnum(out.get("USRIDIN"), 8);
146 readUserSecFile(ctx, out, ws);
147 // No check of WS-ERR-FLG here: after NOTFND the fields are compared with the
148 // untouched (LOW-VALUES) SEC-USER-DATA, so the user always looks modified.
149 const fname = alnum(out.get("FNAME"), 20);
150 if (fname !== ws.rec.secUsrFname) {
151 ws.rec.secUsrFname = fname;
152 ws.usrModified = "Y";
153 }
154 const lname = alnum(out.get("LNAME"), 20);
155 if (lname !== ws.rec.secUsrLname) {
156 ws.rec.secUsrLname = lname;
157 ws.usrModified = "Y";
158 }
159 const pwd = alnum(out.get("PASSWD"), 8);
160 if (pwd !== ws.rec.secUsrPwd) {
161 ws.rec.secUsrPwd = pwd;
162 ws.usrModified = "Y";
163 }
164 const type = alnum(out.get("USRTYPE"), 1);
165 if (type !== ws.rec.secUsrType) {
166 ws.rec.secUsrType = type;
167 ws.usrModified = "Y";
168 }
169
170 if (ws.usrModified === "Y") {
171 updateUserSecFile(ctx, out, ws);
172 } else {
173 ws.message = "Please modify to update ...";
174 out.color("ERRMSG", "RED");
175 sendUsrupdScreen(ctx, out, ws);
176 }
177}
178
179/** SEND-USRUPD-SCREEN (COUSR02C.cbl:266-278) */
180function sendUsrupdScreen(ctx: Cics, out: SymbolicMap, ws: Ws): void {
181 populateHeaderInfo(ctx, out, WS_TRANID, WS_PGMNAME);
182 out.set("ERRMSG", ws.message);
183 ctx.sendMap(out, { erase: true, cursor: true });
184}
185
186/** RECEIVE-USRUPD-SCREEN (COUSR02C.cbl:283-291) */
187function receiveUsrupdScreen(ctx: Cics, ws: Ws): SymbolicMap {
188 const { resp, map } = ctx.receiveMap("COUSR02", "COUSR2A");
189 ws.respCd = resp;
190 return map;
191}
192
193/** READ-USER-SEC-FILE (COUSR02C.cbl:320-353) — READ ... UPDATE */
194function readUserSecFile(ctx: Cics, out: SymbolicMap, ws: Ws): void {
195 const { resp, record } = ctx.read<SecUserData>(WS_USRSEC_FILE, ws.rec.secUsrId, { update: true });
196 ws.respCd = resp;
197 switch (resp) {
198 case RESP.NORMAL:
199 ws.rec = record!;
200 ws.held = true;
201 ws.message = "Press PF5 key to save your updates ...";
202 out.color("ERRMSG", "NEUTRAL");
203 sendUsrupdScreen(ctx, out, ws);
204 break;
205 case RESP.NOTFND:
206 ws.errFlg = "Y";
207 ws.message = "User ID NOT found...";
208 out.cursor("USRIDIN");
209 sendUsrupdScreen(ctx, out, ws);
210 break;
211 default:
212 ws.errFlg = "Y";
213 ws.message = "Unable to lookup User...";
214 out.cursor("FNAME");
215 sendUsrupdScreen(ctx, out, ws);
216 }
217}
218
219/**
220 * UPDATE-USER-SEC-FILE (COUSR02C.cbl:358-390). REWRITE without a successful READ
221 * UPDATE is INVREQ in CICS; the runtime does not track the held record, so it is
222 * checked here.
223 */
224function updateUserSecFile(ctx: Cics, out: SymbolicMap, ws: Ws): void {
225 ws.respCd = ws.held ? ctx.rewrite(WS_USRSEC_FILE, ws.rec) : RESP.INVREQ;
226 ws.held = false;
227 switch (ws.respCd) {
228 case RESP.NORMAL:
229 ws.message = "";
230 out.color("ERRMSG", "GREEN");
231 ws.message = `User ${delimitedBySpace(ws.rec.secUsrId)} has been updated ...`;
232 sendUsrupdScreen(ctx, out, ws);
233 break;
234 case RESP.NOTFND:
235 ws.errFlg = "Y";
236 ws.message = "User ID NOT found...";
237 out.cursor("USRIDIN");
238 sendUsrupdScreen(ctx, out, ws);
239 break;
240 default:
241 ws.errFlg = "Y";
242 ws.message = "Unable to Update User...";
243 out.cursor("FNAME");
244 sendUsrupdScreen(ctx, out, ws);
245 }
246}
247
248/** CLEAR-CURRENT-SCREEN (COUSR02C.cbl:395-398) */
249function clearCurrentScreen(ctx: Cics, out: SymbolicMap, ws: Ws): void {
250 initializeAllFields(out, ws);
251 sendUsrupdScreen(ctx, out, ws);
252}
253
254/** INITIALIZE-ALL-FIELDS (COUSR02C.cbl:403-411) */
255function initializeAllFields(out: SymbolicMap, ws: Ws): void {
256 out.cursor("USRIDIN");
257 for (const f of ["USRIDIN", "FNAME", "LNAME", "PASSWD", "USRTYPE"]) out.set(f, " ".repeat(20));
258 ws.message = "";
259}

COBOL app/cbl/COUSR02C.cbl

1 ******************************************************************
2 * Program : COUSR02C.CBL
3 * Application : CardDemo
4 * Type : CICS COBOL Program
5 * Function : Update a user in USRSEC 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. COUSR02C.
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 'COUSR02C'.
37 05 WS-TRANID PIC X(04) VALUE 'CU02'.
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-USR-MODIFIED PIC X(01) VALUE 'N'.
46 88 USR-MODIFIED-YES VALUE 'Y'.
47 88 USR-MODIFIED-NO VALUE 'N'.
48
49 COPY COCOM01Y.
50 05 CDEMO-CU02-INFO.
51 10 CDEMO-CU02-USRID-FIRST PIC X(08).
52 10 CDEMO-CU02-USRID-LAST PIC X(08).
53 10 CDEMO-CU02-PAGE-NUM PIC 9(08).
54 10 CDEMO-CU02-NEXT-PAGE-FLG PIC X(01) VALUE 'N'.
55 88 NEXT-PAGE-YES VALUE 'Y'.
56 88 NEXT-PAGE-NO VALUE 'N'.
57 10 CDEMO-CU02-USR-SEL-FLG PIC X(01).
58 10 CDEMO-CU02-USR-SELECTED PIC X(08).
59
60 COPY COUSR02.
61
62 COPY COTTL01Y.
63 COPY CSDAT01Y.
64 COPY CSMSG01Y.
65 COPY CSUSR01Y.
66
67 COPY DFHAID.
68 COPY DFHBMSCA.
69
70 *----------------------------------------------------------------*
71 * LINKAGE SECTION
72 *----------------------------------------------------------------*
73 LINKAGE SECTION.
74 01 DFHCOMMAREA.
75 05 LK-COMMAREA PIC X(01)
76 OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
77
78 *----------------------------------------------------------------*
79 * PROCEDURE DIVISION
80 *----------------------------------------------------------------*
81 PROCEDURE DIVISION.
82 MAIN-PARA.
83
84 SET ERR-FLG-OFF TO TRUE
85 SET USR-MODIFIED-NO TO TRUE
86
87 MOVE SPACES TO WS-MESSAGE
88 ERRMSGO OF COUSR2AO
89
90 IF EIBCALEN = 0
91 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
92 PERFORM RETURN-TO-PREV-SCREEN
93 ELSE
94 MOVE DFHCOMMAREA(1:EIBCALEN) TO CARDDEMO-COMMAREA
95 IF NOT CDEMO-PGM-REENTER
96 SET CDEMO-PGM-REENTER TO TRUE
97 MOVE LOW-VALUES TO COUSR2AO
98 MOVE -1 TO USRIDINL OF COUSR2AI
99 IF CDEMO-CU02-USR-SELECTED NOT =
100 SPACES AND LOW-VALUES
101 MOVE CDEMO-CU02-USR-SELECTED TO
102 USRIDINI OF COUSR2AI
103 PERFORM PROCESS-ENTER-KEY
104 END-IF
105 PERFORM SEND-USRUPD-SCREEN
106 ELSE
107 PERFORM RECEIVE-USRUPD-SCREEN
108 EVALUATE EIBAID
109 WHEN DFHENTER
110 PERFORM PROCESS-ENTER-KEY
111 WHEN DFHPF3
112 PERFORM UPDATE-USER-INFO
113 IF CDEMO-FROM-PROGRAM = SPACES OR LOW-VALUES
114 MOVE 'COADM01C' TO CDEMO-TO-PROGRAM
115 ELSE
116 MOVE CDEMO-FROM-PROGRAM TO
117 CDEMO-TO-PROGRAM
118 END-IF
119 PERFORM RETURN-TO-PREV-SCREEN
120 WHEN DFHPF4
121 PERFORM CLEAR-CURRENT-SCREEN
122 WHEN DFHPF5
123 PERFORM UPDATE-USER-INFO
124 WHEN DFHPF12
125 MOVE 'COADM01C' TO CDEMO-TO-PROGRAM
126 PERFORM RETURN-TO-PREV-SCREEN
127 WHEN OTHER
128 MOVE 'Y' TO WS-ERR-FLG
129 MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE
130 PERFORM SEND-USRUPD-SCREEN
131 END-EVALUATE
132 END-IF
133 END-IF
134
135 EXEC CICS RETURN
136 TRANSID (WS-TRANID)
137 COMMAREA (CARDDEMO-COMMAREA)
138 END-EXEC.
139
140 *----------------------------------------------------------------*
141 * PROCESS-ENTER-KEY
142 *----------------------------------------------------------------*
143 PROCESS-ENTER-KEY.
144
145 EVALUATE TRUE
146 WHEN USRIDINI OF COUSR2AI = SPACES OR LOW-VALUES
147 MOVE 'Y' TO WS-ERR-FLG
148 MOVE 'User ID can NOT be empty...' TO
149 WS-MESSAGE
150 MOVE -1 TO USRIDINL OF COUSR2AI
151 PERFORM SEND-USRUPD-SCREEN
152 WHEN OTHER
153 MOVE -1 TO USRIDINL OF COUSR2AI
154 CONTINUE
155 END-EVALUATE
156
157 IF NOT ERR-FLG-ON
158 MOVE SPACES TO FNAMEI OF COUSR2AI
159 LNAMEI OF COUSR2AI
160 PASSWDI OF COUSR2AI
161 USRTYPEI OF COUSR2AI
162 MOVE USRIDINI OF COUSR2AI TO SEC-USR-ID
163 PERFORM READ-USER-SEC-FILE
164 END-IF.
165
166 IF NOT ERR-FLG-ON
167 MOVE SEC-USR-FNAME TO FNAMEI OF COUSR2AI
168 MOVE SEC-USR-LNAME TO LNAMEI OF COUSR2AI
169 MOVE SEC-USR-PWD TO PASSWDI OF COUSR2AI
170 MOVE SEC-USR-TYPE TO USRTYPEI OF COUSR2AI
171 PERFORM SEND-USRUPD-SCREEN
172 END-IF.
173
174 *----------------------------------------------------------------*
175 * UPDATE-USER-INFO
176 *----------------------------------------------------------------*
177 UPDATE-USER-INFO.
178
179 EVALUATE TRUE
180 WHEN USRIDINI OF COUSR2AI = SPACES OR LOW-VALUES
181 MOVE 'Y' TO WS-ERR-FLG
182 MOVE 'User ID can NOT be empty...' TO
183 WS-MESSAGE
184 MOVE -1 TO USRIDINL OF COUSR2AI
185 PERFORM SEND-USRUPD-SCREEN
186 WHEN FNAMEI OF COUSR2AI = SPACES OR LOW-VALUES
187 MOVE 'Y' TO WS-ERR-FLG
188 MOVE 'First Name can NOT be empty...' TO
189 WS-MESSAGE
190 MOVE -1 TO FNAMEL OF COUSR2AI
191 PERFORM SEND-USRUPD-SCREEN
192 WHEN LNAMEI OF COUSR2AI = SPACES OR LOW-VALUES
193 MOVE 'Y' TO WS-ERR-FLG
194 MOVE 'Last Name can NOT be empty...' TO
195 WS-MESSAGE
196 MOVE -1 TO LNAMEL OF COUSR2AI
197 PERFORM SEND-USRUPD-SCREEN
198 WHEN PASSWDI OF COUSR2AI = SPACES OR LOW-VALUES
199 MOVE 'Y' TO WS-ERR-FLG
200 MOVE 'Password can NOT be empty...' TO
201 WS-MESSAGE
202 MOVE -1 TO PASSWDL OF COUSR2AI
203 PERFORM SEND-USRUPD-SCREEN
204 WHEN USRTYPEI OF COUSR2AI = SPACES OR LOW-VALUES
205 MOVE 'Y' TO WS-ERR-FLG
206 MOVE 'User Type can NOT be empty...' TO
207 WS-MESSAGE
208 MOVE -1 TO USRTYPEL OF COUSR2AI
209 PERFORM SEND-USRUPD-SCREEN
210 WHEN OTHER
211 MOVE -1 TO FNAMEL OF COUSR2AI
212 CONTINUE
213 END-EVALUATE
214
215 IF NOT ERR-FLG-ON
216 MOVE USRIDINI OF COUSR2AI TO SEC-USR-ID
217 PERFORM READ-USER-SEC-FILE
218
219 IF FNAMEI OF COUSR2AI NOT = SEC-USR-FNAME
220 MOVE FNAMEI OF COUSR2AI TO SEC-USR-FNAME
221 SET USR-MODIFIED-YES TO TRUE
222 END-IF
223 IF LNAMEI OF COUSR2AI NOT = SEC-USR-LNAME
224 MOVE LNAMEI OF COUSR2AI TO SEC-USR-LNAME
225 SET USR-MODIFIED-YES TO TRUE
226 END-IF
227 IF PASSWDI OF COUSR2AI NOT = SEC-USR-PWD
228 MOVE PASSWDI OF COUSR2AI TO SEC-USR-PWD
229 SET USR-MODIFIED-YES TO TRUE
230 END-IF
231 IF USRTYPEI OF COUSR2AI NOT = SEC-USR-TYPE
232 MOVE USRTYPEI OF COUSR2AI TO SEC-USR-TYPE
233 SET USR-MODIFIED-YES TO TRUE
234 END-IF
235
236 IF USR-MODIFIED-YES
237 PERFORM UPDATE-USER-SEC-FILE
238 ELSE
239 MOVE 'Please modify to update ...' TO
240 WS-MESSAGE
241 MOVE DFHRED TO ERRMSGC OF COUSR2AO
242 PERFORM SEND-USRUPD-SCREEN
243 END-IF
244
245 END-IF.
246
247 *----------------------------------------------------------------*
248 * RETURN-TO-PREV-SCREEN
249 *----------------------------------------------------------------*
250 RETURN-TO-PREV-SCREEN.
251
252 IF CDEMO-TO-PROGRAM = LOW-VALUES OR SPACES
253 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
254 END-IF
255 MOVE WS-TRANID TO CDEMO-FROM-TRANID
256 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
257 MOVE ZEROS TO CDEMO-PGM-CONTEXT
258 EXEC CICS
259 XCTL PROGRAM(CDEMO-TO-PROGRAM)
260 COMMAREA(CARDDEMO-COMMAREA)
261 END-EXEC.
262
263 *----------------------------------------------------------------*
264 * SEND-USRUPD-SCREEN
265 *----------------------------------------------------------------*
266 SEND-USRUPD-SCREEN.
267
268 PERFORM POPULATE-HEADER-INFO
269
270 MOVE WS-MESSAGE TO ERRMSGO OF COUSR2AO
271
272 EXEC CICS SEND
273 MAP('COUSR2A')
274 MAPSET('COUSR02')
275 FROM(COUSR2AO)
276 ERASE
277 CURSOR
278 END-EXEC.
279
280 *----------------------------------------------------------------*
281 * RECEIVE-USRUPD-SCREEN
282 *----------------------------------------------------------------*
283 RECEIVE-USRUPD-SCREEN.
284
285 EXEC CICS RECEIVE
286 MAP('COUSR2A')
287 MAPSET('COUSR02')
288 INTO(COUSR2AI)
289 RESP(WS-RESP-CD)
290 RESP2(WS-REAS-CD)
291 END-EXEC.
292
293 *----------------------------------------------------------------*
294 * POPULATE-HEADER-INFO
295 *----------------------------------------------------------------*
296 POPULATE-HEADER-INFO.
297
298 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
299
300 MOVE CCDA-TITLE01 TO TITLE01O OF COUSR2AO
301 MOVE CCDA-TITLE02 TO TITLE02O OF COUSR2AO
302 MOVE WS-TRANID TO TRNNAMEO OF COUSR2AO
303 MOVE WS-PGMNAME TO PGMNAMEO OF COUSR2AO
304
305 MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
306 MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
307 MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
308
309 MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF COUSR2AO
310
311 MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
312 MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
313 MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
314
315 MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF COUSR2AO.
316
317 *----------------------------------------------------------------*
318 * READ-USER-SEC-FILE
319 *----------------------------------------------------------------*
320 READ-USER-SEC-FILE.
321
322 EXEC CICS READ
323 DATASET (WS-USRSEC-FILE)
324 INTO (SEC-USER-DATA)
325 LENGTH (LENGTH OF SEC-USER-DATA)
326 RIDFLD (SEC-USR-ID)
327 KEYLENGTH (LENGTH OF SEC-USR-ID)
328 UPDATE
329 RESP (WS-RESP-CD)
330 RESP2 (WS-REAS-CD)
331 END-EXEC.
332
333 EVALUATE WS-RESP-CD
334 WHEN DFHRESP(NORMAL)
335 CONTINUE
336 MOVE 'Press PF5 key to save your updates ...' TO
337 WS-MESSAGE
338 MOVE DFHNEUTR TO ERRMSGC OF COUSR2AO
339 PERFORM SEND-USRUPD-SCREEN
340 WHEN DFHRESP(NOTFND)
341 MOVE 'Y' TO WS-ERR-FLG
342 MOVE 'User ID NOT found...' TO
343 WS-MESSAGE
344 MOVE -1 TO USRIDINL OF COUSR2AI
345 PERFORM SEND-USRUPD-SCREEN
346 WHEN OTHER
347 DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
348 MOVE 'Y' TO WS-ERR-FLG
349 MOVE 'Unable to lookup User...' TO
350 WS-MESSAGE
351 MOVE -1 TO FNAMEL OF COUSR2AI
352 PERFORM SEND-USRUPD-SCREEN
353 END-EVALUATE.
354
355 *----------------------------------------------------------------*
356 * UPDATE-USER-SEC-FILE
357 *----------------------------------------------------------------*
358 UPDATE-USER-SEC-FILE.
359
360 EXEC CICS REWRITE
361 DATASET (WS-USRSEC-FILE)
362 FROM (SEC-USER-DATA)
363 LENGTH (LENGTH OF SEC-USER-DATA)
364 RESP (WS-RESP-CD)
365 RESP2 (WS-REAS-CD)
366 END-EXEC.
367
368 EVALUATE WS-RESP-CD
369 WHEN DFHRESP(NORMAL)
370 MOVE SPACES TO WS-MESSAGE
371 MOVE DFHGREEN TO ERRMSGC OF COUSR2AO
372 STRING 'User ' DELIMITED BY SIZE
373 SEC-USR-ID DELIMITED BY SPACE
374 ' has been updated ...' DELIMITED BY SIZE
375 INTO WS-MESSAGE
376 PERFORM SEND-USRUPD-SCREEN
377 WHEN DFHRESP(NOTFND)
378 MOVE 'Y' TO WS-ERR-FLG
379 MOVE 'User ID NOT found...' TO
380 WS-MESSAGE
381 MOVE -1 TO USRIDINL OF COUSR2AI
382 PERFORM SEND-USRUPD-SCREEN
383 WHEN OTHER
384 DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
385 MOVE 'Y' TO WS-ERR-FLG
386 MOVE 'Unable to Update User...' TO
387 WS-MESSAGE
388 MOVE -1 TO FNAMEL OF COUSR2AI
389 PERFORM SEND-USRUPD-SCREEN
390 END-EVALUATE.
391
392 *----------------------------------------------------------------*
393 * CLEAR-CURRENT-SCREEN
394 *----------------------------------------------------------------*
395 CLEAR-CURRENT-SCREEN.
396
397 PERFORM INITIALIZE-ALL-FIELDS.
398 PERFORM SEND-USRUPD-SCREEN.
399
400 *----------------------------------------------------------------*
401 * INITIALIZE-ALL-FIELDS
402 *----------------------------------------------------------------*
403 INITIALIZE-ALL-FIELDS.
404
405 MOVE -1 TO USRIDINL OF COUSR2AI
406 MOVE SPACES TO USRIDINI OF COUSR2AI
407 FNAMEI OF COUSR2AI
408 LNAMEI OF COUSR2AI
409 PASSWDI OF COUSR2AI
410 USRTYPEI OF COUSR2AI
411 WS-MESSAGE.
412 *
413 * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:34 CDT
414 *