This COBOL program reads mortgage information from an input file, calculates mortgage payments, and produces an amortization schedule in either text or HTML format.
IDENTIFICATION DIVISION.
PROGRAM-ID. MORTGAGE.
* Program name: MORTGAGE
* Generates mortgage amortization schedules.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
* Define input and output files
SELECT INFILE ASSIGN TO MRTS
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS INFILE-STS.
SELECT OUTFILE ASSIGN TO MRTS2
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS OUTFILE-STS.
DATA DIVISION.
FILE SECTION.
* Input file record structure
FD INFILE RECORDING MODE F.
01 IN-REC.
05 F-TITLE PIC X(40). *> Loan title
05 F-AMT PIC X(14). *> Loan amount
05 F-RATE PIC X(4). *> Interest rate
05 F-YEARS PIC X(2). *> Loan term
05 F-EXTRA PIC X(14). *> Extra payment amount
05 F-FORMAT PIC X(4). *> Output format
* Output file record definition
FD OUTFILE RECORDING MODE F
RECORD CONTAINS 200 CHARACTERS
DATA RECORD IS OUT-REC.
01 OUT-REC PIC X(200).
WORKING-STORAGE SECTION.
* File status tracking
01 INFILE-STS PIC XX.
01 OUTFILE-STS PIC XX.
* End-of-file control flag
01 EOF-FLAG PIC X VALUE 'N'.
88 EOF VALUE 'Y'.
88 NOT-EOF VALUE 'N'.
* Working variables
01 WS-T PIC X(40).
01 WS-MONTHLY-RATE PIC 9(3)V99999.
01 N-MONTHS PIC 9(5) COMP.
* Financial calculation fields
01 SCHED-PAY PIC 9(12)V99.
01 CUM-INT PIC 9(12)V99 VALUE 0.
01 B-BAL PIC 9(12)V99.
01 PRINCIPAL PIC 9(12)V99.
01 INTEREST PIC 9(12)V99.
01 TOT-PAY PIC 9(12)V99.
01 EXTRA-PAY PIC 9(12)V99.
* Payment tracking
01 PAYMENT-NUM PIC 9(5) COMP.
01 PAYMENT-DATE PIC X(10).
* Date handling variables
01 WS-DATE-FIELDS.
05 WS-YEAR PIC 9(4).
05 WS-MONTH PIC 9(2).
05 WS-DAY PIC 9(2).
* Display formatting
01 WS-DATE-ALPHA PIC X(10).
* Runtime metadata
01 WS-USER PIC X(8).
01 WS-RUN-DATE PIC X(8).
01 WS-RUN-TIME PIC X(6).
01 WS-RUN-ALPHA PIC X(30).
* Display conversion fields
* Used to format numeric output nicely
01 WS-PAYMENT-NUM-D PIC Z(5).
01 WS-B-BAL-D PIC Z,ZZZ,ZZZ,ZZ9.99.
01 WS-SCHED-PAY-D PIC Z,ZZZ,ZZZ,ZZ9.99.
01 WS-EXTRA-PAY-D PIC Z,ZZZ,ZZZ,ZZ9.99.
01 WS-TOT-PAY-D PIC Z,ZZZ,ZZZ,ZZ9.99.
01 WS-PRINCIPAL-D PIC Z,ZZZ,ZZZ,ZZ9.99.
01 WS-INTEREST-D PIC Z,ZZZ,ZZZ,ZZ9.99.
01 WS-CUM-INT-D PIC Z,ZZZ,ZZZ,ZZ9.99.
* Parameter block from job execution
LINKAGE SECTION.
01 PARM-BLOCK.
05 PARM-LENGTH PIC S9(4) COMP.
05 PARM-USER PIC X(7).
05 PARM-DATA PIC X(5).
PROCEDURE DIVISION USING PARM-BLOCK.
* ===== Main program control =====
MAIN-PARA.
* Capture user and format info
IF PARM-LENGTH > 0
MOVE PARM-USER TO WS-USER
END-IF
* Capture current system date/time
MOVE FUNCTION CURRENT-DATE(1:4) TO WS-YEAR
MOVE FUNCTION CURRENT-DATE(5:2) TO WS-MONTH
MOVE FUNCTION CURRENT-DATE(7:2) TO WS-DAY
MOVE FUNCTION CURRENT-DATE(1:8) TO WS-RUN-DATE
MOVE FUNCTION CURRENT-DATE(9:6) TO WS-RUN-TIME
* Open files
PERFORM OPEN-FILES
* Process each input record
PERFORM UNTIL EOF
PERFORM READ-INPUT
IF NOT EOF
PERFORM CALC-MORTGAGE
PERFORM WRITE-SCHEDULE
END-IF
END-PERFORM
PERFORM CLOSE-FILES
GOBACK.
* ===== Mortgage calculations =====
CALC-MORTGAGE.
* Convert input strings to numeric values
COMPUTE B-BAL = FUNCTION NUMVAL(F-AMT)
COMPUTE EXTRA-PAY = FUNCTION NUMVAL(F-EXTRA)
* Convert annual rate to monthly rate
COMPUTE WS-MONTHLY-RATE =
FUNCTION NUMVAL(F-RATE) / 100 / 12
* Total payment count
COMPUTE N-MONTHS =
FUNCTION NUMVAL(F-YEARS) * 12
* Mortgage payment formula
* Handles zero-interest case safely
IF WS-MONTHLY-RATE = 0
COMPUTE SCHED-PAY = B-BAL / N-MONTHS
ELSE
COMPUTE SCHED-PAY =
(B-BAL * WS-MONTHLY-RATE)
/ (1 - FUNCTION EXP(-1 * N-MONTHS *
FUNCTION LOG(1 + WS-MONTHLY-RATE)))
END-IF.
* ===== Schedule generation =====
WRITE-SCHEDULE.
* Loop until loan fully paid off
PERFORM UNTIL B-BAL <= 0
* Interest for current month
COMPUTE INTEREST =
B-BAL * WS-MONTHLY-RATE
* Portion applied to principal
COMPUTE PRINCIPAL =
SCHED-PAY - INTEREST
* Update remaining balance
SUBTRACT PRINCIPAL FROM B-BAL
* Track total interest paid
ADD INTEREST TO CUM-INT
* Output formatted row
PERFORM WRITE-TEXT
END-PERFORM.
* ===== Output formatting =====
WRITE-TEXT.
* Writes formatted payment line
WRITE OUT-REC.
CLOSE-FILES.
* Close all files
CLOSE INFILE OUTFILE.