MFmainframe-rea
WS carddemo · 26f629ef

Converted program · 371 lines of TypeScript from 695 lines of COBOL · 522 COBOL lines cited (75%)COUSR00C

Run it on the 3270 →Analysis →All programs

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

1/**
2 * COUSR00C — list users from USRSEC (transaction CU00).
3 * Converted from app/cbl/COUSR00C.cbl; screen COUSR00/COUSR0A; file USRSEC (browse).
4 */
5import { alnum, digits, 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, returnToPrevScreen, WS_USRSEC_FILE, type CuInfo } from "./users-lib.js";
11
12const WS_PGMNAME = "COUSR00C";
13const WS_TRANID = "CU00";
14const HIGH_VALUES = "￿";
15
16/** WS-VARIABLES (COUSR00C.cbl:35-54) plus SEC-USER-DATA (CSUSR01Y). */
17interface Ws {
18 message: string;
19 errFlg: string;
20 userSecEof: string;
21 sendEraseFlg: string;
22 respCd: number;
23 idx: number;
24 /** SEC-USR-ID: browse key (RIDFLD). "" = LOW-VALUES, HIGH_VALUES = HIGH-VALUES. */
25 secUsrId: string;
26 /** SEC-USER-DATA: last record read (INTO). */
27 rec: SecUserData | undefined;
28 /** Whether a STARTBR succeeded (ENDBR without one raises INVREQ). */
29 browsing: boolean;
30}
31
32interface Task {
33 ctx: Cics;
34 ws: Ws;
35 out: SymbolicMap;
36 info: CuInfo;
37}
38
39const row = (n: number) => String(n).padStart(2, "0");
40
41export const COUSR00C: Program = {
42 name: WS_PGMNAME,
43 source: "app/cbl/COUSR00C.cbl",
44 run(ctx: Cics) {
45 const ws: Ws = { message: "", errFlg: "N", userSecEof: "N", sendEraseFlg: "Y", respCd: 0, idx: 0, secUsrId: "", rec: undefined, browsing: false };
46 const t: Task = { ctx, ws, out: ctx.map("COUSR00", "COUSR0A"), info: undefined as unknown as CuInfo };
47
48 // MAIN-PARA (COUSR00C.cbl:98-144)
49 ws.errFlg = "N";
50 ws.userSecEof = "N";
51 ws.sendEraseFlg = "Y";
52 ws.message = "";
53 t.out.set("ERRMSG", "");
54 t.out.cursor("USRIDIN");
55
56 if (ctx.eib.calen === 0) {
57 ctx.area().toProgram = "COSGN00C";
58 returnToPrevScreen(ctx, WS_TRANID, WS_PGMNAME);
59 }
60 const area = ctx.area();
61 t.info = cuInfo(ctx);
62 if (area.pgmContext !== 1) {
63 area.pgmContext = 1;
64 t.out.clear();
65 processEnterKey(t);
66 sendUsrlstScreen(t);
67 } else {
68 t.out = receiveUsrlstScreen(t);
69 switch (ctx.eib.aid) {
70 case "ENTER":
71 processEnterKey(t);
72 break;
73 case "PF3":
74 area.toProgram = "COADM01C";
75 returnToPrevScreen(ctx, WS_TRANID, WS_PGMNAME);
76 // falls through: XCTL does not return
77 case "PF7":
78 processPf7Key(t);
79 break;
80 case "PF8":
81 processPf8Key(t);
82 break;
83 default:
84 ws.errFlg = "Y";
85 t.out.cursor("USRIDIN");
86 ws.message = CCDA_MSG_INVALID_KEY;
87 sendUsrlstScreen(t);
88 }
89 }
90 ctx.return(WS_TRANID, area);
91 },
92};
93
94/** PROCESS-ENTER-KEY (COUSR00C.cbl:149-232) */
95function processEnterKey(t: Task): void {
96 const { ctx, ws, out, info } = t;
97 // EVALUATE TRUE WHEN SEL0001I NOT = SPACES AND LOW-VALUES ...: first selected row wins.
98 let picked = 0;
99 for (let n = 1; n <= 10; n++) {
100 if (!isBlank(out.get(`SEL${String(n).padStart(4, "0")}`))) {
101 picked = n;
102 break;
103 }
104 }
105 if (picked > 0) {
106 info.usrSelFlg = alnum(out.get(`SEL${String(picked).padStart(4, "0")}`), 1);
107 info.usrSelected = alnum(out.get(`USRID${row(picked)}`), 8);
108 } else {
109 info.usrSelFlg = " ";
110 info.usrSelected = alnum("", 8);
111 }
112
113 if (!isBlank(info.usrSelFlg) && !isBlank(info.usrSelected)) {
114 const area = ctx.area();
115 switch (info.usrSelFlg) {
116 case "U":
117 case "u":
118 area.toProgram = "COUSR02C";
119 area.fromTranid = WS_TRANID;
120 area.fromProgram = WS_PGMNAME;
121 area.pgmContext = 0;
122 ctx.xctl(area.toProgram, area);
123 // falls through: XCTL does not return
124 case "D":
125 case "d":
126 area.toProgram = "COUSR03C";
127 area.fromTranid = WS_TRANID;
128 area.fromProgram = WS_PGMNAME;
129 area.pgmContext = 0;
130 ctx.xctl(area.toProgram, area);
131 // falls through: XCTL does not return
132 default:
133 ws.message = "Invalid selection. Valid values are U and D";
134 out.cursor("USRIDIN");
135 }
136 }
137
138 ws.secUsrId = isBlank(out.get("USRIDIN")) ? "" : out.get("USRIDIN");
139 out.cursor("USRIDIN");
140
141 info.pageNum = 0;
142 processPageForward(t);
143
144 if (ws.errFlg !== "Y") out.set("USRIDIN", " ");
145}
146
147/** PROCESS-PF7-KEY (COUSR00C.cbl:237-255) */
148function processPf7Key(t: Task): void {
149 const { ws, out, info } = t;
150 ws.secUsrId = isBlank(info.usridFirst) ? "" : info.usridFirst;
151 info.nextPageFlg = "Y";
152 out.cursor("USRIDIN");
153 if (info.pageNum > 1) {
154 processPageBackward(t);
155 } else {
156 ws.message = "You are already at the top of the page...";
157 ws.sendEraseFlg = "N";
158 sendUsrlstScreen(t);
159 }
160}
161
162/** PROCESS-PF8-KEY (COUSR00C.cbl:260-277) */
163function processPf8Key(t: Task): void {
164 const { ws, out, info } = t;
165 ws.secUsrId = isBlank(info.usridLast) ? HIGH_VALUES : info.usridLast;
166 out.cursor("USRIDIN");
167 if (info.nextPageFlg === "Y") {
168 processPageForward(t);
169 } else {
170 ws.message = "You are already at the bottom of the page...";
171 ws.sendEraseFlg = "N";
172 sendUsrlstScreen(t);
173 }
174}
175
176/** PROCESS-PAGE-FORWARD (COUSR00C.cbl:282-331) */
177function processPageForward(t: Task): void {
178 const { ctx, ws, out, info } = t;
179 startbrUserSecFile(t);
180 if (ws.errFlg === "Y") return;
181
182 const aid = ctx.eib.aid;
183 // Skip the record the browse started on (the last one of the previous page).
184 if (aid !== "ENTER" && aid !== "PF7" && aid !== "PF3") readnextUserSecFile(t);
185
186 if (ws.userSecEof === "N" && ws.errFlg === "N") {
187 for (ws.idx = 1; ws.idx <= 10; ws.idx++) initializeUserData(t);
188 }
189
190 ws.idx = 1;
191 while (!(ws.idx >= 11 || ws.userSecEof === "Y" || ws.errFlg === "Y")) {
192 readnextUserSecFile(t);
193 if (ws.userSecEof === "N" && ws.errFlg === "N") {
194 populateUserData(t);
195 ws.idx++;
196 }
197 }
198
199 if (ws.userSecEof === "N" && ws.errFlg === "N") {
200 info.pageNum += 1;
201 readnextUserSecFile(t);
202 info.nextPageFlg = ws.userSecEof === "N" && ws.errFlg === "N" ? "Y" : "N";
203 } else {
204 info.nextPageFlg = "N";
205 if (ws.idx > 1) info.pageNum += 1;
206 }
207
208 endbrUserSecFile(t);
209
210 // MOVE CDEMO-CU00-PAGE-NUM (PIC 9(08)) TO PAGENUMI (PIC X(08)): all eight digits.
211 out.set("PAGENUM", digits(info.pageNum, 8));
212 out.set("USRIDIN", " ");
213 sendUsrlstScreen(t);
214}
215
216/** PROCESS-PAGE-BACKWARD (COUSR00C.cbl:336-379) */
217function processPageBackward(t: Task): void {
218 const { ctx, ws, out, info } = t;
219 startbrUserSecFile(t);
220 if (ws.errFlg === "Y") return;
221
222 const aid = ctx.eib.aid;
223 if (aid !== "ENTER" && aid !== "PF8") readprevUserSecFile(t);
224
225 if (ws.userSecEof === "N" && ws.errFlg === "N") {
226 for (ws.idx = 1; ws.idx <= 10; ws.idx++) initializeUserData(t);
227 }
228
229 ws.idx = 10;
230 while (!(ws.idx <= 0 || ws.userSecEof === "Y" || ws.errFlg === "Y")) {
231 readprevUserSecFile(t);
232 if (ws.userSecEof === "N" && ws.errFlg === "N") {
233 populateUserData(t);
234 ws.idx--;
235 }
236 }
237
238 if (ws.userSecEof === "N" && ws.errFlg === "N") {
239 readprevUserSecFile(t);
240 if (info.nextPageFlg === "Y") {
241 if (ws.userSecEof === "N" && ws.errFlg === "N" && info.pageNum > 1) info.pageNum -= 1;
242 else info.pageNum = 1;
243 }
244 }
245
246 endbrUserSecFile(t);
247
248 out.set("PAGENUM", digits(info.pageNum, 8));
249 sendUsrlstScreen(t);
250}
251
252/** POPULATE-USER-DATA (COUSR00C.cbl:384-441) */
253function populateUserData(t: Task): void {
254 const { ws, out, info } = t;
255 const rec = ws.rec!;
256 if (ws.idx < 1 || ws.idx > 10) return;
257 const n = row(ws.idx);
258 out.set(`USRID${n}`, rec.secUsrId);
259 if (ws.idx === 1) info.usridFirst = rec.secUsrId;
260 if (ws.idx === 10) info.usridLast = rec.secUsrId;
261 out.set(`FNAME${n}`, rec.secUsrFname);
262 out.set(`LNAME${n}`, rec.secUsrLname);
263 out.set(`UTYPE${n}`, rec.secUsrType);
264}
265
266/** INITIALIZE-USER-DATA (COUSR00C.cbl:446-501) */
267function initializeUserData(t: Task): void {
268 const { ws, out } = t;
269 if (ws.idx < 1 || ws.idx > 10) return;
270 const n = row(ws.idx);
271 for (const f of ["USRID", "FNAME", "LNAME", "UTYPE"]) out.set(`${f}${n}`, " ".repeat(20));
272}
273
274/** SEND-USRLST-SCREEN (COUSR00C.cbl:522-544) */
275function sendUsrlstScreen(t: Task): void {
276 const { ctx, ws, out } = t;
277 populateHeaderInfo(ctx, out, WS_TRANID, WS_PGMNAME);
278 out.set("ERRMSG", ws.message);
279 // SEND-ERASE-NO only drops ERASE: the map is still written in full (no DATAONLY).
280 ctx.sendMap(out, { erase: ws.sendEraseFlg === "Y", cursor: true });
281}
282
283/** RECEIVE-USRLST-SCREEN (COUSR00C.cbl:549-557) */
284function receiveUsrlstScreen(t: Task): SymbolicMap {
285 const { resp, map } = t.ctx.receiveMap("COUSR00", "COUSR0A");
286 t.ws.respCd = resp;
287 // INTO(COUSR0AI) overwrites USRIDINL: every EVALUATE branch sets the cursor again.
288 return map;
289}
290
291/** STARTBR-USER-SEC-FILE (COUSR00C.cbl:586-614) — GTEQ is the default (the GTEQ line is commented out). */
292function startbrUserSecFile(t: Task): void {
293 const { ctx, ws, out } = t;
294 ws.respCd = ctx.startbr(WS_USRSEC_FILE, ws.secUsrId);
295 switch (ws.respCd) {
296 case RESP.NORMAL:
297 ws.browsing = true;
298 break;
299 case RESP.NOTFND:
300 ws.userSecEof = "Y";
301 ws.message = "You are at the top of the page...";
302 out.cursor("USRIDIN");
303 sendUsrlstScreen(t);
304 break;
305 default:
306 ws.errFlg = "Y";
307 ws.message = "Unable to lookup User...";
308 out.cursor("USRIDIN");
309 sendUsrlstScreen(t);
310 }
311}
312
313/** READNEXT-USER-SEC-FILE (COUSR00C.cbl:619-648) */
314function readnextUserSecFile(t: Task): void {
315 const { ctx, ws, out } = t;
316 const { resp, record } = ctx.readnext<SecUserData>(WS_USRSEC_FILE);
317 ws.respCd = resp;
318 switch (resp) {
319 case RESP.NORMAL:
320 ws.rec = record;
321 ws.secUsrId = record!.secUsrId;
322 break;
323 case RESP.ENDFILE:
324 ws.userSecEof = "Y";
325 ws.message = "You have reached the bottom of the page...";
326 out.cursor("USRIDIN");
327 sendUsrlstScreen(t);
328 break;
329 default:
330 ws.errFlg = "Y";
331 ws.message = "Unable to lookup User...";
332 out.cursor("USRIDIN");
333 sendUsrlstScreen(t);
334 }
335}
336
337/** READPREV-USER-SEC-FILE (COUSR00C.cbl:653-682) */
338function readprevUserSecFile(t: Task): void {
339 const { ctx, ws, out } = t;
340 const { resp, record } = ctx.readprev<SecUserData>(WS_USRSEC_FILE);
341 ws.respCd = resp;
342 switch (resp) {
343 case RESP.NORMAL:
344 ws.rec = record;
345 ws.secUsrId = record!.secUsrId;
346 break;
347 case RESP.ENDFILE:
348 ws.userSecEof = "Y";
349 ws.message = "You have reached the top of the page...";
350 out.cursor("USRIDIN");
351 sendUsrlstScreen(t);
352 break;
353 default:
354 ws.errFlg = "Y";
355 ws.message = "Unable to lookup User...";
356 out.cursor("USRIDIN");
357 sendUsrlstScreen(t);
358 }
359}
360
361/**
362 * ENDBR-USER-SEC-FILE (COUSR00C.cbl:687-691). It has no RESP option: after a STARTBR
363 * that ended NOTFND no browse is active, CICS raises INVREQ (RESP2 35) and, with no
364 * HANDLE CONDITION, the task abends AEIP. The runtime's ENDBR does not check this.
365 */
366function endbrUserSecFile(t: Task): void {
367 const { ctx, ws } = t;
368 if (!ws.browsing) ctx.abend("AEIP", "INVREQ: EXEC CICS ENDBR DATASET(USRSEC) without an active browse (STARTBR returned NOTFND)");
369 ctx.endbr(WS_USRSEC_FILE);
370 ws.browsing = false;
371}

COBOL app/cbl/COUSR00C.cbl

1 ******************************************************************
2 * Program : COUSR00C.CBL
3 * Application : CardDemo
4 * Type : CICS COBOL Program
5 * Function : List all users from 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. COUSR00C.
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 'COUSR00C'.
37 05 WS-TRANID PIC X(04) VALUE 'CU00'.
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-USER-SEC-EOF PIC X(01) VALUE 'N'.
44 88 USER-SEC-EOF VALUE 'Y'.
45 88 USER-SEC-NOT-EOF VALUE 'N'.
46 05 WS-SEND-ERASE-FLG PIC X(01) VALUE 'Y'.
47 88 SEND-ERASE-YES VALUE 'Y'.
48 88 SEND-ERASE-NO VALUE 'N'.
49
50 05 WS-RESP-CD PIC S9(09) COMP VALUE ZEROS.
51 05 WS-REAS-CD PIC S9(09) COMP VALUE ZEROS.
52 05 WS-REC-COUNT PIC S9(04) COMP VALUE ZEROS.
53 05 WS-IDX PIC S9(04) COMP VALUE ZEROS.
54 05 WS-PAGE-NUM PIC S9(04) COMP VALUE ZEROS.
55
56 01 WS-USER-DATA.
57 02 USER-REC OCCURS 10 TIMES.
58 05 USER-SEL PIC X(01).
59 05 FILLER PIC X(02).
60 05 USER-ID PIC X(08).
61 05 FILLER PIC X(02).
62 05 USER-NAME PIC X(25).
63 05 FILLER PIC X(02).
64 05 USER-TYPE PIC X(08).
65
66 COPY COCOM01Y.
67 05 CDEMO-CU00-INFO.
68 10 CDEMO-CU00-USRID-FIRST PIC X(08).
69 10 CDEMO-CU00-USRID-LAST PIC X(08).
70 10 CDEMO-CU00-PAGE-NUM PIC 9(08).
71 10 CDEMO-CU00-NEXT-PAGE-FLG PIC X(01) VALUE 'N'.
72 88 NEXT-PAGE-YES VALUE 'Y'.
73 88 NEXT-PAGE-NO VALUE 'N'.
74 10 CDEMO-CU00-USR-SEL-FLG PIC X(01).
75 10 CDEMO-CU00-USR-SELECTED PIC X(08).
76 COPY COUSR00.
77
78 COPY COTTL01Y.
79 COPY CSDAT01Y.
80 COPY CSMSG01Y.
81 COPY CSUSR01Y.
82
83 COPY DFHAID.
84 COPY DFHBMSCA.
85
86 *----------------------------------------------------------------*
87 * LINKAGE SECTION
88 *----------------------------------------------------------------*
89 LINKAGE SECTION.
90 01 DFHCOMMAREA.
91 05 LK-COMMAREA PIC X(01)
92 OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
93
94 *----------------------------------------------------------------*
95 * PROCEDURE DIVISION
96 *----------------------------------------------------------------*
97 PROCEDURE DIVISION.
98 MAIN-PARA.
99
100 SET ERR-FLG-OFF TO TRUE
101 SET USER-SEC-NOT-EOF TO TRUE
102 SET NEXT-PAGE-NO TO TRUE
103 SET SEND-ERASE-YES TO TRUE
104
105 MOVE SPACES TO WS-MESSAGE
106 ERRMSGO OF COUSR0AO
107
108 MOVE -1 TO USRIDINL OF COUSR0AI
109
110 IF EIBCALEN = 0
111 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
112 PERFORM RETURN-TO-PREV-SCREEN
113 ELSE
114 MOVE DFHCOMMAREA(1:EIBCALEN) TO CARDDEMO-COMMAREA
115 IF NOT CDEMO-PGM-REENTER
116 SET CDEMO-PGM-REENTER TO TRUE
117 MOVE LOW-VALUES TO COUSR0AO
118 PERFORM PROCESS-ENTER-KEY
119 PERFORM SEND-USRLST-SCREEN
120 ELSE
121 PERFORM RECEIVE-USRLST-SCREEN
122 EVALUATE EIBAID
123 WHEN DFHENTER
124 PERFORM PROCESS-ENTER-KEY
125 WHEN DFHPF3
126 MOVE 'COADM01C' TO CDEMO-TO-PROGRAM
127 PERFORM RETURN-TO-PREV-SCREEN
128 WHEN DFHPF7
129 PERFORM PROCESS-PF7-KEY
130 WHEN DFHPF8
131 PERFORM PROCESS-PF8-KEY
132 WHEN OTHER
133 MOVE 'Y' TO WS-ERR-FLG
134 MOVE -1 TO USRIDINL OF COUSR0AI
135 MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE
136 PERFORM SEND-USRLST-SCREEN
137 END-EVALUATE
138 END-IF
139 END-IF
140
141 EXEC CICS RETURN
142 TRANSID (WS-TRANID)
143 COMMAREA (CARDDEMO-COMMAREA)
144 END-EXEC.
145
146 *----------------------------------------------------------------*
147 * PROCESS-ENTER-KEY
148 *----------------------------------------------------------------*
149 PROCESS-ENTER-KEY.
150
151 EVALUATE TRUE
152 WHEN SEL0001I OF COUSR0AI NOT = SPACES AND LOW-VALUES
153 MOVE SEL0001I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
154 MOVE USRID01I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
155 WHEN SEL0002I OF COUSR0AI NOT = SPACES AND LOW-VALUES
156 MOVE SEL0002I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
157 MOVE USRID02I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
158 WHEN SEL0003I OF COUSR0AI NOT = SPACES AND LOW-VALUES
159 MOVE SEL0003I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
160 MOVE USRID03I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
161 WHEN SEL0004I OF COUSR0AI NOT = SPACES AND LOW-VALUES
162 MOVE SEL0004I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
163 MOVE USRID04I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
164 WHEN SEL0005I OF COUSR0AI NOT = SPACES AND LOW-VALUES
165 MOVE SEL0005I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
166 MOVE USRID05I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
167 WHEN SEL0006I OF COUSR0AI NOT = SPACES AND LOW-VALUES
168 MOVE SEL0006I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
169 MOVE USRID06I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
170 WHEN SEL0007I OF COUSR0AI NOT = SPACES AND LOW-VALUES
171 MOVE SEL0007I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
172 MOVE USRID07I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
173 WHEN SEL0008I OF COUSR0AI NOT = SPACES AND LOW-VALUES
174 MOVE SEL0008I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
175 MOVE USRID08I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
176 WHEN SEL0009I OF COUSR0AI NOT = SPACES AND LOW-VALUES
177 MOVE SEL0009I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
178 MOVE USRID09I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
179 WHEN SEL0010I OF COUSR0AI NOT = SPACES AND LOW-VALUES
180 MOVE SEL0010I OF COUSR0AI TO CDEMO-CU00-USR-SEL-FLG
181 MOVE USRID10I OF COUSR0AI TO CDEMO-CU00-USR-SELECTED
182 WHEN OTHER
183 MOVE SPACES TO CDEMO-CU00-USR-SEL-FLG
184 MOVE SPACES TO CDEMO-CU00-USR-SELECTED
185 END-EVALUATE
186
187 IF (CDEMO-CU00-USR-SEL-FLG NOT = SPACES AND LOW-VALUES) AND
188 (CDEMO-CU00-USR-SELECTED NOT = SPACES AND LOW-VALUES)
189 EVALUATE CDEMO-CU00-USR-SEL-FLG
190 WHEN 'U'
191 WHEN 'u'
192 MOVE 'COUSR02C' TO CDEMO-TO-PROGRAM
193 MOVE WS-TRANID TO CDEMO-FROM-TRANID
194 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
195 MOVE 0 TO CDEMO-PGM-CONTEXT
196 EXEC CICS
197 XCTL PROGRAM(CDEMO-TO-PROGRAM)
198 COMMAREA(CARDDEMO-COMMAREA)
199 END-EXEC
200 WHEN 'D'
201 WHEN 'd'
202 MOVE 'COUSR03C' TO CDEMO-TO-PROGRAM
203 MOVE WS-TRANID TO CDEMO-FROM-TRANID
204 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
205 MOVE 0 TO CDEMO-PGM-CONTEXT
206 EXEC CICS
207 XCTL PROGRAM(CDEMO-TO-PROGRAM)
208 COMMAREA(CARDDEMO-COMMAREA)
209 END-EXEC
210 WHEN OTHER
211 MOVE
212 'Invalid selection. Valid values are U and D' TO
213 WS-MESSAGE
214 MOVE -1 TO USRIDINL OF COUSR0AI
215 END-EVALUATE
216 END-IF
217
218 IF USRIDINI OF COUSR0AI = SPACES OR LOW-VALUES
219 MOVE LOW-VALUES TO SEC-USR-ID
220 ELSE
221 MOVE USRIDINI OF COUSR0AI TO SEC-USR-ID
222 END-IF
223
224 MOVE -1 TO USRIDINL OF COUSR0AI
225
226
227 MOVE 0 TO CDEMO-CU00-PAGE-NUM
228 PERFORM PROCESS-PAGE-FORWARD
229
230 IF NOT ERR-FLG-ON
231 MOVE SPACE TO USRIDINO OF COUSR0AO
232 END-IF.
233
234 *----------------------------------------------------------------*
235 * PROCESS-PF7-KEY
236 *----------------------------------------------------------------*
237 PROCESS-PF7-KEY.
238
239 IF CDEMO-CU00-USRID-FIRST = SPACES OR LOW-VALUES
240 MOVE LOW-VALUES TO SEC-USR-ID
241 ELSE
242 MOVE CDEMO-CU00-USRID-FIRST TO SEC-USR-ID
243 END-IF
244
245 SET NEXT-PAGE-YES TO TRUE
246 MOVE -1 TO USRIDINL OF COUSR0AI
247
248 IF CDEMO-CU00-PAGE-NUM > 1
249 PERFORM PROCESS-PAGE-BACKWARD
250 ELSE
251 MOVE 'You are already at the top of the page...' TO
252 WS-MESSAGE
253 SET SEND-ERASE-NO TO TRUE
254 PERFORM SEND-USRLST-SCREEN
255 END-IF.
256
257 *----------------------------------------------------------------*
258 * PROCESS-PF8-KEY
259 *----------------------------------------------------------------*
260 PROCESS-PF8-KEY.
261
262 IF CDEMO-CU00-USRID-LAST = SPACES OR LOW-VALUES
263 MOVE HIGH-VALUES TO SEC-USR-ID
264 ELSE
265 MOVE CDEMO-CU00-USRID-LAST TO SEC-USR-ID
266 END-IF
267
268 MOVE -1 TO USRIDINL OF COUSR0AI
269
270 IF NEXT-PAGE-YES
271 PERFORM PROCESS-PAGE-FORWARD
272 ELSE
273 MOVE 'You are already at the bottom of the page...' TO
274 WS-MESSAGE
275 SET SEND-ERASE-NO TO TRUE
276 PERFORM SEND-USRLST-SCREEN
277 END-IF.
278
279 *----------------------------------------------------------------*
280 * PROCESS-PAGE-FORWARD
281 *----------------------------------------------------------------*
282 PROCESS-PAGE-FORWARD.
283
284 PERFORM STARTBR-USER-SEC-FILE
285
286 IF NOT ERR-FLG-ON
287
288 IF EIBAID NOT = DFHENTER AND DFHPF7 AND DFHPF3
289 PERFORM READNEXT-USER-SEC-FILE
290 END-IF
291
292 IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
293 PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 10
294 PERFORM INITIALIZE-USER-DATA
295 END-PERFORM
296 END-IF
297
298 MOVE 1 TO WS-IDX
299
300 PERFORM UNTIL WS-IDX >= 11 OR USER-SEC-EOF OR ERR-FLG-ON
301 PERFORM READNEXT-USER-SEC-FILE
302 IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
303 PERFORM POPULATE-USER-DATA
304 COMPUTE WS-IDX = WS-IDX + 1
305 END-IF
306 END-PERFORM
307
308 IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
309 COMPUTE CDEMO-CU00-PAGE-NUM =
310 CDEMO-CU00-PAGE-NUM + 1
311 PERFORM READNEXT-USER-SEC-FILE
312 IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
313 SET NEXT-PAGE-YES TO TRUE
314 ELSE
315 SET NEXT-PAGE-NO TO TRUE
316 END-IF
317 ELSE
318 SET NEXT-PAGE-NO TO TRUE
319 IF WS-IDX > 1
320 COMPUTE CDEMO-CU00-PAGE-NUM = CDEMO-CU00-PAGE-NUM
321 + 1
322 END-IF
323 END-IF
324
325 PERFORM ENDBR-USER-SEC-FILE
326
327 MOVE CDEMO-CU00-PAGE-NUM TO PAGENUMI OF COUSR0AI
328 MOVE SPACE TO USRIDINO OF COUSR0AO
329 PERFORM SEND-USRLST-SCREEN
330
331 END-IF.
332
333 *----------------------------------------------------------------*
334 * PROCESS-PAGE-BACKWARD
335 *----------------------------------------------------------------*
336 PROCESS-PAGE-BACKWARD.
337
338 PERFORM STARTBR-USER-SEC-FILE
339
340 IF NOT ERR-FLG-ON
341
342 IF EIBAID NOT = DFHENTER AND DFHPF8
343 PERFORM READPREV-USER-SEC-FILE
344 END-IF
345
346 IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
347 PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 10
348 PERFORM INITIALIZE-USER-DATA
349 END-PERFORM
350 END-IF
351
352 MOVE 10 TO WS-IDX
353
354 PERFORM UNTIL WS-IDX <= 0 OR USER-SEC-EOF OR ERR-FLG-ON
355 PERFORM READPREV-USER-SEC-FILE
356 IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
357 PERFORM POPULATE-USER-DATA
358 COMPUTE WS-IDX = WS-IDX - 1
359 END-IF
360 END-PERFORM
361
362 IF USER-SEC-NOT-EOF AND ERR-FLG-OFF
363 PERFORM READPREV-USER-SEC-FILE
364 IF NEXT-PAGE-YES
365 IF USER-SEC-NOT-EOF AND ERR-FLG-OFF AND
366 CDEMO-CU00-PAGE-NUM > 1
367 SUBTRACT 1 FROM CDEMO-CU00-PAGE-NUM
368 ELSE
369 MOVE 1 TO CDEMO-CU00-PAGE-NUM
370 END-IF
371 END-IF
372 END-IF
373
374 PERFORM ENDBR-USER-SEC-FILE
375
376 MOVE CDEMO-CU00-PAGE-NUM TO PAGENUMI OF COUSR0AI
377 PERFORM SEND-USRLST-SCREEN
378
379 END-IF.
380
381 *----------------------------------------------------------------*
382 * POPULATE-USER-DATA
383 *----------------------------------------------------------------*
384 POPULATE-USER-DATA.
385
386 EVALUATE WS-IDX
387 WHEN 1
388 MOVE SEC-USR-ID TO USRID01I OF COUSR0AI
389 CDEMO-CU00-USRID-FIRST
390 MOVE SEC-USR-FNAME TO FNAME01I OF COUSR0AI
391 MOVE SEC-USR-LNAME TO LNAME01I OF COUSR0AI
392 MOVE SEC-USR-TYPE TO UTYPE01I OF COUSR0AI
393 WHEN 2
394 MOVE SEC-USR-ID TO USRID02I OF COUSR0AI
395 MOVE SEC-USR-FNAME TO FNAME02I OF COUSR0AI
396 MOVE SEC-USR-LNAME TO LNAME02I OF COUSR0AI
397 MOVE SEC-USR-TYPE TO UTYPE02I OF COUSR0AI
398 WHEN 3
399 MOVE SEC-USR-ID TO USRID03I OF COUSR0AI
400 MOVE SEC-USR-FNAME TO FNAME03I OF COUSR0AI
401 MOVE SEC-USR-LNAME TO LNAME03I OF COUSR0AI
402 MOVE SEC-USR-TYPE TO UTYPE03I OF COUSR0AI
403 WHEN 4
404 MOVE SEC-USR-ID TO USRID04I OF COUSR0AI
405 MOVE SEC-USR-FNAME TO FNAME04I OF COUSR0AI
406 MOVE SEC-USR-LNAME TO LNAME04I OF COUSR0AI
407 MOVE SEC-USR-TYPE TO UTYPE04I OF COUSR0AI
408 WHEN 5
409 MOVE SEC-USR-ID TO USRID05I OF COUSR0AI
410 MOVE SEC-USR-FNAME TO FNAME05I OF COUSR0AI
411 MOVE SEC-USR-LNAME TO LNAME05I OF COUSR0AI
412 MOVE SEC-USR-TYPE TO UTYPE05I OF COUSR0AI
413 WHEN 6
414 MOVE SEC-USR-ID TO USRID06I OF COUSR0AI
415 MOVE SEC-USR-FNAME TO FNAME06I OF COUSR0AI
416 MOVE SEC-USR-LNAME TO LNAME06I OF COUSR0AI
417 MOVE SEC-USR-TYPE TO UTYPE06I OF COUSR0AI
418 WHEN 7
419 MOVE SEC-USR-ID TO USRID07I OF COUSR0AI
420 MOVE SEC-USR-FNAME TO FNAME07I OF COUSR0AI
421 MOVE SEC-USR-LNAME TO LNAME07I OF COUSR0AI
422 MOVE SEC-USR-TYPE TO UTYPE07I OF COUSR0AI
423 WHEN 8
424 MOVE SEC-USR-ID TO USRID08I OF COUSR0AI
425 MOVE SEC-USR-FNAME TO FNAME08I OF COUSR0AI
426 MOVE SEC-USR-LNAME TO LNAME08I OF COUSR0AI
427 MOVE SEC-USR-TYPE TO UTYPE08I OF COUSR0AI
428 WHEN 9
429 MOVE SEC-USR-ID TO USRID09I OF COUSR0AI
430 MOVE SEC-USR-FNAME TO FNAME09I OF COUSR0AI
431 MOVE SEC-USR-LNAME TO LNAME09I OF COUSR0AI
432 MOVE SEC-USR-TYPE TO UTYPE09I OF COUSR0AI
433 WHEN 10
434 MOVE SEC-USR-ID TO USRID10I OF COUSR0AI
435 CDEMO-CU00-USRID-LAST
436 MOVE SEC-USR-FNAME TO FNAME10I OF COUSR0AI
437 MOVE SEC-USR-LNAME TO LNAME10I OF COUSR0AI
438 MOVE SEC-USR-TYPE TO UTYPE10I OF COUSR0AI
439 WHEN OTHER
440 CONTINUE
441 END-EVALUATE.
442
443 *----------------------------------------------------------------*
444 * INITIALIZE-USER-DATA
445 *----------------------------------------------------------------*
446 INITIALIZE-USER-DATA.
447
448 EVALUATE WS-IDX
449 WHEN 1
450 MOVE SPACES TO USRID01I OF COUSR0AI
451 MOVE SPACES TO FNAME01I OF COUSR0AI
452 MOVE SPACES TO LNAME01I OF COUSR0AI
453 MOVE SPACES TO UTYPE01I OF COUSR0AI
454 WHEN 2
455 MOVE SPACES TO USRID02I OF COUSR0AI
456 MOVE SPACES TO FNAME02I OF COUSR0AI
457 MOVE SPACES TO LNAME02I OF COUSR0AI
458 MOVE SPACES TO UTYPE02I OF COUSR0AI
459 WHEN 3
460 MOVE SPACES TO USRID03I OF COUSR0AI
461 MOVE SPACES TO FNAME03I OF COUSR0AI
462 MOVE SPACES TO LNAME03I OF COUSR0AI
463 MOVE SPACES TO UTYPE03I OF COUSR0AI
464 WHEN 4
465 MOVE SPACES TO USRID04I OF COUSR0AI
466 MOVE SPACES TO FNAME04I OF COUSR0AI
467 MOVE SPACES TO LNAME04I OF COUSR0AI
468 MOVE SPACES TO UTYPE04I OF COUSR0AI
469 WHEN 5
470 MOVE SPACES TO USRID05I OF COUSR0AI
471 MOVE SPACES TO FNAME05I OF COUSR0AI
472 MOVE SPACES TO LNAME05I OF COUSR0AI
473 MOVE SPACES TO UTYPE05I OF COUSR0AI
474 WHEN 6
475 MOVE SPACES TO USRID06I OF COUSR0AI
476 MOVE SPACES TO FNAME06I OF COUSR0AI
477 MOVE SPACES TO LNAME06I OF COUSR0AI
478 MOVE SPACES TO UTYPE06I OF COUSR0AI
479 WHEN 7
480 MOVE SPACES TO USRID07I OF COUSR0AI
481 MOVE SPACES TO FNAME07I OF COUSR0AI
482 MOVE SPACES TO LNAME07I OF COUSR0AI
483 MOVE SPACES TO UTYPE07I OF COUSR0AI
484 WHEN 8
485 MOVE SPACES TO USRID08I OF COUSR0AI
486 MOVE SPACES TO FNAME08I OF COUSR0AI
487 MOVE SPACES TO LNAME08I OF COUSR0AI
488 MOVE SPACES TO UTYPE08I OF COUSR0AI
489 WHEN 9
490 MOVE SPACES TO USRID09I OF COUSR0AI
491 MOVE SPACES TO FNAME09I OF COUSR0AI
492 MOVE SPACES TO LNAME09I OF COUSR0AI
493 MOVE SPACES TO UTYPE09I OF COUSR0AI
494 WHEN 10
495 MOVE SPACES TO USRID10I OF COUSR0AI
496 MOVE SPACES TO FNAME10I OF COUSR0AI
497 MOVE SPACES TO LNAME10I OF COUSR0AI
498 MOVE SPACES TO UTYPE10I OF COUSR0AI
499 WHEN OTHER
500 CONTINUE
501 END-EVALUATE.
502
503 *----------------------------------------------------------------*
504 * RETURN-TO-PREV-SCREEN
505 *----------------------------------------------------------------*
506 RETURN-TO-PREV-SCREEN.
507
508 IF CDEMO-TO-PROGRAM = LOW-VALUES OR SPACES
509 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
510 END-IF
511 MOVE WS-TRANID TO CDEMO-FROM-TRANID
512 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
513 MOVE ZEROS TO CDEMO-PGM-CONTEXT
514 EXEC CICS
515 XCTL PROGRAM(CDEMO-TO-PROGRAM)
516 COMMAREA(CARDDEMO-COMMAREA)
517 END-EXEC.
518
519 *----------------------------------------------------------------*
520 * SEND-USRLST-SCREEN
521 *----------------------------------------------------------------*
522 SEND-USRLST-SCREEN.
523
524 PERFORM POPULATE-HEADER-INFO
525
526 MOVE WS-MESSAGE TO ERRMSGO OF COUSR0AO
527
528 IF SEND-ERASE-YES
529 EXEC CICS SEND
530 MAP('COUSR0A')
531 MAPSET('COUSR00')
532 FROM(COUSR0AO)
533 ERASE
534 CURSOR
535 END-EXEC
536 ELSE
537 EXEC CICS SEND
538 MAP('COUSR0A')
539 MAPSET('COUSR00')
540 FROM(COUSR0AO)
541 * ERASE
542 CURSOR
543 END-EXEC
544 END-IF.
545
546 *----------------------------------------------------------------*
547 * RECEIVE-USRLST-SCREEN
548 *----------------------------------------------------------------*
549 RECEIVE-USRLST-SCREEN.
550
551 EXEC CICS RECEIVE
552 MAP('COUSR0A')
553 MAPSET('COUSR00')
554 INTO(COUSR0AI)
555 RESP(WS-RESP-CD)
556 RESP2(WS-REAS-CD)
557 END-EXEC.
558
559 *----------------------------------------------------------------*
560 * POPULATE-HEADER-INFO
561 *----------------------------------------------------------------*
562 POPULATE-HEADER-INFO.
563
564 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
565
566 MOVE CCDA-TITLE01 TO TITLE01O OF COUSR0AO
567 MOVE CCDA-TITLE02 TO TITLE02O OF COUSR0AO
568 MOVE WS-TRANID TO TRNNAMEO OF COUSR0AO
569 MOVE WS-PGMNAME TO PGMNAMEO OF COUSR0AO
570
571 MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
572 MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
573 MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
574
575 MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF COUSR0AO
576
577 MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
578 MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
579 MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
580
581 MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF COUSR0AO.
582
583 *----------------------------------------------------------------*
584 * STARTBR-USER-SEC-FILE
585 *----------------------------------------------------------------*
586 STARTBR-USER-SEC-FILE.
587
588 EXEC CICS STARTBR
589 DATASET (WS-USRSEC-FILE)
590 RIDFLD (SEC-USR-ID)
591 KEYLENGTH (LENGTH OF SEC-USR-ID)
592 * GTEQ
593 RESP (WS-RESP-CD)
594 RESP2 (WS-REAS-CD)
595 END-EXEC.
596
597 EVALUATE WS-RESP-CD
598 WHEN DFHRESP(NORMAL)
599 CONTINUE
600 WHEN DFHRESP(NOTFND)
601 CONTINUE
602 SET USER-SEC-EOF TO TRUE
603 MOVE 'You are at the top of the page...' TO
604 WS-MESSAGE
605 MOVE -1 TO USRIDINL OF COUSR0AI
606 PERFORM SEND-USRLST-SCREEN
607 WHEN OTHER
608 DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
609 MOVE 'Y' TO WS-ERR-FLG
610 MOVE 'Unable to lookup User...' TO
611 WS-MESSAGE
612 MOVE -1 TO USRIDINL OF COUSR0AI
613 PERFORM SEND-USRLST-SCREEN
614 END-EVALUATE.
615
616 *----------------------------------------------------------------*
617 * READNEXT-USER-SEC-FILE
618 *----------------------------------------------------------------*
619 READNEXT-USER-SEC-FILE.
620
621 EXEC CICS READNEXT
622 DATASET (WS-USRSEC-FILE)
623 INTO (SEC-USER-DATA)
624 LENGTH (LENGTH OF SEC-USER-DATA)
625 RIDFLD (SEC-USR-ID)
626 KEYLENGTH (LENGTH OF SEC-USR-ID)
627 RESP (WS-RESP-CD)
628 RESP2 (WS-REAS-CD)
629 END-EXEC.
630
631 EVALUATE WS-RESP-CD
632 WHEN DFHRESP(NORMAL)
633 CONTINUE
634 WHEN DFHRESP(ENDFILE)
635 CONTINUE
636 SET USER-SEC-EOF TO TRUE
637 MOVE 'You have reached the bottom of the page...' TO
638 WS-MESSAGE
639 MOVE -1 TO USRIDINL OF COUSR0AI
640 PERFORM SEND-USRLST-SCREEN
641 WHEN OTHER
642 DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
643 MOVE 'Y' TO WS-ERR-FLG
644 MOVE 'Unable to lookup User...' TO
645 WS-MESSAGE
646 MOVE -1 TO USRIDINL OF COUSR0AI
647 PERFORM SEND-USRLST-SCREEN
648 END-EVALUATE.
649
650 *----------------------------------------------------------------*
651 * READPREV-USER-SEC-FILE
652 *----------------------------------------------------------------*
653 READPREV-USER-SEC-FILE.
654
655 EXEC CICS READPREV
656 DATASET (WS-USRSEC-FILE)
657 INTO (SEC-USER-DATA)
658 LENGTH (LENGTH OF SEC-USER-DATA)
659 RIDFLD (SEC-USR-ID)
660 KEYLENGTH (LENGTH OF SEC-USR-ID)
661 RESP (WS-RESP-CD)
662 RESP2 (WS-REAS-CD)
663 END-EXEC.
664
665 EVALUATE WS-RESP-CD
666 WHEN DFHRESP(NORMAL)
667 CONTINUE
668 WHEN DFHRESP(ENDFILE)
669 CONTINUE
670 SET USER-SEC-EOF TO TRUE
671 MOVE 'You have reached the top of the page...' TO
672 WS-MESSAGE
673 MOVE -1 TO USRIDINL OF COUSR0AI
674 PERFORM SEND-USRLST-SCREEN
675 WHEN OTHER
676 DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
677 MOVE 'Y' TO WS-ERR-FLG
678 MOVE 'Unable to lookup User...' TO
679 WS-MESSAGE
680 MOVE -1 TO USRIDINL OF COUSR0AI
681 PERFORM SEND-USRLST-SCREEN
682 END-EVALUATE.
683
684 *----------------------------------------------------------------*
685 * ENDBR-USER-SEC-FILE
686 *----------------------------------------------------------------*
687 ENDBR-USER-SEC-FILE.
688
689 EXEC CICS ENDBR
690 DATASET (WS-USRSEC-FILE)
691 END-EXEC.
692
693 *
694 * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:34 CDT
695 *