CP/M/CPM_CDROM.iso/mbug/mbug141.arc/PACCTS.LBR/ACCTS1.IQC/ACCTS1.INC

Text File | 1979-12-31 | 6KB | 226 lines

{This is the first INCLUDE file to ACCTS.PAS}


Overlay Procedure SingleAccount;
Var
   A,B,C : Integer;
   Index : Char;
   Flag : Boolean;

Begin
     Gotoxy(1,7); Write('ACCOUNTS:');
     A:=15; B:=7; C:=1;
     While C<=EndCode do
     Begin
          If A>71 then
          Begin
               A:=1; B:=B + 1;
          end;
          Gotoxy(A,B); Write(Code[C],'-',Accounts[C]);
          A:=A + 14; C:=C + 1;
     end; {While C}
     Writeln; Line(80,#45);
     Repeat
           Gotoxy(20,B+2); Write('Select Account code: ');
           Read(Kbd,Index); Flag:=False;
           For A:=1 to EndCode do
           Begin
                If Index=Code[A] then
                Begin
                     C:=A; Write(Index); Flag:=True;
                end;
           end;
     Until Flag=True;
     If not Shown then
     Begin
          LastLine(Message); Close(Dev);
          Assign(Dev,'LST:');Reset(Dev);
     end else
     Begin
          Assign(Dev,'CON:'); Reset(Dev);
          Clear(3,23); Gotoxy(1,3)
     end;
     Headings; AccTitle(C); Bal:=0;
     For A:=0 to LastRec do
     If Found(A,C) then ProcessLine(A);
     AccBal; Close(Dev);
     If Shown then LastLine(Message);
     Clear(3,23);
end;

Overlay Procedure AllAccounts;
Var
   A,B : Integer;
   Flag : Boolean;

Begin
     If not Shown then
     Begin
          LastLine(Message);
          Assign(Dev,'LST:'); Reset(Dev);
     end else
     Begin
          Assign(Dev,'CON:'); Reset(Dev);
          Clear(3,23); Gotoxy(1,3)
     end;
     Flag:=True; Bal:=0; Headings;
     For B:=1 to EndCode do
     Begin
          For A:=0 to LastRec do
          Begin
               If Found(A,B) then
               Begin
                    If Flag = True then AccTitle(B);
                    ProcessLine(A);
                    Flag:=False
               end;
          end;
          If Flag=False then AccBal;
          Flag:=True
     end;
     Close(Dev);
     If Shown then LastLine(Message);
     Clear(3,23);
end;

Overlay Procedure AccountsBalance;
Var
   A,B : Integer;

Begin
     If not Shown then
     Begin
          LastLine(Message);
          Assign(Dev,'LST:'); Reset(Dev);
     end else
     Begin
          Assign(Dev,'CON:'); Reset(Dev);
          Clear(3,23); Gotoxy(1,3);
     end;
     Total:=0; Bal:=0; Headings;
     For B:=1 to EndCode do
     Begin
          For A:=0 to LastRec do
          If Found(A,B) then Bal:=Bal+Ledger[A].Amount;
          CheckRow(Y); Write(Dev,'     ',Accounts[B]);
          Pline(50-Length(Accounts[B]),#32);
          If Bal<0 then
          Begin
               Write(Dev,'|',Abs(Bal):10:2,'|');
               Pline(10,#32);
               Writeln(Dev,'|');
          end else
          Begin
               Write(Dev,'|'); Pline(10,#32);
               Write(Dev,'|',Bal:10:2);
               Writeln(Dev,'|');
          end; {If Bal =>0}
          Total:=Total+Bal; Bal:=0;
     end; {For B}
     CheckRow(Y); Pline(55,#32); Write(Dev,'+');
     Pline(10,#45); Write(Dev,'+');
     Pline(10,#45); Writeln(Dev,'+');
     CheckRow(Y);
     Pline(49,#32); Write(Dev,'Total |');
     If Total < 0 then
     Begin
          Write(Dev,Abs(Total):10:2,'|');
          Pline(10,#32);
          Writeln(Dev,'|');
     end else
     Begin
          Pline(10,#32);
          Writeln(Dev,'|',Total:10:2,'|');
     end;
     Pline(55,#32); Pline(23,#61); Close(Dev);
     If Shown then LastLine(Message);
     Clear(3,23);
end;

Overlay Procedure CashBook;
Var
   J:Integer;

Begin
     If not Shown then
     Begin
          LastLine(Message);
          Assign(Dev,'LST:'); Reset(Dev);
     end else
     Begin
          Assign(Dev,'CON:'); Reset(Dev);
          Clear(3,20); Gotoxy(1,3)
     end;
     Headings; Bal:=0;
     For J:=0 to LastRec do ProcessLine(J);
     AccBal; Close(Dev);
     If Shown then LastLine(Message);
     Clear(3,23);
end;

Overlay Procedure Load;
Var J : Byte;
    A : Char;
    Temp : AccName;

Begin
     Gotoxy(20,6); Write('Enter file name: ');
     BufLen:=14; Read(FileName);
     If Pos('.',FileName)=0 then
        FileName:=FileName + '.PAC';
     For K:=1 to Length(FileName) do
        FileName[K]:=UpCase(FileName[K]);
     Assign(EntryFile,FileName);
     {$I-}
     Reset(EntryFile);
     {$I+}
     If IOresult<>0 then
     Begin
          Close(EntryFile);
          LastLine('Could not find file.'); Halt
     end;
     Clear(6,6); LastRec:=0; Gotoxy(36,1);
     LowVideo; Write(FileName); NormVideo;
     While not EOF(EntryFile) do
     Begin
          Read(EntryFile,Ledger[LastRec]);
          LastRec:=Succ(LastRec);
      end;
      Close(EntryFile); LastRec:=Pred(LastRec); FileName2:=FileName;
      Delete(FileName2,Pos('.',FileName2),4);
      FileName2:=FileName2 + '.ACC';
      Assign(AccFile,FileName2);
      Reset(AccFile);  K:=0;
      While not EOF(AccFile) do
      Begin
           K:=K+1;
           Readln(AccFile,Accounts[K]);
           Temp:=Accounts[K]; A:=Temp[1];
           Code[K]:=Char(Ord(A)+32);
      end;
      Close(AccFile); EndCode:=K;
      If EndCode > 1 then
      Begin
           For K:=2 to EndCode do
           Begin
                For J:=K downto 2 do
                If Code[K]=Code[J-1] then Code[K]:=Char(Ord(Code[K])-32);
           end;
      end;
end;

Overlay Procedure Save;

Begin
     Rewrite(EntryFile);
     For K:=0 to LastRec do
     Write(EntryFile,Ledger[K]);
     Close(EntryFile);
end;