MFmainframe-rea
WS carddemo · 26f629ef

Converted program · 309 lines of TypeScript from 649 lines of COBOL · 517 COBOL lines cited (80%)CORPT00C

Run it on the 3270 →Analysis →All programs

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

1/**
2 * CORPT00C — transaction reports (transaction CR00).
3 * Converted from app/cbl/CORPT00C.cbl; screen CORPT00/CORPT0A. Submits the TRANREPT
4 * job by writing JCL card images to the extra-partition TD queue JOBS (internal reader).
5 */
6import { currentDate, isBlank, numval } from "../runtime/cobol.js";
7import { RESP, type Cics, type Program } from "../runtime/cics.js";
8import type { SymbolicMap } from "../runtime/screen.js";
9import { CCDA_MSG_INVALID_KEY, populateHeaderInfo } from "./common.js";
10import { ceedays } from "./account-lib.js";
11
12// WS-VARIABLES (CORPT00C.cbl:36-79)
13const WS_PGMNAME = "CORPT00C";
14const WS_TRANID = "CR00";
15const WS_DATE_FORMAT = "YYYY-MM-DD";
16
17interface Ws {
18 message: string;
19 errFlg: string;
20 transactEof: string;
21 sendEraseFlg: string;
22 endLoop: string;
23 reportName: string;
24 startDate: { yyyy: string; mm: string; dd: string };
25 endDate: { yyyy: string; mm: string; dd: string };
26 parmStartDate1: string;
27 parmEndDate1: string;
28 parmStartDate2: string;
29 parmEndDate2: string;
30 /** COBOL CORPT0AI / CORPT0AO (shared storage) */
31 map: SymbolicMap;
32}
33
34const dateText = (d: { yyyy: string; mm: string; dd: string }) =>
35 `${d.yyyy.padEnd(4).slice(0, 4)}-${d.mm.padEnd(2).slice(0, 2)}-${d.dd.padEnd(2).slice(0, 2)}`;
36const x = (v: string, n: number) => v.padEnd(n, " ").slice(0, n);
37
38/** JOB-DATA (CORPT00C.cbl:81-127): the TRANREPT job, one 80-byte card per entry. */
39function jobLines(ws: Ws): string[] {
40 return [
41 "//TRNRPT00 JOB 'TRAN REPORT',CLASS=A,MSGCLASS=0,",
42 "// NOTIFY=&SYSUID",
43 "//*",
44 "//JOBLIB JCLLIB ORDER=('AWS.M2.CARDDEMO.PROC')",
45 "//*",
46 "//STEP10 EXEC PROC=TRANREPT",
47 "//*",
48 "//STEP05R.SYMNAMES DD *",
49 "TRAN-CARD-NUM,263,16,ZD",
50 "TRAN-PROC-DT,305,10,CH",
51 `PARM-START-DATE,C'${x(ws.parmStartDate1, 10)}'`,
52 `PARM-END-DATE,C'${x(ws.parmEndDate1, 10)}'`,
53 "/*",
54 "//STEP10R.DATEPARM DD *",
55 `${x(ws.parmStartDate2, 10)} ${x(ws.parmEndDate2, 10)}`,
56 "/*",
57 "/*EOF",
58 ].map((l) => x(l, 80));
59}
60
61export const CORPT00C: Program = {
62 name: WS_PGMNAME,
63 source: "app/cbl/CORPT00C.cbl",
64 run(ctx: Cics) {
65 const ws: Ws = {
66 message: "",
67 errFlg: "N",
68 transactEof: "N",
69 sendEraseFlg: "Y",
70 endLoop: "N",
71 reportName: "",
72 startDate: { yyyy: "", mm: "", dd: "" },
73 endDate: { yyyy: "", mm: "", dd: "" },
74 parmStartDate1: "",
75 parmEndDate1: "",
76 parmStartDate2: "",
77 parmEndDate2: "",
78 map: ctx.map("CORPT00", "CORPT0A"),
79 };
80
81 // MAIN-PARA (CORPT00C.cbl:163-202)
82 ws.map.set("ERRMSG", "");
83 const area = ctx.area();
84 if (ctx.eib.calen === 0) {
85 area.toProgram = "COSGN00C";
86 returnToPrevScreen(ctx);
87 }
88 if (area.pgmContext !== 1) {
89 area.pgmContext = 1;
90 ws.map.clear();
91 ws.map.cursor("MONTHLY");
92 sendTrnrptScreen(ctx, ws);
93 } else {
94 receiveTrnrptScreen(ctx, ws);
95 switch (ctx.eib.aid) {
96 case "ENTER":
97 processEnterKey(ctx, ws);
98 break;
99 case "PF3":
100 area.toProgram = "COMEN01C";
101 returnToPrevScreen(ctx);
102 // falls through: XCTL does not return
103 default:
104 ws.errFlg = "Y";
105 ws.map.cursor("MONTHLY");
106 ws.message = CCDA_MSG_INVALID_KEY;
107 sendTrnrptScreen(ctx, ws);
108 }
109 }
110 ctx.return(WS_TRANID, area);
111 },
112};
113
114/** PROCESS-ENTER-KEY (CORPT00C.cbl:208-456) */
115function processEnterKey(ctx: Cics, ws: Ws): void {
116 const map = ws.map;
117 // DISPLAY 'PROCESS ENTER KEY' goes to the CICS job log only.
118 if (!isBlank(map.get("MONTHLY"))) {
119 ws.reportName = "Monthly";
120 const now = currentDate(ctx.now);
121 ws.startDate = { yyyy: now.year, mm: now.month, dd: "01" };
122 ws.parmStartDate1 = ws.parmStartDate2 = dateText(ws.startDate);
123 // First day of next month, minus one day via INTEGER-OF-DATE / DATE-OF-INTEGER.
124 let year = Number(now.year);
125 let month = Number(now.month) + 1;
126 if (month > 12) {
127 year += 1;
128 month = 1;
129 }
130 const last = new Date(Date.UTC(year, month - 1, 1) - 86_400_000);
131 ws.endDate = {
132 yyyy: String(last.getUTCFullYear()).padStart(4, "0"),
133 mm: String(last.getUTCMonth() + 1).padStart(2, "0"),
134 dd: String(last.getUTCDate()).padStart(2, "0"),
135 };
136 ws.parmEndDate1 = ws.parmEndDate2 = dateText(ws.endDate);
137 submitJobToIntrdr(ctx, ws);
138 } else if (!isBlank(map.get("YEARLY"))) {
139 ws.reportName = "Yearly";
140 const now = currentDate(ctx.now);
141 ws.startDate = { yyyy: now.year, mm: "01", dd: "01" };
142 ws.endDate = { yyyy: now.year, mm: "12", dd: "31" };
143 ws.parmStartDate1 = ws.parmStartDate2 = dateText(ws.startDate);
144 ws.parmEndDate1 = ws.parmEndDate2 = dateText(ws.endDate);
145 submitJobToIntrdr(ctx, ws);
146 } else if (!isBlank(map.get("CUSTOM"))) {
147 // Every SEND-TRNRPT-SCREEN ends the task (GO TO RETURN-TO-CICS), so the first error wins.
148 const empty: [string, string][] = [
149 ["SDTMM", "Start Date - Month can NOT be empty..."],
150 ["SDTDD", "Start Date - Day can NOT be empty..."],
151 ["SDTYYYY", "Start Date - Year can NOT be empty..."],
152 ["EDTMM", "End Date - Month can NOT be empty..."],
153 ["EDTDD", "End Date - Day can NOT be empty..."],
154 ["EDTYYYY", "End Date - Year can NOT be empty..."],
155 ];
156 for (const [field, msg] of empty) {
157 if (isBlank(map.get(field))) {
158 ws.message = msg;
159 ws.errFlg = "Y";
160 map.cursor(field);
161 sendTrnrptScreen(ctx, ws);
162 }
163 }
164
165 // COMPUTE WS-NUM-99 / WS-NUM-9999 = FUNCTION NUMVAL-C(...) and MOVE back to the field
166 // (CORPT00C.cbl:305-327). Unsigned PIC 9 targets keep the low-order integer digits;
167 // non-numeric text yields 0, which is why the NUMERIC tests below can only fail on range.
168 for (const [field, width] of [["SDTMM", 2], ["SDTDD", 2], ["SDTYYYY", 4], ["EDTMM", 2], ["EDTDD", 2], ["EDTYYYY", 4]] as const) {
169 const v = numval(map.get(field)) ?? 0;
170 map.set(field, String(Math.trunc(Math.abs(v)) % 10 ** width).padStart(width, "0"));
171 }
172
173 const notNum = (f: string, n: number) => !/^[0-9]+$/.test(map.get(f).padEnd(n, " ").slice(0, n));
174 if (notNum("SDTMM", 2) || map.get("SDTMM") > "12") {
175 fail(ctx, ws, "Start Date - Not a valid Month...", "SDTMM");
176 }
177 if (notNum("SDTDD", 2) || map.get("SDTDD") > "31") {
178 fail(ctx, ws, "Start Date - Not a valid Day...", "SDTDD");
179 }
180 if (notNum("SDTYYYY", 4)) fail(ctx, ws, "Start Date - Not a valid Year...", "SDTYYYY");
181 if (notNum("EDTMM", 2) || map.get("EDTMM") > "12") {
182 fail(ctx, ws, "End Date - Not a valid Month...", "EDTMM");
183 }
184 if (notNum("EDTDD", 2) || map.get("EDTDD") > "31") {
185 fail(ctx, ws, "End Date - Not a valid Day...", "EDTDD");
186 }
187 if (notNum("EDTYYYY", 4)) fail(ctx, ws, "End Date - Not a valid Year...", "EDTYYYY");
188
189 ws.startDate = { yyyy: map.get("SDTYYYY"), mm: map.get("SDTMM"), dd: map.get("SDTDD") };
190 ws.endDate = { yyyy: map.get("EDTYYYY"), mm: map.get("EDTMM"), dd: map.get("EDTDD") };
191
192 // CALL 'CSUTLDTC' (CEEDAYS); feedback 2513 (unsupported range) is tolerated.
193 const start = ceedays(dateText(ws.startDate), WS_DATE_FORMAT);
194 if (start.severity !== 0 && start.msgNo !== 2513) fail(ctx, ws, "Start Date - Not a valid date...", "SDTMM");
195 const end = ceedays(dateText(ws.endDate), WS_DATE_FORMAT);
196 if (end.severity !== 0 && end.msgNo !== 2513) fail(ctx, ws, "End Date - Not a valid date...", "EDTMM");
197
198 ws.parmStartDate1 = ws.parmStartDate2 = dateText(ws.startDate);
199 ws.parmEndDate1 = ws.parmEndDate2 = dateText(ws.endDate);
200 ws.reportName = "Custom";
201 if (ws.errFlg !== "Y") submitJobToIntrdr(ctx, ws);
202 } else {
203 ws.message = "Select a report type to print report...";
204 ws.errFlg = "Y";
205 map.cursor("MONTHLY");
206 sendTrnrptScreen(ctx, ws);
207 }
208
209 if (ws.errFlg !== "Y") {
210 initializeAllFields(ws);
211 map.color("ERRMSG", "GREEN");
212 // STRING WS-REPORT-NAME DELIMITED BY SPACE ' report submitted for printing ...'
213 ws.message = `${ws.reportName.split(" ")[0]} report submitted for printing ...`;
214 map.cursor("MONTHLY");
215 sendTrnrptScreen(ctx, ws);
216 }
217}
218
219/** MOVE msg TO WS-MESSAGE, MOVE 'Y' TO WS-ERR-FLG, MOVE -1 TO fieldL, PERFORM SEND-TRNRPT-SCREEN. */
220function fail(ctx: Cics, ws: Ws, msg: string, field: string): never {
221 ws.message = msg;
222 ws.errFlg = "Y";
223 ws.map.cursor(field);
224 sendTrnrptScreen(ctx, ws);
225}
226
227/** SUBMIT-JOB-TO-INTRDR (CORPT00C.cbl:462-510) */
228function submitJobToIntrdr(ctx: Cics, ws: Ws): void {
229 const map = ws.map;
230 const confirm = map.get("CONFIRM");
231 if (isBlank(confirm)) {
232 ws.message = `Please confirm to print the ${ws.reportName.split(" ")[0]} report...`;
233 ws.errFlg = "Y";
234 map.cursor("CONFIRM");
235 sendTrnrptScreen(ctx, ws);
236 }
237
238 if (ws.errFlg !== "Y") {
239 if (confirm === "Y" || confirm === "y") {
240 // CONTINUE
241 } else if (confirm === "N" || confirm === "n") {
242 initializeAllFields(ws);
243 ws.errFlg = "Y";
244 sendTrnrptScreen(ctx, ws);
245 } else {
246 ws.message = `"${confirm.split(" ")[0]}" is not a valid value to confirm...`;
247 ws.errFlg = "Y";
248 map.cursor("CONFIRM");
249 sendTrnrptScreen(ctx, ws);
250 }
251
252 ws.endLoop = "N";
253 const lines = jobLines(ws);
254 // PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 1000 OR END-LOOP-YES OR ERR-FLG-ON
255 for (let idx = 1; !(idx > 1000 || ws.endLoop === "Y" || ws.errFlg === "Y"); idx++) {
256 // JOB-LINES beyond the 17 cards defined are uninitialised storage; never reached.
257 const jclRecord = lines[idx - 1] ?? " ".repeat(80);
258 if (jclRecord.trimEnd() === "/*EOF" || isBlank(jclRecord)) ws.endLoop = "Y";
259 wirteJobsubTdq(ctx, ws, jclRecord); // the '/*EOF' card itself is written too
260 }
261 }
262}
263
264/** WIRTE-JOBSUB-TDQ [sic] (CORPT00C.cbl:515-535) */
265function wirteJobsubTdq(ctx: Cics, ws: Ws, jclRecord: string): void {
266 const resp = ctx.writeqTd("JOBS", jclRecord);
267 if (resp !== RESP.NORMAL) {
268 ws.errFlg = "Y";
269 ws.message = "Unable to Write TDQ (JOBS)...";
270 ws.map.cursor("MONTHLY");
271 sendTrnrptScreen(ctx, ws);
272 }
273}
274
275/** RETURN-TO-PREV-SCREEN (CORPT00C.cbl:540-551) */
276function returnToPrevScreen(ctx: Cics): never {
277 const area = ctx.area();
278 if (isBlank(area.toProgram)) area.toProgram = "COSGN00C";
279 area.fromTranid = WS_TRANID;
280 area.fromProgram = WS_PGMNAME;
281 area.pgmContext = 0;
282 ctx.xctl(area.toProgram, area);
283}
284
285/** SEND-TRNRPT-SCREEN (CORPT00C.cbl:556-580) — ends with GO TO RETURN-TO-CICS. */
286function sendTrnrptScreen(ctx: Cics, ws: Ws): never {
287 populateHeaderInfo(ctx, ws.map, WS_TRANID, WS_PGMNAME);
288 ws.map.set("ERRMSG", ws.message);
289 if (ws.sendEraseFlg === "Y") ctx.sendMap(ws.map, { erase: true, cursor: true });
290 else ctx.sendMap(ws.map, { cursor: true });
291 returnToCics(ctx);
292}
293
294/** RETURN-TO-CICS (CORPT00C.cbl:585-591) */
295function returnToCics(ctx: Cics): never {
296 ctx.return(WS_TRANID, ctx.area());
297}
298
299/** RECEIVE-TRNRPT-SCREEN (CORPT00C.cbl:596-604) */
300function receiveTrnrptScreen(ctx: Cics, ws: Ws): void {
301 ws.map = ctx.receiveMap("CORPT00", "CORPT0A").map;
302}
303
304/** INITIALIZE-ALL-FIELDS (CORPT00C.cbl:633-646) */
305function initializeAllFields(ws: Ws): void {
306 ws.map.cursor("MONTHLY");
307 for (const f of ["MONTHLY", "YEARLY", "CUSTOM", "SDTMM", "SDTDD", "SDTYYYY", "EDTMM", "EDTDD", "EDTYYYY", "CONFIRM"]) ws.map.set(f, "");
308 ws.message = "";
309}

COBOL app/cbl/CORPT00C.cbl

1 ******************************************************************
2 * Program : CORPT00C.CBL
3 * Application : CardDemo
4 * Type : CICS COBOL Program
5 * Function : Print Transaction reports by submitting batch
6 * job from online using extra partition TDQ.
7 ******************************************************************
8 * Copyright Amazon.com, Inc. or its affiliates.
9 * All Rights Reserved.
10 *
11 * Licensed under the Apache License, Version 2.0 (the "License").
12 * You may not use this file except in compliance with the License.
13 * You may obtain a copy of the License at
14 *
15 * http://www.apache.org/licenses/LICENSE-2.0
16 *
17 * Unless required by applicable law or agreed to in writing,
18 * software distributed under the License is distributed on an
19 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
20 * either express or implied. See the License for the specific
21 * language governing permissions and limitations under the License
22 ******************************************************************
23 IDENTIFICATION DIVISION.
24 PROGRAM-ID. CORPT00C.
25 AUTHOR. AWS.
26
27 ENVIRONMENT DIVISION.
28 CONFIGURATION SECTION.
29
30 DATA DIVISION.
31 *----------------------------------------------------------------*
32 * WORKING STORAGE SECTION
33 *----------------------------------------------------------------*
34 WORKING-STORAGE SECTION.
35
36 01 WS-VARIABLES.
37 05 WS-PGMNAME PIC X(08) VALUE 'CORPT00C'.
38 05 WS-TRANID PIC X(04) VALUE 'CR00'.
39 05 WS-MESSAGE PIC X(80) VALUE SPACES.
40 05 WS-TRANSACT-FILE PIC X(08) VALUE 'TRANSACT'.
41 05 WS-ERR-FLG PIC X(01) VALUE 'N'.
42 88 ERR-FLG-ON VALUE 'Y'.
43 88 ERR-FLG-OFF VALUE 'N'.
44 05 WS-TRANSACT-EOF PIC X(01) VALUE 'N'.
45 88 TRANSACT-EOF VALUE 'Y'.
46 88 TRANSACT-NOT-EOF VALUE 'N'.
47 05 WS-SEND-ERASE-FLG PIC X(01) VALUE 'Y'.
48 88 SEND-ERASE-YES VALUE 'Y'.
49 88 SEND-ERASE-NO VALUE 'N'.
50 05 WS-END-LOOP PIC X(01) VALUE 'N'.
51 88 END-LOOP-YES VALUE 'Y'.
52 88 END-LOOP-NO VALUE 'N'.
53
54 05 WS-RESP-CD PIC S9(09) COMP VALUE ZEROS.
55 05 WS-REAS-CD PIC S9(09) COMP VALUE ZEROS.
56 05 WS-REC-COUNT PIC S9(04) COMP VALUE ZEROS.
57 05 WS-IDX PIC S9(04) COMP VALUE ZEROS.
58 05 WS-REPORT-NAME PIC X(10) VALUE SPACES.
59
60 05 WS-START-DATE.
61 10 WS-START-DATE-YYYY PIC X(04) VALUE SPACES.
62 10 FILLER PIC X(01) VALUE '-'.
63 10 WS-START-DATE-MM PIC X(02) VALUE SPACES.
64 10 FILLER PIC X(01) VALUE '-'.
65 10 WS-START-DATE-DD PIC X(02) VALUE SPACES.
66 05 WS-END-DATE.
67 10 WS-END-DATE-YYYY PIC X(04) VALUE SPACES.
68 10 FILLER PIC X(01) VALUE '-'.
69 10 WS-END-DATE-MM PIC X(02) VALUE SPACES.
70 10 FILLER PIC X(01) VALUE '-'.
71 10 WS-END-DATE-DD PIC X(02) VALUE SPACES.
72 05 WS-DATE-FORMAT PIC X(10) VALUE 'YYYY-MM-DD'.
73
74 05 WS-NUM-99 PIC 99 VALUE 0.
75 05 WS-NUM-9999 PIC 9999 VALUE 0.
76
77 05 WS-TRAN-AMT PIC +99999999.99.
78 05 WS-TRAN-DATE PIC X(08) VALUE '00/00/00'.
79 05 JCL-RECORD PIC X(80) VALUE ' '.
80
81 01 JOB-DATA.
82 02 JOB-DATA-1.
83 05 FILLER PIC X(80) VALUE
84 "//TRNRPT00 JOB 'TRAN REPORT',CLASS=A,MSGCLASS=0,".
85 05 FILLER PIC X(80) VALUE
86 "// NOTIFY=&SYSUID".
87 05 FILLER PIC X(80) VALUE
88 "//*".
89 05 FILLER PIC X(80) VALUE
90 "//JOBLIB JCLLIB ORDER=('AWS.M2.CARDDEMO.PROC')".
91 05 FILLER PIC X(80) VALUE
92 "//*".
93 05 FILLER PIC X(80) VALUE
94 "//STEP10 EXEC PROC=TRANREPT".
95 05 FILLER PIC X(80) VALUE
96 "//*".
97 05 FILLER PIC X(80) VALUE
98 "//STEP05R.SYMNAMES DD *".
99 05 FILLER PIC X(80) VALUE
100 "TRAN-CARD-NUM,263,16,ZD".
101 05 FILLER PIC X(80) VALUE
102 "TRAN-PROC-DT,305,10,CH".
103 05 FILLER-1.
104 10 FILLER PIC X(18) VALUE
105 "PARM-START-DATE,C'".
106 10 PARM-START-DATE-1 PIC X(10) VALUE SPACES.
107 10 FILLER PIC X(52) VALUE "'".
108 05 FILLER-2.
109 10 FILLER PIC X(16) VALUE
110 "PARM-END-DATE,C'".
111 10 PARM-END-DATE-1 PIC X(10) VALUE SPACES.
112 10 FILLER PIC X(54) VALUE "'".
113 05 FILLER PIC X(80) VALUE
114 "/*".
115 05 FILLER PIC X(80) VALUE
116 "//STEP10R.DATEPARM DD *".
117 05 FILLER-3.
118 10 PARM-START-DATE-2 PIC X(10) VALUE SPACES.
119 10 FILLER PIC X VALUE SPACE.
120 10 PARM-END-DATE-2 PIC X(10) VALUE SPACES.
121 10 FILLER PIC X(59) VALUE SPACES.
122 05 FILLER PIC X(80) VALUE
123 "/*".
124 05 FILLER PIC X(80) VALUE
125 "/*EOF".
126 02 JOB-DATA-2 REDEFINES JOB-DATA-1.
127 05 JOB-LINES OCCURS 1000 TIMES PIC X(80).
128
129 01 CSUTLDTC-PARM.
130 05 CSUTLDTC-DATE PIC X(10).
131 05 CSUTLDTC-DATE-FORMAT PIC X(10).
132 05 CSUTLDTC-RESULT.
133 10 CSUTLDTC-RESULT-SEV-CD PIC X(04).
134 10 FILLER PIC X(11).
135 10 CSUTLDTC-RESULT-MSG-NUM PIC X(04).
136 10 CSUTLDTC-RESULT-MSG PIC X(61).
137
138 COPY COCOM01Y.
139
140 COPY CORPT00.
141
142 COPY COTTL01Y.
143 COPY CSDAT01Y.
144 COPY CSMSG01Y.
145
146 COPY CVTRA05Y.
147
148 COPY DFHAID.
149 COPY DFHBMSCA.
150
151 *----------------------------------------------------------------*
152 * LINKAGE SECTION
153 *----------------------------------------------------------------*
154 LINKAGE SECTION.
155 01 DFHCOMMAREA.
156 05 LK-COMMAREA PIC X(01)
157 OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
158
159 *----------------------------------------------------------------*
160 * PROCEDURE DIVISION
161 *----------------------------------------------------------------*
162 PROCEDURE DIVISION.
163 MAIN-PARA.
164
165 SET ERR-FLG-OFF TO TRUE
166 SET TRANSACT-NOT-EOF TO TRUE
167 SET SEND-ERASE-YES TO TRUE
168
169 MOVE SPACES TO WS-MESSAGE
170 ERRMSGO OF CORPT0AO
171
172 IF EIBCALEN = 0
173 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
174 PERFORM RETURN-TO-PREV-SCREEN
175 ELSE
176 MOVE DFHCOMMAREA(1:EIBCALEN) TO CARDDEMO-COMMAREA
177 IF NOT CDEMO-PGM-REENTER
178 SET CDEMO-PGM-REENTER TO TRUE
179 MOVE LOW-VALUES TO CORPT0AO
180 MOVE -1 TO MONTHLYL OF CORPT0AI
181 PERFORM SEND-TRNRPT-SCREEN
182 ELSE
183 PERFORM RECEIVE-TRNRPT-SCREEN
184 EVALUATE EIBAID
185 WHEN DFHENTER
186 PERFORM PROCESS-ENTER-KEY
187 WHEN DFHPF3
188 MOVE 'COMEN01C' TO CDEMO-TO-PROGRAM
189 PERFORM RETURN-TO-PREV-SCREEN
190 WHEN OTHER
191 MOVE 'Y' TO WS-ERR-FLG
192 MOVE -1 TO MONTHLYL OF CORPT0AI
193 MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE
194 PERFORM SEND-TRNRPT-SCREEN
195 END-EVALUATE
196 END-IF
197 END-IF
198
199 EXEC CICS RETURN
200 TRANSID (WS-TRANID)
201 COMMAREA (CARDDEMO-COMMAREA)
202 END-EXEC.
203
204
205 *----------------------------------------------------------------*
206 * PROCESS-ENTER-KEY
207 *----------------------------------------------------------------*
208 PROCESS-ENTER-KEY.
209
210 DISPLAY 'PROCESS ENTER KEY'
211
212 EVALUATE TRUE
213 WHEN MONTHLYI OF CORPT0AI NOT = SPACES AND LOW-VALUES
214 MOVE 'Monthly' TO WS-REPORT-NAME
215 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
216
217 MOVE WS-CURDATE-YEAR TO WS-START-DATE-YYYY
218 MOVE WS-CURDATE-MONTH TO WS-START-DATE-MM
219 MOVE '01' TO WS-START-DATE-DD
220 MOVE WS-START-DATE TO PARM-START-DATE-1
221 PARM-START-DATE-2
222
223 MOVE 1 TO WS-CURDATE-DAY
224 ADD 1 TO WS-CURDATE-MONTH
225 IF WS-CURDATE-MONTH > 12
226 ADD 1 TO WS-CURDATE-YEAR
227 MOVE 1 TO WS-CURDATE-MONTH
228 END-IF
229 COMPUTE WS-CURDATE-N = FUNCTION DATE-OF-INTEGER(
230 FUNCTION INTEGER-OF-DATE(WS-CURDATE-N) - 1)
231
232 MOVE WS-CURDATE-YEAR TO WS-END-DATE-YYYY
233 MOVE WS-CURDATE-MONTH TO WS-END-DATE-MM
234 MOVE WS-CURDATE-DAY TO WS-END-DATE-DD
235 MOVE WS-END-DATE TO PARM-END-DATE-1
236 PARM-END-DATE-2
237
238 PERFORM SUBMIT-JOB-TO-INTRDR
239 WHEN YEARLYI OF CORPT0AI NOT = SPACES AND LOW-VALUES
240 MOVE 'Yearly' TO WS-REPORT-NAME
241 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
242
243 MOVE WS-CURDATE-YEAR TO WS-START-DATE-YYYY
244 WS-END-DATE-YYYY
245 MOVE '01' TO WS-START-DATE-MM
246 WS-START-DATE-DD
247 MOVE WS-START-DATE TO PARM-START-DATE-1
248 PARM-START-DATE-2
249
250 MOVE '12' TO WS-END-DATE-MM
251 MOVE '31' TO WS-END-DATE-DD
252 MOVE WS-END-DATE TO PARM-END-DATE-1
253 PARM-END-DATE-2
254
255 PERFORM SUBMIT-JOB-TO-INTRDR
256 WHEN CUSTOMI OF CORPT0AI NOT = SPACES AND LOW-VALUES
257
258 EVALUATE TRUE
259 WHEN SDTMMI OF CORPT0AI = SPACES OR
260 LOW-VALUES
261 MOVE 'Start Date - Month can NOT be empty...'
262 TO WS-MESSAGE
263 MOVE 'Y' TO WS-ERR-FLG
264 MOVE -1 TO SDTMML OF CORPT0AI
265 PERFORM SEND-TRNRPT-SCREEN
266 WHEN SDTDDI OF CORPT0AI = SPACES OR
267 LOW-VALUES
268 MOVE 'Start Date - Day can NOT be empty...'
269 TO WS-MESSAGE
270 MOVE 'Y' TO WS-ERR-FLG
271 MOVE -1 TO SDTDDL OF CORPT0AI
272 PERFORM SEND-TRNRPT-SCREEN
273 WHEN SDTYYYYI OF CORPT0AI = SPACES OR
274 LOW-VALUES
275 MOVE 'Start Date - Year can NOT be empty...'
276 TO WS-MESSAGE
277 MOVE 'Y' TO WS-ERR-FLG
278 MOVE -1 TO SDTYYYYL OF CORPT0AI
279 PERFORM SEND-TRNRPT-SCREEN
280 WHEN EDTMMI OF CORPT0AI = SPACES OR
281 LOW-VALUES
282 MOVE 'End Date - Month can NOT be empty...'
283 TO WS-MESSAGE
284 MOVE 'Y' TO WS-ERR-FLG
285 MOVE -1 TO EDTMML OF CORPT0AI
286 PERFORM SEND-TRNRPT-SCREEN
287 WHEN EDTDDI OF CORPT0AI = SPACES OR
288 LOW-VALUES
289 MOVE 'End Date - Day can NOT be empty...'
290 TO WS-MESSAGE
291 MOVE 'Y' TO WS-ERR-FLG
292 MOVE -1 TO EDTDDL OF CORPT0AI
293 PERFORM SEND-TRNRPT-SCREEN
294 WHEN EDTYYYYI OF CORPT0AI = SPACES OR
295 LOW-VALUES
296 MOVE 'End Date - Year can NOT be empty...'
297 TO WS-MESSAGE
298 MOVE 'Y' TO WS-ERR-FLG
299 MOVE -1 TO EDTYYYYL OF CORPT0AI
300 PERFORM SEND-TRNRPT-SCREEN
301 WHEN OTHER
302 CONTINUE
303 END-EVALUATE
304
305 COMPUTE WS-NUM-99 = FUNCTION NUMVAL-C
306 (SDTMMI OF CORPT0AI)
307 MOVE WS-NUM-99 TO SDTMMI OF CORPT0AI
308
309 COMPUTE WS-NUM-99 = FUNCTION NUMVAL-C
310 (SDTDDI OF CORPT0AI)
311 MOVE WS-NUM-99 TO SDTDDI OF CORPT0AI
312
313 COMPUTE WS-NUM-9999 = FUNCTION NUMVAL-C
314 (SDTYYYYI OF CORPT0AI)
315 MOVE WS-NUM-9999 TO SDTYYYYI OF CORPT0AI
316
317 COMPUTE WS-NUM-99 = FUNCTION NUMVAL-C
318 (EDTMMI OF CORPT0AI)
319 MOVE WS-NUM-99 TO EDTMMI OF CORPT0AI
320
321 COMPUTE WS-NUM-99 = FUNCTION NUMVAL-C
322 (EDTDDI OF CORPT0AI)
323 MOVE WS-NUM-99 TO EDTDDI OF CORPT0AI
324
325 COMPUTE WS-NUM-9999 = FUNCTION NUMVAL-C
326 (EDTYYYYI OF CORPT0AI)
327 MOVE WS-NUM-9999 TO EDTYYYYI OF CORPT0AI
328
329 IF SDTMMI OF CORPT0AI IS NOT NUMERIC OR
330 SDTMMI OF CORPT0AI > '12'
331 MOVE 'Start Date - Not a valid Month...'
332 TO WS-MESSAGE
333 MOVE 'Y' TO WS-ERR-FLG
334 MOVE -1 TO SDTMML OF CORPT0AI
335 PERFORM SEND-TRNRPT-SCREEN
336 END-IF
337
338 IF SDTDDI OF CORPT0AI IS NOT NUMERIC OR
339 SDTDDI OF CORPT0AI > '31'
340 MOVE 'Start Date - Not a valid Day...'
341 TO WS-MESSAGE
342 MOVE 'Y' TO WS-ERR-FLG
343 MOVE -1 TO SDTDDL OF CORPT0AI
344 PERFORM SEND-TRNRPT-SCREEN
345 END-IF
346
347 IF SDTYYYYI OF CORPT0AI IS NOT NUMERIC
348 MOVE 'Start Date - Not a valid Year...'
349 TO WS-MESSAGE
350 MOVE 'Y' TO WS-ERR-FLG
351 MOVE -1 TO SDTYYYYL OF CORPT0AI
352 PERFORM SEND-TRNRPT-SCREEN
353 END-IF
354
355 IF EDTMMI OF CORPT0AI IS NOT NUMERIC OR
356 EDTMMI OF CORPT0AI > '12'
357 MOVE 'End Date - Not a valid Month...'
358 TO WS-MESSAGE
359 MOVE 'Y' TO WS-ERR-FLG
360 MOVE -1 TO EDTMML OF CORPT0AI
361 PERFORM SEND-TRNRPT-SCREEN
362 END-IF
363
364 IF EDTDDI OF CORPT0AI IS NOT NUMERIC OR
365 EDTDDI OF CORPT0AI > '31'
366 MOVE 'End Date - Not a valid Day...'
367 TO WS-MESSAGE
368 MOVE 'Y' TO WS-ERR-FLG
369 MOVE -1 TO EDTDDL OF CORPT0AI
370 PERFORM SEND-TRNRPT-SCREEN
371 END-IF
372
373 IF EDTYYYYI OF CORPT0AI IS NOT NUMERIC
374 MOVE 'End Date - Not a valid Year...'
375 TO WS-MESSAGE
376 MOVE 'Y' TO WS-ERR-FLG
377 MOVE -1 TO EDTYYYYL OF CORPT0AI
378 PERFORM SEND-TRNRPT-SCREEN
379 END-IF
380
381 MOVE SDTYYYYI OF CORPT0AI TO WS-START-DATE-YYYY
382 MOVE SDTMMI OF CORPT0AI TO WS-START-DATE-MM
383 MOVE SDTDDI OF CORPT0AI TO WS-START-DATE-DD
384 MOVE EDTYYYYI OF CORPT0AI TO WS-END-DATE-YYYY
385 MOVE EDTMMI OF CORPT0AI TO WS-END-DATE-MM
386 MOVE EDTDDI OF CORPT0AI TO WS-END-DATE-DD
387
388 MOVE WS-START-DATE TO CSUTLDTC-DATE
389 MOVE WS-DATE-FORMAT TO CSUTLDTC-DATE-FORMAT
390 MOVE SPACES TO CSUTLDTC-RESULT
391
392 CALL 'CSUTLDTC' USING CSUTLDTC-DATE
393 CSUTLDTC-DATE-FORMAT
394 CSUTLDTC-RESULT
395
396 IF CSUTLDTC-RESULT-SEV-CD = '0000'
397 CONTINUE
398 ELSE
399 IF CSUTLDTC-RESULT-MSG-NUM NOT = '2513'
400 MOVE 'Start Date - Not a valid date...'
401 TO WS-MESSAGE
402 MOVE 'Y' TO WS-ERR-FLG
403 MOVE -1 TO SDTMML OF CORPT0AI
404 PERFORM SEND-TRNRPT-SCREEN
405 END-IF
406 END-IF
407
408 MOVE WS-END-DATE TO CSUTLDTC-DATE
409 MOVE WS-DATE-FORMAT TO CSUTLDTC-DATE-FORMAT
410 MOVE SPACES TO CSUTLDTC-RESULT
411
412 CALL 'CSUTLDTC' USING CSUTLDTC-DATE
413 CSUTLDTC-DATE-FORMAT
414 CSUTLDTC-RESULT
415
416 IF CSUTLDTC-RESULT-SEV-CD = '0000'
417 CONTINUE
418 ELSE
419 IF CSUTLDTC-RESULT-MSG-NUM NOT = '2513'
420 MOVE 'End Date - Not a valid date...'
421 TO WS-MESSAGE
422 MOVE 'Y' TO WS-ERR-FLG
423 MOVE -1 TO EDTMML OF CORPT0AI
424 PERFORM SEND-TRNRPT-SCREEN
425 END-IF
426 END-IF
427
428
429 MOVE WS-START-DATE TO PARM-START-DATE-1
430 PARM-START-DATE-2
431 MOVE WS-END-DATE TO PARM-END-DATE-1
432 PARM-END-DATE-2
433 MOVE 'Custom' TO WS-REPORT-NAME
434 IF NOT ERR-FLG-ON
435 PERFORM SUBMIT-JOB-TO-INTRDR
436 END-IF
437 WHEN OTHER
438 MOVE 'Select a report type to print report...' TO
439 WS-MESSAGE
440 MOVE 'Y' TO WS-ERR-FLG
441 MOVE -1 TO MONTHLYL OF CORPT0AI
442 PERFORM SEND-TRNRPT-SCREEN
443 END-EVALUATE
444
445 IF NOT ERR-FLG-ON
446
447 PERFORM INITIALIZE-ALL-FIELDS
448 MOVE DFHGREEN TO ERRMSGC OF CORPT0AO
449 STRING WS-REPORT-NAME DELIMITED BY SPACE
450 ' report submitted for printing ...'
451 DELIMITED BY SIZE
452 INTO WS-MESSAGE
453 MOVE -1 TO MONTHLYL OF CORPT0AI
454 PERFORM SEND-TRNRPT-SCREEN
455
456 END-IF.
457
458
459 *----------------------------------------------------------------*
460 * SUBMIT-JOB-TO-INTRDR
461 *----------------------------------------------------------------*
462 SUBMIT-JOB-TO-INTRDR.
463
464 IF CONFIRMI OF CORPT0AI = SPACES OR LOW-VALUES
465 STRING
466 'Please confirm to print the '
467 DELIMITED BY SIZE
468 WS-REPORT-NAME DELIMITED BY SPACE
469 ' report...' DELIMITED BY SIZE
470 INTO WS-MESSAGE
471 MOVE 'Y' TO WS-ERR-FLG
472 MOVE -1 TO CONFIRML OF CORPT0AI
473 PERFORM SEND-TRNRPT-SCREEN
474 END-IF
475
476 IF NOT ERR-FLG-ON
477 EVALUATE TRUE
478 WHEN CONFIRMI OF CORPT0AI = 'Y' OR 'y'
479 CONTINUE
480 WHEN CONFIRMI OF CORPT0AI = 'N' OR 'n'
481 PERFORM INITIALIZE-ALL-FIELDS
482 MOVE 'Y' TO WS-ERR-FLG
483 PERFORM SEND-TRNRPT-SCREEN
484 WHEN OTHER
485 STRING
486 '"' DELIMITED BY SIZE
487 CONFIRMI OF CORPT0AI DELIMITED BY SPACE
488 '" is not a valid value to confirm...'
489 DELIMITED BY SIZE
490 INTO WS-MESSAGE
491 MOVE 'Y' TO WS-ERR-FLG
492 MOVE -1 TO CONFIRML OF CORPT0AI
493 PERFORM SEND-TRNRPT-SCREEN
494 END-EVALUATE
495
496 SET END-LOOP-NO TO TRUE
497
498 PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 1000 OR
499 END-LOOP-YES OR ERR-FLG-ON
500
501 MOVE JOB-LINES(WS-IDX) TO JCL-RECORD
502 IF JCL-RECORD = '/*EOF' OR
503 JCL-RECORD = SPACES OR LOW-VALUES
504 SET END-LOOP-YES TO TRUE
505 END-IF
506
507 PERFORM WIRTE-JOBSUB-TDQ
508 END-PERFORM
509
510 END-IF.
511
512 *----------------------------------------------------------------*
513 * WIRTE-JOBSUB-TDQ
514 *----------------------------------------------------------------*
515 WIRTE-JOBSUB-TDQ.
516
517 EXEC CICS WRITEQ TD
518 QUEUE ('JOBS')
519 FROM (JCL-RECORD)
520 LENGTH (LENGTH OF JCL-RECORD)
521 RESP(WS-RESP-CD)
522 RESP2(WS-REAS-CD)
523 END-EXEC.
524
525 EVALUATE WS-RESP-CD
526 WHEN DFHRESP(NORMAL)
527 CONTINUE
528 WHEN OTHER
529 DISPLAY 'RESP:' WS-RESP-CD 'REAS:' WS-REAS-CD
530 MOVE 'Y' TO WS-ERR-FLG
531 MOVE 'Unable to Write TDQ (JOBS)...' TO
532 WS-MESSAGE
533 MOVE -1 TO MONTHLYL OF CORPT0AI
534 PERFORM SEND-TRNRPT-SCREEN
535 END-EVALUATE.
536
537 *----------------------------------------------------------------*
538 * RETURN-TO-PREV-SCREEN
539 *----------------------------------------------------------------*
540 RETURN-TO-PREV-SCREEN.
541
542 IF CDEMO-TO-PROGRAM = LOW-VALUES OR SPACES
543 MOVE 'COSGN00C' TO CDEMO-TO-PROGRAM
544 END-IF
545 MOVE WS-TRANID TO CDEMO-FROM-TRANID
546 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
547 MOVE ZEROS TO CDEMO-PGM-CONTEXT
548 EXEC CICS
549 XCTL PROGRAM(CDEMO-TO-PROGRAM)
550 COMMAREA(CARDDEMO-COMMAREA)
551 END-EXEC.
552
553 *----------------------------------------------------------------*
554 * SEND-TRNRPT-SCREEN
555 *----------------------------------------------------------------*
556 SEND-TRNRPT-SCREEN.
557
558 PERFORM POPULATE-HEADER-INFO
559
560 MOVE WS-MESSAGE TO ERRMSGO OF CORPT0AO
561
562 IF SEND-ERASE-YES
563 EXEC CICS SEND
564 MAP('CORPT0A')
565 MAPSET('CORPT00')
566 FROM(CORPT0AO)
567 ERASE
568 CURSOR
569 END-EXEC
570 ELSE
571 EXEC CICS SEND
572 MAP('CORPT0A')
573 MAPSET('CORPT00')
574 FROM(CORPT0AO)
575 * ERASE
576 CURSOR
577 END-EXEC
578 END-IF.
579
580 GO TO RETURN-TO-CICS.
581
582 *----------------------------------------------------------------*
583 * RETURN-TO-CICS
584 *----------------------------------------------------------------*
585 RETURN-TO-CICS.
586
587 EXEC CICS RETURN
588 TRANSID (WS-TRANID)
589 COMMAREA (CARDDEMO-COMMAREA)
590 * LENGTH(LENGTH OF CARDDEMO-COMMAREA)
591 END-EXEC.
592
593 *----------------------------------------------------------------*
594 * RECEIVE-TRNRPT-SCREEN
595 *----------------------------------------------------------------*
596 RECEIVE-TRNRPT-SCREEN.
597
598 EXEC CICS RECEIVE
599 MAP('CORPT0A')
600 MAPSET('CORPT00')
601 INTO(CORPT0AI)
602 RESP(WS-RESP-CD)
603 RESP2(WS-REAS-CD)
604 END-EXEC.
605
606 *----------------------------------------------------------------*
607 * POPULATE-HEADER-INFO
608 *----------------------------------------------------------------*
609 POPULATE-HEADER-INFO.
610
611 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
612
613 MOVE CCDA-TITLE01 TO TITLE01O OF CORPT0AO
614 MOVE CCDA-TITLE02 TO TITLE02O OF CORPT0AO
615 MOVE WS-TRANID TO TRNNAMEO OF CORPT0AO
616 MOVE WS-PGMNAME TO PGMNAMEO OF CORPT0AO
617
618 MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
619 MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
620 MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
621
622 MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF CORPT0AO
623
624 MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
625 MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
626 MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
627
628 MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF CORPT0AO.
629
630 *----------------------------------------------------------------*
631 * INITIALIZE-ALL-FIELDS
632 *----------------------------------------------------------------*
633 INITIALIZE-ALL-FIELDS.
634
635 MOVE -1 TO MONTHLYL OF CORPT0AI
636 INITIALIZE MONTHLYI OF CORPT0AI
637 YEARLYI OF CORPT0AI
638 CUSTOMI OF CORPT0AI
639 SDTMMI OF CORPT0AI
640 SDTDDI OF CORPT0AI
641 SDTYYYYI OF CORPT0AI
642 EDTMMI OF CORPT0AI
643 EDTDDI OF CORPT0AI
644 EDTYYYYI OF CORPT0AI
645 CONFIRMI OF CORPT0AI
646 WS-MESSAGE.
647 *
648 * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:33 CDT
649 *