Module

fProbLex

Path

C:\CPRS\CPRS30\fProbLex.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
fProbFreetext -
mTreeGrid -
rPCE -
uConst -
uInit -
uProbs -

Units Used in Implementation

Name Comments
fProbEdt -
fProbs -
rCore -
rProbs -
uCore -

Classes

Name Comments
TfrmPLLex -

Procedures

Name Owner Declaration Scope Comments
bbCanClick TfrmPLLex procedure bbCanClick(Sender: TObject); Public/Published -
bbExtendedSearchClick TfrmPLLex procedure bbExtendedSearchClick(Sender: TObject); Public/Published -
bbFreetextClick TfrmPLLex procedure bbFreetextClick(Sender: TObject); Public/Published -
bbOKClick TfrmPLLex procedure bbOKClick(Sender: TObject); Public/Published -
bbSearchClick TfrmPLLex procedure bbSearchClick(Sender: TObject); Public/Published -
CenterForm TfrmPLLex procedure CenterForm(tgf: TTreeGridFrame; w: Integer); Public/Published -
DisableExtend TfrmPLLex procedure DisableExtend; Public/Published -
DisableFreeText TfrmPLLex procedure DisableFreeText; Public/Published -
ebLexChange TfrmPLLex procedure ebLexChange(Sender: TObject); Public/Published -
ebLexKeyPress TfrmPLLex procedure ebLexKeyPress(Sender: TObject; var Key: Char); Public/Published -
EnableExtend TfrmPLLex procedure EnableExtend; Public/Published -
EnableFreeText TfrmPLLex procedure EnableFreeText; Public/Published -
FormClose TfrmPLLex procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmPLLex procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmPLLex procedure FormShow(Sender: TObject); Public/Published -
processSearch TfrmPLLex procedure processSearch(Extend: Boolean); Private -
setClientWidth TfrmPLLex procedure setClientWidth(tgf: TTreeGridFrame); Public/Published -
SetColumnTreeModel TfrmPLLex procedure SetColumnTreeModel(ResultSet: TStrings); Private -
SetICDVersion TfrmPLLex procedure SetICDVersion(ADate: TFMDateTime = 0); Private -
SetSearchString TfrmPLLex procedure SetSearchString(sstring: String); Public Public declarations
tgfLextvChange TfrmPLLex procedure tgfLextvChange(Sender: TObject; Node: TTreeNode); Public/Published -
tgfLextvDblClick TfrmPLLex procedure tgfLextvDblClick(Sender: TObject); Public/Published -
tgfLextvEnter TfrmPLLex procedure tgfLextvEnter(Sender: TObject); Public/Published -
tgfLextvExit TfrmPLLex procedure tgfLextvExit(Sender: TObject); Public/Published -
updateStatus TfrmPLLex procedure updateStatus(status: String); Private -

Functions

Name Owner Declaration Scope Comments
SaveFreetext TfrmPLLex function SaveFreetext: Boolean; Private -
SetFreetextProblem TfrmPLLex function SetFreetextProblem: String; Public -
setProblem - function setProblem: String; Local -

Global Variables

Name Type Declaration Comments
ProblemNOSs TStringList ProblemNOSs: TStringList; -
TriedExtend Boolean TriedExtend: Boolean = false; -

Constants

Name Declaration Scope Comments
SUPPRESS_CODES False Global -
TX_CHOOSE 'You must select a valid term to identify your patient''s problem. Either click ' + Global -
TX_CONTINUE_799 'The term you selected is not yet mapped to an ICD-9-CM code. ' + Global -
TX_CONTINUE_R69 'The term you selected is not yet mapped to an ICD-10-CM code. ' + Global -
TX_EXTEND_SEARCH 'A suitable term was not found in the Problem List subset of SNOMED CT. ' + Global -
TX_FREETEXT_799 'A suitable term was not found based on user input and current defaults. ' + Global -
TX799 '799.9' Global -
TXR69 'R69.' Global -


Module Source

1     unit fProbLex;
2     
3     interface
4     
5     uses
6       SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
7       Forms, Dialogs, ORFn, uProbs, StdCtrls, Buttons, ExtCtrls, ORctrls, uConst,
8       fAutoSz, uInit, fBase508Form, VA508AccessibilityManager, Grids, fProbFreetext,
9       ComCtrls, Windows, rPCE, mTreeGrid;
10    
11    type
12      TfrmPLLex = class(TfrmBase508Form)
13        {Label1: TLabel;}
14        bbCan: TBitBtn;
15        bbOK: TBitBtn;
16        pnlStatus: TPanel;
17        lblStatus: TVA508StaticText;
18        ebLex: TCaptionEdit;
19        bbSearch: TBitBtn;
20        bbExtendedSearch: TBitBtn;
21        pnlDialog: TPanel;
22        pnlSearch: TPanel;
23        pnlButtons: TPanel;
24        pnlList: TPanel;
25        lblSelect: TLabel;
26        lblSearch: Tlabel;
27        bbFreetext: TBitBtn;
28        tgfLex: TTreeGridFrame;
29        procedure EnableExtend;
30        procedure DisableExtend;
31        procedure EnableFreeText;
32        procedure DisableFreeText;
33        procedure FormClose(Sender: TObject; var Action: TCloseAction);
34        procedure bbOKClick(Sender: TObject);
35        procedure bbCanClick(Sender: TObject);
36        procedure FormCreate(Sender: TObject);
37        procedure ebLexKeyPress(Sender: TObject; var Key: Char);
38        procedure bbSearchClick(Sender: TObject);
39        procedure FormShow(Sender: TObject);
40        procedure bbExtendedSearchClick(Sender: TObject);
41        procedure ebLexChange(Sender: TObject);
42        procedure setClientWidth(tgf: TTreeGridFrame);
43        procedure CenterForm(tgf: TTreeGridFrame; w: Integer);
44        procedure bbFreetextClick(Sender: TObject);
45        procedure tgfLextvChange(Sender: TObject; Node: TTreeNode);
46        procedure tgfLextvEnter(Sender: TObject);
47        procedure tgfLextvExit(Sender: TObject);
48        procedure tgfLextvDblClick(Sender: TObject);
49      private
50        FExtendOffered: Boolean;
51        FSuppressCodes: Boolean;
52        FICDLookup: Boolean;
53        FBuildingList: Boolean;
54        FCenteringForm: Boolean;
55        FICDVersion: String;
56        FProblemNOS: String;
57        FContinueNOS: String;
58        FI10Active: Boolean;
59        procedure SetICDVersion(ADate: TFMDateTime = 0);
60        procedure updateStatus(status: String);
61        procedure processSearch(Extend: Boolean);
62        procedure SetColumnTreeModel(ResultSet: TStrings);
63        function SaveFreetext: Boolean;
64        { Private declarations }
65      public
66        { Public declarations }
67        procedure SetSearchString(sstring: String);
68        function SetFreetextProblem: String;
69      end;
70    
71    
72    implementation
73    
74    uses
75     fProbs, rProbs, fProbEdt, uCore, rCore;
76    
77    {$R *.DFM}
78    
79    var
80     ProblemNOSs: TStringList;
81     TriedExtend: Boolean = false;
82    
83    const
84      TX799 = '799.9';
85      TX_CONTINUE_799 = 'The term you selected is not yet mapped to an ICD-9-CM code. ' +
86                        'If you select this term, an ICD-9-CM code of 799.9 will be entered into ' +
87                        'the system and your selected term will be sent for review to be mapped ' +
88                        'to an ICD-9-CM code. Until that process is completed, you will not be able ' +
89                        'to choose your selected term from the Encounter Form pick list.' + CRLF + CRLF +
90                        'Use ';
91      TXR69 = 'R69.';
92      TX_CONTINUE_R69 = 'The term you selected is not yet mapped to an ICD-10-CM code. ' +
93                        'If you select this term, an ICD-10-CM code of R69. will be entered into ' +
94                        'the system and your selected term will be sent for review to be mapped ' +
95                        'to an ICD-10-CM code. Until that process is completed, you will not be able ' +
96                        'to choose your selected term from the Encounter Form pick list.' + CRLF + CRLF +
97                        'Use ';
98      TX_FREETEXT_799  = 'A suitable term was not found based on user input and current defaults. ' +
99                         'If you proceed with this nonspecific term, an ICD code of "799.9 - OTHER ' +
100                        'UNKNOWN AND UNSPECIFIED CAUSE OF MORBIDITY OR MORTALITY" will ' +
101                        'be filed.' + CRLF + CRLF + 'Use ';
102     TX_EXTEND_SEARCH = 'A suitable term was not found in the Problem List subset of SNOMED CT. ' +
103                        'If you''d like to extend your search to include the entire Clinical ' +
104                        'Findings Hierarchy of SNOMED CT, click the Extend Search button. ';
105     TX_CHOOSE        = 'You must select a valid term to identify your patient''s problem. Either click ' +
106                        'on a term from the list, or click on the Extend Search button, to extend your ' +
107                        'search to include the entire Clinical Findings Hierarchy of SNOMED CT.';
108     SUPPRESS_CODES = False;
109   
110   procedure TfrmPLLex.FormClose(Sender: TObject; var Action: TCloseAction);
111   begin
112     ProblemNOSs.Free;
113     Release;
114   end;
115   
116   procedure TfrmPLLex.bbExtendedSearchClick(Sender: TObject);
117   begin
118     TriedExtend := true;
119     processSearch(true);
120     DisableExtend;
121     if (ebLex.Text <> '') and (lblstatus.Caption <> 'Code search failed by Extended Search.') then
122       EnableFreeText;
123   end;
124   
125   procedure TfrmPLLex.bbFreetextClick(Sender: TObject);
126   begin
127     inherited;
128     if not SaveFreetext then
129       Exit;
130   
131     //save freetext problem
132     PLProblem := SetFreetextProblem;
133     {prevents GPF if system close box is clicked while frmDlgProbs is visible}
134     if (not Application.Terminated) and (not uInit.TimedOut) then
135       if Assigned(frmProblems) then PostMessage(frmProblems.Handle, UM_PLLex, 0, 0);
136     Close;
137   end;
138   
139   procedure TfrmPLLex.updateStatus(status: String);
140   begin
141     lblStatus.caption := status;
142     lblStatus.Invalidate;
143     lblStatus.Update;
144   end;
145   
146   procedure TfrmPLLex.SetICDVersion(ADate: TFMDateTime = 0);
147   begin
148     FICDVersion := Encounter.GetICDVersion;
149     tgfLex.TargetTitle := Piece(FICDVersion, '^', 2) + ':  ';
150     if Piece(FICDVersion, '^', 1) = 'ICD' then
151     begin
152       FProblemNOS := TX799;
153       FContinueNOS := TX_CONTINUE_799;
154       FI10Active := False;
155       tgfLex.ShowTargetCode := True;
156     end
157     else
158     begin
159       FProblemNOS := TXR69;
160       FContinueNOS := TX_CONTINUE_R69;
161       FI10Active := True;
162       tgfLex.ShowTargetCode := False;
163     end;
164   end;
165   
166   procedure TfrmPLLex.bbOKClick(Sender: TObject);
167   
168   function setProblem: String;
169   var
170     x, y: String;
171     i: integer;
172   begin
173     x := String(tgfLex.SelectedNode.Data);
174     y := Piece(x, U, 2);
175     i := Pos(' *', y);
176     if i > 0 then y := Copy(y, 1, i - 1);
177     SetPiece(x, U, 2, y);
178     // e.g., Result = 7030665^Atrial arrhythmia^427.9^2566^SNOMED CT^17366009^29361012^ICD-9-CM|arrhyth
179     Result := x + '|' + ebLex.Text;
180   end;
181   
182   begin
183     {nothing entered, nothing selected - bail out}
184     if (ebLex.Text = '') and (tgfLex.SelectedNode = nil) and (tgfLex.tv.Items.Count = 0) then
185       Exit
186     {nothing selected, or search returned void - suggest extended search}
187     else if ((tgfLex.SelectedNode = nil) or (tgfLex.tv.Items.Count = 0)) then
188     begin
189       if TriedExtend then
190       begin
191         if not SaveFreetext then
192           Exit;
193   
194         //save freetext problem
195         PLProblem := SetFreetextProblem;
196         Exit;
197       end
198       else
199       begin
200         if not FExtendOffered then
201         begin
202           if (tgfLex.tv.Items.Count = 0) then
203             InfoBox(TX_EXTEND_SEARCH, 'Term not found', MB_OK or MB_ICONINFORMATION)
204           else
205             InfoBox(TX_CHOOSE, 'Term not selected', MB_OK or MB_ICONINFORMATION);
206         end
207         else
208         begin
209           if not SaveFreetext then
210             Exit;
211           PLProblem := SetFreetextProblem;
212           if (not Application.Terminated) and (not uInit.TimedOut) then
213             if Assigned(frmProblems) then PostMessage(frmProblems.Handle, UM_PLLex, 0, 0);
214           Close;
215         end;
216         EnableExtend;
217         FExtendOffered := true;
218       end;
219       Exit;
220     end
221     else if TriedExtend and ((tgfLex.SelectedNode.Code = '')
222          or  ((tgfLex.SelectedNode.Code = FProblemNOS)
223          and (ProblemNOSs.IndexOf(tgfLex.SelectedNode.Code) < 0))) then
224     begin
225       if (not FI10Active) and (InfoBox(FContinueNOS + UpperCase(tgfLex.SelectedNode.Text) + '?', 'Unmapped Problem Selected',
226         MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES) then Exit;
227       PLProblem := setProblem;
228     end
229     else
230       PLProblem := setProblem;
231   
232     {prevents GPF if system close box is clicked while frmDlgProbs is visible}
233     if (not Application.Terminated) and (not uInit.TimedOut) then
234        if Assigned(frmProblems) then PostMessage(frmProblems.Handle, UM_PLLex, 0, 0);
235     Close;
236   end;
237   
238   procedure TfrmPLLex.bbCanClick(Sender: TObject);
239   begin
240    PLProblem:='';
241    close;
242   end;
243   
244   procedure TfrmPLLex.FormCreate(Sender: TObject);
245   var
246     ADate: TFMDateTime;
247   begin
248     ADate := 0;
249     FExtendOffered := False;
250     FBuildingList := False;
251     FCenteringForm := False;
252     FICDLookup := False;
253     FSuppressCodes := PLUser.usSuppressCodes;
254     PLProblem := '';
255     ProblemNOSs := TStringList.Create;
256     ResizeAnchoredFormToFont(self);
257     if not ((Encounter.VisitCategory = 'E') or (Encounter.VisitCategory = 'H')
258       or (Encounter.VisitCategory = 'D')) then
259         ADate := Encounter.DateTime;
260     SetICDVersion(ADate);
261     tgfLex.HorizPanelSpace := 8;
262     tgfLex.VertPanelSpace := 4;
263   end;
264   
265   procedure TfrmPLLex.ebLexKeyPress(Sender: TObject; var Key: Char);
266   begin
267     if key=#13 then
268     begin
269       bbSearchClick(Sender);
270       Key:=#0;
271     end
272     else
273     begin
274       lblStatus.caption:='';
275     end;
276   end;
277   
278   procedure TfrmPLLex.ebLexChange(Sender: TObject);
279   begin
280     inherited;
281     bbSearch.Default := True;
282     bbOK.Default := False;
283     DisableExtend;
284     DisableFreeText;
285     if tgfLex.tv.Items.Count > 0 then
286     begin
287       tgfLex.tv.Selected := nil;
288       tgfLex.tv.Items.Clear;
289       updateStatus('');
290       CenterForm(tgfLex, Constraints.MinWidth);
291     end;
292   end;
293   
294   procedure TfrmPLLex.setClientWidth(tgf: TTreeGridFrame);
295   var
296     i, maxw, tl, maxtl: integer;
297     ctn: TLexTreeNode;
298   begin
299     maxtl := 0;
300     for i := 0 to pred(tgf.tv.Items.Count) do
301     begin
302       ctn := tgf.tv.Items[i] as TLexTreeNode;
303       tl := TextWidthByFont(Font.Handle, ctn.Text);
304       if (tl > maxtl) then
305         maxtl := tl;
306     end;
307   
308     maxw := maxtl + 30;
309   
310     if maxw < Constraints.MinWidth then
311       maxw := Constraints.MinWidth;
312   
313     self.Width := maxw;
314   
315     //resize tv to maximum pixel width of its elements
316     if (maxw > 0) and (self.ClientWidth <> maxw) then
317     begin
318       CenterForm(tgf, maxw);
319     end;
320   end;
321   
322   procedure TfrmPLLex.SetSearchString(sstring: String);
323   begin
324     ebLex.Text := sstring;
325     Invalidate;
326   end;
327   
328   procedure TfrmPLLex.CenterForm(tgf: TTreeGridFrame; w: Integer);
329   var
330     wdiff, mainw: Integer;
331   begin
332     FCenteringForm := True;
333     mainw := Application.MainForm.Width;
334   
335     if w > mainw then
336     begin
337       w := mainw;
338     end;
339   
340     self.ClientWidth := w + (tgf.Width - tgf.ClientWidth) + (pnlList.Padding.Left + pnlList.Padding.Right);
341   
342     wdiff := ((mainw - self.Width) div 2);
343     self.Left := Application.MainForm.Left + wdiff;
344   
345     invalidate;
346     FCenteringForm := False;
347   end;
348   
349   procedure TfrmPLLex.tgfLextvChange(Sender: TObject; Node: TTreeNode);
350   begin
351     inherited;
352     tgfLex.tvChange(Sender, Node);
353     if (tgfLex.SelectedNode = nil) then
354     begin
355       bbOK.Enabled := false;
356       bbOK.Default := false;
357     end
358     else
359     begin
360       bbOK.Enabled := true;
361       bbOK.Default := true;
362       bbSearch.Default := false;
363     end;
364   end;
365   
366   procedure TfrmPLLex.tgfLextvDblClick(Sender: TObject);
367   begin
368     inherited;
369     bbOK.Enabled := true;
370     bbOKClick(sender);
371   end;
372   
373   procedure TfrmPLLex.tgfLextvEnter(Sender: TObject);
374   begin
375     inherited;
376     if (tgfLex.SelectedNode = nil) then
377       bbOK.Enabled := false
378     else
379       bbOK.Enabled := true;
380   end;
381   
382   procedure TfrmPLLex.tgfLextvExit(Sender: TObject);
383   begin
384     inherited;
385     if (tgfLex.SelectedNode = nil) then
386       bbOK.Enabled := false
387     else
388       bbOK.Enabled := true;
389   end;
390   
391   procedure TfrmPLLex.bbSearchClick(Sender: TObject);
392   begin
393     TriedExtend := false;
394     ProblemNOSs.Clear;
395     DisableFreeText;
396     processSearch(false);
397   end;
398   
399   procedure TfrmPLLex.SetColumnTreeModel(ResultSet: TStrings);
400   var
401     i: Integer;
402     Node: TLexTreeNode;
403     RecStr: String;
404   begin
405     //  1     2        3      4       5       6         7          8     9
406     //VUID^SCT TEXT^ICDCODE^ICDIEN^CODE SYS^CONCEPT^DESIGNATION^ICDVER^PARENT
407     tgfLex.tv.Items.Clear;
408     tgfLex.tv.Refresh;
409   
410     for i := 0 to ResultSet.Count - 1 do
411     begin
412       RecStr := ResultSet[i];
413       if Piece(RecStr, '^', 9) = '' then
414         Node := (tgfLex.tv.Items.Add(nil, Piece(RecStr, '^', 2))) as TLexTreeNode
415       else
416         Node := (tgfLex.tv.Items.AddChild(tgfLex.tv.Items[(StrToInt(Piece(RecStr, '^', 9))-1)], Piece(RecStr, '^', 2))) as TLexTreeNode;
417   
418       Node.ResultLine := RecStr;
419       Node.VUID := Piece(RecStr, '^', 1);
420       Node.Text := Piece(RecStr, '^', 2);
421       Node.CodeDescription := Node.Text;
422       Node.CodeIEN := Piece(RecStr, '^', 4);
423       Node.CodeSys := Piece(RecStr, '^', 5);
424       Node.Code := Piece(RecStr, '^', 6);
425       Node.TargetCode := Piece(RecStr, '^', 3);
426       Node.TargetCodeIEN := Piece(RecStr, '^', 4);
427       Node.TargetCodeSys := Piece(RecStr, '^', 8);
428   
429       if Piece(RecStr, '^', 9) <> '' then
430         Node.ParentIndex := IntToStr(StrToInt(Piece(RecStr, '^', 9)) - 1);
431   
432       //Data = pointer to RecStr
433       Node.Data := Pointer(RecStr);
434   
435       if Piece(RecStr, '^', 1) = 'icd' then
436       begin
437         ebLex.SelectAll;
438         ebLex.SetFocus;
439         tgfLex.tv.Enabled := false;
440         FICDLookup := True;
441       end
442       else
443       begin
444         tgfLex.tv.Enabled := True;
445       end;
446     end;
447     //sort treenodes
448     tgfLex.tv.AlphaSort(True);
449   end;
450   
451   procedure TfrmPLLex.processSearch(Extend: Boolean);
452   const
453     TX_SRCH_REFINE1 = 'Your search ';
454     TX_SRCH_REFINE2 = ' matched ';
455     TX_SRCH_REFINE3 = ' records, too many to display.' + CRLF + CRLF + 'Suggestions:' + CRLF +
456                       #32#32#32#32#42 + '   Refine your search by adding more words' + CRLF + #32#32#32#32#42 + '   Try different keywords';
457     MaxRec = 5000;
458   var
459     ProblemList: TStringList;
460     v, Max, subset: string;
461     Match: TLexTreeNode;
462     SvcCat: Char;
463     DateOfInterest: TFMDateTime;
464     FreqOfText: integer;
465   begin  {processSearch body}
466   
467     FICDLookup := False;
468   
469     if ebLex.text = '' then
470     begin
471      InfoBox('Enter a term to search for, then click "SEARCH"', 'Information', MB_OK or MB_ICONINFORMATION);
472      exit; {don't bother to drop if no text entered}
473     end;
474   
475     if Extend then
476       subset := ' by Extended Search'
477     else
478       subset := '';
479   
480     FBuildingList := True;
481   
482     ProblemList := TStringList.Create;
483     try
484       Screen.Cursor := crHourglass;
485       updateStatus('Searching ' + subset + '...');
486   
487       v := uppercase(ebLex.text);
488       FreqOfText := GetFreqOfText(v);
489       if FreqOfText > MaxRec then
490         begin
491           InfoBox(TX_SRCH_REFINE1 + #39 + v + #39 + TX_SRCH_REFINE2 + IntToStr(FreqOfText) + TX_SRCH_REFINE3,'Refine Search', MB_OK or MB_ICONINFORMATION);
492           lblStatus.Caption := '';
493           Exit;
494         end;
495   
496       SvcCat := Encounter.VisitCategory;
497       if (SvcCat = 'E') or (SvcCat = 'H') then
498         DateOfInterest := FMNow
499       else
500         DateOfInterest := Encounter.DateTime;
501   
502       if (v <> '') then
503       begin
504         if Extend then
505           ProblemList.Assign(ProblemLexiconSearch(v, DateOfInterest, True))
506         else
507           ProblemList.Assign(ProblemLexiconSearch(v, DateOfInterest));
508       end;
509       if ProblemList.count > 0 then
510       begin
511         Max := ProblemList[pred(ProblemList.count)]; {get max number found}
512         ProblemList.delete(pred(ProblemList.count)); {shed max# found}
513         SetColumnTreeModel(ProblemList);
514         setClientWidth(tgfLex);
515         updateStatus(Max + subset + '.');
516   
517         EnableExtend;
518         ActiveControl := bbCan;
519   
520         if Max = 'Code search failed' then
521         begin
522          bbOk.Enabled := False;
523          Exit;
524         end;
525         Match := tgfLex.FindNode(v);
526   
527         if Match <> nil then
528         begin
529           bbOk.Enabled := True;
530         end
531         else
532         begin
533           tgfLex.tv.Items[0].MakeVisible;
534         end;
535         if Piece(ProblemList.Strings[0],U,1) = 'icd' then
536           begin
537             bbOK.Enabled := False;
538             bbExtendedSearch.Enabled := False;
539           end
540         else
541           begin
542             ActiveControl := tgfLex.tv;
543             tgfLex.tv.Items[0].Selected := False;
544           end;
545       end
546       else {search results are empty}
547       begin
548         updateStatus('No Entries Found ' + subset + ' for "' + ebLex.text + '"');
549         if TriedExtend then
550         begin
551           if not SaveFreetext then
552             Exit;
553           PLProblem := SetFreetextProblem;
554           if (not Application.Terminated) and (not uInit.TimedOut) then
555             if Assigned(frmProblems) then PostMessage(frmProblems.Handle, UM_PLLex, 0, 0);
556           Close;
557         end
558         else
559         begin
560           EnableExtend;
561           FExtendOffered := true;
562         end;
563       end;
564     finally
565       ProblemList.free;
566       FBuildingList := False;
567       Screen.Cursor := crDefault;
568     end;
569   end;
570   
571   function TfrmPLLex.SaveFreetext: Boolean;
572   var
573     FTMsgDialog: TForm;
574     SaveFT: Boolean;
575   begin
576     SaveFT := False;
577     FTMsgDialog := CreateFreetextMessage(UpperCase(ebLex.Text), FICDVersion);
578   
579     with FTMsgDialog do
580     try
581       Position := poOwnerFormCenter;
582   
583       if (ShowModal = ID_YES) then
584       begin
585         SaveFT := True;
586       end;
587       finally
588         Free;
589   
590       Result := SaveFT;
591     end;
592   end;
593   
594   function TFrmPLLex.SetFreetextProblem: String;
595   var
596     ICDCode: String;
597   begin
598     if FI10Active then ICDCode := 'R69.' else ICDCode := '799.9';
599     Result := '1^' + ebLex.Text + '^' + ICDCode + '^^^^|' + ebLex.Text;
600   end;
601   
602   procedure TfrmPLLex.EnableExtend;
603   begin
604     bbSearch.Enabled := false;
605     bbExtendedSearch.Visible := true;
606     bbExtendedSearch.Enabled := true;
607     bbExtendedSearch.setFocus;
608   end;
609   
610   procedure TfrmPLLex.DisableExtend;
611   begin
612     bbSearch.Enabled := true;
613     bbExtendedSearch.Enabled := false;
614   end;
615   
616   procedure TfrmPLLex.EnableFreeText;
617   begin
618     bbFreetext.Visible := true;
619     bbFreetext.Enabled := true;
620   end;
621   
622   procedure TfrmPLLex.DisableFreeText;
623   begin
624     bbFreetext.Enabled := false;
625     bbFreetext.Visible := false;
626   end;
627   
628   procedure TfrmPLLex.FormShow(Sender: TObject);
629   begin
630     ebLex.setfocus;
631     RequestNTRT := False;
632     if FSuppressCodes then
633     begin
634       tgfLex.ShowCode := False;
635       tgfLex.ShowTargetCode := False;
636     end
637     else
638     begin
639       tgfLex.ShowCode := True;
640       tgfLex.ShowTargetCode := not FI10Active;
641     end;
642     tgfLex.ShowDescription := True;
643   
644     CenterForm(tgfLex, tgfLex.ClientWidth);
645   end;
646   
647   end.

Module Calls (2 levels)


fProbLex
 ├uProbs
 │ ├uConst
 │ ├rCore
 │ └uCore
 ├uConst
 ├uInit
 │ └fTimeout
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├fProbFreetext
 │ ├uProbs...
 │ └fBase508Form...
 ├rPCE
 │ ├uPCE
 │ ├UBACore
 │ ├rCore...
 │ ├uCore...
 │ ├uConst
 │ ├fEncounterFrame
 │ ├UBAGlobals
 │ └UBAConst
 ├mTreeGrid
 ├fProbs
 │ ├fHSplit
 │ ├uProbs...
 │ ├uCore...
 │ ├fProbEdt
 │ ├uConst
 │ ├fBase508Form...
 │ ├fFrame
 │ ├fProbflt
 │ ├fProbLex...
 │ ├rProbs
 │ ├rCover
 │ ├fRptBox
 │ ├rCore...
 │ ├fProbCmt
 │ ├fEncnt
 │ ├fReportsPrint
 │ ├fReports
 │ └rPCE...
 ├rProbs...
 ├uCore...
 └rCore...

Module Called-By (2 levels)


       fProbLex
       fProbs┤ 
     fFrame┤ │ 
   fProbEdt┤ │ 
   fProbflt┤ │ 
fProbLex...┘ │ 
  fProbEdt...┘