[453] | 1 | //kt -- Modified with SourceScanner on 8/8/2007
|
---|
| 2 | unit fOptionsOther;
|
---|
| 3 |
|
---|
| 4 | interface
|
---|
| 5 |
|
---|
| 6 | uses
|
---|
| 7 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
| 8 | StdCtrls, ExtCtrls, ComCtrls, ORCtrls, ORFn, rOrders, uCore, ORDtTm,
|
---|
| 9 | DKLang;
|
---|
| 10 |
|
---|
| 11 | type
|
---|
| 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;
|
---|
[473] | 41 | TabPositionComboBox: TComboBox;
|
---|
| 42 | Label1: TLabel;
|
---|
[541] | 43 | lblTabColors: TLabel;
|
---|
[473] | 44 | pnlShowColor: TPanel;
|
---|
| 45 | ColorDialog: TColorDialog;
|
---|
[541] | 46 | lblEditTabColor: TLabel;
|
---|
[473] | 47 | cboTabColors: TComboBox;
|
---|
[541] | 48 | cbEnableTabColors: TCheckBox;
|
---|
[453] | 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);
|
---|
[473] | 60 | procedure TabPositionComboBoxChange(Sender: TObject);
|
---|
| 61 | procedure cboTabColorsChange(Sender: TObject);
|
---|
| 62 | procedure pnlShowColorClick(Sender: TObject);
|
---|
[541] | 63 | procedure cbEnableTabColorsClick(Sender: TObject);
|
---|
[453] | 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 |
|
---|
| 74 | var
|
---|
| 75 | frmOptionsOther: TfrmOptionsOther;
|
---|
| 76 |
|
---|
| 77 | const
|
---|
| 78 | ENC_MAX_LIMIT = 999;
|
---|
| 79 |
|
---|
[473] | 80 |
|
---|
[453] | 81 | procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
|
---|
[473] | 82 | procedure SetTabPosition(Position : TTabPosition);
|
---|
[453] | 83 |
|
---|
| 84 | implementation
|
---|
| 85 |
|
---|
| 86 | {$R *.DFM}
|
---|
| 87 |
|
---|
| 88 | uses
|
---|
[473] | 89 | rOptions, uOptions, rCore, rSurgery, uConst, fMeds, fFrame;
|
---|
[453] | 90 |
|
---|
| 91 | procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
|
---|
| 92 | // create the form and make it modal, return an action
|
---|
| 93 | var
|
---|
| 94 | frmOptionsOther: TfrmOptionsOther;
|
---|
| 95 | begin
|
---|
| 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;
|
---|
| 116 | end;
|
---|
| 117 |
|
---|
| 118 | procedure TfrmOptionsOther.FormShow(Sender: TObject);
|
---|
| 119 | // displays defaults
|
---|
| 120 | // opening tab^use last tab^autosave seconds^verify note title
|
---|
| 121 | var
|
---|
| 122 | last: integer;
|
---|
| 123 | values, tab: string;
|
---|
| 124 | begin
|
---|
[541] | 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
|
---|
[453] | 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);
|
---|
| 160 | end;
|
---|
| 161 |
|
---|
| 162 | procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
|
---|
| 163 | // opening tab^use last tab^autosave seconds^verify note title
|
---|
| 164 | var
|
---|
| 165 | values, theVal: string;
|
---|
| 166 | begin
|
---|
| 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;
|
---|
| 197 | end;
|
---|
| 198 |
|
---|
| 199 | procedure TfrmOptionsOther.FormCreate(Sender: TObject);
|
---|
| 200 | begin
|
---|
[667] | 201 | cbEnableTabColors.checked := uTabColorsEnabled;
|
---|
[453] | 202 | FStartDT := 0;
|
---|
| 203 | FStopDT := 0;
|
---|
| 204 | end;
|
---|
| 205 |
|
---|
| 206 | procedure TfrmOptionsOther.dtStartExit(Sender: TObject);
|
---|
| 207 | begin
|
---|
| 208 | if dtStart.FMDateTime > FMToday then
|
---|
| 209 | begin
|
---|
| 210 | // ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
|
---|
| 211 | ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
|
---|
| 212 | dtStart.FMDateTime := FMToday;
|
---|
| 213 | dtStart.SetFocus;
|
---|
| 214 | Exit;
|
---|
| 215 | end;
|
---|
| 216 | end;
|
---|
| 217 |
|
---|
| 218 | procedure TfrmOptionsOther.dtStopExit(Sender: TObject);
|
---|
| 219 | begin
|
---|
| 220 | if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
|
---|
| 221 | if (dtStop.FMDateTime < dtStart.FMDateTime) then
|
---|
| 222 | begin
|
---|
| 223 | // ShowMessage('Stop time can not prior to start time'); <-- original line. //kt 8/8/2007
|
---|
| 224 | ShowMessage(DKLangConstW('fOptionsOther_Stop_time_can_not_prior_to_start_time')); //kt added 8/8/2007
|
---|
| 225 | dtStop.FMDateTime := FMToday;
|
---|
| 226 | dtStop.SetFocus;
|
---|
| 227 | Exit;
|
---|
| 228 | end;
|
---|
| 229 | end;
|
---|
| 230 |
|
---|
| 231 | procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
|
---|
| 232 | begin
|
---|
| 233 | if (dtStart.FMDateTime > FMToday) then
|
---|
| 234 | begin
|
---|
| 235 | // ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
|
---|
| 236 | ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
|
---|
| 237 | dtStart.FMDateTime := FMToday;
|
---|
| 238 | dtStart.SetFocus;
|
---|
| 239 | Exit;
|
---|
| 240 | end;
|
---|
| 241 | end;
|
---|
| 242 |
|
---|
| 243 | procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
|
---|
| 244 | begin
|
---|
| 245 | with txtEncStart do
|
---|
| 246 | begin
|
---|
| 247 | if Text = '' then
|
---|
| 248 | Exit;
|
---|
| 249 | if Text = ' ' then
|
---|
| 250 | Text := '0';
|
---|
| 251 | if StrToInt(Text) < 0 then
|
---|
| 252 | Text := '0';
|
---|
| 253 | if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
|
---|
| 254 | begin
|
---|
| 255 | Text := IntToStr(ENC_MAX_LIMIT);
|
---|
| 256 | Beep;
|
---|
| 257 | // InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
|
---|
| 258 | InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x')+' ' + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
|
---|
| 259 | end;
|
---|
| 260 | end;
|
---|
| 261 | end;
|
---|
| 262 |
|
---|
| 263 | procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject);
|
---|
| 264 | begin
|
---|
| 265 | with txtEncStop do
|
---|
| 266 | begin
|
---|
| 267 | if Text = '' then
|
---|
| 268 | Exit;
|
---|
| 269 | if Text = ' ' then
|
---|
| 270 | Text := '0';
|
---|
| 271 | if StrToInt(Text) < 0 then
|
---|
| 272 | Text := '0';
|
---|
| 273 | if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
|
---|
| 274 | begin
|
---|
| 275 | Text := IntToStr(ENC_MAX_LIMIT);
|
---|
| 276 | Beep;
|
---|
| 277 | // InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
|
---|
| 278 | InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x') + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
|
---|
| 279 | end;
|
---|
| 280 | end;
|
---|
| 281 | end;
|
---|
| 282 |
|
---|
| 283 | procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject);
|
---|
| 284 | begin
|
---|
| 285 | with txtEncStart do
|
---|
| 286 | if Text = '' then
|
---|
| 287 | Text := '0';
|
---|
| 288 | end;
|
---|
| 289 |
|
---|
| 290 | procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject);
|
---|
| 291 | begin
|
---|
| 292 | with txtEncStart do
|
---|
| 293 | if Text = '' then
|
---|
| 294 | Text := '0';
|
---|
| 295 | end;
|
---|
| 296 |
|
---|
| 297 | procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
|
---|
| 298 | begin
|
---|
| 299 | txtEncStart.Text := IntToStr(FEncDefStartDays);
|
---|
| 300 | txtEncStop.Text := IntToStr(FEncDefStopDays);
|
---|
| 301 | end;
|
---|
| 302 |
|
---|
[473] | 303 | procedure TfrmOptionsOther.TabPositionComboBoxChange(Sender: TObject);
|
---|
| 304 | //kt added 8/8/08
|
---|
| 305 | begin
|
---|
| 306 | Case TabPositionComboBox.ItemIndex of
|
---|
| 307 | 0 : SetTabPosition(tpBottom);
|
---|
| 308 | 1 : SetTabPosition(tpTop);
|
---|
| 309 | 2 : SetTabPosition(tpLeft);
|
---|
| 310 | 3 : SetTabPosition(tpRight);
|
---|
| 311 | end; {case}
|
---|
| 312 | end;
|
---|
| 313 |
|
---|
| 314 | procedure SetTabPosition(Position : TTabPosition);
|
---|
| 315 | //kt added 8/8/08
|
---|
| 316 | begin
|
---|
| 317 | frmFrame.tabPage.TabPosition := Position;
|
---|
| 318 | Case Position of
|
---|
| 319 | tpBottom : frmFrame.tabPage.Align := alBottom;
|
---|
| 320 | tpTop: frmFrame.tabPage.Align := alTop;
|
---|
| 321 | tpLeft: frmFrame.tabPage.Align := alLeft;
|
---|
| 322 | tpRight : frmFrame.tabPage.Align := alRight;
|
---|
| 323 | end; {case}
|
---|
| 324 | end;
|
---|
| 325 |
|
---|
| 326 |
|
---|
| 327 | procedure TfrmOptionsOther.cboTabColorsChange(Sender: TObject);
|
---|
| 328 | var color : TColor;
|
---|
| 329 | selIndex : integer;
|
---|
| 330 | begin
|
---|
| 331 | selIndex := cboTabColors.ItemIndex;
|
---|
| 332 | if selIndex < 0 then exit;
|
---|
| 333 | color := TColor(cboTabColors.Items.Objects[selIndex]);
|
---|
| 334 | pnlShowColor.Color := color;
|
---|
| 335 | end;
|
---|
| 336 |
|
---|
| 337 | procedure TfrmOptionsOther.pnlShowColorClick(Sender: TObject);
|
---|
| 338 | //kt added 8/8/08
|
---|
| 339 | var s : string;
|
---|
| 340 | selIndex : integer;
|
---|
| 341 | begin
|
---|
| 342 | if ColorDialog.Execute then begin
|
---|
| 343 | pnlShowColor.Color := ColorDialog.Color;
|
---|
| 344 | selIndex := cboTabColors.ItemIndex;
|
---|
| 345 | if selIndex < 0 then exit;
|
---|
| 346 | cboTabColors.Items.Objects[selIndex] := pointer(ColorDialog.Color);
|
---|
| 347 | uTabColorsList.Objects[selIndex] := pointer(ColorDialog.Color);
|
---|
| 348 | end;
|
---|
| 349 | end;
|
---|
| 350 |
|
---|
[541] | 351 | procedure TfrmOptionsOther.cbEnableTabColorsClick(Sender: TObject);
|
---|
| 352 | //kt added
|
---|
| 353 | begin
|
---|
[667] | 354 | uTabColorsEnabled := cbEnableTabColors.Checked; //elh 01/12/10
|
---|
| 355 | frmFrame.tabPage.OwnerDraw := cbEnableTabColors.Checked; //elh 01/12/10
|
---|
| 356 | //cboTabColors.Enabled := uTabColorsEnabled;
|
---|
| 357 | //lblEditTabColor.Enabled := uTabColorsEnabled;
|
---|
| 358 | //lblTabColors.Enabled := uTabColorsEnabled;
|
---|
| 359 | //pnlShowColor.Enabled := uTabColorsEnabled;
|
---|
[541] | 360 | end;
|
---|
| 361 |
|
---|
[453] | 362 | end.
|
---|