Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB34.ZIP/LOAN.PAS

Pascal/Delphi Source File | 1986-02-09 | 31.3 KB | 872 lines

program Loan_Amortization;

{ Copyright 1984, Steve Wood, precision logic systems. Placed
  in the public domain for non-commercial use 2/1/86.
  This program was thrown together to provide an example of
  how to use T-SCREENs in an application. It has not been
  thouroughly tested and probably has some bugs. Feel free
  to use and modify it as you see fit. But, be aware that the
  user is resposible for verifying the accuracy of the results.

  NOTE: To compile the loan demo for a system using a MONOCRHOME
        monitor change VID_SEG and FILE_EXT in the typed constant
        definitions as noted below. }

const  BS    = #8;      CUR_UP     = #72;      F1   = #59;
       CR    = #13;     CUR_LEFT   = #75;      F9   = #67;
       ESC   = #27;     CUR_RIGHT  = #77;      F10  = #68;
       BL    = #32;     CHAR_INS   = #82;
       OK    = 0;       CHAR_DEL   = #83;
       UP    = -1;      VID_SEG    = $B800;   { Change to $B000 for mono.  }
       DOWN  = 1;       VID_OFFSET = $0000;
       TOF   = #12;     FILE_EXT   = '.TSC';  { Change to '.TSM' for mono. }
                        ENTER      = #17#196#217;
                        ARROW      = #205#205#16#32;

type   Fld_Parms   = record
                       xloc       : Byte;
                       yloc       : Byte;
                       fld_len    : Byte;
                       fld_type   : Char;
                       fld_char   : Char;
                       inp_attr   : Byte;
                       disp_attr  : Byte;
                       msg_ptr    : Byte;
                     end;

       Input_Rec   = record
                       borrower   : String[40];
                       collateral : String[40];
                       principle  : Real;
                       rate       : Real;
                       payment    : Real;
                       pmts_per_yr: Integer;
                       first_mo   : Integer;
                       first_yr   : Integer;
                       no_of_pmts : Integer;
                       select_yr  : Integer;
                       out_to     : Char;
                     end;

       Inp_Scrn    = array[1..1792] of Integer;
       Inp_Parm    = array[1..72] of Fld_Parms;
       Inp_Buf     = record
                       buf_scrn   : array[1..1760] of Integer;
                       buf_parm   : Inp_Parm;
                     end;
       Inp_Lines   = array[1..25,1..80] of Integer;

var    fld_dat     : Inp_Parm;
       inp_str     : String[80];
       default     : String[80];
       err_msg     : String[72];
       retry       : String[30];
       inp_rec     : Input_Rec;
       inp_file    : File of Input_Rec;
       vid_scrn    : Inp_Scrn  absolute  VID_SEG:VID_OFFSET;
       vid_line    : Inp_Lines absolute  vid_scrn;
       scrn_buf    : Inp_Buf;
       prompt_buf  : Inp_Scrn;
       prompt_line : Inp_Lines absolute prompt_buf;
       temp_buf    : Inp_Scrn;
       help_buf    : Inp_Scrn;
       scrn_file   : File;
       calc_rate,
       pmt_cnt     : Real;
       io_status,
       last_yr,
       direction   : Integer;
       inchr       : Char;
       incnt, j,
       last_fld,
       fld_no      : Byte;
       data_ok,
       msg_on,
       esc_exit,
       dos_exit    : Boolean;

function Fgnd(attr: Byte): Integer;
    begin
      Fgnd := (attr and $0F) + ((attr and $80) div 8);
    end { Fgnd };

function Bgnd(attr: Byte): Integer;
    begin
      Bgnd := (attr and $70) div $10;
    end { Bgnd };

procedure Beep;
    begin
      Sound(440); Delay(150); NoSound;
    end { Beep };

procedure Clr_Kbd_Buf;
    var kbd_buf  : Byte absolute $0000:$041A;
    var kbd_clr  : Byte absolute $0000:$041C;
    begin
      kbd_buf := kbd_clr;
    end { Clr_Kbd_Buf };

procedure BW_Vid;
    begin
      TextColor(Black); TextBackground(White);
    end { BW_Vid };

procedure Rep_Str(chr: Char; len: Integer);
    var  i  : Integer;
    begin
      for i := 1 to len do
         Write(chr);
    end { Rep_Str };

procedure Do_BackSpace(chr: Char);
    begin
      if incnt > 0 then
        begin
          inp_str[incnt] := BL;
          incnt := incnt -1; Write(BS,chr,BS);
        end
      else Beep;
    end { Do_BackSpace };

procedure Strip_Trailing_Blanks(len: Byte);
   begin
     While inp_str[len] = BL do
       len := len - 1;
     inp_str[0] := chr(len);
   end;

procedure Strip_Leading_Blanks(len: Byte);
   var  p : Byte;
   begin
     p := 1; default := inp_str;
     While inp_str[p] = BL do p := p + 1;
     if p > 1 then
       begin default := Copy(inp_str,p,len); inp_str := default; end;
   end;

procedure Strip_Blanks(len: Byte);
    begin
      Strip_Trailing_Blanks(len);
      Strip_Leading_Blanks(len);
    end;

procedure Disp_Msg;
    var  msg_line  : Byte;
    begin
      if msg_on then
        begin
          msg_line := fld_dat[fld_no].msg_ptr + 9;
          Move(prompt_line[msg_line],vid_line[24],160)
        end
      else
    end { Disp_Msg };

procedure Clear_Prompt;
    begin
      Move(prompt_line[5],vid_line[23],160);
      Move(prompt_line[5],vid_line[24],160);
      Move(prompt_line[5],vid_line[25],160);
    end { Clear_Prompt };

procedure Print_Prompt;
    begin
      Clear_Prompt; Move(prompt_line[21],vid_line[25],160);
    end { Print_Prompt };

procedure Help_Prompt;
    begin
      Clear_Prompt; Move(prompt_line[22],vid_line[24],160);
    end { Help_Prompt };

procedure Disp_Prompt(prmt_no: Byte);
    begin
      vid_line[23] := prompt_line[3 * prmt_no + 1];
      vid_line[24] := prompt_line[3 * prmt_no + 2];
      vid_line[25] := prompt_line[3 * prmt_no + 3];
    end { Disp_Prompt };

procedure Disp_Help;
    var xpos, ypos : Byte;
    begin
      Move(vid_scrn,temp_buf,3520);
      Move(help_buf,vid_scrn,3520);
      Help_Prompt;
      xpos := WhereX; ypos := WhereY;
      GoToXY(51,24); Read(Kbd,inchr); Clr_Kbd_Buf;
      Move(temp_buf,vid_scrn,3520); GoToXY(xpos,ypos);
    end;

procedure Do_Esc(seq: Byte; var end_fld: Boolean);
    var  xchr      : Char;
         temp_str  : String[80];
    begin
      if KeyPressed then with fld_dat[seq] do
        begin
          Read(Kbd,xchr);
          case xchr of
            CUR_UP     : if fld_no > 1 then
                           begin direction := UP; end_fld := True; end
                         else Beep;

            CUR_RIGHT  : if incnt < fld_len then
                           begin
                             incnt := incnt + 1;
                             Strip_Trailing_Blanks(fld_len);
                             if (incnt > length(inp_str)) and
                                (length(inp_str) < length(default)) then
                               begin
                                 inp_str[incnt] := default[incnt];
                                 Write(inp_str[incnt]);
                               end
                             else GoToXY(WhereX + 1,WhereY);
                           end
                         else Beep;
            CUR_LEFT   : if incnt > 0 then
                           begin
                             GoToXY(WhereX - 1, WhereY); incnt := incnt - 1;
                           end
                         else Beep;
            CHAR_INS   : begin
                           Strip_Trailing_Blanks(fld_len);
                           Insert(BL,inp_str,incnt + 1);
                           if length(inp_str) > fld_len then
                             inp_str[0] := chr(fld_len);
                           GoToXY(xloc,yloc); Write(inp_str);
                           GoToXY(xloc + incnt,yloc);
                         end;
            CHAR_DEL   : begin
                           Strip_Trailing_Blanks(fld_len);
                           if (length(inp_str) > 0) and
                              (incnt <= length(inp_str)) then
                             begin
                               Delete(inp_str,incnt + 1,1);
                               GoToXY(xloc,yloc); Write(inp_str,fld_char);
                               inp_str[length(inp_str) + 1] := BL;
                               GoToXY(xloc + incnt,yloc);
                             end;
                         end;
            F9         : begin
                           msg_on := (not msg_on); Disp_Msg;
                           if msg_on then
                             Disp_Msg
                           else
                             Move(prompt_line[8],vid_line[24],160);
                         end;
            F10        : begin
                           Disp_Help; Disp_Prompt(0); Disp_Msg; Clr_Kbd_Buf;
                         end;
            else         Beep;
          end;
          inchr := xchr;
        end
      else begin fld_no := last_fld + 1; esc_exit := True; end_fld := True; end;
    end { Do_Esc };

procedure Do_Ctrl(fld_no: Byte; chr: Char; var end_fld: Boolean);
    begin
      case inchr of
        CR         : begin direction := Down; end_fld := True; end;
        BS         : Do_BackSpace(chr);
        ESC        : Do_Esc(fld_no,end_fld);
        else         Beep;
      end;
    end { Do_Ctrl };

procedure Init_Fld(col,row,len,attr: Byte; fill: Char);
    var  i  : Byte;
    begin
      GoToXY(col,row); TextColor(Fgnd(attr)); TextBackground(Bgnd(attr));
      for i := 1 to len do
         begin Write(fill); inp_str[i] := BL; end;
      GoToXY(col,row);
    end { Init_Fld };

procedure Disp_If_Valid(len: Byte; num: Boolean);
    var valid    : Boolean;
    begin
      if incnt < len then
        begin
          valid := (num and (inchr in ['0'..'9','.','-'])) or
                   ((not num) and (inchr in [' '..'~']));
          if valid then
            begin
              Write(inchr); incnt := incnt + 1; inp_str[incnt] := inchr;
            end
          else Beep;
        end;
    end { Disp_If_Valid };

procedure Re_Disp_Attr(seq: Byte);
    begin
      With fld_dat[seq] do
        begin
          TextColor(Fgnd(disp_attr)); TextBackground(Bgnd(disp_attr));
          GoToXY(xloc,yloc); Rep_Str(BL,fld_len); GoToXY(xloc,yloc);
        end;
    end { Re_Disp_Attr };


procedure Get_Field(seq: Byte);
    var  end_fld, is_num, skip  : Boolean;
         init_len               : Byte;
    begin
      With fld_dat[seq] do
      begin
        incnt := 0; if seq = 9 then init_len := 5 else init_len := fld_len;
        Init_Fld(xloc,yloc,init_len,inp_attr,fld_char);
        end_fld := False;
        if fld_type in ['N','D'] then
          is_num := True
        else is_num := False;
        skip := (fld_no = 9) and (inp_rec.payment > 0.0);
        While ((not end_fld) and (not skip)) do
          begin
            Read(Kbd,inchr);
            if inchr < ' ' then Do_Ctrl(seq,fld_char,end_fld)
            else  Disp_If_Valid(fld_len,is_num);
          end;
        if incnt > 0 then Strip_Trailing_Blanks(fld_len);
      end;
    end { Get_Field };

procedure Define_Fld(seq,col,row,len,attr1,attr2: Byte; chr,typ: Char);
    begin
      With fld_dat[seq] do
        begin
          xloc := col; yloc := row; fld_len := len; inp_attr := attr1;
          disp_attr := attr2; fld_char := chr; fld_type := typ;
        end;
    end { Define_Fld };

procedure Load_Screen;
    begin
      Assign(scrn_file,('LOAN'+FILE_EXT));
      {$I-} Reset(scrn_file); {$I+} io_status := IOresult;
      if io_status = OK then
        begin
          {$I-} BlockRead(scrn_file,scrn_buf,32); {$I+} io_status := IOresult;
          if io_status = OK then
            begin
              Move(scrn_buf,vid_scrn,3520); Move(scrn_buf.buf_parm,fld_dat,576);
            end;
          Close(scrn_file);
        end;
    end { Load_Screen };

procedure Load_Prompts;
    begin
      Assign(scrn_file,('LOAN-PMT'+FILE_EXT));
      {$I-} Reset(scrn_file); {$I+} io_status := IOresult;
      if io_status = OK then
        begin
          {$I-} BlockRead(scrn_file,prompt_buf,28); {$I+} io_status := IOresult;
          Close(scrn_file);
        end;
    end { Load Prompts };

procedure Load_Help;
    begin
      Assign(scrn_file,('LOAN-HLP'+FILE_EXT));
      {$I-} Reset(scrn_file); {$I+} io_status := IOresult;
      if io_status = OK then
        begin
          {$I-} BlockRead(scrn_file,help_buf,28); {$I+} io_status := IOresult;
          Close(scrn_file);
        end;
    end { Load Help };

procedure Disp_Default;
    var  real_val   : Real;
         int_val    : Integer;
    begin
      With inp_rec do
      case fld_no of
        1     : begin
                  inp_str := borrower; Write(inp_str); default := inp_str;
                end;
        2     : begin
                  inp_str := collateral; Write(inp_str); default := inp_str;
                end;
        3     : begin
                  Str(principle:11:2,inp_str); Strip_Blanks(length(inp_str));
                  Val(inp_str,real_val,io_status); Write(real_val:11:2);
                end;
        4     : begin
                  Str(rate:5:3,inp_str); Strip_Blanks(length(inp_str));
                  Val(inp_str,real_val,io_status);
                  Write(real_val:5:3);
                end;
        5     : begin
                  Str(payment:11:2,inp_str); Strip_Blanks(length(inp_str));
                  Val(inp_str,real_val,io_status);
                  Write(real_val:11:2);
                end;
        6     : begin
                  Str(pmts_per_yr:2,inp_str); Strip_Blanks(length(inp_str));
                  Val(inp_str,int_val,io_status);
                  Write(int_val:2);
                end;
        7     : begin
                  Str(first_mo:2,inp_str); Strip_Blanks(length(inp_str));
                  Val(inp_str,int_val,io_status);
                  Write(int_val:2);
                end;
        8     : begin
                  Str(first_yr:2,inp_str); Strip_Blanks(length(inp_str));
                  Val(inp_str,int_val,io_status);
                  Write(int_val:2);
                end;
        9     : begin
                  Str(no_of_pmts:3,inp_str); Strip_Blanks(length(inp_str));
                  Val(inp_str,int_val,io_status); real_val := int_val;
                  Write(real_val:5:2);
                end;
        10    : begin
                  Str(select_yr:2,inp_str); Strip_Blanks(length(inp_str));
                  Val(inp_str,int_val,io_status);
                  Write(int_val:2);
                end;
        11    : begin
                  inp_str := out_to; Write(inp_str); default := inp_str;
                end;
      end;
    end { Disp_Default };

procedure Calc_No_Pmts;
    begin
      With inp_rec do
      pmt_cnt := -(Ln(1 - (principle * calc_rate / payment))
                    / Ln((1.0 + calc_rate)));
    end { Calc_No_Pmts };

procedure Edit_Input(var input_ok: Boolean);
    var  real_val : Real;
         int_val  : Integer;

    function No_Of_Mos: Integer;
        begin
          No_Of_Mos := Trunc(12 / inp_rec.pmts_per_yr * pmt_cnt);
        end { No_Of_Mos };

    procedure Calc_Last_Yr;
        begin
          With inp_rec do
          begin
          last_yr := Trunc((No_of_Mos + first_mo - 2) div 12 + first_yr);
          end;
        end;

    begin
      input_ok := True; Re_Disp_Attr(fld_no);
      err_msg := 'Please verify that the data entered is correct.';
      With inp_rec do
      case fld_no of
        1     : begin Write(inp_str); borrower := inp_str; end;
        2     : begin Write(inp_str); collateral := inp_str; end;
        3     : begin
                  Val(inp_str,real_val,io_status); input_ok := (io_status = 0);
                  if input_ok then
                    begin Write('$',real_val:11:2); principle := real_val; end;
                end;
        4     : begin
                  Val(inp_str,real_val,io_status); input_ok := (io_status = 0);
                  if real_val <= 0.0 then real_val := 0.001;
                  if input_ok then
                    begin Write(real_val:6:3); rate := real_val; end;
                end;
        5     : begin
                  Val(inp_str,real_val,io_status); input_ok := (io_status = 0);
                  if input_ok then
                    begin
                      Write('$',real_val:11:2); payment := real_val;
                      if payment > 0.0 then no_of_pmts := 0;
                    end;
                end;
        6     : begin
                  Val(inp_str,int_val,io_status);
                  input_ok := (io_status = 0) and (int_val in [1..4,6,12,24,26,52]);
                  if input_ok then
                    begin
                      Write(int_val:2); pmts_per_yr := int_val;
                      calc_rate := (rate / pmts_per_yr / 100.0);
                      if (payment > 0.0) and ((calc_rate * principle) >= payment) then
                        begin
                          input_ok := False;
                          err_msg := 'Payment amount insuficient to pay interest.';
                          fld_no := 5;
                        end;
                      if principle * calc_rate > 32760.0 then
                        begin
                          input_ok := False;
                          err_msg := 'Values exceed program limits.';
                          fld_no := 3;
                        end;
                    end
                  else err_msg := 'Valid entries are 1 2 3 4 6 12 24 26 52 ';
                end;
        7     : begin
                  Val(inp_str,int_val,io_status);
                  input_ok := (io_status = 0) and (int_val in [1..12]);
                  if input_ok then
                    begin Write(int_val:2); first_mo := int_val; end;
                end;
        8     : begin
                  Val(inp_str,int_val,io_status); input_ok := (io_status = 0);
                  if input_ok then
                    begin Write(int_val:2); first_yr := int_val; end;
                end;
        9     : begin
                  Val(inp_str,int_val,io_status); input_ok := (io_status = 0);
                  if ((int_val = 0) and (payment = 0.00)) then
                    input_ok := False;
                  if input_ok then
                    begin
                      no_of_pmts := int_val;
                      if int_val = 0 then Calc_No_Pmts else pmt_cnt := int_val;
                      Write(pmt_cnt:5:2);
                      Calc_Last_Yr;
                    end
                  else err_msg := 'Number of pmts. required if payment = 0.00. ' + retry;
                end;
        10    : begin
                  Val(inp_str,int_val,io_status); input_ok := False;
                  if (io_status <> 0) then int_val := -99;
                  if int_val = -1 then input_ok := True;
                  if ((int_val >= first_yr) and (int_val <= last_yr)) then
                    input_ok := True;
                  if input_ok then
                    begin Write(int_val:2); select_yr := int_val; end
                  else
                    begin
                      err_msg := 'No payments due in year selected.';
                      input_ok := False;
                    end;
                end;
        11    : begin
                  input_ok := (io_status = 0) and
                              (UpCase(inp_str[1]) in ['P','V']);
                  if input_ok then
                    begin out_to := UpCase(inp_str); Write(out_to); end
                  else err_msg := 'Valid entries are P and V. ' + retry;
                end;
      end;
    end { Edit_Input };

procedure Disp_Error(prompt_no: Byte);
    begin
      Beep; Disp_Prompt(2); GoToXY(6,24); BW_Vid; Write(err_msg);
      Read(kbd,inchr); Clr_Kbd_Buf; Disp_Prompt(prompt_no); Disp_Msg;
    end { Disp_Error };

procedure Input_Data;
    var input_ok    : Boolean;
    begin
      fld_no := 1;
      Repeat
        if msg_on then Disp_Msg;
        GoToXY(6,23); BW_Vid;
        Rep_Str(BL,72); GoToXY(6,23);
        Disp_Default;
        With fld_dat[fld_no] do
          Define_Fld(fld_no,xloc,yloc,fld_len,inp_attr,disp_attr,fld_char,fld_type);
        Get_Field(fld_no); if incnt = 0 then inp_str := default;
        if fld_no <= last_fld then
          begin
            Edit_Input(input_ok);
            if input_ok then fld_no := fld_no + direction
            else Disp_Error(0);
          end;
      Until (fld_no > last_fld);
    end { Input_Data };

procedure Accept_Data;
    var valid_key    : Boolean;
    begin
      data_ok := False; Disp_Prompt(1); GoToXY(25,23);
      Repeat
        valid_key := True; Clr_Kbd_Buf;
        Read(Kbd,inchr);
        if ((inchr = ESC) and KeyPressed) then Read(Kbd,inchr);
        case inchr of
          CR     : data_ok  := True;
          CUR_UP : Delay(1);
          ESC    : dos_exit := True;
          F10    : begin
                     Disp_Help; Disp_Prompt(1);
                     valid_key := False;
                   end;
          else     valid_key := False;
        end;
      Until valid_key;
    end { Accept_Data };

procedure Load_Inp_Rec;
    begin
      Assign(inp_file,'LOAN.DAT');
      {$I-} Reset(inp_file); {$I+} io_status := IOresult;
      if io_status = OK then
        begin {$I-} Read(inp_file,inp_rec); {$I+} io_status := IOresult; end;
      Close(inp_file);
    end { Load_Inp_Rec };

procedure Update_Inp_Rec;
    begin
      Assign(inp_file,'LOAN.DAT');
      {$I-} Reset(inp_file); {$I+} io_status := IOresult;
      if io_status = OK then
        begin {$I-} Write(inp_file,inp_rec); {$I+} io_status := IOresult; end;
      Close(inp_file);
    end { Update_Inp_Rec };

procedure Disp_Data;
    var input_ok   : Boolean;
    begin
      for fld_no := 1 to last_fld do
         begin Re_Disp_Attr(fld_no); Disp_Default; end;
    end { Disp_Data };

procedure Print_Table;
    var ok_to_print, end_prt : Boolean;
        pmt, line_cnt,
        max_line             : Byte;
        calc_pmt,
        interest,
        loan_balance,
        total_interest,
        total_payments,
        princ_pmt, int_pmt,
        mo_offset            : Real;
        yr_total             : Array[1..3] of Real;
        output_device        : String[4];
        out_file             : Text;

    function Mos_Per_Pmt: Real;
        begin
          Mos_Per_Pmt := 12 / inp_rec.pmts_per_yr;
        end { Mos_Per_Pmt };

    procedure Calc_Payment;
        var  cents, temp  : Real;

        function Adj_Rate(rate,pmts: Real): Real;
            var i           : Byte;
                accum_rate, one_plus_rate  : Real;
            begin
              accum_rate := 1.0; one_plus_rate := 1.0 + rate;
              for i := 1 to trunc(pmts) do
                 accum_rate := (accum_rate / one_plus_rate);
              Adj_Rate := accum_rate;
            end { Adj_Rate };

        begin { Calc_Payment }
          calc_pmt := inp_rec.principle * calc_rate
                      / (1 - Adj_Rate(calc_rate,pmt_cnt));
          With fld_dat[5] do GoToXY(xloc,yloc); temp := calc_pmt;
          Re_Disp_Attr(5); Write(calc_pmt:11:2); GoToXY(40,25);
          cents := Frac(calc_pmt);
          calc_pmt := Trunc(temp) + (Round(cents * 100.0) * 0.01);
        end { Calc_Payment };

    procedure Print_Period(pmt_no: Integer);
        type  Month_Str         = String[3];
        var   prt_mo            : array[1..12] of Month_Str;
              mo_str            : String[48] absolute prt_mo;
              mo_out            : String[3];
              int_due, prin_pd  : Real;
              j, yr_out         : Integer;

        procedure Calc_Period;
            var cents, temp  : Real;
            begin
              int_due := (loan_balance * calc_rate); temp := int_due;
              cents := Frac(int_due);
              int_due := Trunc(temp) + (Round(cents * 100.0) * 0.01);
              if (loan_balance + int_due) < calc_pmt
                then calc_pmt := (loan_balance + int_due);
              prin_pd := calc_pmt - int_due;
              total_interest := total_interest + int_due;
              total_payments := total_payments + calc_pmt;
              loan_balance := loan_balance - prin_pd;
              if ((inp_rec.select_yr = -1) or (inp_rec.select_yr = yr_out)) then
                begin
                  yr_total[1] := yr_total[1] + calc_pmt;
                  yr_total[2] := yr_total[2] + prin_pd;
                  yr_total[3] := yr_total[3] + int_due;
                end;
            end { Calc_Period };

        begin
          mo_str := 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec';
          for j := 0 to 11 do
             mo_str[j * 4] := chr(3);
          mo_out := prt_mo[(inp_rec.first_mo + Round(mo_offset) - 1) mod 12 + 1];
          yr_out := inp_rec.first_yr +
                    ((Round(mo_offset) + inp_rec.first_mo - 1) div 12);
          Calc_Period;
          if (inp_rec.select_yr = -1) or (inp_rec.select_yr = yr_out) then
            begin
              if yr_out < 80 then yr_out := yr_out + 2000
              else yr_out := yr_out + 1900;
              WriteLn(out_file,(pmt_no + 1):3,mo_out:5,yr_out:5,
                    loan_balance:11:2,calc_pmt:12:2,prin_pd:12:2,int_due:12:2);
              line_cnt := line_cnt + 1;
            end;
        end { Print_Period };

    procedure Print_Header;
        begin
          WriteLn(out_file,' Payment       Remaining     Total       Principle   Interest');
          WriteLn(out_file,' No./Date      Principle     Payment     Payment     Payment');
          WriteLn(out_file,' ------------------------------------------------------------');
          line_cnt := 3;
        end { Print_Header };

    procedure Print_Yr_Totals;
        var  j  : Byte;
        begin
          if inp_rec.out_to = 'P' then WriteLn(out_file);
          Write(out_file,'Yearly Totals',loan_balance:11:2);
          for j := 1 to 3 do
             begin
               Write(out_file,yr_total[j]:12:2);
               yr_total[j] := 0.0;
             end;
          WriteLn(out_file); line_cnt := line_cnt + 1;
          if inp_rec.out_to = 'P' then
            begin WriteLn(out_file); line_cnt := line_cnt + 2; end;
        end { Print_Yr_Totals };

    procedure New_Page(out_dev: Char);
        begin
          if out_dev = 'P' then
            Write(out_file,TOF)
          else
            begin
              ClrScr; Print_Prompt; GoToXY(1,1);
            end;
        end { New_Page };

    procedure Ok_To_Cont;
        begin
          GoToXY(1,23); Write('MSG: ',retry,ARROW);
          Repeat Delay(1) Until KeyPressed;
          Read(Kbd,inchr); Clr_Kbd_Buf;
          if inchr=ESC then end_prt := True;
          Move(Prompt_line[5],vid_line[23],180);
        end { Ok_To_Cont };

    procedure Print_Desc;
        var year  : Integer;
        begin
          With inp_rec do
          begin
            WriteLn(out_file,'AMORTIZATION SCHEDULE':52); WriteLn(out_file);
            WriteLn(out_file,' Borrower    : ',borrower);
            WriteLn(out_file,' Collateral  : ',collateral); WriteLn(out_file);
            WriteLn(out_file,' Principle   : ',principle:11:2,'  Interest Rate : ',rate:5:3);
            WriteLn(out_file,' Pmts per Yr : ',pmts_per_yr:2,' ':11,'Number Of Pmts: ',pmt_cnt:5:2);
            WriteLn(out_file);
            if select_yr = -1 then
              WriteLn(out_file,' Complete Schedule')
           else
              begin
                if select_yr < 80 then year := select_yr + 2000
                else year := select_yr + 1900;
                WriteLn(out_file,' Schedule for ',year);
              end;
            WriteLn(out_file);
          end;
        end { Print_Desc };

    procedure Print_Summary;
        begin
          WriteLn(out_file,CR,'Loan Totals ',' ':12,total_payments:12:2,
                  ' ':12,total_interest:12:2);
        end;

    begin { Print Table }
      Print_Prompt; GoToXY(6,24); BW_Vid;
      Write('Press ',ENTER,' When ready to print ',ARROW);
      Repeat Read(Kbd,inchr);
      Until (inchr = CR) or ((inchr = ESC) and (not KeyPressed));
      if inchr = CR then
        begin
          Move(prompt_line[21],vid_line[25],160);
          total_interest := 0.0; total_payments := 0.0;
          for j := 1 to 3 do
             yr_total[j] := 0.0;
          With inp_rec do
          begin
            loan_balance := principle; mo_offset := 0.0;
            total_interest := 0.0; total_payments := 0.0;
            calc_rate := (rate / pmts_per_yr / 100.0);
            if no_of_pmts = 0 then Calc_No_Pmts else pmt_cnt := no_of_pmts;
            if payment = 0.0 then Calc_Payment else calc_pmt := payment;
            if out_to = 'P' then
              begin max_line := 56; output_device := 'LST:' end
            else
              begin
                max_line := 20; output_device := 'CON:';
                With fld_dat[1] do
                begin
                  TextColor(Fgnd(disp_attr)); TextBackground(Bgnd(disp_attr));
                end;
                New_Page(out_to);
              end;
            Assign(out_file,output_device); Reset(out_file);
            if (out_to = 'P') then Print_Desc;
            Print_Header; if (out_to = 'P') then line_cnt := line_cnt + 10;
            pmt := 0; end_prt := False;
            Repeat
              Print_Period(pmt);
              mo_offset := mo_offset + Mos_Per_Pmt;
              if (pmts_per_yr in [2..12]) then
                if ((Round(mo_offset) mod 12) = 0) and (select_yr = -1) then
                  Print_Yr_Totals;
              if line_cnt > max_line then
                begin
                  if out_to = 'P' then New_Page(out_to)
                  else begin Ok_To_Cont; New_Page(out_to); end;
                  Print_Header;
                end;
              pmt := pmt + 1;
              if KeyPressed then Read(Kbd,inchr);
              if inchr = ESC then begin end_prt := True; Beep; end;
              if pmt = trunc(pmt_cnt + 0.99) then end_prt := True;
            Until end_prt;
            if select_yr > -1 then Print_Yr_Totals;
            if ((out_to = 'V') and (inchr <> ESC) and (line_cnt > 3)) then
              Ok_To_Cont;
            if (out_to = 'V') and (select_yr = -1) then
              begin New_Page(out_to); Print_Header; end;
            if (inchr <> ESC) and (select_yr = -1) then Print_Summary;
            if (out_to = 'P') then New_Page(out_to) else Ok_To_Cont;
          end;
        end;
    end { Print_Table };

begin { Loan Amortization }
  ClrScr; Load_Screen; Load_Prompts; Disp_Prompt(1); msg_on := True;
  last_fld := fld_dat[72].fld_len; Load_Help; esc_exit := True;
  dos_exit := False; retry := ' Press ' + ENTER + ' to continue. ';
  Load_Inp_Rec; data_ok := False;
  if io_status = OK then
    While (not dos_exit) do
      begin
        if esc_exit then begin Disp_Data; Clr_Kbd_Buf; Accept_Data; end;
        if (not data_ok) and (not dos_exit) then
          begin
            esc_exit := False; Disp_Prompt(0); Input_Data;
            if esc_exit then Disp_Data;
            Accept_Data;
          end;
          if data_ok then
            begin
              Update_Inp_Rec; Print_Table; Load_Screen;
              esc_exit := True; data_ok := False;
            end;
      end;
    ClrScr; GoToXY(1,23); WriteLn('Session Ended');
end { Loan_Amortization }.