unit fPtDemo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ORCtrls, ORFn, ComCtrls;

type
  TfrmPtDemo = class(TForm)
    memPtDemo: TRichEdit;
    pnlTop: TORAutoPanel;
    cmdClose: TButton;
    lblFontTest: TLabel;
    procedure cmdCloseClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FPtId: string;
  public
    { Public declarations }
  end;

procedure PatientInquiry(PtDFN: string);

implementation

{$R *.DFM}

uses uCore, rGroupNote;

procedure PatientInquiry(PtDFN: string);
{ displays patient demographics, returns true in NewPt if the user pressed 'Select New' btn }
var
  frmPtDemo: TfrmPtDemo;
begin
  if StrToInt64Def(PtDFN, 0) <= 0 then exit;
  frmPtDemo := TfrmPtDemo.Create(Application);
  try
    frmPtDemo.FPtId := PtDFN;
    frmPtDemo.ShowModal;
  finally
    frmPtDemo.Release;
  end;
end;

procedure TfrmPtDemo.cmdCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmPtDemo.FormShow(Sender: TObject);
var
  i, MaxWidth, AWidth, AHeight: Integer;
  Rect: TRect;
begin
  memPtDemo.Color := clCream; //ReadOnlyColor;
  LoadDemographics(memPtDemo.Lines,FPtID);
  memPtDemo.SelStart := 0;
  MaxWidth := 350;
  for i := 0 to memPtDemo.Lines.Count - 1 do
  begin
    AWidth := lblFontTest.Canvas.TextWidth(memPtDemo.Lines[i]);
    if AWidth > MaxWidth then MaxWidth := AWidth;
  end;
  MaxWidth := MaxWidth + (GetSystemMetrics(SM_CXFRAME) * 2)
                       + GetSystemMetrics(SM_CXVSCROLL) + 16;
  AHeight := ((memPtDemo.Lines.Count + 4) * (lblFontTest.Height + 1))
             + (GetSystemMetrics(SM_CYFRAME) * 3) + GetSystemMetrics(SM_CYCAPTION);
  AHeight := HigherOf(AHeight, 250);
  if AHeight > (Screen.Height - 120) then AHeight := Screen.Height - 120;
  if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
  Width := MaxWidth;
  Height := AHeight;
  Rect := BoundsRect;
  ForceInsideWorkArea(Rect);
  BoundsRect := Rect;
end;

procedure TfrmPtDemo.FormCreate(Sender: TObject);
begin
  FPtID := '';
end;

end.
