source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Consults/fConsultsView.pas@ 1742

Last change on this file since 1742 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27
File size: 8.0 KB
Line 
1unit fConsultsView;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
7 StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus, fBase508Form,
8 VA508AccessibilityManager;
9
10type
11 TfrmConsultsView = class(TfrmBase508Form)
12 pnlBase: TORAutoPanel;
13 lblBeginDate: TLabel;
14 calBeginDate: TORDateBox;
15 lblEndDate: TLabel;
16 calEndDate: TORDateBox;
17 radSort: TRadioGroup;
18 lblStatus: TLabel;
19 lstStatus: TORListBox;
20 lblService: TLabel;
21 cmdOK: TButton;
22 cmdCancel: TButton;
23 treService: TORTreeView;
24 cboService: TORComboBox;
25 cboGroupBy: TORComboBox;
26 Label1: TLabel;
27 popStatus: TPopupMenu;
28 popStatusSelectNone: TMenuItem;
29 procedure cmdOKClick(Sender: TObject);
30 procedure cmdCancelClick(Sender: TObject);
31 procedure treServiceChange(Sender: TObject; Node: TTreeNode);
32 procedure cboServiceSelect(Sender: TObject);
33 procedure popStatusSelectNoneClick(Sender: TObject);
34 private
35 FChanged: Boolean;
36 FBeginDate: string;
37 FEndDate: string;
38 FGroupBy: string;
39 FAscending: Boolean;
40 FService: string;
41 FServiceName: string;
42 FConsultUser: boolean ;
43 FStatus: string;
44 FStatusName: string;
45 end;
46
47function SelectConsultsView(FontSize: Integer; CurrentContext: TSelectContext; var SelectContext: TSelectContext): boolean ;
48
49var
50 uChanging: Boolean;
51
52implementation
53
54{$R *.DFM}
55
56uses rCore, uCore, rConsults;
57
58var
59 SvcList: TStrings ;
60 SvcInfo: string ;
61
62const
63 TX_DATE_ERR = 'Enter valid beginning and ending dates or press Cancel.';
64 TX_DATE_ERR_CAP = 'Error in Date Range';
65
66function SelectConsultsView(FontSize: Integer; CurrentContext: TSelectContext; var SelectContext: TSelectContext): boolean ;
67{ displays select form for Consults and returns a record of the selection }
68var
69 frmConsultsView: TfrmConsultsView;
70 W, H, i, j: Integer;
71 CurrentStatus, CurrentBegin, CurrentEnd, CurrentService: string;
72begin
73 frmConsultsView := TfrmConsultsView.Create(Application);
74 try
75 with frmConsultsView do
76 begin
77 Font.Size := FontSize;
78 W := ClientWidth;
79 H := ClientHeight;
80 ResizeToFont(FontSize, W, H);
81 ClientWidth := W; pnlBase.Width := W;
82 ClientHeight := H; pnlBase.Height := H;
83 FChanged := False;
84 with radSort do ItemIndex := 1;
85 //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList); {RV}
86 FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList); {RV}
87 SortByPiece(TStringList(SvcList), U, 2); {RV}
88 for i := 0 to SvcList.Count - 1 do
89 if cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1 then {RV}
90 //if cboService.SelectByID(Piece(SvcList.Strings[i], U, 1)) = -1 then
91 cboService.Items.Add(SvcList.Strings[i]);
92 BuildServiceTree(treService, SvcList, '0', nil) ;
93 with treService do
94 for i:=0 to Items.Count-1 do
95 begin
96 if Items[i].Level > 0 then Items[i].Expanded := False else Items[i].Expanded := True;
97 TopItem := Items[0] ;
98 Selected := Items[0] ;
99 end ;
100 CurrentService := CurrentContext.Service;
101 if StrToIntDef(CurrentService, 0) > 0 then
102 begin
103 cboservice.SelectByID(CurrentService);
104 cboServiceSelect(frmConsultsView);
105 end;
106 FastAssign(SubSetOfStatus, lstStatus.Items);
107 CurrentStatus := CurrentContext.Status;
108 if CurrentStatus <> '' then with lstStatus do
109 begin
110 i := 1;
111 while Piece(CurrentStatus, ',', i) <> '' do
112 begin
113 j := SelectByID(Piece(CurrentStatus, ',', i));
114 if j > -1 then Selected[j] := True;
115 Inc(i);
116 end;
117 end;
118 CurrentBegin := CurrentContext.BeginDate;
119 CurrentEnd := CurrentContext.EndDate;
120 if CurrentBegin <> '' then
121 calBeginDate.Text := CurrentBegin;
122 if CurrentEnd <> '' then
123 calEndDate.Text := CurrentEnd;
124 if calEndDate.Text = '' then calEndDate.Text := 'TODAY';
125 cboGroupBy.SelectByID(CurrentContext.GroupBy);
126 ShowModal;
127
128 with SelectContext do
129 begin
130 Changed := FChanged;
131 BeginDate := FBeginDate;
132 EndDate := FEndDate;
133 Ascending := FAscending;
134 Service := FService;
135 ServiceName := FServiceName;
136 ConsultUser := FConsultUser ;
137 Status := FStatus;
138 StatusName := FStatusName;
139 GroupBy := FGroupBy;
140 Result := Changed ;
141 end;
142
143 end; {with frmConsultsView}
144 finally
145 frmConsultsView.Release;
146 end;
147end;
148
149procedure TfrmConsultsView.cmdOKClick(Sender: TObject);
150var
151 bdate, edate: TFMDateTime;
152 i: integer;
153begin
154 if calBeginDate.Text <> '' then
155 bdate := StrToFMDateTime(calBeginDate.Text)
156 else
157 bdate := 0 ;
158
159 if calEndDate.Text <> '' then
160 edate := StrToFMDateTime(calEndDate.Text)
161 else
162 edate := 0 ;
163
164 if (bdate <= edate) then
165 begin
166 FAscending := radSort.ItemIndex = 0;
167 FBeginDate := calBeginDate.Text;
168 FEndDate := calEndDate.Text;
169 end
170 else
171 begin
172 InfoBox(TX_DATE_ERR, TX_DATE_ERR_CAP, MB_OK or MB_ICONWARNING);
173 Exit;
174 end;
175
176 if treService.Selected <> nil then
177 begin
178 FService := Piece(SvcInfo,u,1) ;
179 FServiceName := Piece(SvcInfo,u,2) ;
180 FConsultUser := ConsultServiceUser(StrToIntDef(FService, 0), User.DUZ) ;
181 end
182 else
183 FService := '' ;
184
185 if lstStatus.SelCount > 0 then
186 begin
187 with lstStatus do for i := 0 to Items.Count-1 do if Selected[i] then
188 begin
189 if Piece(Items[i], U, 1) <> '999' then
190 FStatus := FStatus + Piece(Items[i], U, 1) + ','
191 else
192 FStatus := FStatus + Piece(Items[i],U,3) ;
193 FStatusName := FStatusName + DisplayText[i] + ',' ;
194 end;
195 FStatus := Copy(FStatus, 1, Length(FStatus)-1);
196 FStatusName := Copy(FStatusName, 1, Length(FStatusName)-1);
197 end
198 else
199 FStatus := '' ;
200
201 if cboGroupBy.ItemID <> '' then
202 FGroupBy := cboGroupBy.ItemID
203 else
204 FGroupBy := '';
205
206 FChanged := True;
207 Close;
208end;
209
210procedure TfrmConsultsView.cmdCancelClick(Sender: TObject);
211begin
212 Close;
213end;
214
215
216procedure TfrmConsultsView.treServiceChange(Sender: TObject; Node: TTreeNode);
217begin
218 if uChanging then Exit;
219 SvcInfo := TORTreeNode(treService.Selected).StringData ;
220 cboService.ItemIndex := cboService.Items.IndexOf(Trim(treService.Selected.Text)); {RV}
221 //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1));
222end;
223
224procedure TfrmConsultsView.cboServiceSelect(Sender: TObject);
225var
226 i: integer;
227begin
228 uChanging := True;
229 with treService do for i := 0 to Items.Count-1 do
230 begin
231 if Piece(TORTreeNode(Items[i]).StringData,U,1) = cboService.ItemID then
232 begin
233 Selected := Items[i];
234 //treServiceChange(Self, Items[i]);
235 break;
236 end;
237 end;
238 uChanging := False;
239 SvcInfo := TORTreeNode(treService.Selected).StringData ;
240end;
241
242procedure TfrmConsultsView.popStatusSelectNoneClick(Sender: TObject);
243var
244 i: integer;
245begin
246 with lstStatus do
247 begin
248 for i := 0 to Items.Count - 1 do
249 Selected[i] := False;
250 ItemIndex := -1;
251 end;
252end;
253
254initialization
255 SvcList := TStringList.Create ;
256
257finalization
258 SvcList.Free ;
259
260end.
Note: See TracBrowser for help on using the repository browser.