MFmainframe-rea
WS carddemo · 26f629ef

cobol · 230 lines · sha256 ac004f7f40dcb3f2 · guides at columns 7 and 72app/cbl/CBSTM03B.CBL

1 IDENTIFICATION DIVISION.
2 PROGRAM-ID. CBSTM03B.
3 AUTHOR. AWS.
4 ******************************************************************
5 * Program : CBSTM03B.CBL
6 * Application : CardDemo
7 * Type : BATCH COBOL Subroutine
8 * Function : Does file processing related to Transact Report
9 ******************************************************************
10 * Copyright Amazon.com, Inc. or its affiliates.
11 * All Rights Reserved.
12 *
13 * Licensed under the Apache License, Version 2.0 (the "License").
14 * You may not use this file except in compliance with the License.
15 * You may obtain a copy of the License at
16 *
17 * http://www.apache.org/licenses/LICENSE-2.0
18 *
19 * Unless required by applicable law or agreed to in writing,
20 * software distributed under the License is distributed on an
21 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
22 * either express or implied. See the License for the specific
23 * language governing permissions and limitations under the License
24 ******************************************************************
25 * This program is to called by the statement create program
26 * It does file handling
27 ******************************************************************
28 ENVIRONMENT DIVISION.
29 INPUT-OUTPUT SECTION.
30 FILE-CONTROL.
31 SELECT TRNX-FILE ASSIGN TO TRNXFILE
32 ORGANIZATION IS INDEXED
33 ACCESS MODE IS SEQUENTIAL
34 RECORD KEY IS FD-TRNXS-ID
35 FILE STATUS IS TRNXFILE-STATUS.
36
37 SELECT XREF-FILE ASSIGN TO XREFFILE
38 ORGANIZATION IS INDEXED
39 ACCESS MODE IS SEQUENTIAL
40 RECORD KEY IS FD-XREF-CARD-NUM
41 FILE STATUS IS XREFFILE-STATUS.
42
43 SELECT CUST-FILE ASSIGN TO CUSTFILE
44 ORGANIZATION IS INDEXED
45 ACCESS MODE IS RANDOM
46 RECORD KEY IS FD-CUST-ID
47 FILE STATUS IS CUSTFILE-STATUS.
48
49 SELECT ACCT-FILE ASSIGN TO ACCTFILE
50 ORGANIZATION IS INDEXED
51 ACCESS MODE IS RANDOM
52 RECORD KEY IS FD-ACCT-ID
53 FILE STATUS IS ACCTFILE-STATUS.
54
55 *
56 DATA DIVISION.
57 FILE SECTION.
58 FD TRNX-FILE.
59 01 FD-TRNXFILE-REC.
60 05 FD-TRNXS-ID.
61 10 FD-TRNX-CARD PIC X(16).
62 10 FD-TRNX-ID PIC X(16).
63 05 FD-ACCT-DATA PIC X(318).
64
65 FD XREF-FILE.
66 01 FD-XREFFILE-REC.
67 05 FD-XREF-CARD-NUM PIC X(16).
68 05 FD-XREF-DATA PIC X(34).
69
70 FD CUST-FILE.
71 01 FD-CUSTFILE-REC.
72 05 FD-CUST-ID PIC X(09).
73 05 FD-CUST-DATA PIC X(491).
74
75 FD ACCT-FILE.
76 01 FD-ACCTFILE-REC.
77 05 FD-ACCT-ID PIC 9(11).
78 05 FD-ACCT-DATA PIC X(289).
79
80 WORKING-STORAGE SECTION.
81
82 *****************************************************************
83 01 TRNXFILE-STATUS.
84 05 TRNXFILE-STAT1 PIC X.
85 05 TRNXFILE-STAT2 PIC X.
86
87 01 XREFFILE-STATUS.
88 05 XREFFILE-STAT1 PIC X.
89 05 XREFFILE-STAT2 PIC X.
90
91 01 CUSTFILE-STATUS.
92 05 CUSTFILE-STAT1 PIC X.
93 05 CUSTFILE-STAT2 PIC X.
94
95 01 ACCTFILE-STATUS.
96 05 ACCTFILE-STAT1 PIC X.
97 05 ACCTFILE-STAT2 PIC X.
98
99 LINKAGE SECTION.
100 01 LK-M03B-AREA.
101 05 LK-M03B-DD PIC X(08).
102 05 LK-M03B-OPER PIC X(01).
103 88 M03B-OPEN VALUE 'O'.
104 88 M03B-CLOSE VALUE 'C'.
105 88 M03B-READ VALUE 'R'.
106 88 M03B-READ-K VALUE 'K'.
107 88 M03B-WRITE VALUE 'W'.
108 88 M03B-REWRITE VALUE 'Z'.
109 05 LK-M03B-RC PIC X(02).
110 05 LK-M03B-KEY PIC X(25).
111 05 LK-M03B-KEY-LN PIC S9(4).
112 05 LK-M03B-FLDT PIC X(1000).
113
114 PROCEDURE DIVISION USING LK-M03B-AREA.
115
116 0000-START.
117
118 EVALUATE LK-M03B-DD
119 WHEN 'TRNXFILE'
120 PERFORM 1000-TRNXFILE-PROC THRU 1999-EXIT
121 WHEN 'XREFFILE'
122 PERFORM 2000-XREFFILE-PROC THRU 2999-EXIT
123 WHEN 'CUSTFILE'
124 PERFORM 3000-CUSTFILE-PROC THRU 3999-EXIT
125 WHEN 'ACCTFILE'
126 PERFORM 4000-ACCTFILE-PROC THRU 4999-EXIT
127 WHEN OTHER
128 GO TO 9999-GOBACK.
129
130 9999-GOBACK.
131 GOBACK.
132
133 1000-TRNXFILE-PROC.
134
135 IF M03B-OPEN
136 OPEN INPUT TRNX-FILE
137 GO TO 1900-EXIT
138 END-IF.
139
140 IF M03B-READ
141 READ TRNX-FILE INTO LK-M03B-FLDT
142 END-READ
143 GO TO 1900-EXIT
144 END-IF.
145
146 IF M03B-CLOSE
147 CLOSE TRNX-FILE
148 GO TO 1900-EXIT
149 END-IF.
150
151 1900-EXIT.
152 MOVE TRNXFILE-STATUS TO LK-M03B-RC.
153
154 1999-EXIT.
155 EXIT.
156
157 2000-XREFFILE-PROC.
158
159 IF M03B-OPEN
160 OPEN INPUT XREF-FILE
161 GO TO 2900-EXIT
162 END-IF.
163
164 IF M03B-READ
165 READ XREF-FILE INTO LK-M03B-FLDT
166 END-READ
167 GO TO 2900-EXIT
168 END-IF.
169
170 IF M03B-CLOSE
171 CLOSE XREF-FILE
172 GO TO 2900-EXIT
173 END-IF.
174
175 2900-EXIT.
176 MOVE XREFFILE-STATUS TO LK-M03B-RC.
177
178 2999-EXIT.
179 EXIT.
180
181 3000-CUSTFILE-PROC.
182
183 IF M03B-OPEN
184 OPEN INPUT CUST-FILE
185 GO TO 3900-EXIT
186 END-IF.
187
188 IF M03B-READ-K
189 MOVE LK-M03B-KEY (1:LK-M03B-KEY-LN) TO FD-CUST-ID
190 READ CUST-FILE INTO LK-M03B-FLDT
191 END-READ
192 GO TO 3900-EXIT
193 END-IF.
194
195 IF M03B-CLOSE
196 CLOSE CUST-FILE
197 GO TO 3900-EXIT
198 END-IF.
199
200 3900-EXIT.
201 MOVE CUSTFILE-STATUS TO LK-M03B-RC.
202
203 3999-EXIT.
204 EXIT.
205
206 4000-ACCTFILE-PROC.
207
208 IF M03B-OPEN
209 OPEN INPUT ACCT-FILE
210 GO TO 4900-EXIT
211 END-IF.
212
213 IF M03B-READ-K
214 MOVE LK-M03B-KEY (1:LK-M03B-KEY-LN) TO FD-ACCT-ID
215 READ ACCT-FILE INTO LK-M03B-FLDT
216 END-READ
217 GO TO 4900-EXIT
218 END-IF.
219
220 IF M03B-CLOSE
221 CLOSE ACCT-FILE
222 GO TO 4900-EXIT
223 END-IF.
224
225 4900-EXIT.
226 MOVE ACCTFILE-STATUS TO LK-M03B-RC.
227
228 4999-EXIT.
229 EXIT.
230