source: cprs/branches/tmg-cprs/CPRS-Chart/fAllgyFind.pas@ 1806

Last change on this file since 1806 was 453, checked in by Kevin Toppenberg, 16 years ago

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