source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptionsOther.pas@ 619

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

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 11.5 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOptionsOther;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, ExtCtrls, ComCtrls, ORCtrls, ORFn, rOrders, uCore, ORDtTm,
9 DKLang;
10
11type
12 TfrmOptionsOther = class(TForm)
13 pnlBottom: TPanel;
14 btnOK: TButton;
15 btnCancel: TButton;
16 bvlBottom: TBevel;
17 stStart: TStaticText;
18 stStop: TStaticText;
19 dtStart: TORDateBox;
20 dtStop: TORDateBox;
21 lblMedsTab: TLabel;
22 lblTabDefault: TStaticText;
23 lblTab: TLabel;
24 cboTab: TORComboBox;
25 chkLastTab: TCheckBox;
26 Bevel1: TBevel;
27 lblEncAppts: TLabel;
28 stStartEncAppts: TStaticText;
29 txtTodayMinus: TStaticText;
30 txtEncStart: TCaptionEdit;
31 txtDaysMinus: TStaticText;
32 spnEncStart: TUpDown;
33 txtDaysPlus: TStaticText;
34 spnEncStop: TUpDown;
35 txtEncStop: TCaptionEdit;
36 txtTodayPlus: TStaticText;
37 stStopEncAppts: TStaticText;
38 Bevel2: TBevel;
39 btnEncDefaults: TButton;
40 DKLanguageController1: TDKLanguageController;
41 TabPositionComboBox: TComboBox;
42 Label1: TLabel;
43 lblTabColors: TLabel;
44 pnlShowColor: TPanel;
45 ColorDialog: TColorDialog;
46 lblEditTabColor: TLabel;
47 cboTabColors: TComboBox;
48 cbEnableTabColors: TCheckBox;
49 procedure FormShow(Sender: TObject);
50 procedure btnOKClick(Sender: TObject);
51 procedure FormCreate(Sender: TObject);
52 procedure dtStartExit(Sender: TObject);
53 procedure dtStopExit(Sender: TObject);
54 procedure dtStartChange(Sender: TObject);
55 procedure txtEncStartChange(Sender: TObject);
56 procedure txtEncStopChange(Sender: TObject);
57 procedure txtEncStartExit(Sender: TObject);
58 procedure txtEncStopExit(Sender: TObject);
59 procedure btnEncDefaultsClick(Sender: TObject);
60 procedure TabPositionComboBoxChange(Sender: TObject);
61 procedure cboTabColorsChange(Sender: TObject);
62 procedure pnlShowColorClick(Sender: TObject);
63 procedure cbEnableTabColorsClick(Sender: TObject);
64 private
65 { Private declarations }
66 FstartDt: TFMDateTime;
67 FstopDt: TFMDateTime;
68 FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer;
69 //FDefaultEvent: string;
70 public
71 { Public declarations }
72 end;
73
74var
75 frmOptionsOther: TfrmOptionsOther;
76
77const
78 ENC_MAX_LIMIT = 999;
79
80
81procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
82procedure SetTabPosition(Position : TTabPosition);
83
84implementation
85
86{$R *.DFM}
87
88uses
89 rOptions, uOptions, rCore, rSurgery, uConst, fMeds, fFrame;
90
91procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
92// create the form and make it modal, return an action
93var
94 frmOptionsOther: TfrmOptionsOther;
95begin
96 frmOptionsOther := TfrmOptionsOther.Create(Application);
97 actiontype := 0;
98 try
99 with frmOptionsOther do
100 begin
101 if (topvalue < 0) or (leftvalue < 0) then
102 Position := poScreenCenter
103 else
104 begin
105 Position := poDesigned;
106 Top := topvalue;
107 Left := leftvalue;
108 end;
109 ResizeAnchoredFormToFont(frmOptionsOther);
110 ShowModal;
111 actiontype := btnOK.Tag;
112 end;
113 finally
114 frmOptionsOther.Release;
115 end;
116end;
117
118procedure TfrmOptionsOther.FormShow(Sender: TObject);
119// displays defaults
120// opening tab^use last tab^autosave seconds^verify note title
121var
122 last: integer;
123 values, tab: string;
124begin
125 cboTabColors.Items.Assign(frmFrame.tabPage.Tabs); //kt 8/09
126 //cboTabColors.Items.Assign(uTabColorsList); //kt added8808
127 cboTabColors.ItemIndex := 0; //kt
128 cboTab.Items.Assign(rpcGetOtherTabs); //kt
129 cboTabColorsChange(nil); //kt
130 cbEnableTabColors.Checked := uTabColorsEnabled; //kt 8/09
131//if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then <-- original line. //kt 8/8/2007
132 if (cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery')) > -1) and (not ShowSurgeryTab) then //kt added 8/8/2007
133// cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery')); <-- original line. //kt 8/8/2007
134 cboTab.Items.Delete(cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery'))); //kt added 8/8/2007
135 values := rpcGetOther;
136 tab := Piece(values, '^', 1);
137 last := strtointdef(Piece(values, '^', 2), 0);
138 cboTab.SelectByID(tab);
139 cboTab.Tag := strtointdef(tab, -1);
140 chkLastTab.Checked := last = 1;
141 chkLastTab.Tag := last;
142 cboTab.SetFocus;
143 rpcGetRangeForMeds(FstartDt, FstopDt);
144 if FstartDt > 1 then
145 dtStart.Text := FormatFMDateTime('mmm d, yyyy',FstartDt);
146 if FstopDt > 1 then
147 dtStop.Text := FormatFMDateTime('mmm d, yyyy', FstopDt);
148 rpcGetRangeForEncs(FEncDefStartDays, FEncDefStopDays, True); // True gets params settings above User/Service level.
149 if FEncDefStartDays < 1 then
150 FEncDefStartDays := 0;
151 if FEncDefStopDays < 1 then
152 FEncDefStopDays := 0;
153 rpcGetRangeForEncs(FEncStartDays, FEncStopDays, False); // False gets User/Service params.
154 if ((FEncStartDays < 0) and (FEncStartDays <> 0)) then
155 FEncStartDays := FEncDefStartDays;
156 txtEncStart.Text := IntToStr(FEncStartDays);
157 if ((FEncStopDays < 0) and (FEncStopDays <> 0)) then
158 FEncStopDays := FEncDefStopDays;
159 txtEncStop.Text := IntToStr(FEncStopDays);
160end;
161
162procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
163// opening tab^use last tab^autosave seconds^verify note title
164var
165 values, theVal: string;
166begin
167 values := '';
168 if cboTab.ItemIEN <> cboTab.Tag then
169 values := values + cboTab.ItemID;
170 values := values + '^';
171 if chkLastTab.Checked then
172 if chkLastTab.Tag <> 1 then
173 values := values + '1';
174 if not chkLastTab.Checked then
175 if chkLastTab.Tag <> 0 then
176 values := values + '0';
177 values := values + '^^';
178 rpcSetOther(values);
179 if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
180 begin
181 if dtStop.FMDateTime < dtStart.FMDateTime then
182 begin
183// ShowMessage('The stop time can not prior to the start time.'); <-- original line. //kt 8/8/2007
184 ShowMessage(DKLangConstW('fOptionsOther_The_stop_time_can_not_prior_to_the_start_timex')); //kt added 8/8/2007
185 dtStop.FMDateTime := FMToday;
186 dtStop.SetFocus;
187 Exit;
188 end;
189 theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime;
190 rpcPutRangeForMeds(theVal);
191 end;
192 if (dtStart.Text = '') and (dtStop.Text = '') then
193 rpcPutRangeForMeds('');
194 rpcPutRangeForEncs(txtEncStart.Text, txtEncStop.Text);
195 if frmMeds <> nil then
196 frmMeds.RefreshMedLists;
197end;
198
199procedure TfrmOptionsOther.FormCreate(Sender: TObject);
200begin
201 FStartDT := 0;
202 FStopDT := 0;
203end;
204
205procedure TfrmOptionsOther.dtStartExit(Sender: TObject);
206begin
207 if dtStart.FMDateTime > FMToday then
208 begin
209// ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
210 ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
211 dtStart.FMDateTime := FMToday;
212 dtStart.SetFocus;
213 Exit;
214 end;
215end;
216
217procedure TfrmOptionsOther.dtStopExit(Sender: TObject);
218begin
219 if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
220 if (dtStop.FMDateTime < dtStart.FMDateTime) then
221 begin
222// ShowMessage('Stop time can not prior to start time'); <-- original line. //kt 8/8/2007
223 ShowMessage(DKLangConstW('fOptionsOther_Stop_time_can_not_prior_to_start_time')); //kt added 8/8/2007
224 dtStop.FMDateTime := FMToday;
225 dtStop.SetFocus;
226 Exit;
227 end;
228end;
229
230procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
231begin
232 if (dtStart.FMDateTime > FMToday) then
233 begin
234// ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
235 ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
236 dtStart.FMDateTime := FMToday;
237 dtStart.SetFocus;
238 Exit;
239 end;
240end;
241
242procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
243begin
244with txtEncStart do
245 begin
246 if Text = '' then
247 Exit;
248 if Text = ' ' then
249 Text := '0';
250 if StrToInt(Text) < 0 then
251 Text := '0';
252 if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
253 begin
254 Text := IntToStr(ENC_MAX_LIMIT);
255 Beep;
256// InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
257 InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x')+' ' + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
258 end;
259 end;
260end;
261
262procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject);
263begin
264with txtEncStop do
265 begin
266 if Text = '' then
267 Exit;
268 if Text = ' ' then
269 Text := '0';
270 if StrToInt(Text) < 0 then
271 Text := '0';
272 if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
273 begin
274 Text := IntToStr(ENC_MAX_LIMIT);
275 Beep;
276// InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
277 InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x') + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
278 end;
279 end;
280end;
281
282procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject);
283begin
284with txtEncStart do
285 if Text = '' then
286 Text := '0';
287end;
288
289procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject);
290begin
291with txtEncStart do
292 if Text = '' then
293 Text := '0';
294end;
295
296procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
297begin
298txtEncStart.Text := IntToStr(FEncDefStartDays);
299txtEncStop.Text := IntToStr(FEncDefStopDays);
300end;
301
302procedure TfrmOptionsOther.TabPositionComboBoxChange(Sender: TObject);
303//kt added 8/8/08
304begin
305 Case TabPositionComboBox.ItemIndex of
306 0 : SetTabPosition(tpBottom);
307 1 : SetTabPosition(tpTop);
308 2 : SetTabPosition(tpLeft);
309 3 : SetTabPosition(tpRight);
310 end; {case}
311end;
312
313procedure SetTabPosition(Position : TTabPosition);
314//kt added 8/8/08
315begin
316 frmFrame.tabPage.TabPosition := Position;
317 Case Position of
318 tpBottom : frmFrame.tabPage.Align := alBottom;
319 tpTop: frmFrame.tabPage.Align := alTop;
320 tpLeft: frmFrame.tabPage.Align := alLeft;
321 tpRight : frmFrame.tabPage.Align := alRight;
322 end; {case}
323end;
324
325
326procedure TfrmOptionsOther.cboTabColorsChange(Sender: TObject);
327var color : TColor;
328 selIndex : integer;
329begin
330 selIndex := cboTabColors.ItemIndex;
331 if selIndex < 0 then exit;
332 color := TColor(cboTabColors.Items.Objects[selIndex]);
333 pnlShowColor.Color := color;
334end;
335
336procedure TfrmOptionsOther.pnlShowColorClick(Sender: TObject);
337//kt added 8/8/08
338var s : string;
339 selIndex : integer;
340begin
341 if ColorDialog.Execute then begin
342 pnlShowColor.Color := ColorDialog.Color;
343 selIndex := cboTabColors.ItemIndex;
344 if selIndex < 0 then exit;
345 cboTabColors.Items.Objects[selIndex] := pointer(ColorDialog.Color);
346 uTabColorsList.Objects[selIndex] := pointer(ColorDialog.Color);
347 end;
348end;
349
350procedure TfrmOptionsOther.cbEnableTabColorsClick(Sender: TObject);
351//kt added
352begin
353 uTabColorsEnabled := cbEnableTabColors.Checked;
354 cboTabColors.Enabled := uTabColorsEnabled;
355 lblEditTabColor.Enabled := uTabColorsEnabled;
356 lblTabColors.Enabled := uTabColorsEnabled;
357 pnlShowColor.Enabled := uTabColorsEnabled;
358end;
359
360end.
Note: See TracBrowser for help on using the repository browser.