cobol · 924 lines · sha256 23c8753b6b4e0c24 · guides at columns 7 and 72app/cbl/CBSTM03A.CBL

1	IDENTIFICATION DIVISION.
2	PROGRAM-ID. CBSTM03A.
3	AUTHOR. AWS.
4	******************************************************************
5	* Program : CBSTM03A.CBL
6	* Application : CardDemo
7	* Type : BATCH COBOL Program
8	* Function : Print Account Statements from Transaction data
9	* in two formats : 1/plain text and 2/HTML
10	******************************************************************
11	* Copyright Amazon.com, Inc. or its affiliates.
12	* All Rights Reserved.
13	*
14	* Licensed under the Apache License, Version 2.0 (the "License").
15	* You may not use this file except in compliance with the License.
16	* You may obtain a copy of the License at
17	*
18	* http://www.apache.org/licenses/LICENSE-2.0
19	*
20	* Unless required by applicable law or agreed to in writing,
21	* software distributed under the License is distributed on an
22	* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
23	* either express or implied. See the License for the specific
24	* language governing permissions and limitations under the License
25	******************************************************************
26	* This program is to create statement based on the data in
27	* transaction file. The following features are excercised
28	* to help create excercise modernization tooling
29	******************************************************************
30	* 1. Mainframe Control block addressing
31	* 2. Alter and GO TO statements
32	* 3. COMP and COMP-3 variables
33	* 4. 2 dimensional array
34	* 5. Call to Subroutine
35	******************************************************************
36	ENVIRONMENT DIVISION.
37	INPUT-OUTPUT SECTION.
38	FILE-CONTROL.
39	SELECT STMT-FILE ASSIGN TO STMTFILE.
40	SELECT HTML-FILE ASSIGN TO HTMLFILE.
41	*
42	DATA DIVISION.
43	FILE SECTION.
44	FD STMT-FILE.
45	01 FD-STMTFILE-REC PIC X(80).
46	FD HTML-FILE.
47	01 FD-HTMLFILE-REC PIC X(100).
48
49	WORKING-STORAGE SECTION.
50
51	COPY COSTM01.
52
53	COPY CVACT03Y.
54
55	COPY CUSTREC.
56
57	COPY CVACT01Y.
58
59	01 COMP-VARIABLES COMP.
60	05 CR-CNT PIC S9(4) VALUE 0.
61	05 TR-CNT PIC S9(4) VALUE 0.
62	05 CR-JMP PIC S9(4) VALUE 0.
63	05 TR-JMP PIC S9(4) VALUE 0.
64	01 COMP3-VARIABLES COMP-3.
65	05 WS-TOTAL-AMT PIC S9(9)V99 VALUE 0.
66	01 MISC-VARIABLES.
67	05 WS-FL-DD PIC X(8) VALUE 'TRNXFILE'.
68	05 WS-TRN-AMT PIC S9(9)V99 VALUE 0.
69	05 WS-SAVE-CARD VALUE SPACES PIC X(16).
70	05 END-OF-FILE PIC X(01) VALUE 'N'.
71	01 WS-M03B-AREA.
72	05 WS-M03B-DD PIC X(08).
73	05 WS-M03B-OPER PIC X(01).
74	88 M03B-OPEN VALUE 'O'.
75	88 M03B-CLOSE VALUE 'C'.
76	88 M03B-READ VALUE 'R'.
77	88 M03B-READ-K VALUE 'K'.
78	88 M03B-WRITE VALUE 'W'.
79	88 M03B-REWRITE VALUE 'Z'.
80	05 WS-M03B-RC PIC X(02).
81	05 WS-M03B-KEY PIC X(25).
82	05 WS-M03B-KEY-LN PIC S9(4).
83	05 WS-M03B-FLDT PIC X(1000).
84
85	01 STATEMENT-LINES.
86	05 ST-LINE0.
87	10 FILLER VALUE ALL '*' PIC X(31).
88	10 FILLER VALUE ALL 'START OF STATEMENT' PIC X(18).
89	10 FILLER VALUE ALL '*' PIC X(31).
90	05 ST-LINE1.
91	10 ST-NAME PIC X(75).
92	10 FILLER VALUE SPACES PIC X(05).
93	05 ST-LINE2.
94	10 ST-ADD1 PIC X(50).
95	10 FILLER VALUE SPACES PIC X(30).
96	05 ST-LINE3.
97	10 ST-ADD2 PIC X(50).
98	10 FILLER VALUE SPACES PIC X(30).
99	05 ST-LINE4.
100	10 ST-ADD3 PIC X(80).
101	05 ST-LINE5.
102	10 FILLER VALUE ALL '-' PIC X(80).
103	05 ST-LINE6.
104	10 FILLER VALUE SPACES PIC X(33).
105	10 FILLER VALUE 'Basic Details' PIC X(14).
106	10 FILLER VALUE SPACES PIC X(33).
107	05 ST-LINE7.
108	10 FILLER VALUE 'Account ID :' PIC X(20).
109	10 ST-ACCT-ID PIC X(20).
110	10 FILLER VALUE SPACES PIC X(40).
111	05 ST-LINE8.
112	10 FILLER VALUE 'Current Balance :' PIC X(20).
113	10 ST-CURR-BAL PIC 9(9).99-.
114	10 FILLER VALUE SPACES PIC X(07).
115	10 FILLER VALUE SPACES PIC X(40).
116	05 ST-LINE9.
117	10 FILLER VALUE 'FICO Score :' PIC X(20).
118	10 ST-FICO-SCORE PIC X(20).
119	10 FILLER VALUE SPACES PIC X(40).
120	05 ST-LINE10.
121	10 FILLER VALUE ALL '-' PIC X(80).
122	05 ST-LINE11.
123	10 FILLER VALUE SPACES PIC X(30).
124	10 FILLER VALUE 'TRANSACTION SUMMARY ' PIC X(20).
125	10 FILLER VALUE SPACES PIC X(30).
126	05 ST-LINE12.
127	10 FILLER VALUE ALL '-' PIC X(80).
128	05 ST-LINE13.
129	10 FILLER VALUE 'Tran ID ' PIC X(16).
130	10 FILLER VALUE 'Tran Details ' PIC X(51).
131	10 FILLER VALUE ' Tran Amount' PIC X(13).
132	05 ST-LINE14.
133	10 ST-TRANID PIC X(16).
134	10 FILLER VALUE ' ' PIC X(01).
135	10 ST-TRANDT PIC X(49).
136	10 FILLER VALUE '$' PIC X(01).
137	10 ST-TRANAMT PIC Z(9).99-.
138	05 ST-LINE14A.
139	10 FILLER VALUE 'Total EXP:' PIC X(10).
140	10 FILLER VALUE SPACES PIC X(56).
141	10 FILLER VALUE '$' PIC X(01).
142	10 ST-TOTAL-TRAMT PIC Z(9).99-.
143	05 ST-LINE15.
144	10 FILLER VALUE ALL '*' PIC X(32).
145	10 FILLER VALUE ALL 'END OF STATEMENT' PIC X(16).
146	10 FILLER VALUE ALL '*' PIC X(32).
147
148	01 HTML-LINES.
149	05 HTML-FIXED-LN PIC X(100).
150	88 HTML-L01 VALUE '<!DOCTYPE html>'.
151	88 HTML-L02 VALUE '<html lang="en">'.
152	88 HTML-L03 VALUE '<head>'.
153	88 HTML-L04 VALUE '<meta charset="utf-8">'.
154	88 HTML-L05 VALUE '<title>HTML Table Layout</title>'.
155	88 HTML-L06 VALUE '</head>'.
156	88 HTML-L07 VALUE '<body style="margin:0px;">'.
157	88 HTML-L08 VALUE '<table align="center" frame="box" styl
158	- 'e="width:70%; font:12px Segoe UI,sans-serif;">'.
159	88 HTML-LTRS VALUE '<tr>'.
160	88 HTML-LTRE VALUE '</tr>'.
161	88 HTML-LTDS VALUE '<td>'.
162	88 HTML-LTDE VALUE '</td>'.
163	88 HTML-L10 VALUE '<td colspan="3" style="padding:0px 5px;
164	- 'background-color:#1d1d96b3;">'.
165	88 HTML-L15 VALUE '<td colspan="3" style="padding:0px 5px;
166	- 'background-color:#FFAF33;">'.
167	88 HTML-L16
168	VALUE '<p style="font-size:16px">Bank of XYZ</p>'.
169	88 HTML-L17
170	VALUE '<p>410 Terry Ave N</p>'.
171	88 HTML-L18
172	VALUE '<p>Seattle WA 99999</p>'.
173	88 HTML-L22-35
174	VALUE '<td colspan="3" style="padding:0px 5px;
175	- 'background-color:#f2f2f2;">'.
176	88 HTML-L30-42
177	VALUE '<td colspan="3" style="padding:0px 5px;
178	- 'background-color:#33FFD1; text-align:center;">'.
179	88 HTML-L31
180	VALUE '<p style="font-size:16px">Basic Details</p>'.
181	88 HTML-L43
182	VALUE '<p style="font-size:16px">Transaction Summary</p>'.
183	88 HTML-L47
184	VALUE '<td style="width:25%; padding:0px 5px; background-
185	- 'color:#33FF5E; text-align:left;">'.
186	88 HTML-L48
187	VALUE '<p style="font-size:16px">Tran ID</p>'.
188	88 HTML-L50
189	VALUE '<td style="width:55%; padding:0px 5px; background-
190	- 'color:#33FF5E; text-align:left;">'.
191	88 HTML-L51
192	VALUE '<p style="font-size:16px">Tran Details</p>'.
193	88 HTML-L53
194	VALUE '<td style="width:20%; padding:0px 5px; background-
195	- 'color:#33FF5E; text-align:right;">'.
196	88 HTML-L54
197	VALUE '<p style="font-size:16px">Amount</p>'.
198	88 HTML-L58
199	VALUE '<td style="width:25%; padding:0px 5px; background-
200	- 'color:#f2f2f2; text-align:left;">'.
201	88 HTML-L61
202	VALUE '<td style="width:55%; padding:0px 5px; background-
203	- 'color:#f2f2f2; text-align:left;">'.
204	88 HTML-L64
205	VALUE '<td style="width:20%; padding:0px 5px; background-
206	- 'color:#f2f2f2; text-align:right;">'.
207	88 HTML-L75
208	VALUE '<h3>End of Statement</h3>'.
209	88 HTML-L78 VALUE '</table>'.
210	88 HTML-L79 VALUE '</body>'.
211	88 HTML-L80 VALUE '</html>'.
212	05 HTML-L11.
213	10 FILLER PIC X(34)
214	VALUE '<h3>Statement for Account Number: '.
215	10 L11-ACCT PIC X(20).
216	10 FILLER PIC X(05) VALUE '</h3>'.
217	05 HTML-L23.
218	10 FILLER PIC X(26)
219	VALUE '<p style="font-size:16px">'.
220	10 L23-NAME PIC X(50).
221	05 HTML-ADDR-LN PIC X(100).
222	05 HTML-BSIC-LN PIC X(100).
223	05 HTML-TRAN-LN PIC X(100).
224
225	01 WS-TRNX-TABLE.
226	05 WS-CARD-TBL OCCURS 51 TIMES.
227	10 WS-CARD-NUM PIC X(16).
228	10 WS-TRAN-TBL OCCURS 10 TIMES.
229	15 WS-TRAN-NUM PIC X(16).
230	15 WS-TRAN-REST PIC X(318).
231	01 WS-TRN-TBL-CNTR.
232	05 WS-TRN-TBL-CTR OCCURS 51 TIMES.
233	10 WS-TRCT PIC S9(4) COMP.
234
235	01 PSAPTR POINTER.
236	01 BUMP-TIOT PIC S9(08) BINARY VALUE ZERO.
237	01 TIOT-INDEX REDEFINES BUMP-TIOT POINTER.
238
239	LINKAGE SECTION.
240	01 ALIGN-PSA PIC 9(16) BINARY.
241	01 PSA-BLOCK.
242	05 FILLER PIC X(536).
243	05 TCB-POINT POINTER.
244	01 TCB-BLOCK.
245	05 FILLER PIC X(12).
246	05 TIOT-POINT POINTER.
247	01 TIOT-BLOCK.
248	05 TIOTNJOB PIC X(08).
249	05 TIOTJSTP PIC X(08).
250	05 TIOTPSTP PIC X(08).
251	01 TIOT-ENTRY.
252	05 TIOT-SEG.
253	10 TIO-LEN PIC X(01).
254	10 FILLER PIC X(03).
255	10 TIOCDDNM PIC X(08).
256	10 FILLER PIC X(05).
257	10 UCB-ADDR PIC X(03).
258	88 NULL-UCB VALUES LOW-VALUES.
259	05 FILLER PIC X(04).
260	88 END-OF-TIOT VALUE LOW-VALUES.
261	*****************************************************************
262	PROCEDURE DIVISION.
263	*****************************************************************
264	* Check Unit Control blocks *
265	*****************************************************************
266	SET ADDRESS OF PSA-BLOCK TO PSAPTR.
267	SET ADDRESS OF TCB-BLOCK TO TCB-POINT.
268	SET ADDRESS OF TIOT-BLOCK TO TIOT-POINT.
269	SET TIOT-INDEX TO TIOT-POINT.
270	DISPLAY 'Running JCL : ' TIOTNJOB ' Step ' TIOTJSTP.
271
272	COMPUTE BUMP-TIOT = BUMP-TIOT + LENGTH OF TIOT-BLOCK.
273	SET ADDRESS OF TIOT-ENTRY TO TIOT-INDEX.
274
275	DISPLAY 'DD Names from TIOT: '.
276	PERFORM UNTIL END-OF-TIOT
277	OR TIO-LEN = LOW-VALUES
278	IF NOT NULL-UCB
279	DISPLAY ': ' TIOCDDNM ' -- valid UCB'
280	ELSE
281	DISPLAY ': ' TIOCDDNM ' -- null UCB'
282	END-IF
283	COMPUTE BUMP-TIOT = BUMP-TIOT + LENGTH OF TIOT-SEG
284	SET ADDRESS OF TIOT-ENTRY TO TIOT-INDEX
285	END-PERFORM.
286
287	IF NOT NULL-UCB
288	DISPLAY ': ' TIOCDDNM ' -- valid UCB'
289	ELSE
290	DISPLAY ': ' TIOCDDNM ' -- null UCB'
291	END-IF.
292
293	OPEN OUTPUT STMT-FILE HTML-FILE.
294	INITIALIZE WS-TRNX-TABLE WS-TRN-TBL-CNTR.
295
296	0000-START.
297
298	EVALUATE WS-FL-DD
299	WHEN 'TRNXFILE'
300	ALTER 8100-FILE-OPEN TO PROCEED TO 8100-TRNXFILE-OPEN
301	GO TO 8100-FILE-OPEN
302	WHEN 'XREFFILE'
303	ALTER 8100-FILE-OPEN TO PROCEED TO 8200-XREFFILE-OPEN
304	GO TO 8100-FILE-OPEN
305	WHEN 'CUSTFILE'
306	ALTER 8100-FILE-OPEN TO PROCEED TO 8300-CUSTFILE-OPEN
307	GO TO 8100-FILE-OPEN
308	WHEN 'ACCTFILE'
309	ALTER 8100-FILE-OPEN TO PROCEED TO 8400-ACCTFILE-OPEN
310	GO TO 8100-FILE-OPEN
311	WHEN 'READTRNX'
312	GO TO 8500-READTRNX-READ
313	WHEN OTHER
314	GO TO 9999-GOBACK.
315
316	1000-MAINLINE.
317	PERFORM UNTIL END-OF-FILE = 'Y'
318	IF END-OF-FILE = 'N'
319	PERFORM 1000-XREFFILE-GET-NEXT
320	IF END-OF-FILE = 'N'
321	PERFORM 2000-CUSTFILE-GET
322	PERFORM 3000-ACCTFILE-GET
323	PERFORM 5000-CREATE-STATEMENT
324	MOVE 1 TO CR-JMP
325	MOVE ZERO TO WS-TOTAL-AMT
326	PERFORM 4000-TRNXFILE-GET
327	END-IF
328	END-IF
329	END-PERFORM.
330
331	PERFORM 9100-TRNXFILE-CLOSE.
332
333	PERFORM 9200-XREFFILE-CLOSE.
334
335	PERFORM 9300-CUSTFILE-CLOSE.
336
337	PERFORM 9400-ACCTFILE-CLOSE.
338
339	CLOSE STMT-FILE HTML-FILE.
340
341	9999-GOBACK.
342	GOBACK.
343
344	---------------------------------------------------------------
345	1000-XREFFILE-GET-NEXT.
346
347	MOVE 'XREFFILE' TO WS-M03B-DD.
348	SET M03B-READ TO TRUE.
349	MOVE ZERO TO WS-M03B-RC.
350	MOVE SPACES TO WS-M03B-FLDT.
351	CALL 'CBSTM03B' USING WS-M03B-AREA.
352
353	EVALUATE WS-M03B-RC
354	WHEN '00'
355	CONTINUE
356	WHEN '10'
357	MOVE 'Y' TO END-OF-FILE
358	WHEN OTHER
359	DISPLAY 'ERROR READING XREFFILE'
360	DISPLAY 'RETURN CODE: ' WS-M03B-RC
361	PERFORM 9999-ABEND-PROGRAM
362	END-EVALUATE.
363
364	MOVE WS-M03B-FLDT TO CARD-XREF-RECORD.
365
366	EXIT.
367
368	2000-CUSTFILE-GET.
369
370	MOVE 'CUSTFILE' TO WS-M03B-DD.
371	SET M03B-READ-K TO TRUE.
372	MOVE XREF-CUST-ID TO WS-M03B-KEY.
373	MOVE ZERO TO WS-M03B-KEY-LN.
374	COMPUTE WS-M03B-KEY-LN = LENGTH OF XREF-CUST-ID.
375	MOVE ZERO TO WS-M03B-RC.
376	MOVE SPACES TO WS-M03B-FLDT.
377	CALL 'CBSTM03B' USING WS-M03B-AREA.
378
379	EVALUATE WS-M03B-RC
380	WHEN '00'
381	CONTINUE
382	WHEN OTHER
383	DISPLAY 'ERROR READING CUSTFILE'
384	DISPLAY 'RETURN CODE: ' WS-M03B-RC
385	PERFORM 9999-ABEND-PROGRAM
386	END-EVALUATE.
387
388	MOVE WS-M03B-FLDT TO CUSTOMER-RECORD.
389
390	EXIT.
391
392	3000-ACCTFILE-GET.
393
394	MOVE 'ACCTFILE' TO WS-M03B-DD.
395	SET M03B-READ-K TO TRUE.
396	MOVE XREF-ACCT-ID TO WS-M03B-KEY.
397	MOVE ZERO TO WS-M03B-KEY-LN.
398	COMPUTE WS-M03B-KEY-LN = LENGTH OF XREF-ACCT-ID.
399	MOVE ZERO TO WS-M03B-RC.
400	MOVE SPACES TO WS-M03B-FLDT.
401	CALL 'CBSTM03B' USING WS-M03B-AREA.
402
403	EVALUATE WS-M03B-RC
404	WHEN '00'
405	CONTINUE
406	WHEN OTHER
407	DISPLAY 'ERROR READING ACCTFILE'
408	DISPLAY 'RETURN CODE: ' WS-M03B-RC
409	PERFORM 9999-ABEND-PROGRAM
410	END-EVALUATE.
411
412	MOVE WS-M03B-FLDT TO ACCOUNT-RECORD.
413
414	EXIT.
415
416	4000-TRNXFILE-GET.
417	PERFORM VARYING CR-JMP FROM 1 BY 1
418	UNTIL CR-JMP > CR-CNT
419	OR (WS-CARD-NUM (CR-JMP) > XREF-CARD-NUM)
420	IF XREF-CARD-NUM = WS-CARD-NUM (CR-JMP)
421	MOVE WS-CARD-NUM (CR-JMP) TO TRNX-CARD-NUM
422	PERFORM VARYING TR-JMP FROM 1 BY 1
423	UNTIL (TR-JMP > WS-TRCT (CR-JMP))
424	MOVE WS-TRAN-NUM (CR-JMP, TR-JMP)
425	TO TRNX-ID
426	MOVE WS-TRAN-REST (CR-JMP, TR-JMP)
427	TO TRNX-REST
428	PERFORM 6000-WRITE-TRANS
429	ADD TRNX-AMT TO WS-TOTAL-AMT
430	END-PERFORM
431	END-IF
432	END-PERFORM.
433	MOVE WS-TOTAL-AMT TO WS-TRN-AMT.
434	MOVE WS-TRN-AMT TO ST-TOTAL-TRAMT.
435	WRITE FD-STMTFILE-REC FROM ST-LINE12.
436	WRITE FD-STMTFILE-REC FROM ST-LINE14A.
437	WRITE FD-STMTFILE-REC FROM ST-LINE15.
438
439	SET HTML-LTRS TO TRUE.
440	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
441	SET HTML-L10 TO TRUE.
442	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
443	SET HTML-L75 TO TRUE.
444	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
445	SET HTML-LTDE TO TRUE.
446	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
447	SET HTML-LTRE TO TRUE.
448	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
449	SET HTML-L78 TO TRUE.
450	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
451	SET HTML-L79 TO TRUE.
452	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
453	SET HTML-L80 TO TRUE.
454	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
455
456	EXIT.
457	---------------------------------------------------------------
458	5000-CREATE-STATEMENT.
459	INITIALIZE STATEMENT-LINES.
460	WRITE FD-STMTFILE-REC FROM ST-LINE0.
461	PERFORM 5100-WRITE-HTML-HEADER THRU 5100-EXIT.
462	STRING CUST-FIRST-NAME DELIMITED BY ' '
463	' ' DELIMITED BY SIZE
464	CUST-MIDDLE-NAME DELIMITED BY ' '
465	' ' DELIMITED BY SIZE
466	CUST-LAST-NAME DELIMITED BY ' '
467	' ' DELIMITED BY SIZE
468	INTO ST-NAME
469	END-STRING.
470	MOVE CUST-ADDR-LINE-1 TO ST-ADD1.
471	MOVE CUST-ADDR-LINE-2 TO ST-ADD2.
472	STRING CUST-ADDR-LINE-3 DELIMITED BY ' '
473	' ' DELIMITED BY SIZE
474	CUST-ADDR-STATE-CD DELIMITED BY ' '
475	' ' DELIMITED BY SIZE
476	CUST-ADDR-COUNTRY-CD DELIMITED BY ' '
477	' ' DELIMITED BY SIZE
478	CUST-ADDR-ZIP DELIMITED BY ' '
479	' ' DELIMITED BY SIZE
480	INTO ST-ADD3
481	END-STRING.
482
483	MOVE ACCT-ID TO ST-ACCT-ID.
484	MOVE ACCT-CURR-BAL TO ST-CURR-BAL.
485	MOVE CUST-FICO-CREDIT-SCORE TO ST-FICO-SCORE.
486	PERFORM 5200-WRITE-HTML-NMADBS THRU 5200-EXIT.
487
488	WRITE FD-STMTFILE-REC FROM ST-LINE1.
489	WRITE FD-STMTFILE-REC FROM ST-LINE2.
490	WRITE FD-STMTFILE-REC FROM ST-LINE3.
491	WRITE FD-STMTFILE-REC FROM ST-LINE4.
492	WRITE FD-STMTFILE-REC FROM ST-LINE5.
493	WRITE FD-STMTFILE-REC FROM ST-LINE6.
494	WRITE FD-STMTFILE-REC FROM ST-LINE5.
495	WRITE FD-STMTFILE-REC FROM ST-LINE7.
496	WRITE FD-STMTFILE-REC FROM ST-LINE8.
497	WRITE FD-STMTFILE-REC FROM ST-LINE9.
498	WRITE FD-STMTFILE-REC FROM ST-LINE10.
499	WRITE FD-STMTFILE-REC FROM ST-LINE11.
500	WRITE FD-STMTFILE-REC FROM ST-LINE12.
501	WRITE FD-STMTFILE-REC FROM ST-LINE13.
502	WRITE FD-STMTFILE-REC FROM ST-LINE12.
503
504	EXIT.
505
506	5100-WRITE-HTML-HEADER.
507
508	SET HTML-L01 TO TRUE.
509	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
510	SET HTML-L02 TO TRUE.
511	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
512	SET HTML-L03 TO TRUE.
513	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
514	SET HTML-L04 TO TRUE.
515	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
516	SET HTML-L05 TO TRUE.
517	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
518	SET HTML-L06 TO TRUE.
519	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
520	SET HTML-L07 TO TRUE.
521	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
522	SET HTML-L08 TO TRUE.
523	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
524	SET HTML-LTRS TO TRUE.
525	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
526	SET HTML-L10 TO TRUE.
527	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
528
529	MOVE ACCT-ID TO L11-ACCT.
530	WRITE FD-HTMLFILE-REC FROM HTML-L11.
531	SET HTML-LTDE TO TRUE.
532	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
533	SET HTML-LTRE TO TRUE.
534	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
535	SET HTML-LTRS TO TRUE.
536	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
537	SET HTML-L15 TO TRUE.
538	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
539	SET HTML-L16 TO TRUE.
540	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
541	SET HTML-L17 TO TRUE.
542	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
543	SET HTML-L18 TO TRUE.
544	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
545	SET HTML-LTDE TO TRUE.
546	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
547	SET HTML-LTRE TO TRUE.
548	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
549	SET HTML-LTRS TO TRUE.
550	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
551	SET HTML-L22-35 TO TRUE.
552	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
553
554	5100-EXIT.
555	EXIT.
556
557	---------------------------------------------------------------
558	5200-WRITE-HTML-NMADBS.
559
560	MOVE ST-NAME TO L23-NAME.
561	MOVE SPACES TO FD-HTMLFILE-REC
562	STRING '<p style="font-size:16px">' DELIMITED BY '*'
563	L23-NAME DELIMITED BY ' '
564	' ' DELIMITED BY SIZE
565	'</p>' DELIMITED BY '*'
566	INTO FD-HTMLFILE-REC
567	END-STRING.
568	WRITE FD-HTMLFILE-REC.
569	MOVE SPACES TO HTML-ADDR-LN.
570	STRING '<p>' DELIMITED BY '*'
571	ST-ADD1 DELIMITED BY ' '
572	' ' DELIMITED BY SIZE
573	'</p>' DELIMITED BY '*'
574	INTO HTML-ADDR-LN
575	END-STRING.
576	WRITE FD-HTMLFILE-REC FROM HTML-ADDR-LN.
577	MOVE SPACES TO HTML-ADDR-LN.
578	STRING '<p>' DELIMITED BY '*'
579	ST-ADD2 DELIMITED BY ' '
580	' ' DELIMITED BY SIZE
581	'</p>' DELIMITED BY '*'
582	INTO HTML-ADDR-LN
583	END-STRING.
584	WRITE FD-HTMLFILE-REC FROM HTML-ADDR-LN.
585	MOVE SPACES TO HTML-ADDR-LN.
586	STRING '<p>' DELIMITED BY '*'
587	ST-ADD3 DELIMITED BY ' '
588	' ' DELIMITED BY SIZE
589	'</p>' DELIMITED BY '*'
590	INTO HTML-ADDR-LN
591	END-STRING.
592	WRITE FD-HTMLFILE-REC FROM HTML-ADDR-LN.
593
594	SET HTML-LTDE TO TRUE.
595	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
596	SET HTML-LTRE TO TRUE.
597	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
598	SET HTML-LTRS TO TRUE.
599	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
600	SET HTML-L30-42 TO TRUE.
601	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
602	SET HTML-L31 TO TRUE.
603	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
604	SET HTML-LTDE TO TRUE.
605	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
606	SET HTML-LTRE TO TRUE.
607	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
608	SET HTML-LTRS TO TRUE.
609	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
610	SET HTML-L22-35 TO TRUE.
611	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
612
613	MOVE SPACES TO HTML-BSIC-LN.
614	STRING '<p>Account ID : ' DELIMITED BY '*'
615	ST-ACCT-ID DELIMITED BY '*'
616	'</p>' DELIMITED BY '*'
617	INTO HTML-BSIC-LN
618	END-STRING.
619	WRITE FD-HTMLFILE-REC FROM HTML-BSIC-LN.
620	MOVE SPACES TO HTML-BSIC-LN.
621	STRING '<p>Current Balance : ' DELIMITED BY '*'
622	ST-CURR-BAL DELIMITED BY '*'
623	'</p>' DELIMITED BY '*'
624	INTO HTML-BSIC-LN
625	END-STRING.
626	WRITE FD-HTMLFILE-REC FROM HTML-BSIC-LN.
627	MOVE SPACES TO HTML-BSIC-LN.
628	STRING '<p>FICO Score : ' DELIMITED BY '*'
629	ST-FICO-SCORE DELIMITED BY '*'
630	'</p>' DELIMITED BY '*'
631	INTO HTML-BSIC-LN
632	END-STRING.
633	WRITE FD-HTMLFILE-REC FROM HTML-BSIC-LN.
634	SET HTML-LTDE TO TRUE.
635	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
636	SET HTML-LTRE TO TRUE.
637	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
638	SET HTML-LTRS TO TRUE.
639	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
640	SET HTML-L30-42 TO TRUE.
641	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
642	SET HTML-L43 TO TRUE.
643	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
644	SET HTML-LTDE TO TRUE.
645	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
646	SET HTML-LTRE TO TRUE.
647	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
648	SET HTML-LTRS TO TRUE.
649	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
650	SET HTML-L47 TO TRUE.
651	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
652	SET HTML-L48 TO TRUE.
653	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
654	SET HTML-LTDE TO TRUE.
655	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
656	SET HTML-L50 TO TRUE.
657	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
658	SET HTML-L51 TO TRUE.
659	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
660	SET HTML-LTDE TO TRUE.
661	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
662	SET HTML-L53 TO TRUE.
663	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
664	SET HTML-L54 TO TRUE.
665	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
666	SET HTML-LTDE TO TRUE.
667	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
668	SET HTML-LTRE TO TRUE.
669	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
670
671	5200-EXIT.
672	EXIT.
673
674	---------------------------------------------------------------
675	6000-WRITE-TRANS.
676	MOVE TRNX-ID TO ST-TRANID.
677	MOVE TRNX-DESC TO ST-TRANDT.
678	MOVE TRNX-AMT TO ST-TRANAMT.
679	WRITE FD-STMTFILE-REC FROM ST-LINE14.
680
681	SET HTML-LTRS TO TRUE.
682	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
683
684	SET HTML-L58 TO TRUE.
685	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
686	MOVE SPACES TO HTML-TRAN-LN.
687	STRING '<p>' DELIMITED BY '*'
688	ST-TRANID DELIMITED BY '*'
689	'</p>' DELIMITED BY '*'
690	INTO HTML-TRAN-LN
691	END-STRING.
692	WRITE FD-HTMLFILE-REC FROM HTML-TRAN-LN.
693	SET HTML-LTDE TO TRUE.
694	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
695
696	SET HTML-L61 TO TRUE.
697	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
698	MOVE SPACES TO HTML-TRAN-LN.
699	STRING '<p>' DELIMITED BY '*'
700	ST-TRANDT DELIMITED BY '*'
701	'</p>' DELIMITED BY '*'
702	INTO HTML-TRAN-LN
703	END-STRING.
704	WRITE FD-HTMLFILE-REC FROM HTML-TRAN-LN.
705	SET HTML-LTDE TO TRUE.
706	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
707
708	SET HTML-L64 TO TRUE.
709	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
710	MOVE SPACES TO HTML-TRAN-LN.
711	STRING '<p>' DELIMITED BY '*'
712	ST-TRANAMT DELIMITED BY '*'
713	'</p>' DELIMITED BY '*'
714	INTO HTML-TRAN-LN
715	END-STRING.
716	WRITE FD-HTMLFILE-REC FROM HTML-TRAN-LN.
717	SET HTML-LTDE TO TRUE.
718	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
719
720	SET HTML-LTRE TO TRUE.
721	WRITE FD-HTMLFILE-REC FROM HTML-FIXED-LN.
722
723	EXIT.
724
725	---------------------------------------------------------------
726	8100-FILE-OPEN.
727	GO TO 8100-TRNXFILE-OPEN
728	.
729
730	8100-TRNXFILE-OPEN.
731	MOVE 'TRNXFILE' TO WS-M03B-DD.
732	SET M03B-OPEN TO TRUE.
733	MOVE ZERO TO WS-M03B-RC.
734	CALL 'CBSTM03B' USING WS-M03B-AREA.
735
736	IF WS-M03B-RC = '00' OR '04'
737	CONTINUE
738	ELSE
739	DISPLAY 'ERROR OPENING TRNXFILE'
740	DISPLAY 'RETURN CODE: ' WS-M03B-RC
741	PERFORM 9999-ABEND-PROGRAM
742	END-IF.
743
744	SET M03B-READ TO TRUE.
745	MOVE SPACES TO WS-M03B-FLDT.
746	CALL 'CBSTM03B' USING WS-M03B-AREA.
747
748	IF WS-M03B-RC = '00' OR '04'
749	CONTINUE
750	ELSE
751	DISPLAY 'ERROR READING TRNXFILE'
752	DISPLAY 'RETURN CODE: ' WS-M03B-RC
753	PERFORM 9999-ABEND-PROGRAM
754	END-IF.
755
756	MOVE WS-M03B-FLDT TO TRNX-RECORD.
757	MOVE TRNX-CARD-NUM TO WS-SAVE-CARD.
758	MOVE 1 TO CR-CNT.
759	MOVE 0 TO TR-CNT.
760	MOVE 'READTRNX' TO WS-FL-DD.
761	GO TO 0000-START.
762	EXIT.
763
764	---------------------------------------------------------------
765	8200-XREFFILE-OPEN.
766	MOVE 'XREFFILE' TO WS-M03B-DD.
767	SET M03B-OPEN TO TRUE.
768	MOVE ZERO TO WS-M03B-RC.
769	CALL 'CBSTM03B' USING WS-M03B-AREA.
770
771	IF WS-M03B-RC = '00' OR '04'
772	CONTINUE
773	ELSE
774	DISPLAY 'ERROR OPENING XREFFILE'
775	DISPLAY 'RETURN CODE: ' WS-M03B-RC
776	PERFORM 9999-ABEND-PROGRAM
777	END-IF.
778
779	MOVE 'CUSTFILE' TO WS-FL-DD.
780	GO TO 0000-START.
781	EXIT.
782	---------------------------------------------------------------
783	8300-CUSTFILE-OPEN.
784	MOVE 'CUSTFILE' TO WS-M03B-DD.
785	SET M03B-OPEN TO TRUE.
786	MOVE ZERO TO WS-M03B-RC.
787	CALL 'CBSTM03B' USING WS-M03B-AREA.
788
789	IF WS-M03B-RC = '00' OR '04'
790	CONTINUE
791	ELSE
792	DISPLAY 'ERROR OPENING CUSTFILE'
793	DISPLAY 'RETURN CODE: ' WS-M03B-RC
794	PERFORM 9999-ABEND-PROGRAM
795	END-IF.
796
797	MOVE 'ACCTFILE' TO WS-FL-DD.
798	GO TO 0000-START.
799	EXIT.
800	---------------------------------------------------------------
801	8400-ACCTFILE-OPEN.
802	MOVE 'ACCTFILE' TO WS-M03B-DD.
803	SET M03B-OPEN TO TRUE.
804	MOVE ZERO TO WS-M03B-RC.
805	CALL 'CBSTM03B' USING WS-M03B-AREA.
806
807	IF WS-M03B-RC = '00' OR '04'
808	CONTINUE
809	ELSE
810	DISPLAY 'ERROR OPENING ACCTFILE'
811	DISPLAY 'RETURN CODE: ' WS-M03B-RC
812	PERFORM 9999-ABEND-PROGRAM
813	END-IF.
814
815	GO TO 1000-MAINLINE.
816	EXIT.
817	---------------------------------------------------------------
818	8500-READTRNX-READ.
819	IF WS-SAVE-CARD = TRNX-CARD-NUM
820	ADD 1 TO TR-CNT
821	ELSE
822	MOVE TR-CNT TO WS-TRCT (CR-CNT)
823	ADD 1 TO CR-CNT
824	MOVE 1 TO TR-CNT
825	END-IF.
826
827	MOVE TRNX-CARD-NUM TO WS-CARD-NUM (CR-CNT).
828	MOVE TRNX-ID TO WS-TRAN-NUM (CR-CNT, TR-CNT).
829	MOVE TRNX-REST TO WS-TRAN-REST (CR-CNT, TR-CNT).
830	MOVE TRNX-CARD-NUM TO WS-SAVE-CARD.
831
832	MOVE 'TRNXFILE' TO WS-M03B-DD.
833	SET M03B-READ TO TRUE.
834	MOVE SPACES TO WS-M03B-FLDT.
835	CALL 'CBSTM03B' USING WS-M03B-AREA.
836
837	EVALUATE WS-M03B-RC
838	WHEN '00'
839	MOVE WS-M03B-FLDT TO TRNX-RECORD
840	GO TO 8500-READTRNX-READ
841	WHEN '10'
842	GO TO 8599-EXIT
843	WHEN OTHER
844	DISPLAY 'ERROR READING TRNXFILE'
845	DISPLAY 'RETURN CODE: ' WS-M03B-RC
846	PERFORM 9999-ABEND-PROGRAM
847	END-EVALUATE.
848
849	8599-EXIT.
850	MOVE TR-CNT TO WS-TRCT (CR-CNT).
851	MOVE 'XREFFILE' TO WS-FL-DD.
852	GO TO 0000-START.
853	EXIT.
854
855	---------------------------------------------------------------
856	9100-TRNXFILE-CLOSE.
857	MOVE 'TRNXFILE' TO WS-M03B-DD.
858	SET M03B-CLOSE TO TRUE.
859	MOVE ZERO TO WS-M03B-RC.
860	CALL 'CBSTM03B' USING WS-M03B-AREA.
861
862	IF WS-M03B-RC = '00' OR '04'
863	CONTINUE
864	ELSE
865	DISPLAY 'ERROR CLOSING TRNXFILE'
866	DISPLAY 'RETURN CODE: ' WS-M03B-RC
867	PERFORM 9999-ABEND-PROGRAM
868	END-IF.
869
870	EXIT.
871
872	---------------------------------------------------------------
873	9200-XREFFILE-CLOSE.
874	MOVE 'XREFFILE' TO WS-M03B-DD.
875	SET M03B-CLOSE TO TRUE.
876	MOVE ZERO TO WS-M03B-RC.
877	CALL 'CBSTM03B' USING WS-M03B-AREA.
878
879	IF WS-M03B-RC = '00' OR '04'
880	CONTINUE
881	ELSE
882	DISPLAY 'ERROR CLOSING XREFFILE'
883	DISPLAY 'RETURN CODE: ' WS-M03B-RC
884	PERFORM 9999-ABEND-PROGRAM
885	END-IF.
886
887	EXIT.
888	---------------------------------------------------------------
889	9300-CUSTFILE-CLOSE.
890	MOVE 'CUSTFILE' TO WS-M03B-DD.
891	SET M03B-CLOSE TO TRUE.
892	MOVE ZERO TO WS-M03B-RC.
893	CALL 'CBSTM03B' USING WS-M03B-AREA.
894
895	IF WS-M03B-RC = '00' OR '04'
896	CONTINUE
897	ELSE
898	DISPLAY 'ERROR CLOSING CUSTFILE'
899	DISPLAY 'RETURN CODE: ' WS-M03B-RC
900	PERFORM 9999-ABEND-PROGRAM
901	END-IF.
902
903	EXIT.
904	---------------------------------------------------------------
905	9400-ACCTFILE-CLOSE.
906	MOVE 'ACCTFILE' TO WS-M03B-DD.
907	SET M03B-CLOSE TO TRUE.
908	MOVE ZERO TO WS-M03B-RC.
909	CALL 'CBSTM03B' USING WS-M03B-AREA.
910
911	IF WS-M03B-RC = '00' OR '04'
912	CONTINUE
913	ELSE
914	DISPLAY 'ERROR CLOSING ACCTFILE'
915	DISPLAY 'RETURN CODE: ' WS-M03B-RC
916	PERFORM 9999-ABEND-PROGRAM
917	END-IF.
918
919	EXIT.
920
921	9999-ABEND-PROGRAM.
922	DISPLAY 'ABENDING PROGRAM'
923	CALL 'CEE3ABD'.
924