352 lines
12 KiB
Plaintext
352 lines
12 KiB
Plaintext
|
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;
|
||
|
|
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;
|
||
|
|
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 - No Matches for ';
|
||
|
|
(* 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.';*)
|
||
|
|
// 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.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 + 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)
|
||
|
|
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.
|