unit fAllgyFind;

interface

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

type
  TfrmAllgyFind = class(TfrmAutoSz)
    txtSearch: TCaptionEdit;
    cmdSearch: TButton;
    cmdOK: TButton;
    cmdCancel: TButton;
    lblSearch: TLabel;
    lblSelect: TLabel;
    stsFound: TStatusBar;
    ckNoKnownAllergies: TCheckBox;
    tvAgent: TORTreeView;
    imTree: TImageList;
    Label1: TLabel;
    procedure cmdSearchClick(Sender: TObject);
    procedure cmdCancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmdOKClick(Sender: TObject);
    procedure txtSearchChange(Sender: TObject);
    procedure BuildAgentTree(AgentList: TStrings; const Parent: string; Node: TORTreeNode);
    procedure ckNoKnownAllergiesClick(Sender: TObject);
    procedure tvAgentDblClick(Sender: TObject);
  private
    FAllergy: string   ;
    FExpanded : boolean;
  end;

procedure AllergyLookup(var Allergy: string; NKAEnabled: boolean);

implementation

{$R *.DFM}

uses rODAllergy, fARTFreeTextMsg;

const
  IMG_MATCHES_FOUND = 1;
  IMG_NO_MATCHES    = 2;

  TX_3_CHAR     = 'Enter at least 3 characters for a search.';
  ST_SEARCHING  = 'Searching for allergies...';
  ST_FOUND      = 'Select from the matching entries on the list, or search again.';
  ST_NONE_FOUND = 'No matching items were found.';
  TC_FREE_TEXT  = 'Causative Agent Not On File';
  TX_FREE_TEXT  = 'Would you like to request that this term be added to' + #13#10 +
                  'the list of available allergies?' + #13#10 + #13#10 +
                  '"YES" will send a bulletin to request addition of your' + #13#10 +
                  'entry to the ALLERGY file for future use, since '   + #13#10 +
                  'free-text entries for a patient are not allowed.' + #13#10 + #13#10 +
                  '"NO" will allow you to enter another search term.  Please' + #13#10 +
                  'check your spelling, try alternate spellings or a trade name,' + #13#10 +
                  'or contact your allergy coordinator for assistance.' + #13#10 + #13#10 +
                  '"CANCEL" will abort this entry process completely.';
  TX_BULLETIN   = 'Bulletin has been sent.';
  TC_BULLETIN_ERROR = 'Unable to Send Bulletin';
  TX_BULLETIN_ERROR = 'Free text entries are no longer allowed.' + #13#10 +
                      'Please contact your allergy coordinator if you need assistance.';
var
  uFileCount: integer;

procedure AllergyLookup(var Allergy: string; NKAEnabled: boolean);
var
  frmAllgyFind: TfrmAllgyFind;
begin
  frmAllgyFind := TfrmAllgyFind.Create(Application);
  try
    ResizeFormToFont(TForm(frmAllgyFind));
    frmAllgyFind.ckNoKnownAllergies.Enabled := NKAEnabled;
    frmAllgyFind.ShowModal;
    Allergy := frmAllgyFind.FAllergy;
  finally
    frmAllgyFind.Release;
  end;
end;

procedure TfrmAllgyFind.FormCreate(Sender: TObject);
begin
  inherited;
  FAllergy := '';
  cmdOK.Enabled := False;
end;

procedure TfrmAllgyFind.txtSearchChange(Sender: TObject);
begin
  inherited;
  cmdSearch.Default := True;
  cmdOK.Default := False;
  cmdOK.Enabled := False;
end;

procedure TfrmAllgyFind.cmdSearchClick(Sender: TObject);
var
  AList: TStringlist;
  tmpNode1: TORTreeNode;
  i: integer;
begin
  inherited;
  if Length(txtSearch.Text) < 3 then
    begin
      InfoBox(TX_3_CHAR, 'Information', MB_OK or MB_ICONINFORMATION);
      Exit;
    end;
  StatusText(ST_SEARCHING);
  FExpanded := False;
  AList := TStringList.Create;
  try
    if tvAgent.Items <> nil then tvAgent.Items.Clear;
    AList.Assign(SearchForAllergies(UpperCase(txtSearch.Text)));
    uFileCount := 0;
    for i := 0 to AList.Count - 1 do
      if Piece(AList[i], U, 5) = 'TOP' then uFileCount := uFileCount + 1;
    if AList.Count = uFileCount  then
    begin
      lblSelect.Visible := False;
      txtSearch.SetFocus;
      txtSearch.SelectAll;
      cmdOK.Default := False;
      cmdSearch.Default := True;
      stsFound.SimpleText := ST_NONE_FOUND;
      cmdOKClick(Self);
    end else
    begin
      //if tvAgent.Items <> nil then tvAgent.Items.Clear;
      AList.Insert(0, 'TOP^' + IntToStr(Alist.Count - uFileCount) + ' matches found.^^^0^+');
      AList.Add('FREETEXT^Add new free-text allergy^^^TOP^+');
      AList.Add('^' + UpperCase(txtSearch.Text) + '^^^FREETEXT^');
      BuildAgentTree(AList, '0', nil);
      tmpNode1 := TORTreeNode(tvAgent.Items.getFirstNode);
      tmpNode1.Expand(False);
      tmpNode1 := TORTreeNode(tmpNode1.GetFirstChild);
      if tmpNode1.HasChildren then
        begin
          tmpNode1.Text := tmpNode1.Text + '  (' + IntToStr(tmpNode1.Count) + ')';
          tmpNode1.Bold := True;
          tmpNode1.StateIndex := IMG_MATCHES_FOUND;
          tmpNode1.Expand(True);
          FExpanded := True;
        end
      else
        begin
          tmpNode1.Text := tmpNode1.Text + '  (no matches)';
          tmpNode1.StateIndex := IMG_NO_MATCHES;
        end;
      while tmpNode1 <> nil do
        begin
           tmpNode1 := TORTreeNode(tmpNode1.GetNextSibling);
           if tmpNode1 <> nil then
             if tmpNode1.HasChildren then
               begin
                 tmpNode1.Text := tmpNode1.Text + '  (' + IntToStr(tmpNode1.Count) + ')';
                 tmpNode1.StateIndex := IMG_MATCHES_FOUND;
                 if not FExpanded then
                   begin
                     tmpNode1.Bold := True;
                     tmpNode1.Expand(True);
                     FExpanded := True;
                   end;
               end
            else
              begin
                tmpNode1.StateIndex := IMG_NO_MATCHES;
                tmpNode1.Text := tmpNode1.Text + '  (no matches)';
              end;
        end;
      lblSelect.Visible := True;
      tvAgent.SetFocus;
      cmdSearch.Default := False;
      cmdOK.Enabled := True;
      stsFound.SimpleText := ST_FOUND;
    end;
  finally
    AList.Free;
    StatusText('');
  end;
end;

procedure TfrmAllgyFind.cmdOKClick(Sender: TObject);
var
  x: string;
  tmpList: TStringList;
  OKtoContinue: boolean;
begin
  inherited;
  if ckNoKnownAllergies.Checked then
    begin
      FAllergy := '-1^No Known Allergy^';
      Close;
    end
  else if (txtSearch.Text = '') and ((tvAgent.Selected = nil) or (tvAgent.Items.Count = uFileCount)) then
    {bail out - no search term present, and (no items currently in tree or none selected)}
    begin
      FAllergy := '';
      Exit ;
    end
  else if ((tvAgent.Selected = nil) or
           (tvAgent.Items.Count = uFileCount) or
           (Piece(TORTreeNode(tvAgent.Selected).StringData, U, 5) = 'FREETEXT')) then
    {entry of free text agent - retry, send bulletin, or abort entry}
    begin
      FAllergy := '';
      case InfoBox(TX_FREE_TEXT, TC_FREE_TEXT, MB_YESNOCANCEL or MB_DEFBUTTON2 or MB_ICONQUESTION)of
        ID_YES   :  // send bulletin and abort free-text entry
                    begin
                      tmpList := TStringList.Create;
                      try
                        OKtoContinue := False;
                        GetFreeTextARTComment(tmpList, OKtoContinue);
                        if not OKtoContinue then
                        begin
                          stsFound.SimpleText := '';
                          txtSearch.SetFocus;
                          Exit;
                        end;
                        x := SendARTBulletin(UpperCase(txtSearch.Text), tmpList);
                        if Piece(x, U, 1) = '-1' then
                          InfoBox(TX_BULLETIN_ERROR, TC_BULLETIN_ERROR, MB_OK or MB_ICONWARNING)
                        else if Piece(x, U, 1) = '1' then
                          InfoBox(TX_BULLETIN, 'Information', MB_OK or MB_ICONINFORMATION)
                        else
                          InfoBox(Piece(x, U, 2), TC_BULLETIN_ERROR, MB_OK or MB_ICONWARNING);
                      finally
                        tmpList.Free;
                      end;
                      Close;
                    end;
        ID_NO    :  // clear status message, and allow repeat search
                    begin
                      stsFound.SimpleText := '';
                      txtSearch.SetFocus;
                      Exit;
                    end;
        ID_CANCEL:  // abort entry and return to order menu or whatever
                    Close;
      end;
    end
  else if Piece(TORTreeNode(tvAgent.Selected).StringData, U, 6) = '+' then
    {bail out - tree grouper selected}
    begin
      FAllergy := '';
      Exit;
    end
  else
    {matching item selected}
    begin
      FAllergy := TORTreeNode(tvAgent.Selected).StringData;
      x := Piece(FAllergy, U, 2);
      x := Trim(Piece(x, '<', 1));
      SetPiece(FAllergy, U, 2, x);
      Close;
    end;
end;

procedure TfrmAllgyFind.cmdCancelClick(Sender: TObject);
begin
  inherited;
  FAllergy := '';
  Close;
end;

procedure TfrmAllgyFind.ckNoKnownAllergiesClick(Sender: TObject);
begin
  inherited;
  with ckNoKnownAllergies do
    begin
      txtSearch.Enabled := not Checked;
      cmdSearch.Enabled := not Checked;
      lblSearch.Enabled := not Checked;
      lblSelect.Enabled := not Checked;
      tvAgent.Enabled   := not Checked;
      cmdOK.Enabled := Checked;
    end;
end;

procedure TfrmAllgyFind.BuildAgentTree(AgentList: TStrings; const Parent: string; Node: TORTreeNode);
var
  MyID, MyParent, Name: string;
  i: Integer;
  ChildNode, tmpNode: TORTreeNode;
  HasChildren, Found: Boolean;
begin
  tvAgent.Items.BeginUpdate;
  with AgentList do for i := 0 to Count - 1 do
    begin
      Found := False;
      MyParent := Piece(Strings[i], U, 5);
      if (MyParent = Parent) then
        begin
          MyID := Piece(Strings[i], U, 1);
          Name := Piece(Strings[i], U, 2);
          HasChildren := Piece(Strings[i], U, 6) = '+';
          if Node <> nil then
            begin
              if Node.HasChildren then
                begin
                  tmpNode := TORTreeNode(Node.GetFirstChild);
                  while tmpNode <> nil do
                    begin
                      if tmpNode.Text = Piece(Strings[i], U, 2) then Found := True;
                      tmpNode := TORTreeNode(Node.GetNextChild(tmpNode));
                    end;
                end
              else
                Node.StateIndex := 0;
            end;
          if Found then
            Continue
          else
            begin
              ChildNode := TORTreeNode(tvAgent.Items.AddChild(Node, Name));
              ChildNode.StringData := AgentList[i];
              if HasChildren then BuildAgentTree(AgentList, MyID, ChildNode);
            end;
        end;
    end;
  tvAgent.Items.EndUpdate;
end;
 
procedure TfrmAllgyFind.tvAgentDblClick(Sender: TObject);
begin
  inherited;
  cmdOKClick(Self);
end;

end.
