Appendix G: Answers to Selected Exercises
Overview
This appendix provides solutions to selected exercises from thirteen chapters spanning the textbook. For each chapter, three to five exercises are solved with complete explanations and, where applicable, full COBOL source code. These solutions are intended as a learning aid -- attempt the exercises yourself before consulting the answers. Understanding why a solution works is more valuable than copying the code.
All solutions compile and run under GnuCOBOL 3.x in fixed-format mode unless otherwise noted. Minor adjustments may be needed for IBM Enterprise COBOL (primarily in compiler directives and file assignments).
Chapter 1: The World of COBOL
Exercise 1.2: Modify the Hello World Program
Problem: Modify the Hello World program from Section 1.5 to display your name, the current date (hardcoded), and the message "I am beginning my COBOL journey."
Solution:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXERCISE-1-2.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-STUDENT-NAME PIC X(30)
VALUE "Jane Smith".
01 WS-CURRENT-DATE PIC X(10)
VALUE "2025-09-15".
PROCEDURE DIVISION.
MAIN-PARA.
DISPLAY "Student: " WS-STUDENT-NAME.
DISPLAY "Date: " WS-CURRENT-DATE.
DISPLAY "I am beginning my COBOL journey."
STOP RUN.
Explanation: The program defines two WORKING-STORAGE items with VALUE clauses for initialization. The DISPLAY statement concatenates a literal string with a data item. Each DISPLAY produces one line of output.
Exercise 1.4: COBOL's Role in Commerce
Problem: List five industries where COBOL is heavily used and explain why COBOL's features make it suitable for each industry.
Solution:
-
Banking and Financial Services -- COBOL's exact decimal arithmetic (COMP-3) prevents the rounding errors that floating-point languages introduce, which is critical when computing interest, balances, and regulatory calculations across millions of accounts.
-
Insurance -- Insurance applications require complex rate calculations, actuarial computations, and policy administration with precise currency handling. COBOL's PICTURE clause and arithmetic verbs provide the deterministic precision that regulators require.
-
Government -- Government systems (tax processing, Social Security, veterans' benefits) process enormous volumes of records in batch and must operate reliably for decades. COBOL's stability, portability across standard revisions, and batch processing efficiency make it ideal.
-
Healthcare -- Claims processing, eligibility determination, and billing systems handle complex rule sets and large transaction volumes. COBOL's structured data definitions (level numbers, copybooks) model hierarchical healthcare records naturally.
-
Retail and Supply Chain -- Inventory management, point-of-sale transaction processing, and supply chain logistics involve high-volume batch processing and real-time transaction processing, both areas where COBOL and CICS excel.
Exercise 1.5: Timeline Exercise
Problem: Create a timeline listing each major COBOL standard (COBOL-60, COBOL-68, COBOL-74, COBOL-85, COBOL 2002, COBOL 2014) with two key features introduced in each.
Solution:
- COBOL-60 (1960): Four-division program structure; PICTURE clause for data definition
- COBOL-68 (1968): First ANSI standardization (X3.23-1968); inter-program communication (CALL)
- COBOL-74 (1974): INSPECT statement for string manipulation; improved file handling with FILE STATUS
- COBOL-85 (1985): Scope terminators (END-IF, END-PERFORM, etc.); inline PERFORM and EVALUATE statement
- COBOL 2002 (2002): Object-oriented programming (CLASS-ID, METHOD-ID); free-format source code
- COBOL 2014 (2014): JSON GENERATE/PARSE for native JSON processing; XML GENERATE/PARSE for native XML processing
Chapter 3: Data Types and the PICTURE Clause
Exercise 3.3: Define Appropriate PICTURE Clauses
Problem: Define PICTURE clauses and USAGE for the following business data items: (a) employee salary up to $999,999.99, (b) Social Security Number, (c) product quantity up to 99,999, (d) interest rate with seven decimal places, (e) customer name up to 40 characters.
Solution:
01 WS-EMPLOYEE-SALARY PIC S9(7)V99 USAGE COMP-3.
01 WS-SSN PIC 9(9) USAGE DISPLAY.
01 WS-PRODUCT-QTY PIC 9(5) USAGE COMP.
01 WS-INTEREST-RATE PIC V9(7) USAGE COMP-3.
01 WS-CUSTOMER-NAME PIC X(40).
Explanation: (a) Salary uses S9(7)V99 COMP-3: signed for potential credit adjustments, seven integer digits for values up to 9,999,999, two decimal places for cents, and packed decimal for exact arithmetic. (b) SSN is nine digits stored as DISPLAY because it is an identifier, not used in arithmetic. (c) Quantity uses COMP (binary) because it is an integer counter. (d) Interest rate uses V9(7) COMP-3 for exact decimal representation of rates like 0.0525000. (e) Customer name is alphanumeric.
Exercise 3.5: PICTURE Clause Editing
Problem: Write PICTURE clauses for display formatting of: (a) salary with dollar sign and commas, (b) SSN with hyphens, (c) a negative balance showing CR.
Solution:
01 WS-SALARY-DISP PIC $$$,$$$, MATH1 $,$$$,$$9.99CR.
Explanation: (a) The floating dollar sign ($$) moves to the position just before the first significant digit, providing clean output without leading zeros. (b) Hyphens are insertion characters placed at fixed positions. (c) CR appears after negative values; two spaces appear for positive values. ### Exercise 3.7: Storage Size Calculation **Problem**: Calculate the storage size in bytes for each of the following: (a) PIC 9(7) DISPLAY, (b) PIC S9(7) COMP-3, (c) PIC S9(9)V99 COMP-3, (d) PIC 9(4) COMP, (e) PIC X(50). **Solution**: (a) **7 bytes**. DISPLAY format stores one digit per byte. (b) **4 bytes**. COMP-3 formula: CEIL((7 + 1) / 2) = CEIL(4) = 4 bytes. Seven digit nibbles plus one sign nibble = 8 nibbles = 4 bytes. (c) **6 bytes**. Total digits = 9 + 2 = 11. CEIL((11 + 1) / 2) = CEIL(6) = 6 bytes. The implied decimal point (V) does not occupy storage. (d) **2 bytes**. COMP with PIC 9(1) through 9(4) uses a halfword (2 bytes). Range: 0 to 9999 fits within the unsigned halfword range of 0 to 65535. (e) **50 bytes**. Alphanumeric items store one character per byte. --- ## Chapter 5: Basic Input and Output ### Exercise 5.2: Read and Display a File **Problem**: Write a program that reads a sequential file of employee records (name PIC X(30), department PIC X(10), salary PIC 9(7)V99) and displays each record with formatting. **Solution**: ```cobol IDENTIFICATION DIVISION. PROGRAM-ID. EXERCISE-5-2. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT EMPLOYEE-FILE ASSIGN TO "employee.dat" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-FILE-STATUS. DATA DIVISION. FILE SECTION. FD EMPLOYEE-FILE. 01 EMPLOYEE-RECORD. 05 EMP-NAME PIC X(30). 05 EMP-DEPARTMENT PIC X(10). 05 EMP-SALARY PIC 9(7)V99. WORKING-STORAGE SECTION. 01 WS-FILE-STATUS PIC XX. 01 WS-EOF-FLAG PIC X VALUE "N". 88 END-OF-FILE VALUE "Y". 01 WS-RECORD-COUNT PIC 9(5) VALUE ZERO. 01 WS-SALARY-DISP PIC $$$,$$$,$$9.99.
PROCEDURE DIVISION.
MAIN-PARA.
OPEN INPUT EMPLOYEE-FILE
IF WS-FILE-STATUS NOT = "00"
DISPLAY "Error opening file: " WS-FILE-STATUS
STOP RUN
END-IF
DISPLAY "Employee Listing"
DISPLAY "------------------------------"
"----------"
"--------------"
PERFORM READ-EMPLOYEE
PERFORM UNTIL END-OF-FILE
ADD 1 TO WS-RECORD-COUNT
MOVE EMP-SALARY TO WS-SALARY-DISP
DISPLAY EMP-NAME
EMP-DEPARTMENT
WS-SALARY-DISP
PERFORM READ-EMPLOYEE
END-PERFORM
DISPLAY "------------------------------"
"----------"
"--------------"
DISPLAY "Total records: " WS-RECORD-COUNT
CLOSE EMPLOYEE-FILE
STOP RUN.
READ-EMPLOYEE.
READ EMPLOYEE-FILE
AT END
SET END-OF-FILE TO TRUE
NOT AT END
CONTINUE
END-READ.
**Explanation**: The program uses the read-ahead pattern: the first READ is performed before the loop, and each iteration reads the next record at the end. FILE STATUS is checked after OPEN to detect errors. The level-88 condition name END-OF-FILE provides a readable loop termination test.
### Exercise 5.4: Record Counting with Totals
**Problem**: Enhance Exercise 5.2 to accumulate and display the total salary and average salary for all employees.
**Solution**:
```cobol
IDENTIFICATION DIVISION.
PROGRAM-ID. EXERCISE-5-4.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT EMPLOYEE-FILE
ASSIGN TO "employee.dat"
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS WS-FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD EMPLOYEE-FILE.
01 EMPLOYEE-RECORD.
05 EMP-NAME PIC X(30).
05 EMP-DEPARTMENT PIC X(10).
05 EMP-SALARY PIC 9(7)V99.
WORKING-STORAGE SECTION.
01 WS-FILE-STATUS PIC XX.
01 WS-EOF-FLAG PIC X VALUE "N".
88 END-OF-FILE VALUE "Y".
01 WS-RECORD-COUNT PIC 9(7) VALUE ZERO.
01 WS-TOTAL-SALARY PIC S9(11)V99 COMP-3
VALUE ZERO.
01 WS-AVG-SALARY PIC S9(7)V99 COMP-3
VALUE ZERO.
01 WS-SALARY-DISP PIC $$$,$$$, MATH6 MATH7 $,$$9.99.
01 WS-AVG-DISP PIC $$$,$$$,$$9.99.
PROCEDURE DIVISION.
MAIN-PARA.
OPEN INPUT EMPLOYEE-FILE
IF WS-FILE-STATUS NOT = "00"
DISPLAY "Error opening file: " WS-FILE-STATUS
STOP RUN
END-IF
PERFORM READ-EMPLOYEE
PERFORM UNTIL END-OF-FILE
ADD 1 TO WS-RECORD-COUNT
ADD EMP-SALARY TO WS-TOTAL-SALARY
MOVE EMP-SALARY TO WS-SALARY-DISP
DISPLAY EMP-NAME EMP-DEPARTMENT
WS-SALARY-DISP
PERFORM READ-EMPLOYEE
END-PERFORM
IF WS-RECORD-COUNT > ZERO
DIVIDE WS-TOTAL-SALARY BY WS-RECORD-COUNT
GIVING WS-AVG-SALARY ROUNDED
MOVE WS-TOTAL-SALARY TO WS-TOTAL-DISP
MOVE WS-AVG-SALARY TO WS-AVG-DISP
DISPLAY SPACES
DISPLAY "Total Salary: " WS-TOTAL-DISP
DISPLAY "Average Salary: " WS-AVG-DISP
DISPLAY "Record Count: " WS-RECORD-COUNT
ELSE
DISPLAY "No records found in file."
END-IF
CLOSE EMPLOYEE-FILE
STOP RUN.
READ-EMPLOYEE.
READ EMPLOYEE-FILE
AT END
SET END-OF-FILE TO TRUE
NOT AT END
CONTINUE
END-READ.
Explanation: WS-TOTAL-SALARY uses PIC S9(11)V99 COMP-3 to accommodate large totals without overflow. The DIVIDE with GIVING and ROUNDED computes the average with proper rounding. The guard condition (IF WS-RECORD-COUNT > ZERO) prevents division by zero if the file is empty.
Chapter 7: IF, EVALUATE, and Conditional Logic
Exercise 7.3: Nested IF for Tax Brackets
Problem: Write a COBOL paragraph that computes federal income tax using the following simplified brackets: 10% on income up to $10,000; 12% on income from $10,001 to $40,000; 22% on income from $40,001 to $85,000; 24% on income over $85,000. Use progressive taxation (each bracket applies only to the income within that bracket's range).
Solution:
COMPUTE-TAX.
MOVE ZERO TO WS-TAX
EVALUATE TRUE
WHEN WS-INCOME <= 10000
COMPUTE WS-TAX =
WS-INCOME * 0.10
WHEN WS-INCOME <= 40000
COMPUTE WS-TAX =
10000 * 0.10
+ (WS-INCOME - 10000) * 0.12
WHEN WS-INCOME <= 85000
COMPUTE WS-TAX =
10000 * 0.10
+ 30000 * 0.12
+ (WS-INCOME - 40000) * 0.22
WHEN OTHER
COMPUTE WS-TAX =
10000 * 0.10
+ 30000 * 0.12
+ 45000 * 0.22
+ (WS-INCOME - 85000) * 0.24
END-EVALUATE.
Explanation: The EVALUATE TRUE pattern tests conditions in order; the first true condition executes. Each bracket applies the rate only to the income within that bracket's range, with fixed amounts for all fully consumed lower brackets. For example, income of $50,000 pays 10% on the first $10,000, 12% on the next $30,000, and 22% on the remaining $10,000.
Exercise 7.5: EVALUATE with Multiple Subjects
Problem: Write an EVALUATE statement that determines a shipping method based on two factors: package weight category (LIGHT, MEDIUM, HEAVY) and destination zone (DOMESTIC, INTERNATIONAL).
Solution:
DETERMINE-SHIPPING.
EVALUATE WS-WEIGHT-CATEGORY ALSO WS-DEST-ZONE
WHEN "LIGHT" ALSO "DOMESTIC"
MOVE "USPS FIRST CLASS" TO WS-SHIP-METHOD
MOVE 3.50 TO WS-SHIP-COST
WHEN "LIGHT" ALSO "INTERNATIONAL"
MOVE "USPS INTL FIRST" TO WS-SHIP-METHOD
MOVE 14.50 TO WS-SHIP-COST
WHEN "MEDIUM" ALSO "DOMESTIC"
MOVE "UPS GROUND" TO WS-SHIP-METHOD
MOVE 8.75 TO WS-SHIP-COST
WHEN "MEDIUM" ALSO "INTERNATIONAL"
MOVE "UPS WORLDWIDE" TO WS-SHIP-METHOD
MOVE 32.00 TO WS-SHIP-COST
WHEN "HEAVY" ALSO "DOMESTIC"
MOVE "FREIGHT GROUND" TO WS-SHIP-METHOD
MOVE 25.00 TO WS-SHIP-COST
WHEN "HEAVY" ALSO "INTERNATIONAL"
MOVE "FREIGHT OCEAN" TO WS-SHIP-METHOD
MOVE 120.00 TO WS-SHIP-COST
WHEN OTHER
MOVE "UNKNOWN" TO WS-SHIP-METHOD
MOVE ZERO TO WS-SHIP-COST
END-EVALUATE.
Explanation: The ALSO keyword allows EVALUATE to test multiple subjects simultaneously. Each WHEN clause specifies a value for each subject. This produces a clean, readable decision table that is far easier to maintain than nested IF statements.
Chapter 8: PERFORM and Looping
Exercise 8.2: PERFORM VARYING for Multiplication Table
Problem: Write a program that displays a multiplication table for values 1 through 12.
Solution:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXERCISE-8-2.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-ROW PIC 99.
01 WS-COL PIC 99.
01 WS-PRODUCT PIC 9(3).
01 WS-PRODUCT-DISP PIC ZZ9.
01 WS-LINE PIC X(60).
01 WS-HEADER PIC X(60).
01 WS-COL-DISP PIC ZZ9.
PROCEDURE DIVISION.
MAIN-PARA.
MOVE SPACES TO WS-HEADER
STRING " |" DELIMITED SIZE
INTO WS-HEADER
END-STRING
PERFORM VARYING WS-COL FROM 1 BY 1
UNTIL WS-COL > 12
MOVE WS-COL TO WS-COL-DISP
STRING WS-HEADER DELIMITED SPACES
" " DELIMITED SIZE
WS-COL-DISP DELIMITED SIZE
INTO WS-HEADER
END-STRING
END-PERFORM
DISPLAY WS-HEADER
DISPLAY "----+------------------------------------"
PERFORM VARYING WS-ROW FROM 1 BY 1
UNTIL WS-ROW > 12
MOVE SPACES TO WS-LINE
MOVE WS-ROW TO WS-COL-DISP
STRING WS-COL-DISP DELIMITED SIZE
"|" DELIMITED SIZE
INTO WS-LINE
END-STRING
PERFORM VARYING WS-COL FROM 1 BY 1
UNTIL WS-COL > 12
MULTIPLY WS-ROW BY WS-COL
GIVING WS-PRODUCT
MOVE WS-PRODUCT TO WS-PRODUCT-DISP
STRING WS-LINE DELIMITED SPACES
" " DELIMITED SIZE
WS-PRODUCT-DISP DELIMITED SIZE
INTO WS-LINE
END-STRING
END-PERFORM
DISPLAY WS-LINE
END-PERFORM
STOP RUN.
Explanation: The outer PERFORM VARYING iterates rows 1 through 12; the inner PERFORM VARYING iterates columns 1 through 12. MULTIPLY with GIVING computes each product. STRING concatenates the formatted values into a display line.
Exercise 8.4: PERFORM UNTIL with Input Validation
Problem: Write a program that accepts numeric input from the user and accumulates a running total. Stop when the user enters 0. Validate that each entry is numeric.
Solution:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXERCISE-8-4.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-INPUT PIC X(10).
01 WS-NUMBER PIC S9(7)V99.
01 WS-TOTAL PIC S9(9)V99 COMP-3
VALUE ZERO.
01 WS-TOTAL-DISP PIC -$$,$$$, MATH11 $,$$$,$$9.99.
01 WS-TOTAL-DISP PIC $$$$,$$$,$$9.99.
PROCEDURE DIVISION.
MAIN-PARA.
OPEN INPUT EMP-FILE
IF WS-FS NOT = "00"
DISPLAY "File open error: " WS-FS
STOP RUN
END-IF
DISPLAY "DEPARTMENT SALARY REPORT"
DISPLAY "========================"
PERFORM READ-RECORD
IF NOT END-OF-FILE
MOVE EMP-DEPT TO WS-PREV-DEPT
END-IF
PERFORM UNTIL END-OF-FILE
IF EMP-DEPT NOT = WS-PREV-DEPT
PERFORM PRINT-DEPT-TOTAL
MOVE EMP-DEPT TO WS-PREV-DEPT
END-IF
ADD 1 TO WS-DEPT-COUNT
ADD 1 TO WS-GRAND-COUNT
ADD EMP-SALARY TO WS-DEPT-TOTAL
ADD EMP-SALARY TO WS-GRAND-TOTAL
MOVE EMP-SALARY TO WS-SALARY-DISP
DISPLAY " " EMP-NAME WS-SALARY-DISP
PERFORM READ-RECORD
END-PERFORM
IF WS-GRAND-COUNT > ZERO
PERFORM PRINT-DEPT-TOTAL
END-IF
DISPLAY "========================"
MOVE WS-GRAND-TOTAL TO WS-TOTAL-DISP
DISPLAY "GRAND TOTAL: " WS-GRAND-COUNT
" employees " WS-TOTAL-DISP
CLOSE EMP-FILE
STOP RUN.
READ-RECORD.
READ EMP-FILE
AT END SET END-OF-FILE TO TRUE
END-READ.
PRINT-DEPT-TOTAL.
MOVE WS-DEPT-TOTAL TO WS-TOTAL-DISP
DISPLAY " --- " WS-PREV-DEPT " Total: "
WS-DEPT-COUNT " employees "
WS-TOTAL-DISP
DISPLAY SPACES
MOVE ZERO TO WS-DEPT-TOTAL
MOVE ZERO TO WS-DEPT-COUNT.
Explanation: The control break pattern saves the current department value and compares each new record's department against it. When the department changes, the subtotal paragraph prints the accumulated totals and resets the department accumulators. The grand total accumulates independently and is printed after all records are processed.
Chapter 11: Indexed File Processing (VSAM KSDS)
Exercise 11.2: Random Access Read
Problem: Write a program that accepts an account number from the user and retrieves the corresponding record from an indexed file.
Solution:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXERCISE-11-2.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ACCOUNT-FILE
ASSIGN TO "accounts.dat"
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS ACCT-NUMBER
FILE STATUS IS WS-FS.
DATA DIVISION.
FILE SECTION.
FD ACCOUNT-FILE.
01 ACCOUNT-RECORD.
05 ACCT-NUMBER PIC 9(10).
05 ACCT-NAME PIC X(30).
05 ACCT-TYPE PIC X.
88 CHECKING VALUE "C".
88 SAVINGS VALUE "S".
05 ACCT-BALANCE PIC S9(9)V99.
WORKING-STORAGE SECTION.
01 WS-FS PIC XX.
01 WS-INPUT-ACCT PIC X(10).
01 WS-BALANCE-DISP PIC -$$$,$$$, MATH16 $,$$$,$$9.99.
01 WS-REC-COUNT PIC 9(5) VALUE ZERO.
PROCEDURE DIVISION.
MAIN-PARA.
OPEN INPUT ACCOUNT-FILE
IF WS-FS NOT = "00"
DISPLAY "File open error: " WS-FS
STOP RUN
END-IF
DISPLAY "Enter start account number:"
ACCEPT WS-START-KEY
DISPLAY "Enter end account number:"
ACCEPT WS-END-KEY
MOVE WS-START-KEY TO ACCT-NUMBER
START ACCOUNT-FILE
KEY IS NOT LESS THAN ACCT-NUMBER
INVALID KEY
DISPLAY "No records at or beyond start key."
CLOSE ACCOUNT-FILE
STOP RUN
END-START
READ ACCOUNT-FILE NEXT
AT END
DISPLAY "No records found."
CLOSE ACCOUNT-FILE
STOP RUN
END-READ
PERFORM UNTIL WS-FS NOT = "00"
OR ACCT-NUMBER > WS-END-KEY
ADD 1 TO WS-REC-COUNT
MOVE ACCT-BALANCE TO WS-BALANCE-DISP
DISPLAY ACCT-NUMBER " "
ACCT-NAME " "
WS-BALANCE-DISP
READ ACCOUNT-FILE NEXT
AT END CONTINUE
END-READ
END-PERFORM
DISPLAY "Records displayed: " WS-REC-COUNT
CLOSE ACCOUNT-FILE
STOP RUN.
Explanation: ACCESS MODE IS DYNAMIC allows both random and sequential access in the same program. START positions the file pointer at or after the start key. READ NEXT then retrieves records sequentially until the end key is exceeded or end-of-file is reached.
Chapter 14: Subprograms and the CALL Statement
Exercise 14.2: Date Validation Subprogram
Problem: Write a subprogram that receives a date in YYYYMMDD format and returns a validation flag (Y/N) and an error message if invalid.
Solution:
IDENTIFICATION DIVISION.
PROGRAM-ID. DATE-VALIDATE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-DAYS-TABLE.
05 FILLER PIC 99 VALUE 31.
05 FILLER PIC 99 VALUE 28.
05 FILLER PIC 99 VALUE 31.
05 FILLER PIC 99 VALUE 30.
05 FILLER PIC 99 VALUE 31.
05 FILLER PIC 99 VALUE 30.
05 FILLER PIC 99 VALUE 31.
05 FILLER PIC 99 VALUE 31.
05 FILLER PIC 99 VALUE 30.
05 FILLER PIC 99 VALUE 31.
05 FILLER PIC 99 VALUE 30.
05 FILLER PIC 99 VALUE 31.
01 WS-DAYS-REDEF REDEFINES WS-DAYS-TABLE.
05 WS-MAX-DAYS PIC 99 OCCURS 12.
01 WS-LEAP-FLAG PIC X.
88 IS-LEAP-YEAR VALUE "Y".
01 WS-MAX-DAY PIC 99.
01 WS-REMAINDER PIC 9(4).
LINKAGE SECTION.
01 LS-DATE-IN PIC 9(8).
01 LS-DATE-PARTS REDEFINES LS-DATE-IN.
05 LS-YEAR PIC 9(4).
05 LS-MONTH PIC 9(2).
05 LS-DAY PIC 9(2).
01 LS-VALID-FLAG PIC X.
01 LS-ERROR-MSG PIC X(40).
PROCEDURE DIVISION USING LS-DATE-IN
LS-VALID-FLAG
LS-ERROR-MSG.
VALIDATE-DATE.
MOVE "Y" TO LS-VALID-FLAG
MOVE SPACES TO LS-ERROR-MSG
IF LS-DATE-IN IS NOT NUMERIC
MOVE "N" TO LS-VALID-FLAG
MOVE "Date must be numeric YYYYMMDD"
TO LS-ERROR-MSG
GOBACK
END-IF
IF LS-YEAR < 1900 OR LS-YEAR > 2099
MOVE "N" TO LS-VALID-FLAG
MOVE "Year must be 1900-2099"
TO LS-ERROR-MSG
GOBACK
END-IF
IF LS-MONTH < 1 OR LS-MONTH > 12
MOVE "N" TO LS-VALID-FLAG
MOVE "Month must be 01-12"
TO LS-ERROR-MSG
GOBACK
END-IF
MOVE "N" TO WS-LEAP-FLAG
DIVIDE LS-YEAR BY 4
GIVING WS-REMAINDER
REMAINDER WS-REMAINDER
IF WS-REMAINDER = ZERO
DIVIDE LS-YEAR BY 100
GIVING WS-REMAINDER
REMAINDER WS-REMAINDER
IF WS-REMAINDER NOT = ZERO
MOVE "Y" TO WS-LEAP-FLAG
ELSE
DIVIDE LS-YEAR BY 400
GIVING WS-REMAINDER
REMAINDER WS-REMAINDER
IF WS-REMAINDER = ZERO
MOVE "Y" TO WS-LEAP-FLAG
END-IF
END-IF
END-IF
MOVE WS-MAX-DAYS(LS-MONTH) TO WS-MAX-DAY
IF LS-MONTH = 2 AND IS-LEAP-YEAR
ADD 1 TO WS-MAX-DAY
END-IF
IF LS-DAY < 1 OR LS-DAY > WS-MAX-DAY
MOVE "N" TO LS-VALID-FLAG
STRING "Day must be 01-" DELIMITED SIZE
WS-MAX-DAY DELIMITED SIZE
" for this month" DELIMITED SIZE
INTO LS-ERROR-MSG
END-STRING
END-IF
GOBACK.
Explanation: The subprogram receives three parameters through the LINKAGE SECTION. It validates year range, month range, and day range including leap year logic. The REDEFINES clause maps the 8-digit date into year, month, and day components. A table of maximum days per month is defined with OCCURS and REDEFINES for indexed access by month number. The GOBACK statement returns control to the calling program.
Exercise 14.4: String Utility Subprogram
Problem: Write a subprogram that receives a string, trims trailing spaces, converts it to uppercase, and returns the trimmed length.
Solution:
IDENTIFICATION DIVISION.
PROGRAM-ID. STRING-UTIL.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-IDX PIC 9(4).
LINKAGE SECTION.
01 LS-INPUT-STRING PIC X(100).
01 LS-TRIMMED-LENGTH PIC 9(4).
PROCEDURE DIVISION USING LS-INPUT-STRING
LS-TRIMMED-LENGTH.
PROCESS-STRING.
INSPECT LS-INPUT-STRING
CONVERTING
"abcdefghijklmnopqrstuvwxyz"
TO
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
MOVE 100 TO LS-TRIMMED-LENGTH
PERFORM VARYING WS-IDX FROM 100 BY -1
UNTIL WS-IDX < 1
OR LS-INPUT-STRING(WS-IDX:1)
NOT = SPACE
CONTINUE
END-PERFORM
MOVE WS-IDX TO LS-TRIMMED-LENGTH
IF LS-TRIMMED-LENGTH = ZERO
MOVE ZERO TO LS-TRIMMED-LENGTH
END-IF
GOBACK.
Explanation: INSPECT CONVERTING performs the uppercase conversion in a single statement by mapping each lowercase letter to its uppercase equivalent. The PERFORM VARYING loop scans backward from position 100 to find the last non-space character, yielding the trimmed length. Reference modification (LS-INPUT-STRING(WS-IDX:1)) accesses individual character positions.
Chapter 17: The SORT and MERGE Statements
Exercise 17.2: SORT with INPUT PROCEDURE
Problem: Write a program that reads an employee file, filters out terminated employees (status = "T"), and sorts the remaining records by department and then by name.
Solution:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXERCISE-17-2.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT EMP-IN
ASSIGN TO "employees.dat"
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS WS-FS-IN.
SELECT EMP-OUT
ASSIGN TO "emp-sorted.dat"
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS WS-FS-OUT.
SELECT SORT-WORK
ASSIGN TO "sortwork.tmp".
DATA DIVISION.
FILE SECTION.
FD EMP-IN.
01 EMP-IN-RECORD.
05 EMP-IN-ID PIC 9(6).
05 EMP-IN-NAME PIC X(25).
05 EMP-IN-DEPT PIC X(10).
05 EMP-IN-STATUS PIC X.
05 EMP-IN-SALARY PIC 9(7)V99.
FD EMP-OUT.
01 EMP-OUT-RECORD PIC X(50).
SD SORT-WORK.
01 SORT-RECORD.
05 SORT-ID PIC 9(6).
05 SORT-NAME PIC X(25).
05 SORT-DEPT PIC X(10).
05 SORT-STATUS PIC X.
05 SORT-SALARY PIC 9(7)V99.
WORKING-STORAGE SECTION.
01 WS-FS-IN PIC XX.
01 WS-FS-OUT PIC XX.
01 WS-EOF PIC X VALUE "N".
88 END-OF-INPUT VALUE "Y".
01 WS-READ-COUNT PIC 9(7) VALUE ZERO.
01 WS-RELEASE-COUNT PIC 9(7) VALUE ZERO.
PROCEDURE DIVISION.
MAIN-PARA.
SORT SORT-WORK
ON ASCENDING KEY SORT-DEPT
ON ASCENDING KEY SORT-NAME
INPUT PROCEDURE IS FILTER-INPUT
OUTPUT PROCEDURE IS WRITE-OUTPUT
DISPLAY "Records read: " WS-READ-COUNT
DISPLAY "Records written: " WS-RELEASE-COUNT
STOP RUN.
FILTER-INPUT.
OPEN INPUT EMP-IN
PERFORM READ-INPUT
PERFORM UNTIL END-OF-INPUT
ADD 1 TO WS-READ-COUNT
IF EMP-IN-STATUS NOT = "T"
MOVE EMP-IN-RECORD TO SORT-RECORD
RELEASE SORT-RECORD
ADD 1 TO WS-RELEASE-COUNT
END-IF
PERFORM READ-INPUT
END-PERFORM
CLOSE EMP-IN.
READ-INPUT.
READ EMP-IN
AT END SET END-OF-INPUT TO TRUE
END-READ.
WRITE-OUTPUT.
OPEN OUTPUT EMP-OUT
RETURN SORT-WORK
AT END CONTINUE
END-RETURN
PERFORM UNTIL SORT-RETURN NOT = ZERO
WRITE EMP-OUT-RECORD FROM SORT-RECORD
RETURN SORT-WORK
AT END CONTINUE
END-RETURN
END-PERFORM
CLOSE EMP-OUT.
Explanation: The INPUT PROCEDURE (FILTER-INPUT) reads the input file, skips terminated employees (status "T"), and RELEASEs active employees to the sort work file. The SORT statement sorts by department (primary) and name (secondary), both ascending. The OUTPUT PROCEDURE (WRITE-OUTPUT) RETURNs sorted records and writes them to the output file.
Chapter 22: DB2 Embedded SQL in COBOL
Exercise 22.3: Cursor-Based Report
Problem: Write a COBOL program with embedded SQL that produces a customer report from a DB2 CUSTOMER table, displaying customers ordered by last name.
Solution:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXERCISE-22-3.
DATA DIVISION.
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
01 WS-CUST-ID PIC 9(8).
01 WS-LAST-NAME PIC X(30).
01 WS-FIRST-NAME PIC X(20).
01 WS-BALANCE PIC S9(9)V99 COMP-3.
01 WS-BALANCE-DISP PIC -$$$,$$$, MATH19 $,$$$,$$$, MATH21 $,$$$,$$$, MATH23 $,$$$,$$$,$$9.99.
01 WS-RATE-DISP PIC Z9.9999%.
01 WS-FREQ-DESC PIC X(12).
PROCEDURE DIVISION.
MAIN-PARA.
MOVE 100000.00 TO WS-PRINCIPAL
MOVE .0525 TO WS-ANNUAL-RATE
MOVE 10 TO WS-YEARS
MOVE 12 TO WS-PERIODS-PER-YEAR
MOVE "Monthly" TO WS-FREQ-DESC
COMPUTE WS-TOTAL-PERIODS =
WS-YEARS * WS-PERIODS-PER-YEAR
COMPUTE WS-PERIOD-RATE ROUNDED =
WS-ANNUAL-RATE / WS-PERIODS-PER-YEAR
MOVE WS-PRINCIPAL TO WS-CURRENT-BALANCE
PERFORM VARYING WS-PERIOD-IDX
FROM 1 BY 1
UNTIL WS-PERIOD-IDX > WS-TOTAL-PERIODS
COMPUTE WS-CURRENT-BALANCE ROUNDED =
WS-CURRENT-BALANCE
+ (WS-CURRENT-BALANCE
* WS-PERIOD-RATE)
END-PERFORM
COMPUTE WS-INTEREST-EARNED =
WS-CURRENT-BALANCE - WS-PRINCIPAL
MOVE WS-PRINCIPAL TO WS-PRINCIPAL-DISP
MOVE WS-CURRENT-BALANCE TO WS-BALANCE-DISP
MOVE WS-INTEREST-EARNED TO WS-INTEREST-DISP
DISPLAY "Compound Interest Calculation"
DISPLAY "============================"
DISPLAY "Principal: " WS-PRINCIPAL-DISP
DISPLAY "Annual Rate: 5.2500%"
DISPLAY "Compounding: " WS-FREQ-DESC
DISPLAY "Years: " WS-YEARS
DISPLAY "----------------------------"
DISPLAY "Final Balance: " WS-BALANCE-DISP
DISPLAY "Interest Earned:" WS-INTEREST-DISP
STOP RUN.
```
**Explanation**: The program iteratively computes compound interest by applying the per-period rate to the running balance each period. Using COMP-3 ensures exact decimal arithmetic -- essential for financial accuracy. The ROUNDED phrase on each COMPUTE prevents truncation errors from accumulating over hundreds of compounding periods.
### Exercise 33.4: Amortization Schedule
**Problem**: Write a COBOL paragraph that generates the first 12 months of a loan amortization schedule given a loan amount of $250,000, annual rate of 6.5%, and a 30-year term.
**Solution**:
```cobol
IDENTIFICATION DIVISION.
PROGRAM-ID. EXERCISE-33-4.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-LOAN-AMOUNT PIC S9(9)V99 COMP-3
VALUE 250000.00.
01 WS-ANNUAL-RATE PIC V9(7) COMP-3
VALUE .0650000.
01 WS-MONTHLY-RATE PIC V9(9) COMP-3.
01 WS-TERM-MONTHS PIC 9(4) VALUE 360.
01 WS-PAYMENT PIC S9(7)V99 COMP-3.
01 WS-INTEREST-AMT PIC S9(7)V99 COMP-3.
01 WS-PRINCIPAL-AMT PIC S9(7)V99 COMP-3.
01 WS-BALANCE PIC S9(9)V99 COMP-3.
01 WS-MONTH-IDX PIC 9(4).
01 WS-ANNUITY-FACTOR PIC V9(9) COMP-3.
01 WS-PMT-DISP PIC $$,$$$,$$9.99.
01 WS-INT-DISP PIC $$,$$$,$$9.99.
01 WS-PRIN-DISP PIC $$,$$$,$$9.99.
01 WS-BAL-DISP PIC $$$,$$$, MATH31 $,$$$,$$$,$$9.99.
01 WS-MSG PIC X(50).
01 WS-RESP PIC S9(8) COMP.
LINKAGE SECTION.
01 DFHCOMMAREA PIC X(11).
PROCEDURE DIVISION.
MAIN-LOGIC.
IF EIBCALEN = ZERO
PERFORM SEND-EMPTY-MAP
ELSE
MOVE DFHCOMMAREA TO WS-COMMAREA
PERFORM RECEIVE-AND-PROCESS
END-IF
GOBACK.
SEND-EMPTY-MAP.
MOVE SPACES TO WS-MSG
MOVE "Enter Account Number and press ENTER"
TO WS-MSG
EXEC CICS SEND MAP('INQMAP1')
MAPSET('INQSET1')
ERASE
RESP(WS-RESP)
END-EXEC
MOVE SPACE TO WS-CA-STATE
EXEC CICS RETURN
TRANSID('AINQ')
COMMAREA(WS-COMMAREA)
LENGTH(LENGTH OF WS-COMMAREA)
END-EXEC.
RECEIVE-AND-PROCESS.
EXEC CICS RECEIVE MAP('INQMAP1')
MAPSET('INQSET1')
RESP(WS-RESP)
END-EXEC
IF WS-RESP NOT = DFHRESP(NORMAL)
MOVE "Map receive error" TO WS-MSG
PERFORM SEND-ERROR
GOBACK
END-IF
PERFORM DB2-ACCOUNT-LOOKUP
IF SQLCODE = 0
MOVE WS-ACCT-BALANCE TO WS-BAL-DISP
EXEC CICS SEND MAP('INQMAP1')
MAPSET('INQSET1')
DATAONLY
RESP(WS-RESP)
END-EXEC
ELSE
IF SQLCODE = 100
MOVE "Account not found" TO WS-MSG
ELSE
MOVE "Database error occurred"
TO WS-MSG
END-IF
PERFORM SEND-ERROR
END-IF
MOVE "I" TO WS-CA-STATE
EXEC CICS RETURN
TRANSID('AINQ')
COMMAREA(WS-COMMAREA)
LENGTH(LENGTH OF WS-COMMAREA)
END-EXEC.
DB2-ACCOUNT-LOOKUP.
EXEC SQL
SELECT ACCT_NUM,
ACCT_NAME,
ACCT_TYPE,
BALANCE,
STATUS,
OPEN_DATE
INTO :WS-ACCT-NUM,
:WS-ACCT-NAME,
:WS-ACCT-TYPE,
:WS-ACCT-BALANCE,
:WS-ACCT-STATUS,
:WS-OPEN-DATE
FROM ACCOUNT
WHERE ACCT_NUM = :WS-CA-ACCT-NUM
END-EXEC.
SEND-ERROR.
EXEC CICS SEND MAP('INQMAP1')
MAPSET('INQSET1')
DATAONLY
RESP(WS-RESP)
END-EXEC.
Explanation: This is a pseudo-conversational CICS program. On first entry (EIBCALEN = 0), it sends an empty map and returns with a COMMAREA, freeing CICS resources while the user types. On re-entry, it receives the map data, queries DB2 for the account, and displays the results or an error message. The COMMAREA preserves state between pseudo-conversational interactions. The RESP option on each CICS command captures the response code for inline error handling. This pattern is the foundation of all CICS online transaction processing.
Exercise 41.4: Batch Interest Calculation
Problem: Describe the data definitions needed for a batch interest calculation program that reads all savings accounts from DB2 and computes monthly interest.
Solution:
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL INCLUDE ACCOUNT END-EXEC.
01 WS-PROCESSING-DATE PIC 9(8).
01 WS-PROCESS-YEAR PIC 9(4).
01 WS-PROCESS-MONTH PIC 9(2).
01 WS-DAYS-IN-MONTH PIC 99.
01 WS-DAYS-IN-YEAR PIC 999.
01 WS-ACCT-NUM PIC 9(10).
01 WS-BALANCE PIC S9(11)V99 COMP-3.
01 WS-ANNUAL-RATE PIC V9(7) COMP-3.
01 WS-DAILY-RATE PIC V9(11) COMP-3.
01 WS-INTEREST-AMT PIC S9(9)V99 COMP-3.
01 WS-NEW-BALANCE PIC S9(11)V99 COMP-3.
01 WS-COUNTERS.
05 WS-ACCTS-READ PIC 9(9) COMP VALUE 0.
05 WS-ACCTS-POSTED PIC 9(9) COMP VALUE 0.
05 WS-ACCTS-ERROR PIC 9(9) COMP VALUE 0.
05 WS-TOTAL-INTEREST PIC S9(13)V99 COMP-3
VALUE ZERO.
01 WS-JOURNAL-RECORD.
05 WJ-ACCT-NUM PIC 9(10).
05 WJ-TRAN-TYPE PIC X(4)
VALUE "INTR".
05 WJ-TRAN-DATE PIC 9(8).
05 WJ-AMOUNT PIC S9(9)V99 COMP-3.
05 WJ-DEBIT-ACCT PIC 9(10).
05 WJ-CREDIT-ACCT PIC 9(10).
05 WJ-DESCRIPTION PIC X(30).
Explanation: The data definitions include: host variables for DB2 retrieval (account number, balance, rate), computation work fields for daily rate and interest amount (using high-precision COMP-3 to prevent rounding errors over millions of accounts), processing counters (using COMP for efficient integer arithmetic), and a journal record structure for double-entry general ledger posting. The daily rate field uses V9(11) -- eleven decimal places -- to maintain precision in the intermediate calculation before rounding the final interest amount to cents.