Module
Path
C:\CPRS\CPRS30\Encounter\fHFSearch.pas
Last Modified
7/15/2014 3:26:36 PM
Units Used in Interface
Units Used in Implementation
Classes
Procedures
Constants
 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┘
fAutoSz
TfrmHFSearch
btnOKClick