Module

fPCELex

Path

C:\CPRS\CPRS30\Encounter\fPCELex.pas

Last Modified

7/15/2014 3:26:36 PM

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
mTreeGrid -
uCore -

Units Used in Implementation

Name Comments
rPCE -
rProbs -
UBAGlobals -
uProbs -

Classes

Name Comments
TfrmPCELex -

Procedures

Name Owner Declaration Scope Comments
CenterForm TfrmPCELex procedure CenterForm(w: Integer); Private -
cmdCancelClick TfrmPCELex procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdExtendedSearchClick TfrmPCELex procedure cmdExtendedSearchClick(Sender: TObject); Public/Published -
cmdOKClick TfrmPCELex procedure cmdOKClick(Sender: TObject); Public/Published -
cmdSearchClick TfrmPCELex procedure cmdSearchClick(Sender: TObject); Public/Published -
disableExtend TfrmPCELex procedure disableExtend; Private -
enableExtend TfrmPCELex procedure enableExtend; Private -
FormClose TfrmPCELex procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmPCELex procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmPCELex procedure FormShow(Sender: TObject); Public/Published -
LexiconLookup - procedure LexiconLookup(var Code: string; ALexApp: Integer; ADate: TFMDateTime = 0; AExtend: Boolean = False; AInputString: String = ''; AMessage: String = ''; ADefaultToInput: Boolean = False); Interfaced -
processSearch TfrmPCELex procedure processSearch; Private -
SetApp TfrmPCELex procedure SetApp(LexApp: Integer); Private -
setClientWidth TfrmPCELex procedure setClientWidth; Private -
SetColumnTreeModel TfrmPCELex procedure SetColumnTreeModel(ResultSet: TStrings); Private -
SetDate TfrmPCELex procedure SetDate(ADate: TFMDateTime); Private -
SetICDVersion TfrmPCELex procedure SetICDVersion; Private -
tgfLextvChange TfrmPCELex procedure tgfLextvChange(Sender: TObject; Node: TTreeNode); Public/Published -
tgfLextvClick TfrmPCELex procedure tgfLextvClick(Sender: TObject); Public/Published -
tgfLextvDblClick TfrmPCELex procedure tgfLextvDblClick(Sender: TObject); Public/Published -
tgfLextvEnter TfrmPCELex procedure tgfLextvEnter(Sender: TObject); Public/Published -
tgfLextvExit TfrmPCELex procedure tgfLextvExit(Sender: TObject); Public/Published -
tgfLextvExpanding TfrmPCELex procedure tgfLextvExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); Public/Published -
tgfLextvHint TfrmPCELex procedure tgfLextvHint(Sender: TObject; const Node: TTreeNode; var Hint: string); Public/Published -
txtSearchChange TfrmPCELex procedure txtSearchChange(Sender: TObject); Public/Published -
updateStatus TfrmPCELex procedure updateStatus(status: String); Private -

Functions

Name Owner Declaration Scope Comments
isNumeric TfrmPCELex function isNumeric(inStr: String): Boolean; Public/Published -
ParseNarrCode TfrmPCELex function ParseNarrCode(ANarrCode: String): String; Private -

Global Variables

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


Module Source

1     unit fPCELex;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, uCore,
7       fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, Buttons, VA508AccessibilityManager,
8       ComCtrls, fBase508Form, CommCtrl, mTreeGrid;
9     
10    type
11      TfrmPCELex = class(TfrmBase508Form)
12        txtSearch: TCaptionEdit;
13        cmdSearch: TButton;
14        pnlStatus: TPanel;
15        pnlDialog: TPanel;
16        pnlButtons: TPanel;
17        cmdOK: TButton;
18        cmdCancel: TButton;
19        cmdExtendedSearch: TBitBtn;
20        pnlSearch: TPanel;
21        pnlList: TPanel;
22        lblStatus: TVA508StaticText;
23        lblSelect: TVA508StaticText;
24        lblSearch: TLabel;
25        tgfLex: TTreeGridFrame;
26        procedure cmdSearchClick(Sender: TObject);
27        procedure cmdCancelClick(Sender: TObject);
28        procedure FormCreate(Sender: TObject);
29        procedure cmdOKClick(Sender: TObject);
30        procedure txtSearchChange(Sender: TObject);
31        procedure cmdExtendedSearchClick(Sender: TObject);
32        function isNumeric(inStr: String): Boolean;
33        procedure FormShow(Sender: TObject);
34        procedure FormClose(Sender: TObject; var Action: TCloseAction);
35        procedure tgfLextvChange(Sender: TObject; Node: TTreeNode);
36        procedure tgfLextvClick(Sender: TObject);
37        procedure tgfLextvDblClick(Sender: TObject);
38        procedure tgfLextvEnter(Sender: TObject);
39        procedure tgfLextvExit(Sender: TObject);
40        procedure tgfLextvHint(Sender: TObject; const Node: TTreeNode;
41          var Hint: string);
42        procedure tgfLextvExpanding(Sender: TObject; Node: TTreeNode;
43          var AllowExpansion: Boolean);
44      private
45        FLexApp: Integer;
46        FSuppressCodes: Boolean;
47        FCode:   string;
48        FDate:   TFMDateTime;
49        FICDVersion: String;
50        FI10Active: Boolean;
51        FExtend: Boolean;
52        FMessage: String;
53        FSingleCodeSys: Boolean;
54        FCodeSys: String;
55        function ParseNarrCode(ANarrCode: String): String;
56        procedure SetApp(LexApp: Integer);
57        procedure SetDate(ADate: TFMDateTime);
58        procedure SetICDVersion;
59        procedure enableExtend;
60        procedure disableExtend;
61        procedure updateStatus(status: String);
62        procedure SetColumnTreeModel(ResultSet: TStrings);
63        procedure processSearch;
64        procedure setClientWidth;
65        procedure CenterForm(w: Integer);
66      end;
67    
68    procedure LexiconLookup(var Code: string; ALexApp: Integer; ADate: TFMDateTime = 0; AExtend: Boolean = False; AInputString: String = ''; AMessage: String = ''; ADefaultToInput: Boolean = False);
69    
70    implementation
71    
72    {$R *.DFM}
73    
74    uses rPCE, uProbs, rProbs, UBAGlobals;
75    
76    var
77      TriedExtend: Boolean = false;
78    
79    procedure LexiconLookup(var Code: string; ALexApp: Integer; ADate: TFMDateTime = 0; AExtend: Boolean = False; AInputString: String = ''; AMessage: String = ''; ADefaultToInput: Boolean = False);
80    var
81      frmPCELex: TfrmPCELex;
82    begin
83      frmPCELex := TfrmPCELex.Create(Application);
84      try
85        ResizeFormToFont(TForm(frmPCELex));
86        if (ADate = 0) and not ((Encounter.VisitCategory = 'E') or (Encounter.VisitCategory = 'H')
87          or (Encounter.VisitCategory = 'D')) then
88            ADate := Encounter.DateTime;
89        if ADefaultToInput and (AInputString <> '') then
90          frmPCELex.txtSearch.Text := Piece(frmPCELex.ParseNarrCode(AInputString), U, 2);
91        frmPCELex.SetApp(ALexApp);
92        frmPCELex.SetDate(ADate);
93        frmPCELex.SetICDVersion;
94        frmPCELex.FMessage := AMessage;
95        frmPCELex.FExtend := AExtend;
96        if (ALexApp = LX_ICD) then
97          frmPCELex.FExtend := True;
98        frmPCELex.ShowModal;
99        Code := frmPCELex.FCode;
100       if (AInputString <> '') and (Pos('(SCT', AInputString) > 0) and (ALexApp <> LX_SCT) then
101         SetPiece(Code, U, 2, AInputString);
102     finally
103       frmPCELex.Free;
104     end;
105   end;
106   
107   procedure TfrmPCELex.FormClose(Sender: TObject; var Action: TCloseAction);
108   begin
109     inherited;
110     Release;
111   end;
112   
113   procedure TfrmPCELex.FormCreate(Sender: TObject);
114   var
115     UserProps: TStringList;
116   begin
117     inherited;
118     FCode := '';
119     FCodeSys := '';
120     FI10Active := False;
121     FSingleCodeSys := True;
122     FExtend := False;
123     UserProps := TStringList.Create;
124     FastAssign(InitUser(User.DUZ), UserProps);
125     PLUser := TPLUserParams.Create(UserProps);
126     FSuppressCodes := PLUser.usSuppressCodes;
127     ResizeAnchoredFormToFont(self);
128   end;
129   
130   procedure TfrmPCELex.FormShow(Sender: TObject);
131   var
132     lt: String;
133     dh, lh: Integer;
134   begin
135     inherited;
136   
137     if FSuppressCodes then
138     begin
139       tgfLex.ShowCode := False;
140       tgfLex.ShowTargetCode := False;
141     end
142     else
143     begin
144       tgfLex.ShowCode := True;
145       tgfLex.ShowTargetCode := not FI10Active;
146     end;
147     
148     tgfLex.ShowDescription := True;
149     tgfLex.HorizPanelSpace := 8;
150     tgfLex.VertPanelSpace := 4;
151   
152     if FMessage <> '' then
153     begin
154       lt := lblSearch.Caption;
155       lh := lblSearch.Height;
156       lblSearch.AutoSize := True;
157       lblSearch.Caption := FMessage + CRLF + CRLF + lt;
158       lblSearch.AutoSize := False;
159       dh := (lblSearch.Height - lh);
160       pnlSearch.Height := pnlSearch.Height + dh;
161       Height := Height + dh;
162     end;
163     CenterForm(tgfLex.ClientWidth);
164     if FExtend and (txtSearch.Text <> '') then
165     begin
166       if FExtend then
167         cmdExtendedSearch.Click
168       else
169         cmdSearch.Click;
170     end;
171   end;
172   
173   procedure TfrmPCELex.SetApp(LexApp: Integer);
174   begin
175     FLexApp := LexApp;
176     case LexApp of
177     LX_ICD: begin
178               Caption := 'Lookup Diagnosis';
179               lblSearch.Caption := 'Search for Diagnosis:';
180             end;
181     LX_CPT: begin
182               Caption := 'Lookup Procedure';
183               lblSearch.Caption := 'Search for Procedure:';
184             end;
185     end;
186   end;
187   
188   procedure TfrmPCELex.SetDate(ADate: TFMDateTime);
189   begin
190     FDate := ADate;
191   end;
192   
193   procedure TfrmPCELex.SetICDVersion;
194   begin
195     FICDVersion := Encounter.GetICDVersion;
196     if (Piece(FICDVersion, '^', 1) = '10D') then
197       FI10Active := True;
198     cmdExtendedSearch.Hint := 'Search ' + Piece(FICDVersion, '^', 2) + ' Diagnoses...';
199     tgfLex.pnlTargetCodeSys.Caption := Piece(FICDVersion, '^', 2) + ':  ';
200   end;
201   
202   procedure TfrmPCELex.enableExtend;
203   begin
204     cmdExtendedSearch.Visible := true;
205     cmdExtendedSearch.Enabled := true;
206   end;
207   
208   procedure TfrmPCELex.disableExtend;
209   begin
210     cmdExtendedSearch.Enabled := false;
211     cmdExtendedSearch.Visible := false;
212     if not FI10Active then
213       FExtend := False;
214   end;
215   
216   procedure TfrmPCELex.txtSearchChange(Sender: TObject);
217   begin
218     inherited;
219     cmdSearch.Default := True;
220     cmdOK.Default := False;
221     cmdCancel.Default := False;
222     disableExtend;
223     if tgfLex.tv.Items.Count > 0 then
224     begin
225       tgfLex.tv.Selected := nil;
226       tgfLex.tv.Items.Clear;
227       CenterForm(Constraints.MinWidth);
228     end;
229   end;
230   
231   procedure TfrmPCELex.cmdSearchClick(Sender: TObject);
232   begin
233     TriedExtend := false;
234     FCodeSys := '';
235     FSingleCodeSys := True;
236     if not FI10Active and (FLexApp = LX_ICD) then
237       FExtend := False;
238     if not tgfLex.pnlTarget.Visible then tgfLex.pnlTarget.Visible := True;
239     processSearch;
240   end;
241   
242   procedure TfrmPCELex.setClientWidth;
243   var
244     i, maxw, tl, maxtl: integer;
245     ctn: TLexTreeNode;
246   begin
247     maxtl := 0;
248     for i := 0 to pred(tgfLex.tv.Items.Count) do
249     begin
250       ctn := tgfLex.tv.Items[i] as TLexTreeNode;
251       tl := TextWidthByFont(Font.Handle, ctn.Text);
252       if (tl > maxtl) then
253         maxtl := tl;
254     end;
255   
256     maxw := maxtl + 30;
257   
258     if maxw < Constraints.MinWidth then
259       maxw := Constraints.MinWidth;
260   
261     self.Width := maxw;
262   
263     //resize tv to maximum pixel width of its elements
264     if (maxw > 0) and (self.ClientWidth <> maxw) then
265     begin
266       CenterForm(maxw);
267     end;
268   end;
269   
270   procedure TfrmPCELex.CenterForm(w: Integer);
271   var
272     wdiff, mainw: Integer;
273   begin
274     mainw := Application.MainForm.Width;
275   
276     if w > mainw then
277     begin
278       w := mainw;
279     end;
280   
281     self.ClientWidth := w + (tgfLex.Width - tgfLex.ClientWidth) + (pnlList.Padding.Left + pnlList.Padding.Right);
282   
283     wdiff := ((mainw - self.Width) div 2);
284     self.Left := Application.MainForm.Left + wdiff;
285   
286     invalidate;
287   end;
288   
289   procedure TfrmPCELex.SetColumnTreeModel(ResultSet: TStrings);
290   var
291     i: Integer;
292     Node, StubNode: TLexTreeNode;
293     RecStr: String;
294   begin
295     tgfLex.tv.Items.Clear;
296     for i := 0 to ResultSet.Count - 1 do
297     begin
298       //RecStr = VUID^Description^CodeSys^Code^TargetCodeSys^TargetCode^DesignationID^Parent
299       RecStr := ResultSet[i];
300       if Piece(RecStr, '^', 8) = '' then
301         Node := (tgfLex.tv.Items.Add(nil, Piece(RecStr, '^', 2))) as TLexTreeNode
302       else
303         Node := (tgfLex.tv.Items.AddChild(tgfLex.tv.Items[(StrToInt(Piece(RecStr, '^', 8))-1)], Piece(RecStr, '^', 2))) as TLexTreeNode;
304   
305       with Node do
306       begin
307         VUID := Piece(RecStr, '^', 1);
308         Text := Piece(RecStr, '^', 2);
309         CodeDescription := Text;
310         CodeSys := Piece(RecStr, '^', 3);
311   
312         if ((FCodeSys <> '') and (CodeSys <> FCodeSys)) then
313           FSingleCodeSys := False;
314   
315         FCodeSys := CodeSys;
316   
317         Code := Piece(RecStr, '^', 4);
318   
319         if Piece(RecStr, '^', 8) <> '' then
320           ParentIndex := IntToStr(StrToInt(Piece(RecStr, '^', 8)) - 1);
321   
322         //TODO: Need to accommodate Designation Code in ColumnTreeNode...
323         if CodeSys = 'SNOMED CT' then
324           CodeIEN := Code
325         else
326           CodeIEN := Piece(RecStr, '^', 9);
327   
328         TargetCode := Piece(RecStr, '^', 6);
329   
330       end;
331       if (Node.VUID = '+') then
332       begin
333         StubNode := (tgfLex.tv.Items.AddChild(Node, 'Searching...')) as TLexTreeNode;
334         with StubNode do
335         begin
336           VUID := '';
337           Text := 'Searching...';
338           CodeDescription := Text;
339           CodeSys := 'ICD-10-CM';
340   
341           if ((FCodeSys <> '') and (CodeSys <> FCodeSys)) then
342             FSingleCodeSys := False;
343   
344           FCodeSys := CodeSys;
345   
346           Code := '';
347           CodeIEN := '';
348   
349           ParentIndex := IntToStr(Node.Index);
350         end;
351       end;
352     end;
353     //sort treenodes
354     tgfLex.tv.AlphaSort(True);
355   end;
356   
357   procedure TfrmPCELex.processSearch;
358   const
359     TX_SRCH_REFINE1 = 'Your search ';
360     TX_SRCH_REFINE2 = ' matched ';
361     TX_SRCH_REFINE3 = ' records, too many to display.' + CRLF + CRLF + 'Suggestions:' + CRLF +
362                       #32#32#32#32#42 + '   Refine your search by adding more words' + CRLF + #32#32#32#32#42 + '   Try different keywords';
363     MaxRec = 5000;
364   var
365     LexResults: TStringList;
366     found, subset, SearchStr: String;
367     FreqOfText: integer;
368     Match: TLexTreeNode;
369   begin
370     if Length(txtSearch.Text) = 0 then
371     begin
372      InfoBox('Enter a term to search for, then click "SEARCH"', 'Information', MB_OK or MB_ICONINFORMATION);
373      exit; {don't bother to drop if no text entered}
374     end;
375   
376     if (FLexApp = LX_ICD) or (FLexApp = LX_SCT) then
377     begin
378       if FExtend and (FLexApp = LX_ICD) then
379         subset := Piece(FICDVersion, '^', 2) + ' Diagnoses'
380       else
381         subset := 'SNOMED CT Concepts';
382     end
383     else if FLexApp = LX_CPT then
384       subset := 'Current Procedural Terminology (CPT)'
385     else
386       subset := 'Clinical Lexicon';
387   
388     LexResults := TStringList.Create;
389   
390     try
391       Screen.Cursor := crHourGlass;
392       updateStatus('Searching ' + subset + '...');
393       SearchStr := Uppercase(txtSearch.Text);
394       FreqOfText := GetFreqOfText(SearchStr);
395       if FreqOfText > MaxRec then
396       begin
397         InfoBox(TX_SRCH_REFINE1 + #39 + SearchStr + #39 + TX_SRCH_REFINE2 + IntToStr(FreqOfText) + TX_SRCH_REFINE3,'Refine Search', MB_OK or MB_ICONINFORMATION);
398         lblStatus.Caption := '';
399         Exit;
400       end;
401       ListLexicon(LexResults, SearchStr, FLexApp, FDate, FExtend, FI10Active);
402   
403       if (Piece(LexResults[0], u, 1) = '-1') then
404       begin
405         found := '0 matches found';
406         if FExtend then
407           found := found + ' by ' + subset + ' Search.'
408         else
409           found := found + '.';
410         lblSelect.Visible := False;
411         txtSearch.SetFocus;
412         txtSearch.SelectAll;
413         cmdOK.Default := False;
414         cmdOK.Enabled := False;
415         tgfLex.tv.Enabled := False;
416         tgfLex.tv.Items.Clear;
417         cmdCancel.Default := False;
418         cmdSearch.Default := True;
419         if not FExtend and (FLexApp = LX_ICD) then
420         begin
421           cmdExtendedSearch.Click;
422           Exit;
423         end;
424       end
425       else
426       begin
427         found := inttostr(LexResults.Count) + ' matches found';
428         if FExtend then
429           found := found + ' by ' + subset + ' Search.'
430         else
431           found := found + '.';
432   
433         SetColumnTreeModel(LexResults);
434   
435         setClientWidth;
436         lblSelect.Visible := True;
437         tgfLex.tv.Enabled := True;
438         tgfLex.tv.SetFocus;
439   
440         Match := tgfLex.FindNode(SearchStr);
441   
442         if Match <> nil then
443         begin  {search term is on return list, so highlight it}
444           cmdOk.Enabled := True;
445           ActiveControl := tgfLex.tv;
446         end
447         else
448           begin
449             tgfLex.tv.Items[0].Selected := False;
450           end;
451   
452         if (not FExtend) and (FLexApp = LX_ICD) and (not isNumeric(txtSearch.Text)) then
453           enableExtend;
454         cmdSearch.Default := False;
455       end;
456       updateStatus(found);
457       if FExtend then tgfLex.pnlTarget.Visible := False;
458     finally
459       LexResults.Free;
460       Screen.Cursor := crDefault;
461     end;
462   end;
463   
464   procedure TfrmPCELex.cmdExtendedSearchClick(Sender: TObject);
465   begin
466     inherited;
467     FExtend := True;
468     FCodeSys := '';
469     FSingleCodeSys := True;
470     processSearch;
471     disableExtend;
472   end;
473   
474   procedure TfrmPCELex.cmdOKClick(Sender: TObject);
475   var
476     Node: TLexTreeNode;
477   begin
478     inherited;
479     if(tgfLex.SelectedNode = nil) then
480       Exit;
481     Node := tgfLex.SelectedNode;
482     if ((FLexApp = LX_ICD) or (FLexApp = LX_SCT)) and (Node.Code <> '') then
483     begin
484       if (Copy(Node.CodeSys, 0, 3) = 'ICD') then
485         FCode := Node.Code + U + Node.Text
486       else if (Copy(Node.CodeSys, 0, 3) = 'SNO')  then
487         FCode := Node.TargetCode + U + Node.Text + ' (SNOMED CT ' + Node.Code + ')';
488   
489       FCode := FCode + U + Node.CodeIEN + U + Node.CodeSys;
490     end
491     else if BAPersonalDX then
492       FCode := LexiconToCode(StrToInt(Node.VUID), FLexApp, FDate) + U + Node.Text + U + Node.VUID
493     else
494       FCode := LexiconToCode(StrToInt(Node.VUID), FLexApp, FDate) + U + Node.Text;
495     Close;
496   end;
497   
498   procedure TfrmPCELex.cmdCancelClick(Sender: TObject);
499   begin
500     inherited;
501     FCode := '';
502     Close;
503   end;
504   
505   procedure TfrmPCELex.tgfLextvChange(Sender: TObject; Node: TTreeNode);
506   begin
507     inherited;
508     tgfLex.tvChange(Sender, Node);
509     if (tgfLex.SelectedNode = nil) or (tgfLex.SelectedNode.VUID = '+')  then
510     begin
511       cmdOK.Enabled := false;
512       cmdOk.Default := false;
513     end
514     else  // valid Node selected
515     begin
516       cmdOK.Enabled := true;
517       cmdOK.Default := true;
518       cmdSearch.Default := false;
519     end;
520   end;
521   
522   procedure TfrmPCELex.tgfLextvClick(Sender: TObject);
523   begin
524     inherited;
525     if(tgfLex.SelectedNode <> nil) and (tgfLex.SelectedNode.VUID <> '+') then
526     begin
527       cmdOK.Enabled := true;
528       cmdSearch.Default := False;
529       cmdOK.Default := True;
530     end;
531   end;
532   
533   procedure TfrmPCELex.tgfLextvDblClick(Sender: TObject);
534   begin
535     inherited;
536     tgfLextvClick(Sender);
537     if tgfLex.SelectedNode.VUID <> '+' then
538       cmdOKClick(Sender);
539   end;
540   
541   procedure TfrmPCELex.tgfLextvEnter(Sender: TObject);
542   begin
543     inherited;
544     if (tgfLex.SelectedNode = nil) then
545       cmdOK.Enabled := false
546     else
547       cmdOK.Enabled := true;
548   end;
549   
550   procedure TfrmPCELex.tgfLextvExit(Sender: TObject);
551   begin
552     inherited;
553     if (tgfLex.SelectedNode = nil) then
554       cmdOK.Enabled := false
555     else
556       cmdOK.Enabled := true;
557   end;
558   
559   procedure TfrmPCELex.tgfLextvExpanding(Sender: TObject; Node: TTreeNode;
560     var AllowExpansion: Boolean);
561   var
562     ctNode, ChildNode, StubNode: TLexTreeNode;
563     ChildRecs: TStringList;
564     RecStr: String;
565     i: integer;
566   begin
567     inherited;
568     ctNode := Node as TLexTreeNode;
569   
570     if ctNode.VUID = '+' then
571     begin
572       ChildRecs := TStringList.Create;
573       ListLexicon(ChildRecs, ctNode.Code, FLexApp, FDate, True, FI10Active);
574   
575       //clear node's placeholder child
576       ctNode.DeleteChildren;
577   
578       //create children
579       for i := 0 to ChildRecs.Count - 1 do
580       begin
581         RecStr := ChildRecs[i];
582         ChildNode := (tgfLex.tv.Items.AddChild(ctNode, Piece(RecStr, '^', 2))) as TLexTreeNode;
583   
584         with ChildNode do
585         begin
586           VUID := Piece(RecStr, '^', 1);
587           Text := Piece(RecStr, '^', 2);
588           CodeDescription := Text;
589           CodeSys := Piece(RecStr, '^', 3);
590   
591           if ((FCodeSys <> '') and (CodeSys <> FCodeSys)) then
592             FSingleCodeSys := False;
593   
594           FCodeSys := CodeSys;
595   
596           Code := Piece(RecStr, '^', 4);
597   
598           if Piece(RecStr, '^', 8) <> '' then
599             ParentIndex := IntToStr(StrToInt(Piece(RecStr, '^', 8)) - 1);
600   
601           //TODO: Need to accommodate Designation Code in ColumnTreeNode...
602           if CodeSys = 'SNOMED CT' then
603             CodeIEN := Code
604           else
605             CodeIEN := Piece(RecStr, '^', 9);
606   
607           TargetCode := Piece(RecStr, '^', 6);
608         end;
609   
610         if (ChildNode.VUID = '+') then
611         begin
612           StubNode := (tgfLex.tv.Items.AddChild(ChildNode, 'Searching...')) as TLexTreeNode;
613           with StubNode do
614           begin
615             VUID := '';
616             Text := 'Searching...';
617             CodeDescription := Text;
618             CodeSys := 'ICD-10-CM';
619   
620             if ((FCodeSys <> '') and (CodeSys <> FCodeSys)) then
621               FSingleCodeSys := False;
622   
623             FCodeSys := CodeSys;
624   
625             Code := '';
626             CodeIEN := '';
627   
628             ParentIndex := IntToStr(Node.Index);
629           end;
630         end;
631       end;
632     end;
633     AllowExpansion := True;
634     //sort treenodes
635     tgfLex.tv.AlphaSort(True);
636     tgfLex.tv.Invalidate;
637   end;
638   
639   procedure TfrmPCELex.tgfLextvHint(Sender: TObject; const Node: TTreeNode;
640     var Hint: string);
641   begin
642     inherited;
643     // Only show hint if caption is less than width of Column[0]
644     if TextWidthByFont(Font.Handle, Node.Text) < tgfLex.tv.Width then
645       Hint := ''
646     else
647       Hint := Node.Text;
648   end;
649   
650   procedure TfrmPCELex.updateStatus(status: String);
651   begin
652     lblStatus.caption := status;
653     lblStatus.Invalidate;
654     lblStatus.Update;
655   end;
656   
657   function TfrmPCELex.isNumeric(inStr: String): Boolean;
658   var
659     dbl: Double;
660     error, intDecimal: Integer;
661   begin
662     Result := False;
663     if (DecimalSeparator <> '.') then
664       intDecimal := Pos(DecimalSeparator, inStr)
665     else
666       intDecimal := 0;
667     if (intDecimal > 0) then
668       inStr[intDecimal] := '.';
669     Val(inStr, dbl, error);
670     if (dbl = 0.0) then
671       ; //do nothing
672     if (intDecimal > 0) then
673       inStr[intDecimal] := DecimalSeparator;
674     if (error = 0) then
675       Result := True;
676   end;
677   
678   function TfrmPCELex.ParseNarrCode(ANarrCode: String): String;
679   var
680     narr, code: String;
681     ps: Integer;
682   begin
683     narr := ANarrCode;
684     ps := Pos('(SCT', narr);
685     if not (ps > 0) then
686       ps := Pos('(SNOMED', narr);
687     if not (ps > 0) then
688       ps := Pos('(ICD', narr);
689     if (ps > 0) then
690     begin
691       narr := TrimRight(Copy(ANarrCode, 0, ps - 1));
692       code := Copy(ANarrCode, ps, Length(ANarrCode));
693       code := Piece(Piece(Piece(code, ')', 1), '(', 2), ' ', 2);
694     end
695     else
696       code := '';
697     Result := code + U + narr;
698   end;
699   
700   end.

Module Calls (2 levels)


fPCELex
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├mTreeGrid
 ├rPCE
 │ ├uPCE
 │ ├UBACore
 │ ├rCore...
 │ ├uCore...
 │ ├uConst
 │ ├fEncounterFrame
 │ ├UBAGlobals
 │ └UBAConst
 ├uProbs
 │ ├uConst
 │ ├rCore...
 │ └uCore...
 ├rProbs
 │ └uCore...
 └UBAGlobals...

Module Called-By (2 levels)


              fPCELex
  fBALocalDiagnoses┤ 
       UBAGlobals┤ │ 
      fOrdersSign┤ │ 
          fReview┤ │ 
       fODConsult┘ │ 
         fDiagnoses┤ 
  fEncounterFrame┘ │ 
       fPCEBaseMain┤ 
    fDiagnoses...┤ │ 
       fProcedure┤ │ 
    fImmunization┤ │ 
        fSkinTest┤ │ 
       fPatientEd┤ │ 
    fHealthFactor┤ │ 
            fExam┘ │ 
fBAOptionsDiagnoses┤ 
         fOptions┘ │ 
      fODConsult...┤ 
            fODProc┤ 
          uOrders┘ │ 
          fEditProc┤ 
        fConsults┘ │ 
       fEditConsult┘ 
     fConsults...┘