Topspeed_JPI/TS/MODBASE/CUSTOMER.MOD

IMPLEMENTATION MODULE Customer;
(*
 *  ModBase
 *  Release 3.0
 *  (c) Copyright 1986 - 1991 PMI
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *  by Ed Ross
 *)


FROM ModBase3 IMPORT UpdateDBFile,WriteDBRec,DeleteRecord,ReadDBRec,
     AppendBlank;
FROM PMIGlobals IMPORT PMIScreens,Config,NormalTitle;
FROM DBStuff IMPORT MakeSeqNbr,MakeKey;
FROM DBUtils IMPORT ChangeDateField,ChangeRealField,PrintTitle;
FROM Scrn2DBF IMPORT FrameToDBF, DBFToFrame;
FROM NumTypes IMPORT Real8;
FROM DateFunctions IMPORT Date;
FROM Numbers IMPORT Max;
FROM PosUtils IMPORT Equal;
FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append,CAPstr,
      AssignStr,DeleteChar;
FROM M2Strings IMPORT Length,Assign,Concat;
FROM LowLevel IMPORT Fill;
FROM StringIO IMPORT PrintMessage,ErrorMessage,WriteEol,WriteStr;
(* these next two are from stonybrook - the pmi version doesn't work*)

FROM SmartScreen IMPORT ClearScreen;
FROM ScrnUtl1 IMPORT FieldNum;
FROM ScrnUtl2 IMPORT CloseDisplayFrame;
FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight;
FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName,DisplayFile;
FROM FramePainter IMPORT ShowDisplayFrame,RedrawField;
FROM InputManager IMPORT ControlFrame;
FROM FrameManager IMPORT EraseFrame;
FROM Prompts IMPORT Prompt,PromptStr,PromptNum,PromptYN;
FROM SYSTEM IMPORT ADR,SIZE,ADDRESS;
FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,ChangeField;
FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame;
FROM HandleIO IMPORT FileExists,OpenFile,CloseHandle;
FROM Prompts IMPORT Prompt;
FROM ManualInvoice IMPORT AddManualInvoice;
FROM GenLists IMPORT GenList, NewList,ListLength,GetElmt,
     GetElmtAdr,DisposeList;

FROM Invoice IMPORT ControlInvoice,PayInvoice,InvoiceHistory,
     MakeInvoicePrintLine,InvoiceDaysLate,GetOutstanding;
FROM DBFCustomer IMPORT CustomerDBF, OpenCustomerDBF,
     CloseCustomerDBF,CustomerRec,FindCustomerByCin,FindCustomerByName,
     NextCustomer,PrevCustomer,FirstCustomer,LastCustomer,MoveCustomerFromDBF,
     MoveCustomerToDBF;
FROM Payments IMPORT ShowPaymentHist;
FROM Gas IMPORT ListOutstanding,ListHistory;

VAR
 Status : INTEGER;
 Environ : ARRAY [0..60] OF CHAR;
 J : CARDINAL;
 FirstTime: BOOLEAN;
 NextFrame,EndingFrame : AFrameName;
 SelChar    : CHAR;
 NoData     : BOOLEAN;    (* true when no data is on the screen *)
 CustomerDF : DisplayFrame;
 DSPFile      : DisplayFile;
 PullDnMenu  : GenList;
 CurrentCust : CustomerRec;



PROCEDURE GetCustNbr( VAR CustNbr : ARRAY OF CHAR);
BEGIN
  Assign(CurrentCust.CIN,CustNbr);
  CrunchBlanks(CustNbr);
END GetCustNbr;

PROCEDURE GetCustTerms(VAR Terms : ARRAY OF CHAR);
BEGIN
  Assign(CurrentCust.TERMS,Terms );
END GetCustTerms;

PROCEDURE GetCustSalesRep(VAR Rep : ARRAY OF CHAR);
BEGIN
 Assign(CurrentCust.SALESREP,Rep );
END GetCustSalesRep;

PROCEDURE GetCustSalesRepCom(VAR Percent : Real8);
BEGIN
  Percent := CurrentCust.SALEREPCOM;
END GetCustSalesRepCom;

PROCEDURE GetCustShipVia(VAR Ship : ARRAY OF CHAR);
BEGIN
  Assign( CurrentCust.SHIPVIA,Ship);
END GetCustShipVia;

PROCEDURE GetCustDisAmount(VAR DcntAmount : Real8);
BEGIN
  DcntAmount := CurrentCust.DISCAMOUNT;
END GetCustDisAmount;

PROCEDURE GetCustDisCntLvl(VAR DefaultLvl : CARDINAL);
BEGIN
  DefaultLvl := CurrentCust.DISCLEVEL;
END GetCustDisCntLvl;

PROCEDURE GetCustTaxable(VAR Taxable : CHAR);
BEGIN
  Taxable := CurrentCust.TAXABLE;
  CAPstr(Taxable);
END GetCustTaxable;

PROCEDURE GetCustFreeFrght(VAR FreeFrght : CHAR);
BEGIN
  FreeFrght := CurrentCust.FREEFRGHT;
  CAPstr(FreeFrght);
END GetCustFreeFrght;


PROCEDURE GetCustAddr(VAR Addr : AddressRec; AddrType : AddressTypes);
VAR J : CARDINAL;
BEGIN
  Fill(ADR(Addr),SIZE(Addr),0);
  J := 1;
  WITH CurrentCust DO
    IF AddrType = Billing
      THEN
        Assign(NAME,Addr.Line[0]);
        Assign(   BILLTOZP,Addr.ZipCode);
	Assign(   BILLTOA1,Addr.Line[1]);
	CrunchBlanks(Addr.Line[1]);
	IF Length(Addr.Line[1]) > 0
	  THEN INC(J);
	  END;
	Assign(   BILLTOA2,Addr.Line[J]);
	CrunchBlanks(Addr.Line[J]);
	IF Length(Addr.Line[J]) > 0
	THEN INC(J);
	END;
	Assign(  BILLTOA3,Addr.Line[J]);
	CrunchBlanks(Addr.Line[J]);
	IF Length(Addr.Line[J]) = 0
	  THEN DEC(J);
	  END;
	Append(Addr.Line[J],' ');
	Append(Addr.Line[J],BILLTOZP);
     ELSE	
        Assign(   NAME,Addr.Line[0]);
        Assign(   SHIPTOZP,Addr.ZipCode);
	Assign(   SHIPTOA1,Addr.Line[1]);
	CrunchBlanks(Addr.Line[1]);
	IF Length(Addr.Line[1]) > 0
	  THEN INC(J);
	  END;
	Assign(   SHIPTOA2,Addr.Line[J]);
	CrunchBlanks(Addr.Line[J]);
	IF Length(Addr.Line[J]) > 0
	THEN INC(J);
	END;
	Assign(  SHIPTOA3,Addr.Line[J] );
	CrunchBlanks(Addr.Line[J]);
	IF Length(Addr.Line[J]) = 0
	  THEN DEC(J);
	  END;
	Append(Addr.Line[J],' ');	
	Append(Addr.Line[J],' ');
	Append(Addr.Line[J],SHIPTOZP);
    END;	
  END;  (* end of with *)
END GetCustAddr;

PROCEDURE GetCurrCustName(VAR Name : ARRAY OF CHAR);
BEGIN
 Assign( CurrentCust.NAME,Name);
END GetCurrCustName;

PROCEDURE SetCustomerRec(Cust : CustomerRec);
BEGIN
  CurrentCust := Cust;
END SetCustomerRec;

PROCEDURE UpdateCustomerFile();
BEGIN
 MoveCustomerToDBF(CurrentCust);
 WriteDBRec(CustomerDBF);
END UpdateCustomerFile;


PROCEDURE SetCustLastInvDate( D : Date);
BEGIN
  CurrentCust.LASTINV := D;
  ChangeDateField(CustomerDF,D,'LASTINV');
(*  RedrawField(CustomerDF,FieldNum(CustomerDF,'LASTINV'),FALSE); *)
  UpdateCustomerFile();
END SetCustLastInvDate;

PROCEDURE SetCustOutStd(AmountOut : Real8);
BEGIN
  CurrentCust.AMTOUT := AmountOut;
  ChangeRealField(CustomerDF,AmountOut,'AMTOUT');
  RedrawField(CustomerDF,FieldNum(CustomerDF,'AMTOUT'),FALSE);
  UpdateCustomerFile();
END SetCustOutStd;

PROCEDURE AddCustOutStd(AmountOut : Real8);
BEGIN
  CurrentCust.AMTOUT := CurrentCust.AMTOUT + AmountOut;
  ChangeRealField(CustomerDF,CurrentCust.AMTOUT,'AMTOUT');
  RedrawField(CustomerDF,FieldNum(CustomerDF,'AMTOUT'),FALSE);
  UpdateCustomerFile();
END AddCustOutStd;

PROCEDURE AddCustYTD(AddAmount : Real8);
BEGIN
  CurrentCust.YTDPURCH := CurrentCust.YTDPURCH + AddAmount;
  IF CurrentCust.YTDPURCH < 0.0
    THEN
     CurrentCust.YTDPURCH := 0.0;
    END;
  ChangeRealField(CustomerDF,CurrentCust.YTDPURCH,'YTDPURCH');
(*  RedrawField(CustomerDF,FieldNum(CustomerDF,'YTDPURCH'),FALSE); *)
  UpdateCustomerFile();
END AddCustYTD;

PROCEDURE GetCustName(CIN : ARRAY OF CHAR; VAR Name : ARRAY OF CHAR);
VAR
  TMP : CustomerRec;
BEGIN
  MakeKey(CIN);
  IF NOT FindCustomerByCin(CIN)
    THEN AssignStr( '?????',Name);
    ELSE
      MoveCustomerFromDBF(CurrentCust);
      Assign(CurrentCust.NAME,Name);
    END;
END GetCustName;

PROCEDURE PrintLabels();
(* print shipping labels*)

CONST
  ShipLines = CHR(12);
  FF        = CHR(12);

  NorLength = CHR(66);
(*  L1:=ARRAY OF CHAR (CHR(27),'C');
  L2:ARRAY OF CHAR=[CHR(27),'C',NorLength]; *)
VAR
  Cnt : CARDINAL;
  J,K : CARDINAL;
  PrtHand : CARDINAL;
  EM : ErrorMessage;
  Addr : AddressRec;
  L1 : ARRAY[0..2] OF CHAR;
  L2 : ARRAY[0..3] OF CHAR;
BEGIN
  Concat(27C,'C',L1);
  Concat(L1,NorLength,L2);
  Cnt := PromptNum(' Enter number of labels to print ',1);
  EM := OpenFile(PrtHand,Config.LabelPrt);
  (* put the form length here *)
(*  WriteStr(PrtHand,L1); *) (* set form length to lenght of lables*)
  WriteStr(PrtHand,CHAR(18));
   FOR J := 1 TO Cnt DO
    WriteStr(PrtHand,'FROM  ');
    WriteEol(PrtHand,Config.CompanyName);
    WriteStr(PrtHand,'      ');
    WriteEol(PrtHand,Config.CompanyAddr1);
    WriteStr(PrtHand,'      ');
    WriteEol(PrtHand,Config.CompanyAddr2);
    WriteEol(PrtHand,'');               (* go to the from part *)
    WriteEol(PrtHand,'');
    WriteEol(PrtHand,'');
    WriteEol(PrtHand,'');
    WriteEol(PrtHand,'');
    WriteStr(PrtHand,'TO ');
    GetCustAddr(Addr,Shipping);
    FOR K := 0 TO 3 DO
      WriteEol(PrtHand,Addr.Line[K]);
      WriteStr(PrtHand,'   ');
    END;
    FOR K := 1 TO 6 DO
      WriteEol(PrtHand,'');
     END;
  END;
(*  WriteStr(PrtHand,L2);   (* reset lenght at 66 lines / inch *)*)
  EM := CloseHandle(PrtHand);
END PrintLabels;



PROCEDURE FileMenu(SelChar: CHAR);
VAR
 B : BOOLEAN;
 Str : ARRAY [0..80] OF CHAR;
BEGIN
  CASE SelChar OF
 'A'  : ReadDisplayFrame(PMIScreens,CustomerDF,'Customer');  (*Clear out any of the fields *)
        MakeSeqNbr('Cust',Config.CustNbrPre,Str);
	ChangeField(CustomerDF,Str,'CIN',TRUE);
        ShowDisplayFrame(CustomerDF,0,0,0,0);
        Control(CustomerDF);		(* alow user input *)
        AppendBlank(CustomerDBF);
	B := FrameToDBF(CustomerDBF,CustomerDF); (* do something if couldn't add*)
        MoveCustomerFromDBF(CurrentCust);
	WITH CurrentCust DO
  	   CrunchBlanks(BILLTOA1);
	   IF (BILLTOA1[0] = CHR(0))
	     THEN
	       Assign( SHIPTOA1,BILLTOA1);
	       Assign( SHIPTOA2,BILLTOA2);
	       Assign(SHIPTOA3,BILLTOA3 );
	       Assign( SHIPTOZP,BILLTOZP);
	       MoveCustomerToDBF(CurrentCust);       	
	
	       DBFToFrame(CustomerDBF,CustomerDF);
    	       ShowDisplayFrame(CustomerDF,0,0,0,0);
	     END;
	  END; (* end of with *)
	
	WriteDBRec(CustomerDBF);
	
 |'F' : FirstCustomer();
        DBFToFrame(CustomerDBF,CustomerDF);
	ShowDisplayFrame(CustomerDF,0,0,0,0);
 |'L' : LastCustomer();
        DBFToFrame(CustomerDBF,CustomerDF);
	ShowDisplayFrame(CustomerDF,0,0,0,0);

 |'N' : IF NextCustomer()
          THEN
            DBFToFrame(CustomerDBF,CustomerDF);
  	    ShowDisplayFrame(CustomerDF,0,0,0,0);
	  END;

 |'P' : IF PrevCustomer()
          THEN
            DBFToFrame(CustomerDBF,CustomerDF);
  	    ShowDisplayFrame(CustomerDF,0,0,0,0);
	  END;


 |'C' :   (* The first unused letter in the index name  or 'Q'  *)
        Fill(ADR(Str),SIZE(Str),0);

        PromptStr('Enter Customer Cin ',Str);

        MakeKey(Str);
        IF NOT FindCustomerByCin(Str)
	  THEN
	   Prompt('Customer Not Found');
	 ELSE
	   DBFToFrame(CustomerDBF,CustomerDF);
	   ShowDisplayFrame(CustomerDF,0,0,0,0);
	 END;


 |'M' :   (* The first unused letter in the index name  or 'Q'  *)
        Fill(ADR(Str),SIZE(Str),0);

        PromptStr('Enter Customer Nameidx ',Str);

        MakeKey(Str);
        IF NOT FindCustomerByName(Str)
        THEN   (* always display the cust or the closet one *)
	END;
        DBFToFrame(CustomerDBF,CustomerDF);
        ShowDisplayFrame(CustomerDF,0,0,0,0);
  END;  (* end of case  *)
END FileMenu;

PROCEDURE EditMenu(SelChar : CHAR);
VAR
 B : BOOLEAN;
 BEGIN
   CASE SelChar OF
   'U' : Control(CustomerDF);
	 B := FrameToDBF(CustomerDBF,CustomerDF);
         WriteDBRec(CustomerDBF);
  |'D' : IF PromptYN('About to delete customer - continue ?',CustomerDF)
         THEN
            DeleteRecord(CustomerDBF);
            B :=NextCustomer();
	    FileMenu('P');
	 END;
   END;
END EditMenu;


PROCEDURE InvoiceMenu(SelChar: CHAR);
VAR
 Inv : ARRAY[0..15] OF CHAR;
BEGIN
  MoveCustomerFromDBF(CurrentCust);
  CASE SelChar OF
  'A' : ControlInvoice('N');
 |'E' : ControlInvoice('E');   (*edit invoice *)
 |'P' : ControlInvoice('P');
 |'C' : ControlInvoice('C');
 |'Y' : PayInvoice();
 |'M' : AddManualInvoice();

	
   END;  (* end of case *)	
   ShowDisplayFrame(CustomerDF,0,0,0,0);   (* clear out the invoice stuff*)
END InvoiceMenu;

PROCEDURE PrintMenu(SelChar : CHAR);
BEGIN
  MoveCustomerFromDBF(CurrentCust);
  CrunchBlanks(CurrentCust.CIN);
  CASE SelChar OF
  'H' : ListOutstanding(CurrentCust.CIN);
 |'L' : PrintLabels();
 |'E' : ListHistory(CurrentCust.CIN,CustomerDF);
 |'Y' : ShowPaymentHist(CurrentCust.CIN);
 |'V' : InvoiceHistory();
 END;
END PrintMenu;

PROCEDURE ControlCustomer();
BEGIN
(*  OpenCustomerDBF(TRUE); *)
  ClearScreen();
  InitDisplayFrame(CustomerDF,CurrentWindow);
  NewList(PullDnMenu);
  LoadFrameList(PMIScreens,'TopMenu',PullDnMenu);
  NoData := TRUE;
  ReadDisplayFrame(PMIScreens,CustomerDF,'Customer');
  REPEAT
    NextFrame := 'TopMenu';
    ControlSeparately(PullDnMenu,NextFrame,SelChar,EndingFrame);
    IF Equal(EndingFrame,'FileMenu')
         THEN FileMenu(SelChar);
    ELSIF Equal(EndingFrame,'EditMenu')
         THEN EditMenu(SelChar);
    ELSIF Equal(EndingFrame,'InvoiceMenu')
         THEN InvoiceMenu(SelChar);
    ELSIF Equal(EndingFrame,'PrintMenu')
         THEN PrintMenu(SelChar);
    END;

  UNTIL SelChar='X';  (* Assumes  'X' is only used to exit *)
  CloseDisplayFrame(CustomerDF);
(*  CloseCustomerDBF();*)
  ClearScreen();


END ControlCustomer;

END Customer.