1 | unit fAllgyFind;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | fAutoSz, StdCtrls, ORFn, ORCtrls, ComCtrls, ImgList;
|
---|
8 |
|
---|
9 | type
|
---|
10 | TfrmAllgyFind = class(TfrmAutoSz)
|
---|
11 | txtSearch: TCaptionEdit;
|
---|
12 | cmdSearch: TButton;
|
---|
13 | cmdOK: TButton;
|
---|
14 | cmdCancel: TButton;
|
---|
15 | lblSearch: TLabel;
|
---|
16 | lblSelect: TLabel;
|
---|
17 | stsFound: TStatusBar;
|
---|
18 | ckNoKnownAllergies: TCheckBox;
|
---|
19 | tvAgent: TORTreeView;
|
---|
20 | imTree: TImageList;
|
---|
21 | lblDetail: TLabel;
|
---|
22 | lblSearchCaption: TLabel;
|
---|
23 | procedure cmdSearchClick(Sender: TObject);
|
---|
24 | procedure cmdCancelClick(Sender: TObject);
|
---|
25 | procedure FormCreate(Sender: TObject);
|
---|
26 | procedure cmdOKClick(Sender: TObject);
|
---|
27 | procedure txtSearchChange(Sender: TObject);
|
---|
28 | procedure BuildAgentTree(AgentList: TStrings; const Parent: string; Node: TORTreeNode);
|
---|
29 | procedure ckNoKnownAllergiesClick(Sender: TObject);
|
---|
30 | procedure tvAgentDblClick(Sender: TObject);
|
---|
31 | private
|
---|
32 | FAllergy: string ;
|
---|
33 | FExpanded : boolean;
|
---|
34 | end;
|
---|
35 |
|
---|
36 | procedure AllergyLookup(var Allergy: string; NKAEnabled: boolean);
|
---|
37 |
|
---|
38 | implementation
|
---|
39 |
|
---|
40 | {$R *.DFM}
|
---|
41 |
|
---|
42 | uses rODAllergy, fARTFreeTextMsg;
|
---|
43 |
|
---|
44 | const
|
---|
45 | IMG_MATCHES_FOUND = 1;
|
---|
46 | IMG_NO_MATCHES = 2;
|
---|
47 |
|
---|
48 | TX_3_CHAR = 'Enter at least 3 characters for a search.';
|
---|
49 | ST_SEARCHING = 'Searching for allergies...';
|
---|
50 | ST_FOUND = 'Select from the matching entries on the list, or search again.';
|
---|
51 | ST_NONE_FOUND = 'No matching items were found.';
|
---|
52 | TC_FREE_TEXT = 'Causative Agent Not On File - No Matches for ';
|
---|
53 | (* TX_FREE_TEXT = 'Would you like to request that this term be added to' + #13#10 +
|
---|
54 | 'the list of available allergies?' + #13#10 + #13#10 +
|
---|
55 | '"YES" will send a bulletin to request addition of your' + #13#10 +
|
---|
56 | 'entry to the ALLERGY file for future use, since ' + #13#10 +
|
---|
57 | 'free-text entries for a patient are not allowed.' + #13#10 + #13#10 +
|
---|
58 | '"NO" will allow you to enter another search term. Please' + #13#10 +
|
---|
59 | 'check your spelling, try alternate spellings or a trade name,' + #13#10 +
|
---|
60 | 'or contact your allergy coordinator for assistance.' + #13#10 + #13#10 +
|
---|
61 | '"CANCEL" will abort this entry process completely.';*)
|
---|
62 | // NEW TEXT SUBSTITUTED IN V26.50 - RV
|
---|
63 | TX_FREE_TEXT = 'The agent you typed was not found in the database.' + CRLF +
|
---|
64 | 'Consider the common causes of search failure:' + CRLF +
|
---|
65 | ' Misspellings' + CRLF +
|
---|
66 | ' Typing more than one agent in a single entry ' + CRLF +
|
---|
67 | ' Typing "No known allergies"' + CRLF +
|
---|
68 | CRLF +
|
---|
69 | 'Select "NO" to attempt the search again. Carefully check your spelling,'+ CRLF +
|
---|
70 | 'try an alternate spelling, a trade name, a generic name or just entering' + CRLF +
|
---|
71 | 'the first few characters (minimum of 3). Enter only one allergy at a time.' + CRLF +
|
---|
72 | 'Use the "No Known Allergies" check box to mark a patient as NKA.' + CRLF +
|
---|
73 | CRLF +
|
---|
74 | 'Select "YES" to send a bulletin to the allergy coordinator to request assistance.' + CRLF +
|
---|
75 | 'Only do this if you''ve tried alternate methods of finding the causative agent' + CRLF +
|
---|
76 | 'and have been unsuccessful.' + CRLF +
|
---|
77 | CRLF +
|
---|
78 | 'Select "CANCEL" to abort this entry process.';
|
---|
79 |
|
---|
80 | TX_BULLETIN = 'Bulletin has been sent.' + CRLF +
|
---|
81 | 'NOTE: This reactant was NOT added for this patient.';
|
---|
82 | TC_BULLETIN_ERROR = 'Unable to Send Bulletin';
|
---|
83 | TX_BULLETIN_ERROR = 'Free text entries are no longer allowed.' + #13#10 +
|
---|
84 | 'Please contact your allergy coordinator if you need assistance.';
|
---|
85 | var
|
---|
86 | uFileCount: integer;
|
---|
87 |
|
---|
88 | procedure AllergyLookup(var Allergy: string; NKAEnabled: boolean);
|
---|
89 | var
|
---|
90 | frmAllgyFind: TfrmAllgyFind;
|
---|
91 | begin
|
---|
92 | frmAllgyFind := TfrmAllgyFind.Create(Application);
|
---|
93 | try
|
---|
94 | ResizeFormToFont(TForm(frmAllgyFind));
|
---|
95 | frmAllgyFind.ckNoKnownAllergies.Enabled := NKAEnabled;
|
---|
96 | frmAllgyFind.ShowModal;
|
---|
97 | Allergy := frmAllgyFind.FAllergy;
|
---|
98 | finally
|
---|
99 | frmAllgyFind.Release;
|
---|
100 | end;
|
---|
101 | end;
|
---|
102 |
|
---|
103 | procedure TfrmAllgyFind.FormCreate(Sender: TObject);
|
---|
104 | begin
|
---|
105 | inherited;
|
---|
106 | FAllergy := '';
|
---|
107 | cmdOK.Enabled := False;
|
---|
108 | end;
|
---|
109 |
|
---|
110 | procedure TfrmAllgyFind.txtSearchChange(Sender: TObject);
|
---|
111 | begin
|
---|
112 | inherited;
|
---|
113 | cmdSearch.Default := True;
|
---|
114 | cmdOK.Default := False;
|
---|
115 | cmdOK.Enabled := False;
|
---|
116 | end;
|
---|
117 |
|
---|
118 | procedure TfrmAllgyFind.cmdSearchClick(Sender: TObject);
|
---|
119 | var
|
---|
120 | AList: TStringlist;
|
---|
121 | tmpNode1: TORTreeNode;
|
---|
122 | i: integer;
|
---|
123 | begin
|
---|
124 | inherited;
|
---|
125 | if Length(txtSearch.Text) < 3 then
|
---|
126 | begin
|
---|
127 | InfoBox(TX_3_CHAR, 'Information', MB_OK or MB_ICONINFORMATION);
|
---|
128 | Exit;
|
---|
129 | end;
|
---|
130 | StatusText(ST_SEARCHING);
|
---|
131 | FExpanded := False;
|
---|
132 | AList := TStringList.Create;
|
---|
133 | try
|
---|
134 | if tvAgent.Items <> nil then tvAgent.Items.Clear;
|
---|
135 | AList.Assign(SearchForAllergies(UpperCase(txtSearch.Text)));
|
---|
136 | uFileCount := 0;
|
---|
137 | for i := 0 to AList.Count - 1 do
|
---|
138 | if Piece(AList[i], U, 5) = 'TOP' then uFileCount := uFileCount + 1;
|
---|
139 | if AList.Count = uFileCount then
|
---|
140 | begin
|
---|
141 | lblSelect.Visible := False;
|
---|
142 | txtSearch.SetFocus;
|
---|
143 | txtSearch.SelectAll;
|
---|
144 | cmdOK.Default := False;
|
---|
145 | cmdSearch.Default := True;
|
---|
146 | stsFound.SimpleText := ST_NONE_FOUND;
|
---|
147 | cmdOKClick(Self);
|
---|
148 | end else
|
---|
149 | begin
|
---|
150 | //if tvAgent.Items <> nil then tvAgent.Items.Clear;
|
---|
151 | AList.Insert(0, 'TOP^' + IntToStr(Alist.Count - uFileCount) + ' matches found.^^^0^+');
|
---|
152 | AList.Add('FREETEXT^Add new free-text allergy^^^TOP^+');
|
---|
153 | AList.Add('^' + UpperCase(txtSearch.Text) + '^^^FREETEXT^');
|
---|
154 | BuildAgentTree(AList, '0', nil);
|
---|
155 | tmpNode1 := TORTreeNode(tvAgent.Items.getFirstNode);
|
---|
156 | tmpNode1.Expand(False);
|
---|
157 | tmpNode1 := TORTreeNode(tmpNode1.GetFirstChild);
|
---|
158 | if tmpNode1.HasChildren then
|
---|
159 | begin
|
---|
160 | tmpNode1.Text := tmpNode1.Text + ' (' + IntToStr(tmpNode1.Count) + ')';
|
---|
161 | tmpNode1.Bold := True;
|
---|
162 | tmpNode1.StateIndex := IMG_MATCHES_FOUND;
|
---|
163 | tmpNode1.Expand(True);
|
---|
164 | FExpanded := True;
|
---|
165 | end
|
---|
166 | else
|
---|
167 | begin
|
---|
168 | tmpNode1.Text := tmpNode1.Text + ' (no matches)';
|
---|
169 | tmpNode1.StateIndex := IMG_NO_MATCHES;
|
---|
170 | end;
|
---|
171 | while tmpNode1 <> nil do
|
---|
172 | begin
|
---|
173 | tmpNode1 := TORTreeNode(tmpNode1.GetNextSibling);
|
---|
174 | if tmpNode1 <> nil then
|
---|
175 | if tmpNode1.HasChildren then
|
---|
176 | begin
|
---|
177 | tmpNode1.Text := tmpNode1.Text + ' (' + IntToStr(tmpNode1.Count) + ')';
|
---|
178 | tmpNode1.StateIndex := IMG_MATCHES_FOUND;
|
---|
179 | if not FExpanded then
|
---|
180 | begin
|
---|
181 | tmpNode1.Bold := True;
|
---|
182 | tmpNode1.Expand(True);
|
---|
183 | FExpanded := True;
|
---|
184 | end;
|
---|
185 | end
|
---|
186 | else
|
---|
187 | begin
|
---|
188 | tmpNode1.StateIndex := IMG_NO_MATCHES;
|
---|
189 | tmpNode1.Text := tmpNode1.Text + ' (no matches)';
|
---|
190 | end;
|
---|
191 | end;
|
---|
192 | lblSelect.Visible := True;
|
---|
193 | tvAgent.SetFocus;
|
---|
194 | cmdSearch.Default := False;
|
---|
195 | cmdOK.Enabled := True;
|
---|
196 | stsFound.SimpleText := ST_FOUND;
|
---|
197 | end;
|
---|
198 | finally
|
---|
199 | AList.Free;
|
---|
200 | StatusText('');
|
---|
201 | end;
|
---|
202 | end;
|
---|
203 |
|
---|
204 | procedure TfrmAllgyFind.cmdOKClick(Sender: TObject);
|
---|
205 | var
|
---|
206 | x: string;
|
---|
207 | tmpList: TStringList;
|
---|
208 | OKtoContinue: boolean ;
|
---|
209 | begin
|
---|
210 | inherited;
|
---|
211 | if ckNoKnownAllergies.Checked then
|
---|
212 | begin
|
---|
213 | FAllergy := '-1^No Known Allergy^';
|
---|
214 | Close;
|
---|
215 | end
|
---|
216 | else if (txtSearch.Text = '') and ((tvAgent.Selected = nil) or (tvAgent.Items.Count = uFileCount)) then
|
---|
217 | {bail out - no search term present, and (no items currently in tree or none selected)}
|
---|
218 | begin
|
---|
219 | FAllergy := '';
|
---|
220 | Exit ;
|
---|
221 | end
|
---|
222 | else if ((tvAgent.Selected = nil) or
|
---|
223 | (tvAgent.Items.Count = uFileCount) or
|
---|
224 | (Piece(TORTreeNode(tvAgent.Selected).StringData, U, 5) = 'FREETEXT')) then
|
---|
225 | {entry of free text agent - retry, send bulletin, or abort entry}
|
---|
226 | begin
|
---|
227 | FAllergy := '';
|
---|
228 | case InfoBox(TX_FREE_TEXT, TC_FREE_TEXT + UpperCase(txtSearch.Text), MB_YESNOCANCEL or MB_DEFBUTTON2 or MB_ICONQUESTION)of
|
---|
229 | ID_YES : // send bulletin and abort free-text entry
|
---|
230 | begin
|
---|
231 | tmpList := TStringList.Create;
|
---|
232 | try
|
---|
233 | OKtoContinue := False;
|
---|
234 | GetFreeTextARTComment(tmpList, OKtoContinue);
|
---|
235 | if not OKtoContinue then
|
---|
236 | begin
|
---|
237 | stsFound.SimpleText := '';
|
---|
238 | txtSearch.SetFocus;
|
---|
239 | Exit;
|
---|
240 | end;
|
---|
241 | x := SendARTBulletin(UpperCase(txtSearch.Text), tmpList);
|
---|
242 | if Piece(x, U, 1) = '-1' then
|
---|
243 | InfoBox(TX_BULLETIN_ERROR, TC_BULLETIN_ERROR, MB_OK or MB_ICONWARNING)
|
---|
244 | else if Piece(x, U, 1) = '1' then
|
---|
245 | InfoBox(TX_BULLETIN, 'Information', MB_OK or MB_ICONINFORMATION)
|
---|
246 | else
|
---|
247 | InfoBox(Piece(x, U, 2), TC_BULLETIN_ERROR, MB_OK or MB_ICONWARNING);
|
---|
248 | finally
|
---|
249 | tmpList.Free;
|
---|
250 | end;
|
---|
251 | Close;
|
---|
252 | end;
|
---|
253 | ID_NO : // clear status message, and allow repeat search
|
---|
254 | begin
|
---|
255 | stsFound.SimpleText := '';
|
---|
256 | txtSearch.SetFocus;
|
---|
257 | Exit;
|
---|
258 | end;
|
---|
259 | ID_CANCEL: // abort entry and return to order menu or whatever
|
---|
260 | Close;
|
---|
261 | end;
|
---|
262 | end
|
---|
263 | else if Piece(TORTreeNode(tvAgent.Selected).StringData, U, 6) = '+' then
|
---|
264 | {bail out - tree grouper selected}
|
---|
265 | begin
|
---|
266 | FAllergy := '';
|
---|
267 | Exit;
|
---|
268 | end
|
---|
269 | else
|
---|
270 | {matching item selected}
|
---|
271 | begin
|
---|
272 | FAllergy := TORTreeNode(tvAgent.Selected).StringData;
|
---|
273 | x := Piece(FAllergy, U, 2);
|
---|
274 | x := Trim(Piece(x, '<', 1));
|
---|
275 | SetPiece(FAllergy, U, 2, x);
|
---|
276 | Close;
|
---|
277 | end;
|
---|
278 | end;
|
---|
279 |
|
---|
280 | procedure TfrmAllgyFind.cmdCancelClick(Sender: TObject);
|
---|
281 | begin
|
---|
282 | inherited;
|
---|
283 | FAllergy := '';
|
---|
284 | Close;
|
---|
285 | end;
|
---|
286 |
|
---|
287 | procedure TfrmAllgyFind.ckNoKnownAllergiesClick(Sender: TObject);
|
---|
288 | begin
|
---|
289 | inherited;
|
---|
290 | with ckNoKnownAllergies do
|
---|
291 | begin
|
---|
292 | txtSearch.Enabled := not Checked;
|
---|
293 | cmdSearch.Enabled := not Checked;
|
---|
294 | lblSearch.Enabled := not Checked;
|
---|
295 | lblSelect.Enabled := not Checked;
|
---|
296 | tvAgent.Enabled := not Checked;
|
---|
297 | cmdOK.Enabled := Checked;
|
---|
298 | end;
|
---|
299 | end;
|
---|
300 |
|
---|
301 | procedure TfrmAllgyFind.BuildAgentTree(AgentList: TStrings; const Parent: string; Node: TORTreeNode);
|
---|
302 | var
|
---|
303 | MyID, MyParent, Name: string;
|
---|
304 | i: Integer;
|
---|
305 | ChildNode, tmpNode: TORTreeNode;
|
---|
306 | HasChildren, Found: Boolean;
|
---|
307 | begin
|
---|
308 | tvAgent.Items.BeginUpdate;
|
---|
309 | with AgentList do for i := 0 to Count - 1 do
|
---|
310 | begin
|
---|
311 | Found := False;
|
---|
312 | MyParent := Piece(Strings[i], U, 5);
|
---|
313 | if (MyParent = Parent) then
|
---|
314 | begin
|
---|
315 | MyID := Piece(Strings[i], U, 1);
|
---|
316 | Name := Piece(Strings[i], U, 2);
|
---|
317 | HasChildren := Piece(Strings[i], U, 6) = '+';
|
---|
318 | if Node <> nil then
|
---|
319 | begin
|
---|
320 | if Node.HasChildren then
|
---|
321 | begin
|
---|
322 | tmpNode := TORTreeNode(Node.GetFirstChild);
|
---|
323 | while tmpNode <> nil do
|
---|
324 | begin
|
---|
325 | if tmpNode.Text = Piece(Strings[i], U, 2) then Found := True;
|
---|
326 | tmpNode := TORTreeNode(Node.GetNextChild(tmpNode));
|
---|
327 | end;
|
---|
328 | end
|
---|
329 | else
|
---|
330 | Node.StateIndex := 0;
|
---|
331 | end;
|
---|
332 | if Found then
|
---|
333 | Continue
|
---|
334 | else
|
---|
335 | begin
|
---|
336 | ChildNode := TORTreeNode(tvAgent.Items.AddChild(Node, Name));
|
---|
337 | ChildNode.StringData := AgentList[i];
|
---|
338 | if HasChildren then BuildAgentTree(AgentList, MyID, ChildNode);
|
---|
339 | end;
|
---|
340 | end;
|
---|
341 | end;
|
---|
342 | tvAgent.Items.EndUpdate;
|
---|
343 | end;
|
---|
344 |
|
---|
345 | procedure TfrmAllgyFind.tvAgentDblClick(Sender: TObject);
|
---|
346 | begin
|
---|
347 | inherited;
|
---|
348 | cmdOKClick(Self);
|
---|
349 | end;
|
---|
350 |
|
---|
351 | end.
|
---|