-
Notifications
You must be signed in to change notification settings - Fork 65
/
Copy pathCBACT02C.cbl
178 lines (163 loc) · 13.8 KB
/
CBACT02C.cbl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
******************************************************************
* Program : CBACT02C.CBL
* Application : CardDemo
* Type : BATCH COBOL Program
* Function : Read and print card data file.
******************************************************************
* Copyright Amazon.com, Inc. or its affiliates.
* All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License").
* You may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
* either express or implied. See the License for the specific
* language governing permissions and limitations under the License
******************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CBACT02C.
AUTHOR. AWS.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CARDFILE-FILE ASSIGN TO CARDFILE
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS FD-CARD-NUM
FILE STATUS IS CARDFILE-STATUS.
*
DATA DIVISION.
FILE SECTION.
FD CARDFILE-FILE.
01 FD-CARDFILE-REC.
05 FD-CARD-NUM PIC X(16).
05 FD-CARD-DATA PIC X(134).
WORKING-STORAGE SECTION.
*****************************************************************
COPY CVACT02Y.
01 CARDFILE-STATUS.
05 CARDFILE-STAT1 PIC X.
05 CARDFILE-STAT2 PIC X.
01 IO-STATUS.
05 IO-STAT1 PIC X.
05 IO-STAT2 PIC X.
01 TWO-BYTES-BINARY PIC 9(4) BINARY.
01 TWO-BYTES-ALPHA REDEFINES TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT PIC X.
05 TWO-BYTES-RIGHT PIC X.
01 IO-STATUS-04.
05 IO-STATUS-0401 PIC 9 VALUE 0.
05 IO-STATUS-0403 PIC 999 VALUE 0.
01 APPL-RESULT PIC S9(9) COMP.
88 APPL-AOK VALUE 0.
88 APPL-EOF VALUE 16.
01 END-OF-FILE PIC X(01) VALUE 'N'.
01 ABCODE PIC S9(9) BINARY.
01 TIMING PIC S9(9) BINARY.
*****************************************************************
PROCEDURE DIVISION.
DISPLAY 'START OF EXECUTION OF PROGRAM CBACT02C'.
PERFORM 0000-CARDFILE-OPEN.
PERFORM UNTIL END-OF-FILE = 'Y'
IF END-OF-FILE = 'N'
PERFORM 1000-CARDFILE-GET-NEXT
IF END-OF-FILE = 'N'
DISPLAY CARD-RECORD
END-IF
END-IF
END-PERFORM.
PERFORM 9000-CARDFILE-CLOSE.
DISPLAY 'END OF EXECUTION OF PROGRAM CBACT02C'.
GOBACK.
*****************************************************************
* I/O ROUTINES TO ACCESS A KSDS, VSAM DATA SET... *
*****************************************************************
1000-CARDFILE-GET-NEXT.
READ CARDFILE-FILE INTO CARD-RECORD.
IF CARDFILE-STATUS = '00'
MOVE 0 TO APPL-RESULT
* DISPLAY CARD-RECORD
ELSE
IF CARDFILE-STATUS = '10'
MOVE 16 TO APPL-RESULT
ELSE
MOVE 12 TO APPL-RESULT
END-IF
END-IF
IF APPL-AOK
CONTINUE
ELSE
IF APPL-EOF
MOVE 'Y' TO END-OF-FILE
ELSE
DISPLAY 'ERROR READING CARDFILE'
MOVE CARDFILE-STATUS TO IO-STATUS
PERFORM 9910-DISPLAY-IO-STATUS
PERFORM 9999-ABEND-PROGRAM
END-IF
END-IF
EXIT.
*---------------------------------------------------------------*
0000-CARDFILE-OPEN.
MOVE 8 TO APPL-RESULT.
OPEN INPUT CARDFILE-FILE
IF CARDFILE-STATUS = '00'
MOVE 0 TO APPL-RESULT
ELSE
MOVE 12 TO APPL-RESULT
END-IF
IF APPL-AOK
CONTINUE
ELSE
DISPLAY 'ERROR OPENING CARDFILE'
MOVE CARDFILE-STATUS TO IO-STATUS
PERFORM 9910-DISPLAY-IO-STATUS
PERFORM 9999-ABEND-PROGRAM
END-IF
EXIT.
*---------------------------------------------------------------*
9000-CARDFILE-CLOSE.
ADD 8 TO ZERO GIVING APPL-RESULT.
CLOSE CARDFILE-FILE
IF CARDFILE-STATUS = '00'
SUBTRACT APPL-RESULT FROM APPL-RESULT
ELSE
ADD 12 TO ZERO GIVING APPL-RESULT
END-IF
IF APPL-AOK
CONTINUE
ELSE
DISPLAY 'ERROR CLOSING CARDFILE'
MOVE CARDFILE-STATUS TO IO-STATUS
PERFORM 9910-DISPLAY-IO-STATUS
PERFORM 9999-ABEND-PROGRAM
END-IF
EXIT.
9999-ABEND-PROGRAM.
DISPLAY 'ABENDING PROGRAM'
MOVE 0 TO TIMING
MOVE 999 TO ABCODE
CALL 'CEE3ABD'.
*****************************************************************
9910-DISPLAY-IO-STATUS.
IF IO-STATUS NOT NUMERIC
OR IO-STAT1 = '9'
MOVE IO-STAT1 TO IO-STATUS-04(1:1)
MOVE 0 TO TWO-BYTES-BINARY
MOVE IO-STAT2 TO TWO-BYTES-RIGHT
MOVE TWO-BYTES-BINARY TO IO-STATUS-0403
DISPLAY 'FILE STATUS IS: NNNN' IO-STATUS-04
ELSE
MOVE '0000' TO IO-STATUS-04
MOVE IO-STATUS TO IO-STATUS-04(3:2)
DISPLAY 'FILE STATUS IS: NNNN' IO-STATUS-04
END-IF
EXIT.
*
* Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:31 CDT
*