'===========================================================================
' Subject: AMORTIZATION PROGRAM              Date: 12-07-89 (00:00)       
' Author:  Tom Hammond                       Code: QB, QBasic, PDS        
' Origin:  FidoNet QUIK_BAS Echo           Packet: MISC.ABC
'===========================================================================
' > I am in need of a formula to calculate how much of a loan
' > payment goes towards principle and how much goes towards interest.
' > Can anybody Help???

    DSN$ = "AMORT1c.BAS (.EXE)"
    AUTHOR$ = "Tom Hammond"
    REVISED$ = "12/07/89"

    ' Amortization formula

    '    A = P * (I/(1-(1/((1+I)^N))))

    '    Where:  A = Amount of payment
    '            P = Principal
    '            N = Number of payments
    '            I = Periodic interest rate

MAIN:
    GOSUB INTRO.MSG
    GOSUB LOAD.CONSTANTS
    GOSUB ENTER.NAME
    GOSUB ENTER.PRINCIPAL
    GOSUB ENTER.TERM
    GOSUB ENTER.APR
    GOSUB DISPLAY.PMT.DATA.CHECK
    GOSUB SELECT.PRINT.TO.PRINTER
    GOSUB CALC.AMORT.DATA
    GOSUB CHECK.PRINTER.STATUS
    GOSUB PRINT.REPORT.HEADERS
    GOSUB MONTHLY.DATA.ROUTINE
    GOSUB PRINT.FOOTER

    TXT$ = "Press any <Key> to continue"
    GOSUB SCRNCTR
    WHILE INKEY$ = ""
    WEND
    GOTO MAIN

INTRO.MSG:
    CLS
    PRINT DSN$; TAB(66); "By: "; AUTHOR$
    LOCATE 25, 32
    PRINT "Revised: "; REVISED$;
    LOCATE 7, 1
    TXT$ = "Written for"
    GOSUB SCRNCTR
    PRINT
    TXT$ = "{EMPLOYMENT SECURITY CREDIT UNION}"
    GOSUB SCRNCTR
    LOCATE 12, 1
    TXT$ = "This program calculates the amortization of a loan    "
    GOSUB SCRNCTR
    TXT$ = "based upon the initial amount of the loan (principal),"
    GOSUB SCRNCTR
    TXT$ = "the length of time that the loan is for (term) and    "
    GOSUB SCRNCTR
    TXT$ = "the annual interest rate (APR).  Estimates assume an  "
    GOSUB SCRNCTR
    TXT$ = "average of 30.4 days per month.                       "
    GOSUB SCRNCTR
    LOCATE 19, 1
    TXT$ = "<C>ontinue or <Q>uit"
    GOSUB SCRNCTR
QUIT.OR.CONT:
    CQ$ = UCASE$(INKEY$)
    IF CQ$ = "" THEN
        GOTO QUIT.OR.CONT
    ELSEIF CQ$ = "Q" THEN
        CLS
        GOSUB TURN.CAPS.AND.NUMLOCK.OFF
        END
    ELSEIF CQ$ <> "C" AND CQ$ <> CHR$(13) THEN
        BEEP
        GOTO QUIT.OR.CONT
    END IF
    RETURN

LOAD.CONSTANTS:
    HEAD1$ = "           Monthly        Applied        Applied   Unpaid"
    HEAD2$ = "Pmt#       Payment      to Interest   to Principal Balance"
    PF$ = "####   $$###,###.##   $$###,###.##   $$###,###.##     $$###,###.##"
    RETURN

ENTER.NAME:
    CLS
    LOCATE 4, 1
    TXT$ = "Enter the {NAME} of the person for whom these data are being calcul
    PTAB% = 1
    GOSUB SCRNCTR
    PRINT
    PRINT TAB(5); "Name ==> ";
    GOSUB TURN.CAPS.AND.NUMLOCK.ON
    COLOR 15
    INPUT "", NAME$
    COLOR 7
    RETURN

ENTER.PRINCIPAL:
    GOSUB TURN.CAPS.AND.NUMLOCK.ON
    PRINT
    PRINT
    TXT$ = "Enter the {amount} of the loan (principal): "
    PTAB% = 1
    GOSUB SCRNCTR
    LOCATE CSRLIN - 1, 60
    COLOR 15
    PRINT "<== Use ";
    COLOR 31
    PRINT "NO";
    COLOR 15
    PRINT " COMMAS "
    LOCATE CSRLIN - 1, 44
    COLOR 15
    INPUT "$", P
    COLOR 7
    IF P <= 0 THEN
        GOTO MAIN
    END IF
    RETURN

ENTER.TERM:
    LOCATE CSRLIN + 1, 1
    PTAB% = 1
    TXT$ = "Will the {length} (term) of the loan will be in <M>onths or <Y>ears
    GOSUB SCRNCTR
ENTER.TERM.1:
    MY$ = UCASE$(INKEY$)
    IF MY$ = "" THEN
        GOTO ENTER.TERM.1
    END IF
    PRINT
    IF MY$ <> "M" AND MY$ <> "Y" THEN
        BEEP
        GOTO ENTER.TERM.1
    ELSEIF MY$ = "M" THEN
        PTAB% = 10
        TXT$ = "Enter the term in {months}: "
        GOSUB SCRNCTR
        LOCATE CSRLIN - 1, 36
        COLOR 15
        INPUT "", T
        COLOR 7
    ELSEIF MY$ = "Y" THEN
        PTAB% = 10
        TXT$ = "Enter the term in {years}: "
        GOSUB SCRNCTR
        LOCATE CSRLIN - 1, 35
        COLOR 15
        INPUT "", T
        COLOR 7
    END IF
    RETURN

ENTER.APR:
    PRINT
    PTAB% = 10
    TXT$ = "Enter the {annual percentage rate}: "
    GOSUB SCRNCTR
    LOCATE CSRLIN - 1, 44
    COLOR 15
    INPUT "", APR
    COLOR 7
    PRINT
    PRINT
    RETURN

DISPLAY.PMT.DATA.CHECK:
    TXT$ = "Do you want to see payment/balance data for each month <{Y}/N>"
    PTAB% = 1
    GOSUB SCRNCTR
DISPLAY.PMT.DATA.CHECK.1:
    MNTHDATA$ = UCASE$(INKEY$)
    IF MNTHDATA$ = "" THEN
        GOTO DISPLAY.PMT.DATA.CHECK.1
    ELSEIF MNTHDATA$ = CHR$(13) THEN
        MNTHDATA$ = "Y"
    ELSEIF MNTHDATA$ <> "Y" AND MNTHDATA$ <> "N" THEN
        BEEP
        GOTO DISPLAY.PMT.DATA.CHECK.1
    END IF
    RETURN

SELECT.PRINT.TO.PRINTER:
    PRINT
    TXT$ = "Do you want to send the results to your printer <{Y}/N>"
    PTAB% = 1
    GOSUB SCRNCTR
SELECT.PRINT.TO.PRINTER.1:
    PRT$ = UCASE$(INKEY$)
    IF PRT$ = "" THEN
        GOTO SELECT.PRINT.TO.PRINTER.1
    ELSEIF PRT$ = CHR$(13) THEN
        PRT$ = "Y"
    ELSEIF PRT$ <> "Y" AND PRT$ <> "N" THEN
        BEEP
        GOTO SELECT.PRINT.TO.PRINTER.1
    END IF
    IF PRT$ = "Y" THEN
        GOSUB LASER.PRINTER.CHECK
    END IF
    RETURN

LASER.PRINTER.CHECK:
    PRINT
    TXT$ = "Do you have a Laser Printer <{Y}/N>"
    PTAB% = 1
    GOSUB SCRNCTR
LASER.PRINTER.CHECK.1:
    LASER$ = UCASE$(INKEY$)
    IF LASER$ = "" THEN
        GOTO LASER.PRINTER.CHECK.1
    ELSEIF LASER$ = CHR$(13) THEN
        LASER$ = "Y"
    ELSEIF PRT$ <> "Y" AND PRT$ <> "N" THEN
        BEEP
        GOTO LASER.PRINTER.CHECK.1
    END IF
    RETURN

CALC.AMORT.DATA:
    D = P                    ' SAVE PRINCIPAL FOR LATER
    IF MY$ = "Y" THEN
        N = T * 12           ' CONVERT YEARS TO MONTHS
    ELSE
        N = T
    END IF
    I = APR * .01            ' CONVERT APR TO DECIMAL

    I = I / 12               ' CONVERT TO MONTHLY RATE
    A = P * (I / (1 - (1 / ((1 + I) ^ N))))  ' CALCULATE PAYMENT
    RETURN

PRINT.REPORT.HEADERS:
    CLS
    LOCATE 5, 1
    PRINT USING "$$###,###.##"; P;
    PRINT " for";
    IF MY$ = "M" THEN PRINT T; "months at";
    IF MY$ = "Y" THEN PRINT T; "years at";
    PRINT USING " ##.##%"; APR;
    PRINT " APR"
    PRINT
    PRINT "Monthly Payment is:   ";
    PRINT USING "$$###,###.##"; A
    IF PRT$ = "Y" THEN
        GOSUB CHECK.PRINTER.STATUS
        IF LASER$ = "Y" THEN
            LPRINT CHR$(27); "E";           ' RESET LASER PRINTER
        ELSE
            LPRINT CHR$(27); "@";           ' RESET EPSON LQ PRINTERS
            LPRINT
            LPRINT
            LPRINT
        END IF
        LPRINT TAB(30); "EMPLOYMENT SECURITY CREDIT UNION"
        LPRINT
        LPRINT
        LPRINT TAB(10); "Prepared for: "; NAME$;
        LPRINT TAB(58); "Date: "; DATE$
        LPRINT
        LPRINT TAB(9); USING "$$###,###.##"; P;
        LPRINT " for";
        IF MY$ = "M" THEN
            LPRINT T; "months";
        ELSE
            LPRINT T; "years";
        END IF
        LPRINT " at an Annual Percentage Rate of ";
        LPRINT USING "##.##%"; APR
        LPRINT
        LINES = 7
    END IF

    IF MNTHDATA$ = "Y" THEN GOSUB PRINT.HEADERS
    IF PRT$ = "Y" THEN GOSUB LPRINT.HEADERS

    RETURN

MONTHLY.DATA.ROUTINE:
    BB = 0
    FOR X = 1 TO N
        B = D * I            'INTEREST FOR THIS PERIOD
        BB = BB + B          'SUM INTEREST PAID
        IF D <= A - B THEN
            A = B + D        'LAST PAYMENT CALCULATION
        END IF
        C = A - B            'AMOUNT APPLIED TO PRINCIPLE
        D = D - C            'UNPAID BAL. OF PRINCIPLE

        GOSUB DATA.PRINT.ROUTINE

    NEXT X
    RETURN

DATA.PRINT.ROUTINE:
    IF MNTHDATA$ = "Y" THEN
        IF LINES > 57 THEN
            LPRINT
            LPRINT TAB(10); "continued on the next page";
            IF LASER$ = "N" THEN
                LPRINT CHR$(12);
            END IF
            GOSUB LPRINT.NEXT.PAGE
            GOSUB LPRINT.HEADERS
        END IF

        PRINT USING PF$; X; A; B; C; D
        IF PRT$ = "Y" THEN
            LPRINT TAB(10); USING PF$; X; A; B; C; D
            LINES = LINES + 1
        END IF
    END IF
    RETURN

PRINT.FOOTER:
    IF PRT$ = "Y" THEN
        IF LINES > 45 THEN
            LPRINT
            LPRINT TAB(10); "Continued on next page";
            LINES = LINES + 2
            IF LASER$ = "N" OR (LASER$ = "Y" AND LINES < 60) THEN
                LPRINT CHR$(12);
            END IF
            GOSUB LPRINT.NEXT.PAGE
        END IF
        LPRINT
    END IF
    IF PRT$ = "Y" THEN
        LPRINT
        LPRINT TAB(10); "     Amount borrowed:  ";
        LPRINT USING "$$###,###.##"; P
        LPRINT TAB(10); "     Monthly payment:  ";
        LPRINT USING "$$###,###.##"; A
        LPRINT TAB(10); " Total Interest Paid:  ";
        LPRINT USING "$$###,###.##"; BB
        LPRINT TAB(10); "Total Principal Paid:  ";
        LPRINT USING "$$###,###.##"; P
        LPRINT
        LPRINT TAB(10); "Your";
        LPRINT USING "$$###,###.##"; P;
        LPRINT " loan will cost you:";
        LPRINT USING "$$###,###.##"; BB + P
        LPRINT
        LPRINT
        LPRINT TAB(10); "NOTE:  These calculations are based upon 30.4 days per
        LPRINT TAB(10); "       Due to the number of days in the months, your a
        LPRINT TAB(10); "       figures may vary slightly.  Interest is paid on
        LPRINT TAB(10); "       unpaid balance and is calculated on the number
        LPRINT TAB(10); "       between payment.";
        LINES = LINES + 15
        IF LASER$ = "Y" THEN
            IF LINES < 60 THEN
                LPRINT CHR$(12);
            ELSE
                LPRINT
            END IF
        ELSE
            LPRINT CHR$(12);
        END IF
        IF LASER$ = "Y" THEN
            LPRINT CHR$(27); "E";           'RESET LASER PRINTERS
        ELSE
            LPRINT CHR$(27); "@";           'RESET EPSON LQ PRINTERS

        END IF
    END IF

    IF MNTHDATA$ = "Y" THEN
        PRINT
        PRINT
    END IF
    PRINT "Total Interest Paid:  ";
    PRINT USING "$$###,###.##"; BB
    PRINT "Total Principal Paid: ";
    PRINT USING "$$###,###.##"; P
    PRINT
    PRINT "Your";
    PRINT USING "$$###,###.##"; P;
    PRINT " loan will cost you:";
    PRINT USING "$$###,###.##"; BB + P
    PRINT
    PRINT
    PRINT
    RETURN

TURN.CAPS.AND.NUMLOCK.ON:
    DEF SEG = &H40
    POKE 23, 96
    DEF SEG
    RETURN

TURN.CAPS.AND.NUMLOCK.OFF:
    DEF SEG = &H40
    POKE 23, 0
    DEF SEG
    RETURN

SCRNCTR:
    ' SCREEN TEXT-CENTERING AND PRINTING ROUTINE TO HIGHLIGHT TEXT
    ' LAST CHANGED 07/10/89

    ' NOTE: Text enclosed by '{}s' is highlighted WITHOUT the '{}s' printed
    '       Text enclosed by '<>s' is highlighted WITH the '<>s' printed

    '       If the variable PTAB% is equal to zero, TXT$ will be centered.
    '       PTAB% is reset to zero after each pass through this  routine.
    '       If PTAB% is assigned a value greater than zero, then cente
    '       will be bypassed and the PTAB% value will be used as a TAB value.

    '       If PTAB$ is assigned ANY negative value, no centering or TABbing
    '       is done, TXT$ is parsed and printed at the current cursor position.

CHK4TAB:
    ' CHECK FOR TAB% VALUE
    IF PTAB% < 0 THEN
        GOTO PARSETXT
    END IF
    IF PTAB% >= 1 THEN
        LOCATE CSRLIN, PTAB%
        GOTO PARSETXT
    END IF

    ' CENTER TEXT (FIRST REDUCE LINE LENGH BY # BRACES)
    XBRACE = 0
    BRACES = 0


CALCCNTR:
    XBRACE = INSTR(XBRACE + 1, TXT$, "{")
    IF XBRACE = 0 THEN
        GOTO CNTR
    ELSE
         BRACES = BRACES + 2
         GOTO CALCCNTR
    END IF

CNTR:
    LOCATE CSRLIN, INT((80 - LEN(TXT$) + BRACES) / 2) + 1

PARSETXT:
    ' PARSE TEXT FOR '<>s' AND '{}s' AND PRINT ACCORDINGLY
    PTAB% = 0

    POINTER = 1
    PARSED = 0

PARSE1:
    OBRACE = INSTR(POINTER, TXT$, "{")
    LTSYMB = INSTR(POINTER, TXT$, "<")
    IF OBRACE = 0 AND LTSYMB = 0 AND PARSED = 0 THEN
        GOTO PARSE2
    END IF
    PARSED = 1
    IF LTSYMB > 0 AND OBRACE = LTSYMB + 1 THEN
        GOTO PARSE5
    END IF
    IF (LTSYMB > 0 AND LTSYMB < OBRACE) OR (OBRACE = 0 AND LTSYMB > 0) THEN
        GOTO PARSE4
    END IF
    IF (OBRACE > 0 AND OBRACE < LTSYMB) OR (LTSYMB = 0 AND OBRACE > 0) THEN
        GOTO PARSE5
    END IF
    PRINT MID$(TXT$, POINTER, LEN(TXT$))
    GOTO CNTRDONE

PARSE2:
    ' PRINT ENTIRE LINE (NO '<' OR '{' SYMBOLS)
    COLOR 7
    PRINT TXT$
    GOTO CNTRDONE

PARSE4:
    ' ROUTINE TO HIGHLIGHT AND PRINT TEXT, INCLUDING THE '<>' SYMBOLS
    IF LTSYMB > 1 THEN
        PRINT MID$(TXT$, POINTER, LTSYMB - POINTER + 1);
    ELSE
         PRINT LEFT$(TXT$, 1);
    END IF
    COLOR 15
    GTSYMB = INSTR(LTSYMB, TXT$, ">")
    PRINT MID$(TXT$, LTSYMB + 1, GTSYMB - LTSYMB - 1);
    COLOR 7
    PRINT MID$(TXT$, GTSYMB, 1);
    POINTER = GTSYMB + 1
    GOTO PARSE1

PARSE5:
    ' ROUTINE TO HIGHLIGHT AND PRINT TEXT-ONLY WITHIN '{}' SYMBOLS
    IF OBRACE > 1 THEN
        PRINT MID$(TXT$, POINTER, OBRACE - POINTER);
    END IF
    COLOR 15
    CBRACE = INSTR(OBRACE, TXT$, "}")
    PRINT MID$(TXT$, OBRACE + 1, CBRACE - OBRACE - 1);
    COLOR 7
    POINTER = CBRACE + 1
    GOTO PARSE1

CNTRDONE:
    RETURN

CHECK.PRINTER.STATUS:
     DEF SEG = 0
     PORT.NR = 1     ' USE PORT.NR = 1 FOR LPT1 AND N=2 FOR LPT2
     PORT% = PEEK(1030 + (2 * PORT.NR)) + 256 * PEEK(1031 + (2 * PORT.NR))

GET.PRINTER.STATUS:
     STATUS% = INP(PORT% + 1)
     IF STATUS% AND 8 THEN
         CLS
         DEF SEG
         RETURN
     END IF
     CLS


     SOUND 600, 1
     SOUND 800, 1
     SOUND 1000, 1
     LOCATE 11, 32
     PRINT "Printer ";
     COLOR 31
     PRINT "NOT READY"
     COLOR 7
     LOCATE 13, 25
     PRINT "Set printer ";
     COLOR 15
     PRINT "ON-LINE";
     COLOR 7
     PRINT " or ";
     COLOR 15
     PRINT "TURN ON"
     COLOR 7
     SLEEP 2
     CLS
     GOTO GET.PRINTER.STATUS

PRINT.HEADERS:
    PRINT
    PRINT HEAD1$
    PRINT HEAD2$
    PRINT
    RETURN

LPRINT.HEADERS:
    LPRINT TAB(10); HEAD1$
    LPRINT TAB(10); HEAD2$
    LPRINT
    LINES = LINES + 3
    RETURN

LPRINT.NEXT.PAGE:
    IF LASER$ = "N" THEN
        LPRINT
        LPRINT
        LPRINT
    END IF
    LPRINT TAB(10); NAME$; " (cont'd.)"
    LPRINT
    LINES = 2
    RETURN