source: cprs/trunk/CPRS-Chart/Consults/fConsultsView.pas@ 825

Last change on this file since 825 was 456, checked in by Kevin Toppenberg, 16 years ago

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