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

//kt -- Modified with SourceScanner on 8/8/2007
unit fOptionsOther;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, ORCtrls, ORFn, rOrders, uCore, ORDtTm,
  DKLang;

type
  TfrmOptionsOther = class(TForm)
    pnlBottom: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    bvlBottom: TBevel;
    stStart: TStaticText;
    stStop: TStaticText;
    dtStart: TORDateBox;
    dtStop: TORDateBox;
    lblMedsTab: TLabel;
    lblTabDefault: TStaticText;
    lblTab: TLabel;
    cboTab: TORComboBox;
    chkLastTab: TCheckBox;
    Bevel1: TBevel;
    lblEncAppts: TLabel;
    stStartEncAppts: TStaticText;
    txtTodayMinus: TStaticText;
    txtEncStart: TCaptionEdit;
    txtDaysMinus: TStaticText;
    spnEncStart: TUpDown;
    txtDaysPlus: TStaticText;
    spnEncStop: TUpDown;
    txtEncStop: TCaptionEdit;
    txtTodayPlus: TStaticText;
    stStopEncAppts: TStaticText;
    Bevel2: TBevel;
    btnEncDefaults: TButton;
    DKLanguageController1: TDKLanguageController;
    TabPositionComboBox: TComboBox;
    Label1: TLabel;
    lblTabColors: TLabel;
    pnlShowColor: TPanel;
    ColorDialog: TColorDialog;
    lblEditTabColor: TLabel;
    cboTabColors: TComboBox;
    cbEnableTabColors: TCheckBox;
    procedure FormShow(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure dtStartExit(Sender: TObject);
    procedure dtStopExit(Sender: TObject);
    procedure dtStartChange(Sender: TObject);
    procedure txtEncStartChange(Sender: TObject);
    procedure txtEncStopChange(Sender: TObject);
    procedure txtEncStartExit(Sender: TObject);
    procedure txtEncStopExit(Sender: TObject);
    procedure btnEncDefaultsClick(Sender: TObject);
    procedure TabPositionComboBoxChange(Sender: TObject);
    procedure cboTabColorsChange(Sender: TObject);
    procedure pnlShowColorClick(Sender: TObject);
    procedure cbEnableTabColorsClick(Sender: TObject);
  private
    { Private declarations }
    FstartDt: TFMDateTime;
    FstopDt: TFMDateTime;
    FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer;
    //FDefaultEvent: string;
  public
    { Public declarations }
    procedure SaveTabColors(ColorsList : TStringList); //kt
  end;

var
  frmOptionsOther: TfrmOptionsOther;

const
  ENC_MAX_LIMIT = 999;


procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
procedure SetTabPosition(Position : TTabPosition); //kt

implementation

{$R *.DFM}

uses
  rOptions, uOptions, rCore, rSurgery, uConst, fMeds, fFrame,
  uTMGOptions //kt
  ;

procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
// create the form and make it modal, return an action
var
  frmOptionsOther: TfrmOptionsOther;
begin
  frmOptionsOther := TfrmOptionsOther.Create(Application);
  actiontype := 0;
  try
    with frmOptionsOther do
    begin
      if (topvalue < 0) or (leftvalue < 0) then
        Position := poScreenCenter
      else
      begin
        Position := poDesigned;
        Top := topvalue;
        Left := leftvalue;
      end;
      ResizeAnchoredFormToFont(frmOptionsOther);
      ShowModal;
      actiontype := btnOK.Tag;
    end;
  finally
    frmOptionsOther.Release;
  end;
end;

procedure TfrmOptionsOther.FormShow(Sender: TObject);
// displays defaults
// opening tab^use last tab^autosave seconds^verify note title
var
  last: integer;
  values, tab: string;
begin
  cboTabColors.Items.Assign(frmFrame.tabPage.Tabs);  //kt 8/09
  //cboTabColors.Items.Assign(TabColorsList);       //kt added8808
  cboTabColors.ItemIndex := 0;                       //kt
  cboTab.Items.Assign(rpcGetOtherTabs);              //kt
  cboTabColorsChange(nil);                           //kt
  cbEnableTabColors.Checked := TabColorsEnabled;    //kt 8/09
//if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then  <-- original line.  //kt 8/8/2007
  if (cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery')) > -1) and (not ShowSurgeryTab) then //kt added 8/8/2007
//  cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery'));  <-- original line.  //kt 8/8/2007
    cboTab.Items.Delete(cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery'))); //kt added 8/8/2007
  values := rpcGetOther;
  tab := Piece(values, '^', 1);
  last := strtointdef(Piece(values, '^', 2), 0);
  cboTab.SelectByID(tab);
  cboTab.Tag := strtointdef(tab, -1);
  chkLastTab.Checked := last = 1;
  chkLastTab.Tag := last;
  cboTab.SetFocus;
  rpcGetRangeForMeds(FstartDt, FstopDt);
  if FstartDt > 1 then
    dtStart.Text := FormatFMDateTime('mmm d, yyyy',FstartDt);
  if FstopDt > 1 then
    dtStop.Text  := FormatFMDateTime('mmm d, yyyy', FstopDt);
  rpcGetRangeForEncs(FEncDefStartDays, FEncDefStopDays, True); // True gets params settings above User/Service level.
  if FEncDefStartDays < 1 then
    FEncDefStartDays := 0;
  if FEncDefStopDays < 1 then
    FEncDefStopDays := 0;
  rpcGetRangeForEncs(FEncStartDays, FEncStopDays, False);      // False gets User/Service params.
  if ((FEncStartDays < 0) and (FEncStartDays <> 0)) then
    FEncStartDays := FEncDefStartDays;
  txtEncStart.Text := IntToStr(FEncStartDays);
  if ((FEncStopDays < 0) and (FEncStopDays <> 0)) then
    FEncStopDays := FEncDefStopDays;
  txtEncStop.Text := IntToStr(FEncStopDays);
end;

procedure TfrmOptionsOther.btnOKClick(Sender: TObject);
// opening tab^use last tab^autosave seconds^verify note title
var
  values, theVal: string;
begin
  values := '';
  if cboTab.ItemIEN <> cboTab.Tag then
    values := values + cboTab.ItemID;
  values := values + '^';
  if chkLastTab.Checked then
    if chkLastTab.Tag <> 1 then
      values := values + '1';
  if not chkLastTab.Checked then
    if chkLastTab.Tag <> 0 then
      values := values + '0';
  values := values + '^^';
  rpcSetOther(values);
  if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
  begin
    if dtStop.FMDateTime < dtStart.FMDateTime then
    begin
//    ShowMessage('The stop time can not prior to the start time.');  <-- original line.  //kt 8/8/2007
      ShowMessage(DKLangConstW('fOptionsOther_The_stop_time_can_not_prior_to_the_start_timex')); //kt added 8/8/2007
      dtStop.FMDateTime := FMToday;
      dtStop.SetFocus;
      Exit;
    end;
    theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime;
    rpcPutRangeForMeds(theVal);
  end;
  if (dtStart.Text = '') and (dtStop.Text = '') then
    rpcPutRangeForMeds('');
  rpcPutRangeForEncs(txtEncStart.Text, txtEncStop.Text);
  if frmMeds <> nil then
    frmMeds.RefreshMedLists;
end;

procedure TfrmOptionsOther.FormCreate(Sender: TObject);
begin
  cbEnableTabColors.checked := TabColorsEnabled;
  FStartDT  := 0;
  FStopDT   := 0;
end;

procedure TfrmOptionsOther.dtStartExit(Sender: TObject);
begin
  if dtStart.FMDateTime > FMToday then
  begin
//  ShowMessage('Start time can not greater than today.');  <-- original line.  //kt 8/8/2007
    ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
    dtStart.FMDateTime := FMToday;
    dtStart.SetFocus;
    Exit;
  end;
end;

procedure TfrmOptionsOther.dtStopExit(Sender: TObject);
begin
  if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then
    if (dtStop.FMDateTime < dtStart.FMDateTime) then
    begin
//    ShowMessage('Stop time can not prior to start time');  <-- original line.  //kt 8/8/2007
      ShowMessage(DKLangConstW('fOptionsOther_Stop_time_can_not_prior_to_start_time')); //kt added 8/8/2007
      dtStop.FMDateTime := FMToday;
      dtStop.SetFocus;
      Exit;
    end;
end;

procedure TfrmOptionsOther.dtStartChange(Sender: TObject);
begin
  if (dtStart.FMDateTime > FMToday) then
  begin
//  ShowMessage('Start time can not greater than today.');  <-- original line.  //kt 8/8/2007
    ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007
    dtStart.FMDateTime := FMToday;
    dtStart.SetFocus;
    Exit;
  end;
end;

procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject);
begin
with txtEncStart do
  begin
    if Text = '' then
      Exit;
    if Text = ' ' then
      Text := '0';
    if StrToInt(Text) < 0 then
      Text := '0';
    if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
      begin
        Text := IntToStr(ENC_MAX_LIMIT);
        Beep;
//      InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING);  <-- original line.  //kt 8/8/2007
        InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x')+' ' + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
      end;
  end;
end;

procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject);
begin
with txtEncStop do
  begin
    if Text = '' then
      Exit;
    if Text = ' ' then
      Text := '0';
    if StrToInt(Text) < 0 then
      Text := '0';
    if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then
      begin
        Text := IntToStr(ENC_MAX_LIMIT);
        Beep;
//      InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING);  <-- original line.  //kt 8/8/2007
        InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x') + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007
      end;
  end;
end;

procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject);
begin
with txtEncStart do
  if Text = '' then
    Text := '0';
end;

procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject);
begin
with txtEncStart do
  if Text = '' then
    Text := '0';
end;

procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject);
begin
txtEncStart.Text := IntToStr(FEncDefStartDays);
txtEncStop.Text := IntToStr(FEncDefStopDays);
end;

procedure TfrmOptionsOther.TabPositionComboBoxChange(Sender: TObject);
//kt added 8/8/08
begin
  Case TabPositionComboBox.ItemIndex of
    0 : SetTabPosition(tpBottom);
    1 : SetTabPosition(tpTop);
    2 : SetTabPosition(tpLeft);
    3 : SetTabPosition(tpRight);
  end; {case}
end;

procedure SetTabPosition(Position : TTabPosition);
//NOTE: Don't make this a member function of TFrmOptionsOther, becuase frmFrame needs
//      to be able to call it, even if the OtionsOther form is not instantiated.
//kt added 8/8/08
begin
  frmFrame.tabPage.TabPosition := Position;
  Case Position of
    tpBottom : frmFrame.tabPage.Align := alBottom;
    tpTop: frmFrame.tabPage.Align := alTop;
    tpLeft: frmFrame.tabPage.Align := alLeft;
    tpRight : frmFrame.tabPage.Align := alRight;
  end; {case}
  uTMGOptions.WriteInteger('Tab Location',integer(frmFrame.tabPage.TabPosition));
end;

procedure TfrmOptionsOther.SaveTabColors(ColorsList : TStringList);
//kt added 8/8/08  Entire function
var i : integer;
begin
  for i := 0 to ColorsList.Count-1 do begin
    uTMGOptions.WriteInteger('Tab '+IntToStr(i)+' Color',longword(ColorsList.Objects[i]));
  end;
  uTMGOptions.WriteBool('TAB_COLORS ENABLE',TabColorsEnabled); //kt 8/09
end;


procedure TfrmOptionsOther.cboTabColorsChange(Sender: TObject);
var color : TColor;
    selIndex : integer;
begin
  selIndex := cboTabColors.ItemIndex;
  if selIndex < 0 then exit;
  color := TColor(cboTabColors.Items.Objects[selIndex]);
  pnlShowColor.Color := color;
end;

procedure TfrmOptionsOther.pnlShowColorClick(Sender: TObject);
//kt added 8/8/08
var s : string;
    selIndex : integer;
begin
  if ColorDialog.Execute then begin
    pnlShowColor.Color := ColorDialog.Color;
    selIndex := cboTabColors.ItemIndex;
    if selIndex < 0 then exit;
    cboTabColors.Items.Objects[selIndex] := pointer(ColorDialog.Color);
    TabColorsList.Objects[selIndex] := pointer(ColorDialog.Color);
    uTMGOptions.WriteInteger('Tab '+IntToStr(selIndex)+' Color',longword(TabColorsList.Objects[selIndex]));
  end;
end;

procedure TfrmOptionsOther.cbEnableTabColorsClick(Sender: TObject);
//kt added
begin
  TabColorsEnabled := cbEnableTabColors.Checked;          //elh 01/12/10
  frmFrame.tabPage.OwnerDraw := cbEnableTabColors.Checked; //elh 01/12/10
  cboTabColors.Enabled    := TabColorsEnabled;
  lblEditTabColor.Enabled := TabColorsEnabled;
  lblTabColors.Enabled    := TabColorsEnabled;
  pnlShowColor.Enabled    := TabColorsEnabled;
  uTMGOptions.WriteBool('TAB_COLORS ENABLE',TabColorsEnabled); //kt 3/8/10
end;

end.