CP/M/CPM_CDROM.iso/mbug/mbug117.arc/PACCTS.LBR/ACCTS2.IQC/ACCTS2.INC

Text File | 1979-12-31 | 5KB | 163 lines

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


Overlay Procedure StartLedger;
Var
   J,Z : Byte; A : Char;

Begin
     Gotoxy(20,6); Write('Enter file name: ');
     BufLen:=14; Read(FileName);
     If Pos('.',FileName) = 0 then
          FileName:=FileName + '.ACC' else
     Begin
          Delete(FileName,Pos('.',FileName),4);
          FileName:=FileName + '.ACC'
     end;
     For J:=1 to 20 do
         Accounts[J]:='';
     LastRec:=-1; Clear(6,6); Gotoxy(1,6);
     Write('Enter Account names (Max 20). Press <ESC> to stop entries:');
     K:=0;
     While (K<21) and (A <> #27) do
     Begin
          J:=1; K:=K+1;
          If K<18 then Gotoxy(20,K+6) else
          Gotoxy(50,K-11); Write('--> ');
          Accounts[K]:='';
          Repeat
                Read(Kbd,A); A:=UpCase(A); Write(A);
                Accounts[K]:=Accounts[K] + A;
                If J=1 then Code[K]:=A;
                J:=J+1
          Until (A=#13) or (A=#27);
          Delete(Accounts[K],J-1,1);
          Code[K]:=Char(Ord(Code[K])+32);
          If K>1 then
          Begin
               For J:=K downto 2 do
               If Code[K]=Code[J-1] then Code[K]:=Char(Ord(Code[K])-32);
          end;
     end;
     Assign(AccFile,FileName);
     Rewrite(AccFile); EndCode:=K-1;
     For J:=1 to EndCode do
     Writeln(AccFile,Accounts[J]);
     Close(AccFile);
     Delete(FileName,Pos('.',FileName),4);
     FileName:=FileName + '.PAC';
     For K:=1 to Length(FileName) do
         FileName[K]:=UpCase(FileName[K]);
     Assign(EntryFile, FileName);
     Rewrite(EntryFile);
     Clear(3,23); Gotoxy(36,1);
     LOwVideo; Write(FileName); NormVideo;
end;

Overlay Procedure Enter;
Var
   Chr : Char;
   Temp, Temp1 : Julian;
   ValDate : Boolean;
   Day, Month, Year, Result : Integer;
   A, B, C : Byte;

Const
     Duration : Array [1..12] of Byte = (31,29,31,30,31,30,
                                         31,31,30,31,30,31);

Begin
     Gotoxy(1,5); Write('ACCOUNTS:');
     A:=15; B:=5; 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); LastRec:=LastRec + 1;
     If LastRec > MaxRec then
     Begin
          LastLine('Record capacity exceeded: to abort entries');
          Clear(5,9); Exit
     end;
     Gotoxy(5,12); Write('Record no.');
     If Changing then Write(K:4,'  -  ') else
        Write(LastRec:4,'  -  ');
     Write('Date (ddmmyy): ______'); Gotoxy(39,12);
     Temp:=''; ValDate:=False;
     While (Not ValDate) do
     Begin
          Message:='Invalid date: to start again';
          K:=1; Chr:='~';
          While (Chr <> ^M) and (K<7) do
          Begin
               Repeat
                     Read(Kbd,Chr)
               Until Chr in ['0'..'9',^M];
               Write(Chr); K:=K + 1;
               Temp:=Temp+Chr
          end; {While Chr}
          If Chr=^M then
          Begin
               If LastRec=0 then LastLine(Message) else
               Begin
                    Temp:='';
                    Temp1:=Ledger[Pred(LastRec)].Date;
                    Temp:=Copy(Temp1,5,2);
                    Temp:=Temp+Copy(Temp1,3,2);
                    Temp:=Temp+Copy(Temp1,1,2)
               end;
          end; {If Chr}
          Temp1:=Copy(Temp,1,2); Val(Temp1,Day,Result);
          Temp1:=Copy(Temp,3,2); Val(Temp1,Month,Result);
          Temp1:=Copy(Temp,5,2); Val(Temp1,Year,Result);
          If (Day > Duration [Month]) or (Month > 12) or
          (Year < 86) then
          Begin
               LastLine(Message);
               Temp:=''; Gotoxy(39,12); ClrEol;
          end else ValDate:=True
     end; {While not ValDate}
     Gotoxy(39,12); ClrEol;
     Write(Copy(Temp,1,2),'/');
     Write(Copy(Temp,3,2),'/',Copy(Temp,5,2));
     With Ledger[LastRec] do
     Begin
          Date:=Copy(Temp,5,2)+Copy(Temp,3,2);
          Date:=Date+Copy(Temp,1,2); A:=0;
          Repeat
                Gotoxy(24,14); Write('Account code: ');
                If EndCode=1 then
                Begin
                     Write(Code[1],' - ',Accounts[1]);
                     Accode:=Code[1]; A:=1; end else
                Begin
                     Read(Kbd,Accode);
                     For K:=1 to EndCode do
                     Begin
                          If Accode=Code[K] then
                          Begin
                               Write(Accode,' - ',Accounts[K]);
                               A:=1;
                          end;
                     end;
                end; {If EndCode}
          Until A=1;
          Gotoxy(24,16); Write('Details: '); Line(30,#95);
          Gotoxy(33,16); Read(Descr);
          Gotoxy(24,18); Write('Amount: ');
          Read(Amount);
          If Ch='E' then Amount:= -Amount;
     end; {With Ledger}
     If (not Changing) and (LastRec > 0) then Sort;
     Clear(5,18)
end;