{LA.PAS} {This program requires the following INCLUDE files: A) NUMFUNC.INC - Numeric Functions. B) ERRORMSG.INC - Write error messages to screen. C) DATEDIT.INC - Date editing procedure. E) PRINTUSG.INC - Procedure for formatting output fields. F) LAHEADER.INC - Heading procedures used by input and output routines. G) LAINPUT.INC - Procedures used to input data fields to this program. H) LAOUTPUT.INC - Procedures used to output date fields from this program.} {$C-} (* FOR FASTER SCREEN I/O *) PROGRAM LoanAmort; {This program produces a detailed amortization schedule for a standard loan. Author : L. L. Smith; 2827 Klusner Ave.; Parma, OH 44134 Environment: CP/M-80, CP/M-86, MS-DOS, PC-DOS} Type StrTerm = ARRAY[1..6] of String[9]; String80 = string[80]; String8 = string[8]; Const Sign_OnA : string[21] = 'LA - V1.0 (04/27/85)'; Sign_OnB : string[31] = 'COPYRIGHT (C) 1985, L. L. Smith'; Term_Name : StrTerm = ('YEARS ','QUARTERS ','MONTHS ','BI-MONTHS','WEEKS ','DAYS '); Var Balance, Principal, Month_Prin, Interest_Rate, Interest, Total_Interest, Interest_To_Date, Print_Interest, Month_Interest, Property_Tax, Extra, Print_Extra, Month_Extra, Payment, Total_Payment1, Total_Payment2 : real; Mask, InOption : String80; Print_or_Screen, InKey : char; M1, M2, Date, Balloon_Date, DE_Date, Print_Date, Print_Date2 : string[8]; DD : string[2]; Month, Day, Year, Balloon_Number, Number_Of_Payments, Start_Extra, Result, Line_Number, Line, Payment_Number, T_Indx : Integer; Finished, Recalc, Menu1 : boolean; {$I NUMFUNC.INC} {$I ERRORMSG.INC} {$I DATEDIT.INC} {$I PRINTUSG.INC} {$I LAHELP.INC} {$I LAHEADER.INC} {$I LAINPUT.INC} PROCEDURE Compute_Header; var B1, B2, B3 : real; Begin B1 := Power((1.00 + Interest_Rate/12.00),Number_Of_Payments); B2 := B1 * Interest_Rate / 12.00; B3 := (B1 - 1.00) / B2; Payment := MakeMoney(Principal / B3); Total_Payment2 := 0; Total_Payment1 := Payment + Property_Tax + Extra; If Start_Extra < 999 then If Start_Extra > 1 then Begin Total_Payment2 := Total_Payment1; Total_Payment1 := Payment + Property_Tax; end; end; (* Compute_Header *) {--------------------------------------------------------------------} PROCEDURE Compute_line; Begin Payment_Number := Payment_Number + 1; Str(Month:2,DD);Delete(Date,1,2);Insert(DD,Date,1); Str(Year:2,DD);Delete(Date,7,2);Insert(DD,Date,7); If Payment_Number < Start_Extra then Month_Extra := 0 else Month_Extra := Extra; Month_Interest := MakeMoney(Balance * Interest_Rate / 12.00); Month_Prin := Payment - Month_Interest; If Month_Prin > Balance then Begin Month_Prin := Balance; Month_Extra := 0; end (* Begin *) Else If Payment_Number = Number_Of_Payments then Month_Extra := Month_Extra + Balance - Month_Prin; If Payment_Number = Balloon_Number then Month_Extra := Month_Extra + Balance - Month_Prin; Balance := Balance - Month_Prin; If Month_Extra > Balance then Month_Extra := Balance; Balance := Balance - Month_Extra; Month := Month + 1; If Month > 12 then Begin Year := Year + 1; Month := 1; end; (* Begin *) Year := Year Mod 100; end; (* Compute_Line *) {$I LAOUTPUT.INC} PROCEDURE ShowMenu2; Begin ClrScr; GotoXY(14,12); Write('I am sorry, but this feature is not yet implemented.'); GotoXY(18,14); Write('We expect version 2.0 to be functional soon'); Delay(4096); end; (* ShowMenu2 *) {--------------------------------------------------------------------} (* Body of Main Program *) Begin Principal := 0; Print_Interest := 0; Number_Of_Payments := 0; Total_Payment1 := 0; Total_Payment2 := 0; Payment := 0; Property_Tax := 0; Extra := 0; Print_Date := ' / / '; Print_Date2 := ' '; Interest := 0; Interest_Rate := 0; Line_Number := 0; Balloon_Number := 0; Finished := false; Menu1 := true; Print_Or_Screen := 'S'; Date := Print_Date; Month := 0; Day := 0; Year := 0; T_Indx := 3; Get_Principal; Get_Interest; Get_Number_Of_Payments; Get_Loan_Date; Repeat Repeat ClrScr; Date := Print_Date; DD := Copy(Date,1,2); Val(DD,Month,Result); DD := Copy(Date,4,2); Val(DD,Day,Result); DD := Copy(Date,7,2); Val(DD,Year,Result); If Principal > 0 then If Number_Of_Payments > 0 then Compute_Header; Show_Header; GotoXY(22,Line_Number);Write('USE LETTERS BELOW TO CHANGE VALUES'); Line_Number := Line_Number + 1; GotoXY(22,Line_Number);Write('=================================='); Line_Number := Line_Number + 2; GotoXY(01,Line_Number); WriteLn( ' "P" = (P)rincipal "E" = (E)xtra payment amount'); WriteLn( ' "I" = (I)nterest rate "S" = (S)tart date for extra payment'); WriteLn( ' "T" = (T)erm of loan "D" = (D)ue date for Balloon payoff '); WriteLn( ' "F" = (F)irst payment date "B" = (B)alloon on/off toggle'); WriteLn( ' "N" = (N)on equity amount "X" = e(X)tended functions'); WriteLn( ' "R" = (R)ecalculate "Q" = (Q)uit / return to system'); WriteLn; WriteLn( ' "H" = (H)elp '); WriteLn; Write( ' ENTER OPTION = '); Recalc := false; Read(InOption); If Length(InOption) = 0 then InOption := 'H Q'; InKey := UpCase(Copy(InOption,1,1)); Case InKey Of 'P' : Get_Principal; 'I' : Get_Interest; 'T' : Get_Number_Of_Payments; 'F' : Get_Loan_Date; 'N' : Get_Tax; 'E' : Get_Extra; 'S' : Get_Extra_Start; 'D' : Get_Balloon_Date; 'B' : If Balloon_Number <> 0 then Balloon_Number := 0 Else Get_Balloon_Date; 'X' : ShowMenu2; 'H' : LaHelp(InOption); 'Q' : Begin ClrScr; Finished := true; Recalc := true; end; (* Begin *) 'R' : If Principal > 0 then If Interest_Rate > 0 then If Number_Of_Payments > 0 then If Month In [1..12] then Recalc := true Else Error_Msg('First payment',' "F"',24) Else Error_Msg('Term',' "T"',24) Else Error_Msg('Interest',' "I"',24) Else Error_Msg('Principal',' "P"',24); end; (* Case *) Until Recalc; If NOT Finished then Begin Show_Header; Repeat GotoXY(01,16); Write('Should output go to "S" (screen) or "P" (printer)? : '); Read(Print_or_Screen); Until UpCase(Print_or_Screen) In ['S','P']; Total_Interest := 0; Interest_To_Date := 0; Month_Interest := 0; Payment_Number := 0; Balance := Principal; If UpCase(Print_Or_Screen) = 'S' then ShowOnScreen Else PrintItOut; Print_Or_Screen := 'S'; end; (* Begin *) Until Finished; End. (* program LoanAmort *)