[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;
|
---|
| 43 | Label2: TLabel;
|
---|
| 44 | pnlShowColor: TPanel;
|
---|
| 45 | ColorDialog: TColorDialog;
|
---|
| 46 | Label3: TLabel;
|
---|
| 47 | cboTabColors: TComboBox;
|
---|
[453] | 48 | procedure FormShow(Sender: TObject);
|
---|
| 49 | procedure btnOKClick(Sender: TObject);
|
---|
| 50 | procedure FormCreate(Sender: TObject);
|
---|
| 51 | procedure dtStartExit(Sender: TObject);
|
---|
| 52 | procedure dtStopExit(Sender: TObject);
|
---|
| 53 | procedure dtStartChange(Sender: TObject);
|
---|
| 54 | procedure txtEncStartChange(Sender: TObject);
|
---|
| 55 | procedure txtEncStopChange(Sender: TObject);
|
---|
| 56 | procedure txtEncStartExit(Sender: TObject);
|
---|
| 57 | procedure txtEncStopExit(Sender: TObject);
|
---|
| 58 | procedure btnEncDefaultsClick(Sender: TObject);
|
---|
[473] | 59 | procedure TabPositionComboBoxChange(Sender: TObject);
|
---|
| 60 | procedure cboTabColorsChange(Sender: TObject);
|
---|
| 61 | procedure pnlShowColorClick(Sender: TObject);
|
---|
[453] | 62 | private
|
---|
| 63 | { Private declarations }
|
---|
| 64 | FstartDt: TFMDateTime;
|
---|
| 65 | FstopDt: TFMDateTime;
|
---|
| 66 | FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer;
|
---|
| 67 | //FDefaultEvent: string;
|
---|
| 68 | public
|
---|
| 69 | { Public declarations }
|
---|
| 70 | end;
|
---|
| 71 |
|
---|
| 72 | var
|
---|
| 73 | frmOptionsOther: TfrmOptionsOther;
|
---|
| 74 |
|
---|
| 75 | const
|
---|
| 76 | ENC_MAX_LIMIT = 999;
|
---|
| 77 |
|
---|
[473] | 78 |
|
---|
[453] | 79 | procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
|
---|
[473] | 80 | procedure SetTabPosition(Position : TTabPosition);
|
---|
[453] | 81 |
|
---|
| 82 | implementation
|
---|
| 83 |
|
---|
| 84 | {$R *.DFM}
|
---|
| 85 |
|
---|
| 86 | uses
|
---|
[473] | 87 | rOptions, uOptions, rCore, rSurgery, uConst, fMeds, fFrame;
|
---|
[453] | 88 |
|
---|
| 89 | procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
|
---|
| 90 | // create the form and make it modal, return an action
|
---|
| 91 | var
|
---|
| 92 | frmOptionsOther: TfrmOptionsOther;
|
---|
| 93 | begin
|
---|
| 94 | frmOptionsOther := TfrmOptionsOther.Create(Application);
|
---|
| 95 | actiontype := 0;
|
---|
| 96 | try
|
---|
| 97 | with frmOptionsOther do
|
---|
| 98 | begin
|
---|
| 99 | if (topvalue < 0) or (leftvalue < 0) then
|
---|
| 100 | Position := poScreenCenter
|
---|
| 101 | else
|
---|
| 102 | begin
|
---|
| 103 | Position := poDesigned;
|
---|
| 104 | Top := topvalue;
|
---|
| 105 | Left := leftvalue;
|
---|
| 106 | end;
|
---|
| 107 | ResizeAnchoredFormToFont(frmOptionsOther);
|
---|
| 108 | ShowModal;
|
---|
| 109 | actiontype := btnOK.Tag;
|
---|
| 110 | end;
|
---|
| 111 | finally
|
---|
| 112 | frmOptionsOther.Release;
|
---|
| 113 | end;
|
---|
| 114 | end;
|
---|
| 115 |
|
---|
| 116 | procedure TfrmOptionsOther.FormShow(Sender: TObject);
|
---|
| 117 | // displays defaults
|
---|
| 118 | // opening tab^use last tab^autosave seconds^verify note title
|
---|
| 119 | var
|
---|
| 120 | last: integer;
|
---|
| 121 | values, tab: string;
|
---|
| 122 | begin
|
---|
[473] | 123 | cboTabColors.Items.Assign(uTabColorsList); //kt added8808
|
---|
| 124 | cboTabColors.ItemIndex := 0; //kt
|
---|
| 125 | cboTab.Items.Assign(rpcGetOtherTabs); //kt
|
---|
| 126 | cboTabColorsChange(nil); //kt
|
---|
[453] | 127 | //if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then <-- original line. //kt 8/8/2007
|
---|
| 128 | if (cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery')) > -1) and (not ShowSurgeryTab) then //kt added 8/8/2007
|
---|
| 129 | // cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery')); <-- original line. //kt 8/8/2007
|
---|
| 130 | cboTab.Items.Delete(cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery'))); //kt added 8/8/2007
|
---|
| 131 | values := rpcGetOther;
|
---|
| 132 | tab := Piece(values, '^', 1);
|
---|
| 133 | last := strtointdef(Piece(values, '^', 2), 0);
|
---|
| 134 | cboTab.SelectByID(tab);
|
---|
| 135 | cboTab.Tag := strtointdef(tab, -1);
|
---|
| 136 | chkLastTab.Checked := last = 1;
|
---|
| 137 | chkLastTab.Tag := last;
|
---|
| 138 | cboTab.SetFocus;
|
---|
| 139 | rpcGetRangeForMeds(FstartDt, FstopDt);
|
---|
| 140 | if FstartDt > 1 then
|
---|
| 141 | dtStart.Text := FormatFMDateTime('mmm d, yyyy',FstartDt);
|
---|
| 142 | if FstopDt > 1 then
|
---|
| 143 | dtStop.Text := FormatFMDateTime('mmm d, yyyy', FstopDt);
|
---|
| 144 | rpcGetRangeForEncs(FEncDefStartDays, FEncDefStopDays, True); // True gets params settings above User/Service level.
|
---|
| 145 | if FEncDefStartDays < 1 then
|
---|
| 146 | FEncDefStartDays := 0;
|
---|
| 147 | if FEncDefStopDays < 1 then
|
---|
| 148 | FEncDefStopDays := 0;
|
---|
| 149 | rpcGetRangeForEncs(FEncStartDays, FEncStopDays, False); // False gets User/Service params.
|
---|
| 150 | if ((FEncStartDays < 0) and (FEncStartDays <> 0)) then
|
---|
| 151 | FEncStartDays := FEncDefStartDays;
|
---|
| 152 | txtEncStart.Text := IntToStr(FEncStartDays);
|
---|
| 153 | if ((FEncStopDays < 0) and (FEncStopDays <> 0)) then
|
---|
| 154 | FEncStopDays := FEncDefStopDays;
|
---|
| 155 | txtEncStop.Text := IntToStr(FEncStopDays);
|
---|
| 156 | end;
|
---|
| 157 |
|
---|
| 158 | procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
|
---|
| 159 | // opening tab^use last tab^autosave seconds^verify note title
|
---|
| 160 | var
|
---|
| 161 | values, theVal: string;
|
---|
| 162 | begin
|
---|
| 163 | values := '';
|
---|
| 164 | if cboTab.ItemIEN <> cboTab.Tag then
|
---|
| 165 | values := values + cboTab.ItemID;
|
---|
| 166 | values := values + '^';
|
---|
| 167 | if chkLastTab.Checked then
|
---|
| 168 | if chkLastTab.Tag <> 1 then
|
---|
| 169 | values := values + '1';
|
---|
| 170 | if not chkLastTab.Checked then
|
---|
| 171 | if chkLastTab.Tag <> 0 then
|
---|
| 172 | values := values + '0';
|
---|
| 173 | values := values + '^^';
|
---|
| 174 | rpcSetOther(values);
|
---|
| 175 | if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
|
---|
| 176 | begin
|
---|
| 177 | if dtStop.FMDateTime < dtStart.FMDateTime then
|
---|
| 178 | begin
|
---|
| 179 | // ShowMessage('The stop time can not prior to the start time.'); <-- original line. //kt 8/8/2007
|
---|
| 180 | ShowMessage(DKLangConstW('fOptionsOther_The_stop_time_can_not_prior_to_the_start_timex')); //kt added 8/8/2007
|
---|
| 181 | dtStop.FMDateTime := FMToday;
|
---|
| 182 | dtStop.SetFocus;
|
---|
| 183 | Exit;
|
---|
| 184 | end;
|
---|
| 185 | theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime;
|
---|
| 186 | rpcPutRangeForMeds(theVal);
|
---|
| 187 | end;
|
---|
| 188 | if (dtStart.Text = '') and (dtStop.Text = '') then
|
---|
| 189 | rpcPutRangeForMeds('');
|
---|
| 190 | rpcPutRangeForEncs(txtEncStart.Text, txtEncStop.Text);
|
---|
| 191 | if frmMeds <> nil then
|
---|
| 192 | frmMeds.RefreshMedLists;
|
---|
| 193 | end;
|
---|
| 194 |
|
---|
| 195 | procedure TfrmOptionsOther.FormCreate(Sender: TObject);
|
---|
| 196 | begin
|
---|
| 197 | FStartDT := 0;
|
---|
| 198 | FStopDT := 0;
|
---|
| 199 | end;
|
---|
| 200 |
|
---|
| 201 | procedure TfrmOptionsOther.dtStartExit(Sender: TObject);
|
---|
| 202 | begin
|
---|
| 203 | if dtStart.FMDateTime > FMToday then
|
---|
| 204 | begin
|
---|
| 205 | // ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
|
---|
| 206 | ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
|
---|
| 207 | dtStart.FMDateTime := FMToday;
|
---|
| 208 | dtStart.SetFocus;
|
---|
| 209 | Exit;
|
---|
| 210 | end;
|
---|
| 211 | end;
|
---|
| 212 |
|
---|
| 213 | procedure TfrmOptionsOther.dtStopExit(Sender: TObject);
|
---|
| 214 | begin
|
---|
| 215 | if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
|
---|
| 216 | if (dtStop.FMDateTime < dtStart.FMDateTime) then
|
---|
| 217 | begin
|
---|
| 218 | // ShowMessage('Stop time can not prior to start time'); <-- original line. //kt 8/8/2007
|
---|
| 219 | ShowMessage(DKLangConstW('fOptionsOther_Stop_time_can_not_prior_to_start_time')); //kt added 8/8/2007
|
---|
| 220 | dtStop.FMDateTime := FMToday;
|
---|
| 221 | dtStop.SetFocus;
|
---|
| 222 | Exit;
|
---|
| 223 | end;
|
---|
| 224 | end;
|
---|
| 225 |
|
---|
| 226 | procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
|
---|
| 227 | begin
|
---|
| 228 | if (dtStart.FMDateTime > FMToday) then
|
---|
| 229 | begin
|
---|
| 230 | // ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007
|
---|
| 231 | ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
|
---|
| 232 | dtStart.FMDateTime := FMToday;
|
---|
| 233 | dtStart.SetFocus;
|
---|
| 234 | Exit;
|
---|
| 235 | end;
|
---|
| 236 | end;
|
---|
| 237 |
|
---|
| 238 | procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
|
---|
| 239 | begin
|
---|
| 240 | with txtEncStart do
|
---|
| 241 | begin
|
---|
| 242 | if Text = '' then
|
---|
| 243 | Exit;
|
---|
| 244 | if Text = ' ' then
|
---|
| 245 | Text := '0';
|
---|
| 246 | if StrToInt(Text) < 0 then
|
---|
| 247 | Text := '0';
|
---|
| 248 | if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
|
---|
| 249 | begin
|
---|
| 250 | Text := IntToStr(ENC_MAX_LIMIT);
|
---|
| 251 | Beep;
|
---|
| 252 | // InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
|
---|
| 253 | InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x')+' ' + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
|
---|
| 254 | end;
|
---|
| 255 | end;
|
---|
| 256 | end;
|
---|
| 257 |
|
---|
| 258 | procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject);
|
---|
| 259 | begin
|
---|
| 260 | with txtEncStop do
|
---|
| 261 | begin
|
---|
| 262 | if Text = '' then
|
---|
| 263 | Exit;
|
---|
| 264 | if Text = ' ' then
|
---|
| 265 | Text := '0';
|
---|
| 266 | if StrToInt(Text) < 0 then
|
---|
| 267 | Text := '0';
|
---|
| 268 | if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
|
---|
| 269 | begin
|
---|
| 270 | Text := IntToStr(ENC_MAX_LIMIT);
|
---|
| 271 | Beep;
|
---|
| 272 | // InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007
|
---|
| 273 | InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x') + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
|
---|
| 274 | end;
|
---|
| 275 | end;
|
---|
| 276 | end;
|
---|
| 277 |
|
---|
| 278 | procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject);
|
---|
| 279 | begin
|
---|
| 280 | with txtEncStart do
|
---|
| 281 | if Text = '' then
|
---|
| 282 | Text := '0';
|
---|
| 283 | end;
|
---|
| 284 |
|
---|
| 285 | procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject);
|
---|
| 286 | begin
|
---|
| 287 | with txtEncStart do
|
---|
| 288 | if Text = '' then
|
---|
| 289 | Text := '0';
|
---|
| 290 | end;
|
---|
| 291 |
|
---|
| 292 | procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
|
---|
| 293 | begin
|
---|
| 294 | txtEncStart.Text := IntToStr(FEncDefStartDays);
|
---|
| 295 | txtEncStop.Text := IntToStr(FEncDefStopDays);
|
---|
| 296 | end;
|
---|
| 297 |
|
---|
[473] | 298 | procedure TfrmOptionsOther.TabPositionComboBoxChange(Sender: TObject);
|
---|
| 299 | //kt added 8/8/08
|
---|
| 300 | begin
|
---|
| 301 | Case TabPositionComboBox.ItemIndex of
|
---|
| 302 | 0 : SetTabPosition(tpBottom);
|
---|
| 303 | 1 : SetTabPosition(tpTop);
|
---|
| 304 | 2 : SetTabPosition(tpLeft);
|
---|
| 305 | 3 : SetTabPosition(tpRight);
|
---|
| 306 | end; {case}
|
---|
| 307 | end;
|
---|
| 308 |
|
---|
| 309 | procedure SetTabPosition(Position : TTabPosition);
|
---|
| 310 | //kt added 8/8/08
|
---|
| 311 | begin
|
---|
| 312 | frmFrame.tabPage.TabPosition := Position;
|
---|
| 313 | Case Position of
|
---|
| 314 | tpBottom : frmFrame.tabPage.Align := alBottom;
|
---|
| 315 | tpTop: frmFrame.tabPage.Align := alTop;
|
---|
| 316 | tpLeft: frmFrame.tabPage.Align := alLeft;
|
---|
| 317 | tpRight : frmFrame.tabPage.Align := alRight;
|
---|
| 318 | end; {case}
|
---|
| 319 | end;
|
---|
| 320 |
|
---|
| 321 |
|
---|
| 322 | procedure TfrmOptionsOther.cboTabColorsChange(Sender: TObject);
|
---|
| 323 | var color : TColor;
|
---|
| 324 | selIndex : integer;
|
---|
| 325 | begin
|
---|
| 326 | selIndex := cboTabColors.ItemIndex;
|
---|
| 327 | if selIndex < 0 then exit;
|
---|
| 328 | color := TColor(cboTabColors.Items.Objects[selIndex]);
|
---|
| 329 | pnlShowColor.Color := color;
|
---|
| 330 | end;
|
---|
| 331 |
|
---|
| 332 | procedure TfrmOptionsOther.pnlShowColorClick(Sender: TObject);
|
---|
| 333 | //kt added 8/8/08
|
---|
| 334 | var s : string;
|
---|
| 335 | selIndex : integer;
|
---|
| 336 | begin
|
---|
| 337 | if ColorDialog.Execute then begin
|
---|
| 338 | pnlShowColor.Color := ColorDialog.Color;
|
---|
| 339 | selIndex := cboTabColors.ItemIndex;
|
---|
| 340 | if selIndex < 0 then exit;
|
---|
| 341 | cboTabColors.Items.Objects[selIndex] := pointer(ColorDialog.Color);
|
---|
| 342 | uTabColorsList.Objects[selIndex] := pointer(ColorDialog.Color);
|
---|
| 343 | end;
|
---|
| 344 | end;
|
---|
| 345 |
|
---|
[453] | 346 | end.
|
---|