//kt -- Modified with SourceScanner on 7/8/2007
unit fAllgyFind;

interface

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

type
  TfrmAllgyFind = class(TfrmAutoSz)
    txtSearch: TCaptionEdit;
    cmdSearch: TButton;
    cmdOK: TButton;
    cmdCancel: TButton;
    lblSearch: TLabel;
    lblSelect: TLabel;
    stsFound: TStatusBar;
    ckNoKnownAllergies: TCheckBox;
    tvAgent: TORTreeView;
    imTree: TImageList;
    lblDetail: TLabel;
    lblSearchCaption: 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;
    //kt 7-8-07 begin mod to replace constants with variables.
    TX_3_CHAR     : string;
    ST_SEARCHING  : string;
    ST_FOUND      : string;
    ST_NONE_FOUND : string;
    TC_FREE_TEXT  : string;
    TX_FREE_TEXT  : string;
    TX_BULLETIN   : string;
    TC_BULLETIN_ERROR : string;
    TX_BULLETIN_ERROR : string;
    procedure SetupVars;  //kt 7-8-07 added
    //kt 7-8-07 end mod
  end;

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

implementation

{$R *.DFM}

uses rODAllergy, fARTFreeTextMsg;

const
  IMG_MATCHES_FOUND = 1;
  IMG_NO_MATCHES    = 2;

//kt 7-8-07 Remove constants and made into variables.
//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 - No Matches for ';

//kt 7-8-07 did NOT comment out next section immediately below.  It was that way already...
(*  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.';*)

//kt 7-8-07 Remove constants and made into variables.
// NEW TEXT SUBSTITUTED IN V26.50 - RV
//TX_FREE_TEXT  = 'The agent you typed was not found in the database.'  + CRLF +
//                'Consider the common causes of search failure:'       + CRLF +
//                '      Misspellings'                                  + CRLF +
//    	          '      Typing more than one agent in a single entry ' + CRLF +
//	              '      Typing "No known allergies"'                   + CRLF +
//                 CRLF +
//                 'Select "NO" to attempt the search again.  Carefully check your spelling,'+ CRLF +
//                 'try an alternate spelling, a trade name, a generic name or just entering' + CRLF +
//                 'the first few characters (minimum of 3).  Enter only one allergy at a time.' + CRLF +
//                 'Use the "No Known Allergies" check box to mark a patient as NKA.' + CRLF +
//                 CRLF +
//                 'Select "YES" to send a bulletin to the allergy coordinator to request assistance.'  + CRLF +
//                 'Only do this if you''ve tried alternate methods of finding the causative agent'  + CRLF +
//                 'and have been unsuccessful.'  + CRLF +
//                 CRLF +
//                'Select "CANCEL" to abort this entry process.';

//TX_BULLETIN   = 'Bulletin has been sent.' + CRLF +
//                'NOTE: This reactant was NOT added for this patient.';
//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.SetupVars;  //kt 7-8-07 added entire procedure to replace constants with variables
begin
  TX_3_CHAR     := DKLangConstW('fAllgyFind_Enter_at_least_3_characters_for_a_search'); //kt added 7/8/2007
  ST_SEARCHING  := DKLangConstW('fAllgyFind_Searching_for_allergies'); //kt added 7/8/2007
  ST_FOUND      := DKLangConstW('fAllgyFind_Select_from_the_matching_entries_on_the_list_or_search_again'); //kt added 7/8/2007
  ST_NONE_FOUND := DKLangConstW('fAllgyFind_No_matching_items_were_found'); //kt added 7/8/2007
  TC_FREE_TEXT  := DKLangConstW('fAllgyFind_Causative_Agent_Not_On_File__No_Matches_for'); //kt added 7/8/2007


// NEW TEXT SUBSTITUTED IN V26.50 - RV
  TX_FREE_TEXT  := DKLangConstW('fAllgyFind_The_agent_you_typed_was_not_found_in_the_database')  + CRLF + //kt added 7/8/2007
                   DKLangConstW('fAllgyFind_Consider_the_common_causes_of_search_failure')       + CRLF + //kt added 7/8/2007
                   DKLangConstW('fAllgyFind_Misspellings')                                  + CRLF + //kt added 7/8/2007
	                 DKLangConstW('fAllgyFind_Typing_more_than_one_agent_in_a_single_entry') + CRLF + //kt added 7/8/2007
	                 DKLangConstW('fAllgyFind_Typing_No_known_allergies')                   + CRLF + //kt added 7/8/2007
                   CRLF +
                   DKLangConstW('fAllgyFind_Select_NO_to_attempt_the_search_again__Carefully_check_your_spelling')+ CRLF + //kt added 7/8/2007
                   DKLangConstW('fAllgyFind_try_an_alternate_spelling_a_trade_name_a_generic_name_or_just_entering') + CRLF + //kt added 7/8/2007
                   DKLangConstW('fAllgyFind_the_first_few_characters_minimum_of_3__Enter_only_one_allergy_at_a_time') + CRLF + //kt added 7/8/2007
                   DKLangConstW('fAllgyFind_Use_the_No_Known_Allergies_check_box_to_mark_a_patient_as_NKA') + CRLF + //kt added 7/8/2007
                   CRLF +
                   DKLangConstW('fAllgyFind_Select_YES_to_send_a_bulletin_to_the_allergy_coordinator_to_request_assistance')  + CRLF + //kt added 7/8/2007
                   DKLangConstW('fAllgyFind_Only_do_this_if_youve_tried_alternate_methods_of_finding_the_causative_agent')  + CRLF + //kt added 7/8/2007
                   DKLangConstW('fAllgyFind_and_have_been_unsuccessful')  + CRLF + //kt added 7/8/2007
                   CRLF +
                   DKLangConstW('fAllgyFind_Select_CANCEL_to_abort_this_entry_process'); //kt added 7/8/2007

  TX_BULLETIN   := DKLangConstW('fAllgyFind_Bulletin_has_been_sent') + CRLF + //kt added 7/8/2007
                   DKLangConstW('fAllgyFind_NOTE_This_reactant_was_NOT_added_for_this_patient'); //kt added 7/8/2007
  TC_BULLETIN_ERROR := DKLangConstW('fAllgyFind_Unable_to_Send_Bulletin'); //kt added 7/8/2007
  TX_BULLETIN_ERROR := DKLangConstW('fAllgyFind_Free_text_entries_are_no_longer_allowed') + #13#10 + //kt added 7/8/2007
                       DKLangConstW('fAllgyFind_Please_contact_your_allergy_coordinator_if_you_need_assistance'); //kt added 7/8/2007
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;
  SetupVars;  //kt 7-8-07 added to replace constants with variables.
  if Length(txtSearch.Text) < 3 then
    begin
//    InfoBox(TX_3_CHAR, 'Information', MB_OK or MB_ICONINFORMATION);  <-- original line.  //kt 7/8/2007
      InfoBox(TX_3_CHAR, DKLangConstW('fAllgyFind_Information'), MB_OK or MB_ICONINFORMATION); //kt added 7/8/2007
      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^+');   <-- original line.  //kt 7/8/2007
      AList.Insert(0, 'TOP^' + IntToStr(Alist.Count - uFileCount) + DKLangConstW('fAllgyFind_matches_found')+'^^^0^+'); //kt added 7/8/2007
//    AList.Add('FREETEXT^Add new free-text allergy^^^TOP^+');  <-- original line.  //kt 7/8/2007
      AList.Add('FREETEXT^'+DKLangConstW('fAllgyFind_Add_new_freetext_allergy')+'^TOP+'); //kt added 7/8/2007
      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)';  <-- original line.  //kt 7/8/2007
          tmpNode1.Text := tmpNode1.Text + DKLangConstW('fAllgyFind_no_matches'); //kt added 7/8/2007
          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)';  <-- original line.  //kt 7/8/2007
                tmpNode1.Text := tmpNode1.Text + DKLangConstW('fAllgyFind_no_matches'); //kt added 7/8/2007
              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;
  SetupVars;  //kt 7-8-07 added to replace constants with variables.
  if ckNoKnownAllergies.Checked then
    begin
//    FAllergy := '-1^No Known Allergy^';  <-- original line.  //kt 7/8/2007
      FAllergy := '-1^'+DKLangConstW('fAllgyFind_No_Known_Allergy')+'^'; //kt added 7/8/2007
      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 + UpperCase(txtSearch.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)  <-- original line.  //kt 7/8/2007
                          InfoBox(TX_BULLETIN, DKLangConstW('fAllgyFind_Information'), MB_OK or MB_ICONINFORMATION) //kt added 7/8/2007
                        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.