IDENTIFICATION DIVISION.
*
PROGRAM-ID. LOANT.
*
DATE-WRITTEN. 04/16/84.
*
* MODIFIED 10/18/97.
*
* *******************************
* * *
* * Judson D. McClendon *
* * Sun Valley Systems *
* * 329 37th Court N.E. *
* * Birmingham, AL 35215 *
* * 205-853-8440 *
* * *
* *******************************
*
ENVIRONMENT DIVISION.
*
CONFIGURATION SECTION.
*
INPUT-OUTPUT SECTION.
*
FILE-CONTROL.
*
I-O-CONTROL.
*
DATA DIVISION.
*
FILE SECTION.
*
WORKING-STORAGE SECTION.
*
* ALPHA 77'S
*
77 WS-ANSWER PIC X(01) VALUE SPACE.
77 WS-COMMAND PIC X(01) VALUE SPACE.
77 WS-ERR-MSG PIC X(40) VALUE SPACES.
*
* NUMERIC 77'S
*
77 WS-ESCAPE-FLAG PIC 9(01) VALUE ZERO.
*
******************************************************************
* *
* L O A N W O R K A R E A *
* *
******************************************************************
*
01 LOAN-WORK-AREA.
03 LW-LOAN-ERROR-FLAG PIC 9(01) COMP.
03 LW-LOAN-AMT PIC 9(06)V9(02) COMP.
03 LW-INT-RATE PIC 9(02)V9(02) COMP.
03 LW-NBR-PMTS PIC 9(03) COMP.
03 LW-PMT-AMT PIC 9(06)V9(02) COMP.
03 LW-INT-PMT PIC 9(01)V9(12) COMP.
03 LW-TOTAL-PMTS PIC 9(06)V9(02) COMP.
03 LW-TOTAL-INT PIC 9(06)V9(02) COMP.
*
SCREEN SECTION.
*
*
* C O M M A N D S C R E E N
*
01 COMMAND-SCREEN.
03 BLANK SCREEN.
03 LINE 01 COLUMN 20 VALUE
"L O A N C O M P U T A T I O N".
03 LINE 03 COLUMN 01 VALUE
"Press: P=Compute Payment Amount,".
03 LINE 04 COLUMN 08 VALUE
"L=Compute Loan Amount,".
03 LINE 05 COLUMN 05 VALUE
"or ESCape to exit: ".
03 PIC X TO WS-COMMAND AUTO.
*
*
* L O A N S C R E E N
*
01 LOAN-SCREEN.
03 LINE 03 COLUMN 01 ERASE EOS.
03 LINE 03 COLUMN 01 VALUE "Payment Amt: ".
03 PIC ZZZZZ9.99 USING LW-PMT-AMT.
03 LINE 04 COLUMN 01 VALUE "Interest Rate: ".
03 PIC Z9.99 USING LW-INT-RATE.
03 LINE 05 COLUMN 01 VALUE "Number Payments: ".
03 PIC ZZ9 USING LW-NBR-PMTS.
*
*
* L O A N A N S W E R S C R E E N
*
01 LOAN-ANSWER-SCREEN.
03 LINE 07 COLUMN 01 VALUE "Loan Amount: ".
03 PIC ZZZ,ZZ9.99 FROM LW-LOAN-AMT.
03 LINE 08 COLUMN 01 VALUE "Total Inter: ".
03 PIC ZZZ,ZZ9.99 FROM LW-TOTAL-INT.
03 LINE 09 COLUMN 01 VALUE "Total Pmts: ".
03 PIC ZZZ,ZZ9.99 FROM LW-TOTAL-PMTS.
*
*
* P A Y M E N T S C R E E N
*
01 PAYMENT-SCREEN.
03 LINE 03 COLUMN 01 ERASE EOS.
03 LINE 03 COLUMN 01 VALUE "Loan Amount: ".
03 PIC ZZZZZ9.99 USING LW-LOAN-AMT.
03 LINE 04 COLUMN 01 VALUE "Interest Rate: ".
03 PIC Z9.99 USING LW-INT-RATE.
03 LINE 05 COLUMN 01 VALUE "Number Payments: ".
03 PIC ZZ9 USING LW-NBR-PMTS.
*
*
* P A Y M E N T A N S W E R S C R E E N
*
01 PAYMENT-ANSWER-SCREEN.
03 LINE 07 COLUMN 01 VALUE "Payment Amt: ".
03 PIC ZZZ,ZZ9.99 FROM LW-PMT-AMT.
03 LINE 08 COLUMN 01 VALUE "Total Inter: ".
03 PIC ZZZ,ZZ9.99 FROM LW-TOTAL-INT.
03 LINE 09 COLUMN 01 VALUE "Total Pmts: ".
03 PIC ZZZ,ZZ9.99 FROM LW-TOTAL-PMTS.
*
*
* E R R O R S C R E E N
*
01 ERROR-SCREEN.
03 LINE 24 COLUMN 20 HIGHLIGHT BLANK LINE
PIC X(40) FROM WS-ERR-MSG.
03 COLUMN 70
PIC X TO WS-ANSWER AUTO.
/
PROCEDURE DIVISION.
*
*
* C O N T R O L
*
000000-CONTROL.
*
INITIALIZE LOAN-WORK-AREA.
IF (LW-LOAN-AMT ZERO)
OR
(LW-INT-RATE ZERO)
OR
(LW-NBR-PMTS ZERO)
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004000-EXIT.
*
DISPLAY COMMAND-SCREEN.
*
PERFORM 000100-GET-COMMAND
THRU 000100-EXIT
UNTIL (WS-ESCAPE-FLAG = 1).
*
000000-EXIT.
STOP RUN.
*
*
* G E T C O M M A N D
*
000100-GET-COMMAND.
*
MOVE SPACE TO WS-COMMAND.
ACCEPT COMMAND-SCREEN
ON ESCAPE
MOVE 1 TO WS-ESCAPE-FLAG
GO TO 000100-EXIT.
INSPECT WS-COMMAND
CONVERTING "abcdefghijklmnopqrstuvwxyz"
TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
*
IF (WS-COMMAND = "P")
DISPLAY PAYMENT-SCREEN
PERFORM 000500-FIND-PAYMENT
THRU 000500-EXIT
ELSE
IF (WS-COMMAND = "L")
DISPLAY LOAN-SCREEN
PERFORM 000600-FIND-LOAN
THRU 000600-EXIT.
*
DISPLAY COMMAND-SCREEN.
*
000100-EXIT.
EXIT.
*
*
* F I N D P A Y M E N T
*
000500-FIND-PAYMENT.
*
ACCEPT PAYMENT-SCREEN
ON ESCAPE
GO TO 000500-EXIT.
*
PERFORM 004000-COMPUTE-PAYMENT
THRU 004000-EXIT.
*
IF (LW-LOAN-ERROR-FLAG = 1)
MOVE "PARAMETER ERROR" TO WS-ERR-MSG
DISPLAY ERROR-SCREEN
GO TO 000500-FIND-PAYMENT.
*
DISPLAY PAYMENT-ANSWER-SCREEN.
*
MOVE "PRESS A KEY TO CONTINUE" TO WS-ERR-MSG..
DISPLAY ERROR-SCREEN.
ACCEPT ERROR-SCREEN.
*
000500-EXIT.
EXIT.
*
*
* F I N D L O A N
*
000600-FIND-LOAN.
*
ACCEPT LOAN-SCREEN
ON ESCAPE
GO TO 000600-EXIT.
*
PERFORM 004100-COMPUTE-LOAN
THRU 004100-EXIT.
*
IF (LW-LOAN-ERROR-FLAG = 1)
MOVE "PARAMETER ERROR" TO WS-ERR-MSG
DISPLAY ERROR-SCREEN
GO TO 000600-FIND-LOAN.
*
DISPLAY LOAN-ANSWER-SCREEN.
*
MOVE "PRESS A KEY TO CONTINUE" TO WS-ERR-MSG..
DISPLAY ERROR-SCREEN.
ACCEPT ERROR-SCREEN.
*
000600-EXIT.
EXIT.
******************************************************************
* *
* C O M P U T E L O A N P A Y M E N T *
* *
* Judson D. McClendon *
* Sun Valley Systems *
* 329 37th Court NE *
* Birmingham, AL 35215 *
* 205/853-8440 *
* *
* USAGE: MOVE <LOAN AMOUNT> TO LW-LOAN-AMT. *
* MOVE <ANNUAL INT %> TO LW-INT-RATE. *
* MOVE <NUMBER PAYMENTS> TO LW-NBR-PMTS. *
* PERFORM 004000-COMPUTE-PAYMENT *
* THRU 004000-EXIT. *
* *
* RESULT: LW-LOAN-ERROR-FLAG = 0 IF CALC SUCCESSFUL *
* LW-LOAN-ERROR-FLAG = 1 IF CALC NOT SUCCESSFUL *
* *
* IF LW-LOAN-ERROR-FLAG = 0 *
* *
* LW-PMT-AMT = AMOUNT OF MONTHLY PAYMENT *
* LW-TOTAL-PMTS = TOTAL AMOUNT OF PAYMENTS *
* LW-TOTAL-INT = TOTAL AMOUNT OF INTEREST *
* *
******************************************************************
*
004000-COMPUTE-PAYMENT.
*
MOVE 0 TO LW-LOAN-ERROR-FLAG.
*
IF (LW-LOAN-AMT ZERO)
OR
(LW-INT-RATE ZERO)
OR
(LW-NBR-PMTS ZERO)
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004000-EXIT.
*
COMPUTE LW-INT-PMT = LW-INT-RATE / 1200
ON SIZE ERROR
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004000-EXIT.
*
COMPUTE LW-PMT-AMT ROUNDED =
(LW-LOAN-AMT * LW-INT-PMT) /
(1 - 1.00000000 / ( (1 + LW-INT-PMT) ** LW-NBR-PMTS) )
ON SIZE ERROR
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004000-EXIT.
*
COMPUTE LW-TOTAL-PMTS = LW-PMT-AMT * LW-NBR-PMTS
ON SIZE ERROR
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004000-EXIT.
*
COMPUTE LW-TOTAL-INT = LW-TOTAL-PMTS - LW-LOAN-AMT.
*
004000-EXIT.
EXIT.
*
*
*
******************************************************************
* *
* C O M P U T E L O A N A M O U N T *
* *
* Judson D. McClendon *
* Sun Valley Systems *
* 329 37th Court NE *
* Birmingham, AL 35215 *
* 205/853-8440 *
* *
* USAGE: MOVE <MONTHLY PAYMENT> TO LW-LOAN-AMT. *
* MOVE <ANNUAL INT %> TO LW-INT-RATE. *
* MOVE <NUMBER PAYMENTS> TO LW-NBR-PMTS. *
* PERFORM 004100-COMPUTE-LOAN *
* THRU 004100-EXIT. *
* *
* RESULT: LW-LOAN-ERROR-FLAG = 0 IF CALC SUCCESSFUL *
* LW-LOAN-ERROR-FLAG = 1 IF CALC NOT SUCCESSFUL *
* *
* IF LW-LOAN-ERROR-FLAG = 0 *
* *
* LW-LOAN-AMT = AMOUNT OF LOAN *
* LW-TOTAL-PMTS = TOTAL AMOUNT OF PAYMENTS *
* LW-TOTAL-INT = TOTAL AMOUNT OF INTEREST *
* *
******************************************************************
*
004100-COMPUTE-LOAN.
*
MOVE 0 TO LW-LOAN-ERROR-FLAG.
*
IF (LW-PMT-AMT ZERO)
OR
(LW-INT-RATE ZERO)
OR
(LW-NBR-PMTS ZERO)
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004100-EXIT.
*
COMPUTE LW-INT-PMT = LW-INT-RATE / 1200
ON SIZE ERROR
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004100-EXIT.
*
COMPUTE LW-LOAN-AMT = LW-PMT-AMT *
( (1 - 1.00000000 / ( (1 + LW-INT-PMT) ** LW-NBR-PMTS) )
/ LW-INT-PMT)
ON SIZE ERROR
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004100-EXIT.
COMPUTE LW-TOTAL-PMTS = LW-PMT-AMT * LW-NBR-PMTS
ON SIZE ERROR
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004100-EXIT.
COMPUTE LW-TOTAL-INT = LW-TOTAL-PMTS - LW-LOAN-AMT.
*
COMPUTE LW-TOTAL-PMTS = LW-PMT-AMT * LW-NBR-PMTS
ON SIZE ERROR
MOVE 1 TO LW-LOAN-ERROR-FLAG
GO TO 004100-EXIT.
*
COMPUTE LW-TOTAL-INT = LW-TOTAL-PMTS - LW-LOAN-AMT.
*
004100-EXIT.
EXIT.
¤ Dauer der Verarbeitung: 0.14 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|