Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/INVTORY.ZIP/INVTORY.PAS

Pascal/Delphi Source File | 1986-02-19 | 30.1 KB | 978 lines

program Inventory;  (* INVTORY *)
(*$A+,B+,C-,R-,V-*)

(****************************************************************)
(*                                                              *)
(*                  TURBO-access version 1.00                   *)
(*                                                              *)
(*                       INVENTORY PROGRAM                      *)
(*                                                              *)
(*                       Donald E. Palmer                       *)
(*                                                              *)
(*                       (V1.1 25 MAR 85)                       *)
(****************************************************************)
label Stop;

const

(*  data record Size definition *)
  ItemRecSize  =  79;        (*  item record Size *)

(*  TURBO-access constants *)
  MaxDataRecSize  =  ItemRecSize;   (*  max record Size *)
  MaxKeyLen       =  30;            (*  max key Size *)
  PageSize        =  16;            (*  page Size *)
  Order           =  8;             (*  half page Size *)
  PageStackSize   =  6;             (*  page buffer Size *)
  MaxHeight       =  6;             (*  max B-tree height *)


var
  I             : Integer;
  NoOfRecs      : Integer;
  Quanity       : Integer;
  ValPres       : Real;
  ValTotal      : Real;
  CostOrg       : Real;
  Result        : Integer;
  Title         : string[32];
  StoreFil      : string[9];
  FileD,FileC,
    FileN       : string[9];

(*  include TURBO-access modules *)

(*$I ACCESS.BOX*)
(*$I GETKEY.BOX*)
(*$I ADDKEY.BOX*)
(*$I DELKEY.BOX*)

type
  Str2    =  string[2];
  Str3    =  string[3];
  Str6    =  string[6];
  Str8    =  string[8];
  Str9    =  string[9];
  Str15   =  string[15];
  Str30   =  string[30];
  Str32   =  string[32];
  Str80   =  string[80];
  AnyStr  =  string[255];

(*  character set type *)
  CharSet=  set of Char;

(*  customer record definition *)

  ItemRec = record
              ItemStatus : Integer;       (*  ItemStatus *)
              TypeCode   : string[2];     (*  type code *)
              Name       : string[15];    (*  first name of item *)
              AddName    : string[15];    (*  additional item info *)
              Qty        : string[3];     (*  Quanity       *)
              Location   : string[2];     (*  Item Location *)
              DateObt    : string[6];     (*  Date Obtained *)
              OrgCost    : string[8];     (*  Original cost *)
              PresValue  : string[8];     (*  Present Value *)
              TotalValue : string[9];     (*  PresValue*Qty *)
            end;

var

(*  global variables *)
  InvF          : DataFile;
  CodeIndexFile,
  NameIndexFile : IndexFile;
  Ch            : Char;

(**********************************************)
(*  UpcaseStr converts a string to upper case *)
(*    calls: UpcaseStr   called by: UpcaseStr *)
(*                           Main,KeyFromName *)
(**********************************************)
function UpcaseStr(S : Str80) : Str80;
var
  P : Integer;
begin
  for P := 1 to Length(S) do
    S[P] := Upcase(S[P]);
  UpcaseStr := S;
end;

(***********************************************************)
(*  ConstStr returns a string with N characters of value C *)
(*    calls: Conststr    called by: InputStr, ConstStr,    *)
(*                                              Main       *)
(***********************************************************)
function ConstStr(C : Char; N : Integer) : Str80;
var
  S : string[80];
begin
  if N < 0 then
    N := 0;
  S[0] := Chr(N);
  FillChar(S[1],N,C);
  ConstStr := S;
end;
(***********************************************************)
(*  Beep sounds the terminal bell or beeper                *)
(*     calls:none      called by: Find,Select,InputStr     *)
(***********************************************************)
procedure Beep;
begin
  Write(^G);
end;

(***********************************************************)
(* Inputs Item from screen/keyboard                        *)
(*    calls: Beep,ConstStr   called by:InputItem,Find      *)
(***********************************************************)
procedure InputStr(var S     : AnyStr;
                       L,X,Y : Integer;
                       Term  : CharSet;
                   var TC    : Char    );
const
  UnderScore  =  '_';
var
  P : Integer;
  Ch : Char;
begin
  GotoXY(X + 1,Y + 1); Write(S,ConstStr(UnderScore,L - Length(S)));
  P := 0;
  repeat
    GotoXY(X + P + 1,Y + 1); Read(Kbd,Ch);
    case Ch of
      #32..#126 : if P < L then
                  begin
                    if Length(S) = L then
                      Delete(S,L,1);
                    P := P + 1;
                    Insert(Ch,S,P);
                    Write(Copy(S,P,L));
                  end
                  else Beep;
      ^S        : if P > 0 then
                    P := P - 1
                  else Beep;
      ^D        : if P < Length(S) then
                    P := P + 1
                  else Beep;
      ^A        : P := 0;
      ^F        : P := Length(S);
      ^G        : if P < Length(S) then
                  begin
                    Delete(S,P + 1,1);
                    Write(Copy(S,P + 1,L),UnderScore);
                  end;
      ^H,#127   : if P > 0 then
                  begin
                    Delete(S,P,1);
                    Write(^H,Copy(S,P,L),UnderScore);
                    P := P - 1;
                  end
                  else Beep;
      ^Y        : begin
                    Write(ConstStr(UnderScore,Length(S) - P));
                    Delete(S,P + 1,L);
                  end;
    else
      if not (Ch in Term) then Beep;
    end;  {of case}
  until Ch in Term;
  P := Length(S);
  GotoXY(X + P + 1,Y + 1);
  Write('' :L - P);
  TC := Ch;
end;

(***********************************************************)
(*  Select inputs selection from line 23                   *)
(*     calls: Beep     called by: Main,List,CalcVal,Update *)
(***********************************************************)
procedure Select(    Prompt : Str80;
                     Term   : CharSet;
                 var TC     : Char    );
var
  Ch : Char;
begin
  GotoXY(1,23); Write(Prompt,'? ' ); ClrEol;
  repeat
    Read(Kbd,Ch);
    TC := Upcase(Ch);
    if not (TC in Term) then
      Beep;
  until TC in Term;
  Write(Ch);
end;

(************************************************************)
(*  ClearFrame clears the display frame, I.E. Lines 3 to 20 *)
(*    calls: none            called by: Main, List          *)
(************************************************************)
procedure ClearFrame;
var
  I : Integer;
begin
  for I := 3 to 20 do
  begin
    GotoXY(1,I + 1); ClrEol ;
  end;
end;

(**************************************************)
(*  OutForm displays the entry form on the screen *)
(*     calls: none            called by: Update   *)
(**************************************************)
procedure OutForm;
begin
  GotoXY(5,5); Write('Name :');
  GotoXY(35,5); Write('Added Info :');
  GotoXY(1,7); Write('Location :');
  GotoXY(36,7); Write('Type Code :');
  GotoXY(2,9); Write('Quanity :');
  GotoXY(37,9); Write('Date Obt :');
  GotoXY(1,11); Write('Org Cost :$');
  GotoXY(33,11); Write('Pres Value :$');
  GotoXY(33,13); Write('Total Value :$');
end;
(**************************************************)
(*  ClearForm clears all fields in the entry form *)
(*    calls: none       called by: Add, Update    *)
(**************************************************)
procedure ClearForm;
begin
  GotoXY(11,5); Write('' :15);
  GotoXY(47,5); ClrEol;
  GotoXY(11,7); Write('' :15);
  GotoXY(47,7); ClrEol;
  GotoXY(11,9); Write('' :3);
  GotoXY(47,9); ClrEol;
  GotoXY(12,11); Write('' :8);
  GotoXY(47,11); ClrEol;
  GotoXY(47,13); ClrEol;
end;
(**************************************************)
(*  ErrMsg prints msg if Val function errs        *)
(*    calls: none     called by:InputItem,CalcVal *)
(**************************************************)
procedure ErrMsg(var M : Integer);
begin
  if M = 100 then
      begin
        GoToXY(6,19);
        Write('ERROR:  Error in Calculating SumTotal');
      end
    else
      begin
        GoToXY(6,19);
        Write('ERROR:  Input Conversion Error');
        M := M - 1;
      end;
end;

(**************************************************)
(*  InputItem inputs added Item data              *)
(*   calls: InputStr, ErrMsg   called by: Add     *)
(**************************************************)
procedure InputItem(var Item : ItemRec);
const
  Term : CharSet  =  [^E,^I,^M,^X,^Z];
var
  L : Integer;
  TC : Char;
begin
  L := 1;
  with Item do
  repeat
    case L of
      1 : InputStr(Name,15,10,4,Term,TC);
      2 : InputStr(AddName,15,46,4,Term,TC);
      3 : InputStr(Location,2,10,6,Term,TC);
      4 : InputStr(TypeCode,2,46,6,Term,TC);
      5 : Begin
            InputStr(Qty,3,10,8,Term,TC);
            Val(Qty,Quanity,Result);
            if Result>0 then
                  ErrMsg(L);
          end;
      6 : InputStr(DateObt,6,46,8,Term,TC);
      7 : Begin
            InputStr(OrgCost,8,11,10,Term,TC);
            Val(OrgCost,CostOrg,Result);
            if Result>0 then ErrMsg(L);
          end;
      8 : Begin
            InputStr(PresValue,8,46,10,Term,TC);
            Val(PresValue,ValPres,Result);
            if Result>0 then ErrMsg(L);
          end;
      9 : Begin
            ValTotal := ValPres * Quanity;
            Str(ValTotal:9:2,TotalValue);
            GotoXY(47,13);
            Write(TotalValue);ClrEol;
          end;
    end;
    if (TC = ^I) or (TC = ^M) or (TC = ^X) then
      if L = 9 then
        L := 1
      else L := L + 1
    else
      if TC = ^E then
        if L = 1 then
          L := 9
        else L := L - 1;
  until (TC = ^M) and (L = 1) or (TC = ^Z);
end;
(*****************************************************)
(*  OutItem displays the item data contained in Item *)
(*    calls: none            called by: Find         *)
(*****************************************************)
procedure OutItem(var Item : ItemRec);
begin
  with Item do
  begin
    GotoXY(11,5); Write(Name,'' :15 - Length(Name));
    GotoXY(47,5); Write(AddName); ClrEol ;
    GotoXY(11,7); Write(Location,'' :2 - Length(Location));
    GotoXY(47,7); Write(TypeCode); ClrEol;
    GotoXY(11,9); Write(Qty,'' :3 - Length(Qty));
    GotoXY(47,9); Write(DateObt); ClrEol;
    GotoXY(12,11); Write(OrgCost,'' :8 - Length(OrgCost));
    GotoXY(47,11); Write(PresValue); ClrEol;
    GotoXY(47,13); Write(TotalValue); ClrEol;
  end;
end;

(*****************************************************)
(* KeyFromName creates a key from 'Name' and AddName *)
(*   calls: UpcaseStr         called by: Add, Find   *)
(*****************************************************)
function KeyFromName(LastNm : Str15; FirstNm : Str15) : Str30;
const
  Blanks  =  '               ';
begin
  KeyFromName := UpcaseStr(LastNm) +
                 Copy(Blanks,1,15 - Length(LastNm)) +
                 UpcaseStr(FirstNm);
end;

(*****************************************************)
(*  Update is used to update the data base           *)
(*     calls: Select, OutForm, ClearForm, Find, Add  *)
(*     called by: Main                               *)
(*****************************************************)
procedure Update;
var
  Ch : Char;

(*****************************************************)
(*  Add is used to add items                         *)
(*    calls:InputItem, KeyFromName                   *)
(*    calls (ACCESS): FindKey, AddRec, AddKey        *)
(*    called by: Update                              *)
(*****************************************************)
procedure Add;
var
  ItemF : Integer;
  Icode : string[2];
  KeyN  : string[30];
  Item  : ItemRec;
begin
  with Item do
  begin
    FillChar(Item,SizeOf(Item),0);
    repeat
      InputItem(Item);
      KeyN := KeyFromName(Name,AddName);
      FindKey(NameIndexFile, ItemF,KeyN);
      if OK then
      begin
        GotoXY(6,19);
        Write('ERROR : Duplicate Item');
        Beep;
      end;
    until not OK;
    AddRec(InvF,ItemF,Item);
    AddKey(CodeIndexFile, ItemF,TypeCode);
    AddKey(NameIndexFile, ItemF,KeyN);
    GotoXY(6,19); ClrEol;
  end;
end;

(********************************************************)
(*  Find is used to find, edit and delete items         *)
(*    calls: Beep, InputStr, OutItem, KeyFromName       *)
(*    calls (ACCESS): UsedRecs, FindKey, GetRec, PutRec *)
(*         SearchRec, NextKey, PrevKey, DeleteKey,      *)
(*         AddKey                                       *)
(*    called by: Update                                 *)
(********************************************************)
procedure Find;
var
  D,L,I   : Integer;
  Ch,
  TC      : Char;
  Icode,
  PCode   : string[2];
  FirstNm : string[15]; (* Name *)
  KeyN,
  PNm     : string[30];
  LastNm  : string[15]; (* Addname *)
  Item    : ItemRec;
begin
  if UsedRecs(InvF) > 0 then
  begin
    Icode := '';
    repeat
      InputStr(Icode,2,46,6,[^M,^Z],TC);
      if Icode <> '' then
      begin
        FindKey(CodeIndexFile,D,Icode);
        if OK then
        begin
          GetRec(InvF,D,Item);
          OutItem(Item);
        end
        else
        begin
          GotoXY(6,19);
          Write('ERROR : Type code not found'); Beep;
        end;
      end;
    until OK or (Icode = '');
    GotoXY(6,19); ClrEol;
    if Icode = '' then
    begin
      L := 1;
      FirstNm := '';
      LastNm := '';
      repeat
        case L of
          1 : InputStr(FirstNm,15,10,4,[^I,^M,^Z],TC);
          2 : InputStr(LastNm,15,46,4,[^I,^M,^Z],TC);
        end;
        if (TC = ^I) or (TC = ^M) then
          L := 3 - L;
      until (TC = ^M) and (L = 1) or (TC = ^Z);
      KeyN := KeyFromName(FirstNm,LastNm);
      SearchKey(NameIndexFile, D,KeyN);
      if not OK then
        PrevKey(NameIndexFile,D,KeyN);
      repeat
        GetRec(InvF,D,Item);
        OutItem(Item);
        Select('Find : N)ext, P)revious, Q)uit',['N','P','Q'],Ch);
        case Ch of
          'N' : repeat NextKey(NameIndexFile, D,KeyN) until OK;
          'P' : repeat PrevKey(NameIndexFile, D,KeyN) until OK;
        end;
      until Ch = 'Q';
    end;
    Select('Find : E)dit, D)elete, Q)uit',['E','D','Q'],Ch);
    with Item do
    case Ch of
      'E' : begin
              PCode := TypeCode;
              PNm := KeyFromName(Name,AddName);
              repeat
                InputItem(Item);
                if TypeCode = PCode then
                  OK := false
                else
                begin
                  Icode := TypeCode;
                  FindKey(CodeIndexFile, I,Icode);
                  if OK then Beep;
                end;
              until not OK;
              PutRec(InvF,D,Item);
              if TypeCode <> PCode then
              begin
                DeleteKey(CodeIndexFile, D,PCode);
                AddKey(CodeIndexFile, D,TypeCode);
              end;
              KeyN := KeyFromName(Name,AddName);
              if KeyN <> PNm then
              begin
                DeleteKey(NameIndexFile, D,PNm);
                AddKey(NameIndexFile, D,KeyN);
              end;
            end;
      'D' : begin
              DeleteKey(CodeIndexFile,D,TypeCode);
              KeyN := KeyFromName(Name,AddName);
              DeleteKey(NameIndexFile,D,KeyN);
              DeleteRec(InvF,D);
      end;
    end;
  end { of UsedRecs(InvF) > 0 .. }
  else Beep;
end;

begin(* Update*)
  OutForm;
  repeat
    Select('Update : A)dd, F)ind, Q)uit',['A','F','Q'],Ch);
    case Ch of
      'A' : Add;
      'F' : Find;
    end;
    if Ch <> 'Q' then
    begin
      GotoXY(60,2); Write(UsedRecs(InvF) :5);
      ClearForm;
    end;
  until Ch = 'Q';
end;

(********************************************************)
(*  List is used to list items                          *)
(*    calls: PrintItem, DisplayItem, Select, ClearFrame *)
(*    calls (ACCESS): ClearKey, NextKey, GetRec,FileLen *)
(*    called by: Main                                   *)
(********************************************************)
procedure List;
label Escape;
var
  D,L,LD      : Integer;
  Ch,CO,CS,CT : Char;
  Icode,
  LocCode,
  TmpCode     : string[2];
  KeyN        : string[30];
  Title       : string[32];
  Item        : ItemRec;

(**************************************)
(*  PrintItem sends output to printer *)
(*    calls: none    called by: List  *)
(**************************************)
procedure PrintItem(    AT  : char;
                        AC  : Str2;
                        itm :ItemRec;
                        Ttl :Str32);
begin
  with itm do
    begin
    if AT = 'T' then
        begin
          if TypeCode = AC then
            begin
              Write(Lst,TypeCode,ConstStr(' ',2-Length(TypeCode)),' ',Title);
              Write(Lst,ConstStr(' ',32-Length(Title)),' ');
              Write(Lst,Location,ConstStr(' ',2-Length(Location)),' ');
              Write(Lst,DateObt,ConstStr(' ',6-Length(DateObt)),' $',OrgCost);
              Write(Lst,ConstStr(' ',8-Length(OrgCost)),' $',PresValue);
              Write(Lst,ConstStr(' ',8-Length(PresValue)),' ',Qty);
              Writeln(Lst,ConstStr(' ',3-Length(Qty)),' $',TotalValue);
            end;
        end
      else
        begin
          if AT = 'L' then
            begin
              if Location = AC then
              begin
                Write(Lst,TypeCode,ConstStr(' ',2-Length(TypeCode)),' ',Title);
                Write(Lst,ConstStr(' ',32-Length(Title)),' ');
                Write(Lst,Location,ConstStr(' ',2-Length(Location)),' ');
               Write(Lst,DateObt,ConstStr(' ',6-Length(DateObt)),' $',OrgCost);
                Write(Lst,ConstStr(' ',8-Length(OrgCost)),' $',PresValue);
                Write(Lst,ConstStr(' ',8-Length(PresValue)),' ',Qty);
                Writeln(Lst,ConstStr(' ',3-Length(Qty)),' $',TotalValue);
              end;
            end
          else
            begin
              Write(Lst,TypeCode,ConstStr(' ',2-Length(TypeCode)),' ',Title);
              Write(Lst,ConstStr(' ',32-Length(Title)),' ');
              Write(Lst,Location,ConstStr(' ',2-Length(Location)),' ');
              Write(Lst,DateObt,ConstStr(' ',6-Length(DateObt)),' $',OrgCost);
              Write(Lst,ConstStr(' ',8-Length(OrgCost)),' $',PresValue);
              Write(Lst,ConstStr(' ',8-Length(PresValue)),' ',Qty);
              Writeln(Lst,ConstStr(' ',3-Length(Qty)),' $',TotalValue);
            end;
        end;
    end; {with}
end; {PrintItem}

(****************************************)
(*  DisplayItem sends output to Screen  *)
(*    calls: none    called by: List    *)
(****************************************)
procedure DisplayItem(    AT  : char;
                        AC  : Str2;
                        itm :ItemRec;
                        Ttl :Str32;
                    var M   : integer);
begin
  with itm do
    begin
    if AT = 'T' then
      begin
        if TypeCode = AC then
          begin
            GotoXY(1,M + 1); Write(TypeCode);
            GotoXY(4,M + 1); Write(Title);
            GotoXY(37,M + 1); Write(Location);
            GotoXY(40,M + 1); Write(DateObt);
            GotoXY(47,M + 1); Write('$',OrgCost);
            GotoXY(57,M + 1); Write('$',PresValue);
            GotoXY(66,M + 1); Write(Qty);
            GotoXY(70,M + 1); Write('$',TotalValue);
            M := M + 1;
          end;
      end
   else
      begin
        if Location = AC then
          begin
            GotoXY(1,M + 1); Write(TypeCode);
            GotoXY(4,M + 1); Write(Title);
            GotoXY(37,M + 1); Write(Location);
            GotoXY(40,M + 1); Write(DateObt);
            GotoXY(47,M + 1); Write('$',OrgCost);
            GotoXY(57,M + 1); Write('$',PresValue);
            GotoXY(66,M + 1); Write(Qty);
            GotoXY(70,M + 1); Write('$',TotalValue);
            M := M + 1;
          end;
      end;
    end; {with itm}
end; {DisplayItem}

begin(* List *)
  Select('Output device : P)rinter, S)creen',['P','S'],CO);
  Select('Sort by : C)ode, N)ame, U)nsorted',['C','N','U'],CS);
  Select('Template Wanted?: L)ocation T)ypeCode Z)none',['L','T','Z'],CT);
  if CT <> 'Z' then
    begin
      if CT = 'L' then
          begin
            GotoXY(1,23);Write('Enter Location Template:');ClrEol;
            Read(trm,LocCode);
          end
        else
          begin
            GotoXY(1,23);Write('Enter TypeCode Template:');ClrEol;
            Read(trm,TmpCode);
          end;
    end;
  GotoXY(1,23); Write('Press <Esc> to abort'); ClrEol;
  ClearKey(CodeIndexFile);
  ClearKey(NameIndexFile);
  D := 0;
  LD := FileLen(InvF) - 1;
  L := 4;
  if CO = 'P' then
       begin
         Writeln(Lst);
         Write(Lst,'TC Title                           Loc Date   OrgCost   ');
         Writeln(Lst,'PresVal   Qty TotalVal');
       end;
  repeat
    if KeyPressed then
    begin
      Read(Kbd,Ch);
      if Ch = #27 then
        goto Escape;
    end;
    case CS of
      'C' : NextKey(CodeIndexFile,D,Icode);
      'N' : NextKey(NameIndexFile,D,KeyN);
      'U' : begin
              OK := false;
              while (D < LD) and not OK do
              begin
                D := D + 1;
                GetRec(InvF,D,Item);
                OK := Item.ItemStatus = 0;
              end;
            end;
    end;
    if OK then
      with Item do
      begin
        if CS <> 'U' then
          GetRec(InvF,D,Item);
        Title := Name;
        if AddName <> '' then
          Title := Name + ', ' + AddName;
        if CO = 'P' then
          begin
            if CT = 'L' then
                PrintItem(CT,LocCode,Item,Title)
              else
                if CT = 'T' then
                    PrintItem(CT,TmpCode,Item,Title)
                  else
                    PrintItem(CT,CT,Item,Title);
          end
        else
          begin
            GotoXY(1,4);Write('TC Title');
            GotoxY(36,4);Write('Loc  Date  OrgCost   PresVal  Qty   TotalVal');
            if L = 21 then
              begin
              GotoXY(1,23);
              Write('Press <RETURN> to continue');
              Write(' or <Esc> to abort');
              ClrEol;
              repeat
                Read(Kbd,Ch)
              until (Ch = ^M) or (Ch = #27);
              if Ch = #27 then
                goto Escape;
              GotoXY(1,23);
              Write('Press <Esc> to abort'); ClrEol;
              ClearFrame;
              L := 4;
          end;
          if CT <> 'Z' then
              begin
                if CT = 'L' then
                    DisplayItem(CT,LocCode,Item,Title,L)
                  else
                    DisplayItem(CT,TmpCode,Item,Title,L);
              end
            else
              begin
                GotoXY(1,L + 1); Write(TypeCode);
                GotoXY(4,L + 1); Write(Title);
                GotoXY(37,L + 1); Write(Location);
                GotoXY(40,L + 1); Write(DateObt);
                GotoXY(47,L + 1); Write('$',OrgCost);
                GotoXY(57,L + 1); Write('$',PresValue);
                GotoXY(66,L + 1); Write(Qty);
                GotoXY(70,L + 1); Write('$',TotalValue);
                L := L + 1;
              end;
      end; { of with Item do .. }
    end; { of if OK .. }
  until not OK;
  if CO = 'S' then
  begin
    GotoXY(1,23); Write('Press <RETURN>'); ClrEol;
    repeat
      Read(Kbd,Ch)
    until Ch = ^M;
  end;
  Escape :
end;

(*************************************************************)
(*  CalcValue calculates the present value of selected Items *)
(*   calls:GetRec,Select,ErrMsg,CalcValue    called by: Main *)
(*************************************************************)
procedure CalcValue;
var
  ValTotal,
  SumTotal  : Real;
  Item      : ItemRec;
  Ch,CO,LT  : Char;
  LocCode,
  TmpCode   : string[2];
  LD,D,L,
  Result    : integer;
  TotalSum,
  TmpVal    : string[9];


(*************************************************************)
(*  DelBlanks changes blanks in 'TotalValue' into zeros      *)
(*     This is so the 'Val' function can be used             *)
(*    calls: none          called by: CalcValue              *)
(*************************************************************)
procedure DelBlanks(TotalTmp : Str9; var ValTmp : Str9);
var
  I    : integer;
begin
  for I := 1 to 9 do
    begin
      if TotalTmp[I] = ' ' then
          ValTmp[I] := '0'
        else
          ValTmp[I] := TotalTmp[I];
    end;
end; {DelBlanks}


begin
  SumTotal := 0;
  LD := FileLen(InvF) - 1;
  D := 1;
  L := 100; {dummy var}
  begin
    Select('Output device : P)rinter, S)creen',['P','S'],CO);
    Select('Template? : L)ocation, T)ypeCode, Z)none', ['L','T','Z'], Ch);
    if Ch <> 'Z' then
        begin
          if Ch = 'L' then
              begin
                GotoXY(1,23);Write('Enter Location Template:');ClrEol;
                Read(trm,LocCode);
              end
            else
              begin
                GotoXY(1,23);Write('Enter TypeCode Template:');ClrEol;
                Read(trm,TmpCode);
              end;
        end;
  end;
  repeat
      GetRec(invF,D,Item);
      with Item do
      begin
        if Ch <> 'Z' then
          begin
            if Ch = 'L' then
              begin
                if Location = LocCode then
                  begin
                    DelBlanks(Item.TotalValue,TmpVal);
                    Val(TmpVal,ValTotal,Result);
                    if Result <> 10 then ErrMsg(L);
                    SumTotal := ValTotal + SumTotal;
                  end;
              end
            else
              begin
                if TypeCode = TmpCode then
                  begin
                    DelBlanks(Item.TotalValue,TmpVal);
                    Val(TmpVal,ValTotal,Result);
                    if Result <> 10 then ErrMsg(L);
                    SumTotal := ValTotal + SumTotal;
                  end;
              end;
          end
        else
          begin
            DelBlanks(Item.TotalValue,TmpVal);
            Val(TmpVal,ValTotal,Result);
            SumTotal := ValTotal + SumTotal;
          end;
      end; {with Item do}
    D := D + 1;
  until D > LD;
  Str(SumTotal:9:2,TotalSum);
  if CO = 'P' then
        begin
          if Ch = 'Z' then
              begin
                Writeln(Lst);
                Write(Lst,'Total Value for all items is: $',TotalSum);
              end
            else
              begin
                if Ch = 'L' then
                    begin
                      Writeln(Lst);
                      Write(Lst,'Total Value for items in Location [');
                      Writeln(Lst,LocCode,'] is: $',TotalSum);
                    end
                  else
                    begin
                      Writeln(Lst);
                      Write(Lst,'Total Value for items with TypeCode [');
                      Writeln(Lst,TmpCode,'] is: $',TotalSum);
                    end;
              end;
        end
      else
        begin
          if Ch <> 'Z' then
            begin
                if Ch = 'L' then
                    begin
                      GotoXY(1,6);
                      Write('Total Value for items in Location [');
                      Write(LocCode,'] is: $',TotalSum);
                    end
                  else
                    begin
                      GotoXY(1,6);
                      Write('Total Value for items with TypeCode [');
                      Write(TmpCode,'] is: $',TotalSum);
                    end;
            end
          else
            begin
              GotoXY(1,6);
              Write('Total Value for all items is: $',TotalSum);
            end;
        repeat
          GotoXY(1,23);Write('Press <RETURN> to Continue.');ClrEol;
          Read(Kbd,LT);
        until LT = ^M;
      end;
end; {CalcValue}


(***************************************************************)
(*  Main program                                               *)
(*    calls: List, Update, CalcValue, Select, ClearFrame       *)
(*           ConstStr, UpcaseStr                               *)
(*    calls (ACCESS): OpenFile, OpenIndex, MakeFile, MakeIndex *)
(*                    CloseFile, CloseIndex                    *)
(***************************************************************)
(* Main program *)

begin
  ClrScr ;
  Writeln(ConstStr('-',79));
  Writeln('TURBO-Access Inventory Database');
  Writeln(ConstStr('-',79));
  GotoXY(1,22); Writeln(ConstStr('-',79));
  Writeln;
  Write(ConstStr('-',79)); GotoXY(1,4);
  InitIndex;
  GotoXY(1,23);
  Write('Enter Disk Drive then 3-Letter name of Data & Index file:');
  Read(trm,StoreFil);
  FileD := Concat(StoreFil,'.DAT');
  FileC := Concat(StoreFil,'.IXC');
  FileN := Concat(StoreFil,'.IXN');
  OpenFile(InvF,FileD,ItemRecSize);
  if OK then
    OpenIndex(CodeIndexFile,FileC,2,1);
  if OK then
    OpenIndex(NameIndexFile,FileN,30,0);
  if not OK then
  begin
    Select('Data files missing. Create new files (Y/N)', ['Y','N'], Ch);
    if Ch = 'Y' then
    begin
      MakeFile(InvF,FileD,ItemRecSize);
      MakeIndex(CodeIndexFile,FileC,2,1);
      MakeIndex(NameIndexFile,FileN,30,0);
    end
   else goto Stop;
  end;
  GotoXY(60,2); Write(UsedRecs(InvF):5,' Records in use');
  repeat
    Select('Select: U)pdate, L)ist, C)alc Value, Q)uit',['U','L','C','Q'], Ch);
    case Ch of
      'U' : Update;
      'L' : List;
      'C' : CalcValue;
    end;
    if Ch <> 'Q' then
          ClearFrame
      else
        begin
          GotoXY(1,23);Select('Do you really want to Quit (Y/N)',['Y','N'],Ch);
          if UpCase(Ch) = 'Y' then
              Ch := 'Q'
            else
              Ch := 'X';
        end;
  until UpCase(Ch) = 'Q';
  CloseFile(InvF);
  CloseIndex(CodeIndexFile) ;
  CloseIndex(NameIndexFile) ;
  Stop :
  ClrScr;
end.