Skip to content

Commit 4682a66

Browse files
zeiburazeibura
authored
Merge branch 'master' into cobol-challenges
2 parents 27613df + fe0b682 commit 4682a66

File tree

3 files changed

+402
-0
lines changed

3 files changed

+402
-0
lines changed

‎COBOL Programming Course #2 - Advanced Topics/Challenges/Debugging/cbl/CBL0106.cbl‎

Lines changed: 192 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,192 @@
1+
*-----------------------
2+
IDENTIFICATION DIVISION.
3+
*-----------------------
4+
PROGRAM-ID. CBL0106
5+
AUTHOR. Otto B. Boolean.
6+
*--------------------
7+
ENVIRONMENT DIVISION.
8+
*--------------------
9+
INPUT-OUTPUT SECTION.
10+
FILE-CONTROL.
11+
SELECT PRINT-LINE ASSIGN TO PRTLINE.
12+
SELECT ACCT-REC ASSIGN TO ACCTREC.
13+
*-------------
14+
DATA DIVISION.
15+
*-------------
16+
FILE SECTION.
17+
FD PRINT-LINE RECORDING MODE F.
18+
01 PRINT-REC.
19+
05 ACCT-NO-O PIC X(8).
20+
05 FILLER PIC X(02) VALUE SPACES.
21+
05 LAST-NAME-O PIC X(20).
22+
05 FILLER PIC X(02) VALUE SPACES.
23+
05 ACCT-LIMIT-O PIC $$,$$$,$$9.99.
24+
05 FILLER PIC X(02) VALUE SPACES.
25+
05 ACCT-BALANCE-O PIC $$,$$$,$$9.99.
26+
05 FILLER PIC X(02) VALUE SPACES.
27+
*
28+
FD ACCT-REC RECORDING MODE F.
29+
01 ACCT-FIELDS.
30+
05 ACCT-NO PIC X(8).
31+
05 ACCT-LIMIT PIC S9(7)V99 COMP-3.
32+
05 ACCT-BALANCE PIC S9(7)V99 COMP-3.
33+
05 LAST-NAME PIC X(20).
34+
05 FIRST-NAME PIC X(15).
35+
05 CLIENT-ADDR.
36+
10 STREET-ADDR PIC X(25).
37+
10 CITY-COUNTY PIC X(20).
38+
10 USA-STATE PIC X(15).
39+
05 RESERVED PIC X(7).
40+
05 COMMENTS PIC X(50).
41+
*
42+
WORKING-STORAGE SECTION.
43+
01 Filler.
44+
05 LASTREC PIC X VALUE SPACE.
45+
05 DISP-SUB1 PIC 9999.
46+
05 SUB1 PIC 99.
47+
48+
01 OVERLIMIT.
49+
03 FILLER OCCURS 5 TIMES.
50+
05 OL-ACCT-NO PIC X(8).
51+
05 OL-ACCT-LIMIT PIC S9(7)V99 COMP-3.
52+
05 OL-ACCT-BALANCE PIC S9(7)V99 COMP-3.
53+
05 OL-LASTNAME PIC X(20).
54+
05 OL-FIRSTNAME PIC X(15).
55+
56+
57+
*
58+
01 CLIENTS-PER-STATE.
59+
05 FILLER PIC X(19) VALUE
60+
'Virginia Clients = '.
61+
05 VIRGINIA-CLIENTS PIC 9(3) VALUE ZERO.
62+
05 FILLER PIC X(59) VALUE SPACES.
63+
64+
01 OVERLIMIT-STATUS.
65+
05 OLS-STATUS PIC X(30) VALUE
66+
'No Accounts Overlimit '.
67+
05 OLS-ACCTNUM PIC XXXX VALUE SPACES.
68+
05 FILLER PIC X(45) VALUE SPACES.
69+
70+
*
71+
01 HEADER-1.
72+
05 FILLER PIC X(20) VALUE 'Financial Report for'.
73+
05 FILLER PIC X(60) VALUE SPACES.
74+
*
75+
01 HEADER-2.
76+
05 FILLER PIC X(05) VALUE 'Year '.
77+
05 HDR-YR PIC 9(04).
78+
05 FILLER PIC X(02) VALUE SPACES.
79+
05 FILLER PIC X(06) VALUE 'Month '.
80+
05 HDR-MO PIC X(02).
81+
05 FILLER PIC X(02) VALUE SPACES.
82+
05 FILLER PIC X(04) VALUE 'Day '.
83+
05 HDR-DAY PIC X(02).
84+
05 FILLER PIC X(56) VALUE SPACES.
85+
*
86+
01 HEADER-3.
87+
05 FILLER PIC X(08) VALUE 'Account '.
88+
05 FILLER PIC X(02) VALUE SPACES.
89+
05 FILLER PIC X(10) VALUE 'Last Name '.
90+
05 FILLER PIC X(15) VALUE SPACES.
91+
05 FILLER PIC X(06) VALUE 'Limit '.
92+
05 FILLER PIC X(06) VALUE SPACES.
93+
05 FILLER PIC X(08) VALUE 'Balance '.
94+
05 FILLER PIC X(40) VALUE SPACES.
95+
*
96+
01 HEADER-4.
97+
05 FILLER PIC X(08) VALUE '--------'.
98+
05 FILLER PIC X(02) VALUE SPACES.
99+
05 FILLER PIC X(10) VALUE '----------'.
100+
05 FILLER PIC X(15) VALUE SPACES.
101+
05 FILLER PIC X(10) VALUE '----------'.
102+
05 FILLER PIC X(02) VALUE SPACES.
103+
05 FILLER PIC X(13) VALUE '-------------'.
104+
05 FILLER PIC X(40) VALUE SPACES.
105+
*
106+
01 WS-CURRENT-DATE-DATA.
107+
05 WS-CURRENT-DATE.
108+
10 WS-CURRENT-YEAR PIC 9(04).
109+
10 WS-CURRENT-MONTH PIC 9(02).
110+
10 WS-CURRENT-DAY PIC 9(02).
111+
05 WS-CURRENT-TIME.
112+
10 WS-CURRENT-HOURS PIC 9(02).
113+
10 WS-CURRENT-MINUTE PIC 9(02).
114+
10 WS-CURRENT-SECOND PIC 9(02).
115+
10 WS-CURRENT-MILLISECONDS PIC 9(02).
116+
*
117+
*------------------
118+
PROCEDURE DIVISION.
119+
*------------------
120+
OPEN-FILES.
121+
OPEN INPUT ACCT-REC.
122+
OPEN OUTPUT PRINT-LINE.
123+
*
124+
WRITE-HEADERS.
125+
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-DATA.
126+
MOVE WS-CURRENT-YEAR TO HDR-YR.
127+
MOVE WS-CURRENT-MONTH TO HDR-MO.
128+
MOVE WS-CURRENT-DAY TO HDR-DAY.
129+
WRITE PRINT-REC FROM HEADER-1.
130+
WRITE PRINT-REC FROM HEADER-2.
131+
MOVE SPACES TO PRINT-REC.
132+
WRITE PRINT-REC AFTER ADVANCING 1 LINES.
133+
WRITE PRINT-REC FROM HEADER-3.
134+
WRITE PRINT-REC FROM HEADER-4.
135+
MOVE SPACES TO PRINT-REC.
136+
MOVE 1 TO SUB1.
137+
*
138+
READ-NEXT-RECORD.
139+
PERFORM READ-RECORD
140+
PERFORM UNTIL LASTREC = 'Y'
141+
PERFORM IS-STATE-VIRGINIA
142+
PERFORM IS-OVERLIMIT
143+
PERFORM WRITE-RECORD
144+
PERFORM READ-RECORD
145+
END-PERFORM
146+
.
147+
*
148+
CLOSE-STOP.
149+
WRITE PRINT-REC FROM CLIENTS-PER-STATE.
150+
PERFORM WRITE-OVERLIMIT.
151+
CLOSE ACCT-REC.
152+
CLOSE PRINT-LINE.
153+
STOP RUN.
154+
*
155+
READ-RECORD.
156+
READ ACCT-REC
157+
AT END MOVE 'Y' TO LASTREC
158+
END-READ.
159+
*
160+
IS-OVERLIMIT.
161+
IF ACCT-LIMIT < ACCT-BALANCE THEN
162+
MOVE ACCT-LIMIT TO OL-ACCT-LIMIT(SUB1)
163+
MOVE ACCT-BALANCE TO OL-ACCT-BALANCE(SUB1)
164+
MOVE LAST-NAME TO OL-LASTNAME(SUB1)
165+
MOVE FIRST-NAME TO OL-FIRSTNAME(SUB1)
166+
END-IF.
167+
ADD 1 TO SUB1.
168+
169+
IS-STATE-VIRGINIA.
170+
IF USA-STATE = 'Virginia' THEN
171+
ADD 1 TO VIRGINIA-CLIENTS
172+
END-IF.
173+
*
174+
WRITE-OVERLIMIT.
175+
IF SUB1 = 1 THEN
176+
MOVE OVERLIMIT-STATUS TO PRINT-REC
177+
WRITE PRINT-REC
178+
ELSE
179+
MOVE 'ACCOUNTS OVERLIMIT' TO OLS-STATUS
180+
MOVE SUB1 TO DISP-SUB1
181+
MOVE DISP-SUB1 TO OLS-ACCTNUM
182+
MOVE OVERLIMIT-STATUS TO PRINT-REC
183+
WRITE PRINT-REC
184+
END-IF.
185+
*
186+
WRITE-RECORD.
187+
MOVE ACCT-NO TO ACCT-NO-O.
188+
MOVE ACCT-LIMIT TO ACCT-LIMIT-O.
189+
MOVE ACCT-BALANCE TO ACCT-BALANCE-O.
190+
MOVE LAST-NAME TO LAST-NAME-O.
191+
WRITE PRINT-REC.
192+
*

‎COBOL Programming Course #2 - Advanced Topics/Challenges/Debugging/cbl/CBL0106C.cbl‎

Lines changed: 192 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,192 @@
1+
*-----------------------
2+
IDENTIFICATION DIVISION.
3+
*-----------------------
4+
PROGRAM-ID. CBL0106C
5+
AUTHOR. Otto B. Boolean.
6+
*--------------------
7+
ENVIRONMENT DIVISION.
8+
*--------------------
9+
INPUT-OUTPUT SECTION.
10+
FILE-CONTROL.
11+
SELECT PRINT-LINE ASSIGN TO PRTLINE.
12+
SELECT ACCT-REC ASSIGN TO ACCTREC.
13+
*-------------
14+
DATA DIVISION.
15+
*-------------
16+
FILE SECTION.
17+
FD PRINT-LINE RECORDING MODE F.
18+
01 PRINT-REC.
19+
05 ACCT-NO-O PIC X(8).
20+
05 FILLER PIC X(02) VALUE SPACES.
21+
05 LAST-NAME-O PIC X(20).
22+
05 FILLER PIC X(02) VALUE SPACES.
23+
05 ACCT-LIMIT-O PIC $$,$$$,$$9.99.
24+
05 FILLER PIC X(02) VALUE SPACES.
25+
05 ACCT-BALANCE-O PIC $$,$$$,$$9.99.
26+
05 FILLER PIC X(02) VALUE SPACES.
27+
*
28+
FD ACCT-REC RECORDING MODE F.
29+
01 ACCT-FIELDS.
30+
05 ACCT-NO PIC X(8).
31+
05 ACCT-LIMIT PIC S9(7)V99 COMP-3.
32+
05 ACCT-BALANCE PIC S9(7)V99 COMP-3.
33+
05 LAST-NAME PIC X(20).
34+
05 FIRST-NAME PIC X(15).
35+
05 CLIENT-ADDR.
36+
10 STREET-ADDR PIC X(25).
37+
10 CITY-COUNTY PIC X(20).
38+
10 USA-STATE PIC X(15).
39+
05 RESERVED PIC X(7).
40+
05 COMMENTS PIC X(50).
41+
*
42+
WORKING-STORAGE SECTION.
43+
01 Filler.
44+
05 LASTREC PIC X VALUE SPACE.
45+
05 DISP-SUB1 PIC 9999.
46+
05 SUB1 PIC 99.
47+
48+
01 OVERLIMIT.
49+
03 FILLER OCCURS 20 TIMES.
50+
05 OL-ACCT-NO PIC X(8).
51+
05 OL-ACCT-LIMIT PIC S9(7)V99 COMP-3.
52+
05 OL-ACCT-BALANCE PIC S9(7)V99 COMP-3.
53+
05 OL-LASTNAME PIC X(20).
54+
05 OL-FIRSTNAME PIC X(15).
55+
56+
57+
*
58+
01 CLIENTS-PER-STATE.
59+
05 FILLER PIC X(19) VALUE
60+
'Virginia Clients = '.
61+
05 VIRGINIA-CLIENTS PIC 9(3) VALUE ZERO.
62+
05 FILLER PIC X(59) VALUE SPACES.
63+
64+
01 OVERLIMIT-STATUS.
65+
05 OLS-STATUS PIC X(30) VALUE
66+
'No Accounts Overlimit '.
67+
05 OLS-ACCTNUM PIC XXXX VALUE SPACES.
68+
05 FILLER PIC X(45) VALUE SPACES.
69+
70+
*
71+
01 HEADER-1.
72+
05 FILLER PIC X(20) VALUE 'Financial Report for'.
73+
05 FILLER PIC X(60) VALUE SPACES.
74+
*
75+
01 HEADER-2.
76+
05 FILLER PIC X(05) VALUE 'Year '.
77+
05 HDR-YR PIC 9(04).
78+
05 FILLER PIC X(02) VALUE SPACES.
79+
05 FILLER PIC X(06) VALUE 'Month '.
80+
05 HDR-MO PIC X(02).
81+
05 FILLER PIC X(02) VALUE SPACES.
82+
05 FILLER PIC X(04) VALUE 'Day '.
83+
05 HDR-DAY PIC X(02).
84+
05 FILLER PIC X(56) VALUE SPACES.
85+
*
86+
01 HEADER-3.
87+
05 FILLER PIC X(08) VALUE 'Account '.
88+
05 FILLER PIC X(02) VALUE SPACES.
89+
05 FILLER PIC X(10) VALUE 'Last Name '.
90+
05 FILLER PIC X(15) VALUE SPACES.
91+
05 FILLER PIC X(06) VALUE 'Limit '.
92+
05 FILLER PIC X(06) VALUE SPACES.
93+
05 FILLER PIC X(08) VALUE 'Balance '.
94+
05 FILLER PIC X(40) VALUE SPACES.
95+
*
96+
01 HEADER-4.
97+
05 FILLER PIC X(08) VALUE '--------'.
98+
05 FILLER PIC X(02) VALUE SPACES.
99+
05 FILLER PIC X(10) VALUE '----------'.
100+
05 FILLER PIC X(15) VALUE SPACES.
101+
05 FILLER PIC X(10) VALUE '----------'.
102+
05 FILLER PIC X(02) VALUE SPACES.
103+
05 FILLER PIC X(13) VALUE '-------------'.
104+
05 FILLER PIC X(40) VALUE SPACES.
105+
*
106+
01 WS-CURRENT-DATE-DATA.
107+
05 WS-CURRENT-DATE.
108+
10 WS-CURRENT-YEAR PIC 9(04).
109+
10 WS-CURRENT-MONTH PIC 9(02).
110+
10 WS-CURRENT-DAY PIC 9(02).
111+
05 WS-CURRENT-TIME.
112+
10 WS-CURRENT-HOURS PIC 9(02).
113+
10 WS-CURRENT-MINUTE PIC 9(02).
114+
10 WS-CURRENT-SECOND PIC 9(02).
115+
10 WS-CURRENT-MILLISECONDS PIC 9(02).
116+
*
117+
*------------------
118+
PROCEDURE DIVISION.
119+
*------------------
120+
OPEN-FILES.
121+
OPEN INPUT ACCT-REC.
122+
OPEN OUTPUT PRINT-LINE.
123+
*
124+
WRITE-HEADERS.
125+
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-DATA.
126+
MOVE WS-CURRENT-YEAR TO HDR-YR.
127+
MOVE WS-CURRENT-MONTH TO HDR-MO.
128+
MOVE WS-CURRENT-DAY TO HDR-DAY.
129+
WRITE PRINT-REC FROM HEADER-1.
130+
WRITE PRINT-REC FROM HEADER-2.
131+
MOVE SPACES TO PRINT-REC.
132+
WRITE PRINT-REC AFTER ADVANCING 1 LINES.
133+
WRITE PRINT-REC FROM HEADER-3.
134+
WRITE PRINT-REC FROM HEADER-4.
135+
MOVE SPACES TO PRINT-REC.
136+
MOVE 1 TO SUB1.
137+
*
138+
READ-NEXT-RECORD.
139+
PERFORM READ-RECORD
140+
PERFORM UNTIL LASTREC = 'Y'
141+
PERFORM IS-STATE-VIRGINIA
142+
PERFORM IS-OVERLIMIT
143+
PERFORM WRITE-RECORD
144+
PERFORM READ-RECORD
145+
END-PERFORM
146+
.
147+
*
148+
CLOSE-STOP.
149+
WRITE PRINT-REC FROM CLIENTS-PER-STATE.
150+
PERFORM WRITE-OVERLIMIT.
151+
CLOSE ACCT-REC.
152+
CLOSE PRINT-LINE.
153+
STOP RUN.
154+
*
155+
READ-RECORD.
156+
READ ACCT-REC
157+
AT END MOVE 'Y' TO LASTREC
158+
END-READ.
159+
*
160+
IS-OVERLIMIT.
161+
IF ACCT-LIMIT < ACCT-BALANCE THEN
162+
MOVE ACCT-LIMIT TO OL-ACCT-LIMIT(SUB1)
163+
MOVE ACCT-BALANCE TO OL-ACCT-BALANCE(SUB1)
164+
MOVE LAST-NAME TO OL-LASTNAME(SUB1)
165+
MOVE FIRST-NAME TO OL-FIRSTNAME(SUB1)
166+
ADD 1 TO SUB1
167+
END-IF.
168+
*
169+
IS-STATE-VIRGINIA.
170+
IF USA-STATE = 'Virginia' THEN
171+
ADD 1 TO VIRGINIA-CLIENTS
172+
END-IF.
173+
*
174+
WRITE-OVERLIMIT.
175+
IF SUB1 = 1 THEN
176+
MOVE OVERLIMIT-STATUS TO PRINT-REC
177+
WRITE PRINT-REC
178+
ELSE
179+
MOVE 'ACCOUNTS OVERLIMIT' TO OLS-STATUS
180+
MOVE SUB1 TO DISP-SUB1
181+
MOVE DISP-SUB1 TO OLS-ACCTNUM
182+
MOVE OVERLIMIT-STATUS TO PRINT-REC
183+
WRITE PRINT-REC
184+
END-IF.
185+
*
186+
WRITE-RECORD.
187+
MOVE ACCT-NO TO ACCT-NO-O.
188+
MOVE ACCT-LIMIT TO ACCT-LIMIT-O.
189+
MOVE ACCT-BALANCE TO ACCT-BALANCE-O.
190+
MOVE LAST-NAME TO LAST-NAME-O.
191+
WRITE PRINT-REC.
192+
*

0 commit comments

Comments
 (0)