Module

fHFSearch

Path

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

Last Modified

7/15/2014 3:26:36 PM

Units Used in Interface

Name Comments
fAutoSz -

Units Used in Implementation

Name Comments
dShared -
fEncounterFrame -
rPCE -

Classes

Name Comments
TfrmHFSearch -

Procedures

Name Owner Declaration Scope Comments
btnOKClick TfrmHFSearch procedure btnOKClick(Sender: TObject); Public/Published -
cbxSearchChange TfrmHFSearch procedure cbxSearchChange(Sender: TObject); Public/Published -
FormCreate TfrmHFSearch procedure FormCreate(Sender: TObject); Public/Published -
HFLookup - procedure HFLookup(var Code: string); Interfaced -
tvSearchChange TfrmHFSearch procedure tvSearchChange(Sender: TObject; Node: TTreeNode); Public/Published -
tvSearchDblClick TfrmHFSearch procedure tvSearchDblClick(Sender: TObject); Public/Published -
tvSearchGetImageIndex TfrmHFSearch procedure tvSearchGetImageIndex(Sender: TObject; Node: TTreeNode); Public/Published -
UpdateCat TfrmHFSearch procedure UpdateCat; Private -

Constants

Name Declaration Scope Comments
CatTxt 'Category: ' Global -


Module Source

1     unit fHFSearch;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fAutoSz, ORFn, StdCtrls, ComCtrls, ORCtrls, ExtCtrls,
8       VA508AccessibilityManager, VA508ImageListLabeler;
9     
10    type
11      TfrmHFSearch = class(TfrmAutoSz)
12        cbxSearch: TORComboBox;
13        tvSearch: TORTreeView;
14        pnlBottom: TPanel;
15        btnOK: TButton;
16        btnCancel: TButton;
17        splMain: TSplitter;
18        lblCat: TLabel;
19        imgListHFtvSearch: TVA508ImageListLabeler;
20        procedure FormCreate(Sender: TObject);
21        procedure btnOKClick(Sender: TObject);
22        procedure tvSearchDblClick(Sender: TObject);
23        procedure tvSearchGetImageIndex(Sender: TObject; Node: TTreeNode);
24        procedure tvSearchChange(Sender: TObject; Node: TTreeNode);
25        procedure cbxSearchChange(Sender: TObject);
26      private
27        FCode:   string;
28        FChanging: boolean;
29        procedure UpdateCat;
30      public
31      end;
32    
33    procedure HFLookup(var Code: string);
34    
35    implementation
36    
37    uses rPCE, dShared, fEncounterFrame;
38    
39    {$R *.DFM}
40    
41    const
42      CatTxt = 'Category: ';
43    
44    procedure HFLookup(var Code: string);
45    var
46      frmHFSearch: TfrmHFSearch;
47    
48    begin
49      frmHFSearch := TfrmHFSearch.Create(Application);
50      try
51        ResizeFormToFont(TForm(frmHFSearch));
52        frmHFSearch.ShowModal;
53        Code := frmHFSearch.FCode;
54      finally
55        frmHFSearch.Free;
56      end;
57    end;
58    
59    procedure TfrmHFSearch.cbxSearchChange(Sender: TObject);
60    var
61      Node: TORTreeNode;
62      CurCat, NodeCat: TTreeNode;
63      ID: string;
64    
65    begin
66      inherited;
67      if(not FChanging) then
68      begin
69        FChanging := TRUE;
70        try
71          btnOK.Enabled := (cbxSearch.ItemIndex >= 0);
72          if(cbxSearch.ItemIndex < 0) then
73            tvSearch.Selected := nil
74          else
75          begin
76            ID := cbxSearch.ItemID;
77            if(assigned(tvSearch.Selected)) then
78            begin
79              CurCat := tvSearch.Selected;
80              while (assigned(CurCat.Parent)) do
81                CurCat := CurCat.Parent;
82            end
83            else
84              CurCat := nil;
85            Node := TORTreeNode(tvSearch.Items.GetFirstNode);
86            while assigned(Node) do
87            begin
88              if(piece(Node.StringData,U,1)= ID) then
89              begin
90                NodeCat := Node;
91                while (assigned(NodeCat.Parent)) do
92                  NodeCat := NodeCat.Parent;
93                RedrawSuspend(tvSearch.Handle);
94                try
95                  if(CurCat <> NodeCat) then
96                    tvSearch.FullCollapse;
97                  tvSearch.Selected := Node;
98                  Node.EnsureVisible;
99                finally
100                 RedrawActivate(tvSearch.Handle);
101               end;
102               break;
103             end;
104             Node := TORTreeNode(Node.GetNext);
105           end;
106         end;
107         UpdateCat;
108       finally
109         FChanging := FALSE;
110       end;
111     end;
112   end;
113   
114   
115   procedure TfrmHFSearch.FormCreate(Sender: TObject);
116   var
117     HFList: TStringList;
118     i: integer;
119     Node, Child :TORTreeNode;
120     CAT: string;
121   
122   begin
123     inherited;
124     HFList := TStringList.Create;
125     try
126       LoadcboOther(HFList, uEncPCEData.Location, PCE_HF);
127       for i := 0 to HFList.Count-1 do
128       begin
129         if(Piece(HFList[i],U,3)='F') then
130           cbxSearch.Items.Add(pieces(HFList[i],U,1,2));
131       end;
132       for i := 0 to HFList.Count-1 do
133       begin
134         if(Piece(HFList[i],U,3)='C') then
135         begin
136           with TORTreeNode(tvSearch.Items.Add(nil, '')) do
137           begin
138             StringData := HFList[i];
139             ImageIndex := 2;
140             SelectedIndex := 2;
141           end;
142         end;
143       end;
144       for i := 0 to HFList.Count-1 do
145       begin
146         if(Piece(HFList[i],U,3)='F') then
147         begin
148           CAT := piece(HFList[i],U,4);
149           Node := TORTreeNode(tvSearch.Items.GetFirstNode);
150           while(assigned(Node)) do
151           begin
152             if(Piece(Node.StringData, U, 1) = CAT) then
153               break;
154             Node := TORTreeNode(Node.GetNextSibling);
155           end;
156           Child := TORTreeNode(tvSearch.Items.AddChild(Node, ''));
157           Child.StringData := Pieces(HFList[i],U,1,2);
158           Child.ImageIndex := -1;
159           Child.StateIndex := -1;
160         end;
161       end;
162   //    tvSearch.Invalidate;
163     finally
164       HFList.Free;
165     end;
166   end;
167   
168   procedure TfrmHFSearch.btnOKClick(Sender: TObject);
169   begin
170     inherited;
171     if cbxSearch.ItemIndex = -1 then Exit;
172     FCode := cbxSearch.Items[cbxSearch.ItemIndex];
173     ModalResult := mrOK;
174   end;
175   
176   procedure TfrmHFSearch.tvSearchDblClick(Sender: TObject);
177   begin
178     inherited;
179     btnOKClick(Sender);
180   end;
181   
182   procedure TfrmHFSearch.tvSearchGetImageIndex(Sender: TObject;
183     Node: TTreeNode);
184   begin
185     inherited;
186     if(piece(TORTreeNode(Node).StringData,U,3)= 'C') then
187     begin
188       if(Node.Expanded) then
189         Node.ImageIndex := 3
190       else
191         Node.ImageIndex := 2;
192     end
193     else
194       Node.ImageIndex := -1;
195     Node.SelectedIndex := Node.ImageIndex;
196   //  tvSearch.Invalidate;
197   end;
198   
199   procedure TfrmHFSearch.tvSearchChange(Sender: TObject; Node: TTreeNode);
200   begin
201     inherited;
202     if(not FChanging) then
203     begin
204       FChanging := TRUE;
205       try
206         if(assigned(Node)) then
207           cbxSearch.SelectByID(Piece(TORTreeNode(Node).StringData,U,1))
208         else
209           cbxSearch.ItemIndex := -1;
210         btnOK.Enabled := (cbxSearch.ItemIndex >= 0);
211         UpdateCat;
212       finally
213         FChanging := FALSE;
214       end;
215     end;
216   end;
217   
218   procedure TfrmHFSearch.UpdateCat;
219   var
220     NodeCat: TTreeNode;
221     
222   begin
223     NodeCat := tvSearch.Selected;
224     if(assigned(NodeCat)) then
225     begin
226       while (assigned(NodeCat.Parent)) do
227         NodeCat := NodeCat.Parent;
228       lblCat.Caption := CatTxt + NodeCat.Text;
229     end
230     else
231       lblCat.Caption := CatTxt;
232     cbxSearch.Caption := lblCat.Caption;
233   end;
234   
235   end.

Module Calls (2 levels)


fHFSearch
 ├fAutoSz
 │ └fBase508Form
 ├rPCE
 │ ├uPCE
 │ ├UBACore
 │ ├rCore
 │ ├uCore
 │ ├uConst
 │ ├fEncounterFrame
 │ ├UBAGlobals
 │ └UBAConst
 └fEncounterFrame...

Module Called-By (2 levels)


        fHFSearch
   fPCEBaseMain┘ 
   fDiagnoses┤   
   fProcedure┤   
fImmunization┤   
    fSkinTest┤   
   fPatientEd┤   
fHealthFactor┤   
        fExam┘