source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsultsView.pas@ 1705

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

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