home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / turbopas / tp-la1.lbr / LA.PQS / LA.PAS
Pascal/Delphi Source File  |  1986-07-26  |  9KB  |  241 lines
  1. {LA.PAS}
  2.         {This program requires the following INCLUDE files:
  3.              A)  NUMFUNC.INC  - Numeric Functions.
  4.              B)  ERRORMSG.INC - Write error messages to screen.
  5.              C)  DATEDIT.INC  - Date editing procedure.
  6.              E)  PRINTUSG.INC - Procedure for formatting
  7.                                 output fields.
  8.              F)  LAHEADER.INC - Heading procedures used by input
  9.                                 and output routines.
  10.              G)  LAINPUT.INC  - Procedures used to input
  11.                                 data fields to this program.
  12.              H)  LAOUTPUT.INC - Procedures used to output
  13.                                 date fields from this program.}
  14. {$C-}   (* FOR FASTER SCREEN I/O *)
  15. PROGRAM LoanAmort;
  16.  
  17. {This program produces a detailed amortization schedule for a
  18. standard loan.
  19.  
  20. Author     : L. L. Smith; 2827 Klusner Ave.; Parma, OH 44134
  21. Environment: CP/M-80, CP/M-86, MS-DOS, PC-DOS}
  22.  
  23. Type
  24.     StrTerm  = ARRAY[1..6] of String[9];
  25.     String80 = string[80];
  26.     String8  = string[8];
  27. Const
  28.     Sign_OnA  : string[21] = 'LA - V1.0  (04/27/85)';
  29.     Sign_OnB  : string[31] = 'COPYRIGHT (C) 1985, L. L. Smith';
  30.     Term_Name : StrTerm    = ('YEARS    ','QUARTERS ','MONTHS   ','BI-MONTHS','WEEKS    ','DAYS     ');
  31. Var
  32.     Balance, Principal, Month_Prin, Interest_Rate, Interest,
  33.     Total_Interest, Interest_To_Date, Print_Interest, Month_Interest,
  34.     Property_Tax, Extra, Print_Extra, Month_Extra, Payment,
  35.     Total_Payment1, Total_Payment2                                 : real;
  36.     Mask, InOption                                                 : String80;
  37.     Print_or_Screen, InKey                                         : char;
  38.     M1, M2, Date, Balloon_Date, DE_Date, Print_Date, Print_Date2   : string[8];
  39.     DD                                                             : string[2];
  40.     Month, Day, Year, Balloon_Number, Number_Of_Payments,
  41.     Start_Extra, Result, Line_Number, Line, Payment_Number, T_Indx : Integer;
  42.     Finished, Recalc, Menu1                                        : boolean;
  43. {$I NUMFUNC.INC}
  44. {$I ERRORMSG.INC}
  45. {$I DATEDIT.INC}
  46. {$I PRINTUSG.INC}
  47. {$I LAHELP.INC}
  48. {$I LAHEADER.INC}
  49. {$I LAINPUT.INC}
  50. PROCEDURE Compute_Header;
  51.     var
  52.         B1, B2, B3 : real;
  53.     Begin
  54.         B1 := Power((1.00 + Interest_Rate/12.00),Number_Of_Payments);
  55.         B2 := B1 * Interest_Rate / 12.00;
  56.         B3 := (B1 - 1.00) / B2;
  57.         Payment := MakeMoney(Principal / B3);
  58.         Total_Payment2 := 0;
  59.         Total_Payment1 := Payment + Property_Tax + Extra;
  60.         If Start_Extra < 999 then
  61.             If Start_Extra > 1 then
  62.                 Begin
  63.                     Total_Payment2 := Total_Payment1;
  64.                     Total_Payment1 := Payment + Property_Tax;
  65.                 end;
  66.     end; (* Compute_Header *)
  67.  
  68. {--------------------------------------------------------------------}
  69.  
  70. PROCEDURE Compute_line;
  71.     Begin
  72.         Payment_Number := Payment_Number + 1;
  73.         Str(Month:2,DD);Delete(Date,1,2);Insert(DD,Date,1);
  74.         Str(Year:2,DD);Delete(Date,7,2);Insert(DD,Date,7);
  75.         If Payment_Number < Start_Extra then
  76.             Month_Extra      := 0
  77.         else
  78.             Month_Extra      := Extra;
  79.         Month_Interest       := MakeMoney(Balance * Interest_Rate / 12.00);
  80.         Month_Prin           := Payment - Month_Interest;
  81.         If Month_Prin > Balance then
  82.             Begin
  83.                 Month_Prin   := Balance;
  84.                 Month_Extra  := 0;
  85.             end (* Begin *)
  86.         Else
  87.             If Payment_Number = Number_Of_Payments then
  88.                 Month_Extra := Month_Extra + Balance - Month_Prin;
  89.         If Payment_Number = Balloon_Number then
  90.             Month_Extra := Month_Extra + Balance - Month_Prin;
  91.         Balance              := Balance - Month_Prin;
  92.         If Month_Extra > Balance then
  93.             Month_Extra := Balance;
  94.         Balance              := Balance - Month_Extra;
  95.         Month := Month + 1;
  96.         If Month > 12 then
  97.             Begin
  98.                 Year  := Year + 1;
  99.                 Month := 1;
  100.             end; (* Begin *)
  101.         Year := Year Mod 100;
  102.     end; (* Compute_Line *)
  103. {$I LAOUTPUT.INC}
  104. PROCEDURE ShowMenu2;
  105.     Begin
  106.         ClrScr;
  107.         GotoXY(14,12);
  108.         Write('I am sorry, but this feature is not yet implemented.');
  109.         GotoXY(18,14);
  110.         Write('We expect version 2.0 to be functional soon');
  111.         Delay(4096);
  112.     end; (* ShowMenu2 *)
  113.  
  114. {--------------------------------------------------------------------}
  115.  
  116. (* Body of Main Program *)
  117. Begin
  118.     Principal          := 0;
  119.     Print_Interest     := 0;
  120.     Number_Of_Payments := 0;
  121.     Total_Payment1     := 0;
  122.     Total_Payment2     := 0;
  123.     Payment            := 0;
  124.     Property_Tax       := 0;
  125.     Extra              := 0;
  126.     Print_Date         := '  /  /  ';
  127.     Print_Date2        := '        ';
  128.     Interest           := 0;
  129.     Interest_Rate      := 0;
  130.     Line_Number        := 0;
  131.     Balloon_Number     := 0;
  132.     Finished           := false;
  133.     Menu1              := true;
  134.     Print_Or_Screen    := 'S';
  135.     Date               := Print_Date;
  136.     Month              := 0;
  137.     Day                := 0;
  138.     Year               := 0;
  139.     T_Indx             := 3;
  140.     Get_Principal;
  141.     Get_Interest;
  142.     Get_Number_Of_Payments;
  143.     Get_Loan_Date;
  144.     Repeat
  145.         Repeat
  146.             ClrScr;
  147.             Date := Print_Date;
  148.             DD   := Copy(Date,1,2);
  149.             Val(DD,Month,Result);
  150.             DD   := Copy(Date,4,2);
  151.             Val(DD,Day,Result);
  152.             DD   := Copy(Date,7,2);
  153.             Val(DD,Year,Result);
  154.             If Principal > 0 then
  155.                 If Number_Of_Payments > 0 then
  156.                     Compute_Header;
  157.             Show_Header;
  158.             GotoXY(22,Line_Number);Write('USE LETTERS BELOW TO CHANGE VALUES');
  159.             Line_Number := Line_Number + 1;
  160.             GotoXY(22,Line_Number);Write('==================================');
  161.             Line_Number := Line_Number + 2;
  162.             GotoXY(01,Line_Number);
  163.             WriteLn(
  164. '        "P" = (P)rincipal              "E" = (E)xtra payment amount');
  165.             WriteLn(
  166. '        "I" = (I)nterest rate          "S" = (S)tart date for extra payment');
  167.             WriteLn(
  168. '        "T" = (T)erm of loan           "D" = (D)ue date for Balloon payoff ');
  169.             WriteLn(
  170. '        "F" = (F)irst payment date     "B" = (B)alloon on/off toggle');
  171.             WriteLn(
  172. '        "N" = (N)on equity amount      "X" = e(X)tended functions');
  173.             WriteLn(
  174. '        "R" = (R)ecalculate            "Q" = (Q)uit / return to system');
  175.             WriteLn;
  176.             WriteLn(
  177. '                              "H"  =  (H)elp ');
  178.             WriteLn;
  179.             Write(
  180. '                             ENTER OPTION = ');
  181.             Recalc := false;
  182.             Read(InOption);
  183.             If Length(InOption) = 0 then
  184.                 InOption := 'H Q';
  185.             InKey := UpCase(Copy(InOption,1,1));
  186.             Case InKey Of
  187.                 'P' : Get_Principal;
  188.                 'I' : Get_Interest;
  189.                 'T' : Get_Number_Of_Payments;
  190.                 'F' : Get_Loan_Date;
  191.                 'N' : Get_Tax;
  192.                 'E' : Get_Extra;
  193.                 'S' : Get_Extra_Start;
  194.                 'D' : Get_Balloon_Date;
  195.                 'B' : If Balloon_Number <> 0 then
  196.                           Balloon_Number := 0
  197.                       Else
  198.                           Get_Balloon_Date;
  199.                 'X' : ShowMenu2;
  200.                 'H' : LaHelp(InOption);
  201.                 'Q' : Begin
  202.                           ClrScr;
  203.                           Finished := true;
  204.                           Recalc   := true;
  205.                       end; (* Begin *)
  206.                 'R' : If Principal > 0 then
  207.                           If Interest_Rate > 0 then
  208.                               If Number_Of_Payments > 0 then
  209.                                   If Month In [1..12] then
  210.                                       Recalc   := true
  211.                                   Else
  212.                                       Error_Msg('First payment',' "F"',24)
  213.                               Else
  214.                                   Error_Msg('Term',' "T"',24)
  215.                           Else
  216.                               Error_Msg('Interest',' "I"',24)
  217.                       Else
  218.                           Error_Msg('Principal',' "P"',24);
  219.             end; (* Case *)
  220.         Until Recalc;
  221.         If NOT Finished then
  222.             Begin
  223.                 Show_Header;
  224.                 Repeat
  225.                     GotoXY(01,16);
  226.                     Write('Should output go to "S" (screen) or "P" (printer)? : ');
  227.                     Read(Print_or_Screen);
  228.                 Until UpCase(Print_or_Screen) In ['S','P'];
  229.                 Total_Interest   := 0;
  230.                 Interest_To_Date := 0;
  231.                 Month_Interest   := 0;
  232.                 Payment_Number   := 0;
  233.                 Balance          := Principal;
  234.                 If UpCase(Print_Or_Screen) = 'S' then
  235.                     ShowOnScreen
  236.                 Else
  237.                     PrintItOut;
  238.                 Print_Or_Screen  := 'S';
  239.             end; (* Begin *)
  240.     Until Finished;
  241. End. (* program LoanAmort *)