source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODDietLT.pas@ 1286

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fAutoSz, ExtCtrls, StdCtrls, ORFn, DKLang;

type
  TfrmODDietLT = class(TfrmAutoSz)
    lblMealCutoff: TStaticText;
    Label2: TStaticText;
    GroupBox1: TGroupBox;
    cmdYes: TButton;
    cmdNo: TButton;
    radLT1: TRadioButton;
    radLT2: TRadioButton;
    radLT3: TRadioButton;
    chkBagged: TCheckBox;
    Bevel1: TBevel;
    DKLanguageController2: TDKLanguageController;
    procedure cmdYesClick(Sender: TObject);
    procedure cmdNoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    //kt Begin Mod (change Consts to Vars) 8/8/2007
    TX_MEAL_REQ  : string;  //kt
    TC_MEAL_REQ  : string;  //kt
    //kt End Mod -------------------
    FOutpatient: boolean;
    YesPressed: Boolean;
    procedure SetupVars;  //kt
  public
    { Public declarations }
  end;

  TLateTrayFields = record
    LateMeal: Char;
    LateTime: string;
    IsBagged: Boolean;
  end;

procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);

implementation

{$R *.DFM}

uses rCore, uCore, rODDiet, uConst, rOrders;

//const
//TX_MEAL_REQ = 'A meal time must be selected.';  <-- original line.  //kt 8/8/2007
//TC_MEAL_REQ = 'No Meal Time Selected';  <-- original line.  //kt 8/8/2007



procedure TfrmODDietLT.SetupVars;
//kt Added entire function to replace constant declarations 8/8/2007
begin
  TX_MEAL_REQ := DKLangConstW('fODDietLT_A_meal_time_must_be_selectedx');
  TC_MEAL_REQ := DKLangConstW('fODDietLT_No_Meal_Time_Selected');
end;
 
procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
var
  frmODDietLT: TfrmODDietLT;
  DietParams: TDietParams;
  FMTime: TFMDateTime;
  TimePart: Extended;
  Meal: Char;
  AvailTimes,ALocation: string;
  TimeCount: Integer;

  function AMPMToFMTime(const x: string): Extended;
  var
    IntTime: Integer;
  begin
    Result := 0;
    if Pos(':', x) = 0 then Exit;
    IntTime := StrToIntDef(Piece(x, ':', 1) + Copy(Piece(x, ':', 2), 1, 2), 0);
    if (Pos('P', x) > 0) and (IntTime < 1200) then IntTime := IntTime + 1200;
    if (Pos('A', x) > 0) and (IntTime > 1200) then IntTime := IntTime - 1200;
    Result := IntTime / 10000;
  end;

  function FMTimeToAMPM(x: Extended): string;
  var
    TimePart: extended;
    AMPMTime, Suffix: string;
  begin
    TimePart := Frac(x);
    if TimePart > 0.1159 then
    begin
      if TimePart > 0.1259 then x := x - 0.12;
      Suffix := 'P'
    end
    else Suffix := 'A';
    AMPMTime := FormatFMDateTime('hh:nn', x);
    Result := AMPMTime + Suffix;
  end;

  procedure SetAvailTimes(ATime: Extended; var ACount: Integer; var TimeList: string);
  var
    i: Integer;
    ReturnList: string;
  begin
    ACount := 0;
    ReturnList := '';
    for i := 1 to 3 do
      if AMPMToFMTime(Piece(TimeList, U, i)) > ATime then
      begin
        if Length(ReturnList) > 0 then ReturnList := ReturnList + U;
        ReturnList := ReturnList + Piece(TimeList, U, i);
        Inc(ACount);
      end;
    TimeList := ReturnList;
  end;

begin
  // initialize LateTrayFields
  LateTrayFields.LateMeal := #0;
  LateTrayFields.LateTime := '';
  LateTrayFields.IsBagged := False;
  // make sure the start time is today and not in the future
  FMTime := StrToFMDateTime(StartTime);
  if FMTime < 0 then Exit;
  if Int(FMTime) <> FMToday then Exit;
  TimePart := Frac(FMTime);
  if TimePart = 0 then TimePart := Frac(FMNow);
  if TimePart > Frac(FMNow) then Exit;
  Meal := #0;
  ALocation := IntToStr(Encounter.Location);
  LoadDietParams(DietParams,ALocation);
  // check to see if falling within the alarm range of a meal
  if not IsOutpatient then
  begin
    if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) and
       (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := 'B';
    if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) and
       (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := 'N';
    if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) and
       (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := 'E';
    if Meal = #0 then Exit;
  end
  else  // for outpatients
  begin
(*  From Rich Knoepfle, NFS developer
//If they order a breakfast and it is after the LATE BREAKFAST ALARM END, I don't allow them to do it.  (For special meals I don't allow them to order something for the following day).  <-- original line.  //kt 8/8/2007
If they order a breakfast and it is after the LATE BREAKFAST ALARM END, I donDKLangConstW('fODDietLT_t_allow_them_to_do_itx__xFor_special_meals_I_don')t allow them to order something for the following day). //kt added 8/8/2007
If it's before the LATE BREAKFAST ALARM BEGIN than I accept the order.
If it's between the LATE BREAKFAST ALARM BEGIN and ALARM END then I ask if they want to order a Late breakfast tray.
*)
    Meal := AMeal;
    case AMeal of
      'B':  if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) or
               (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := #0;
      'N':  if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) or
               (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := #0;
      'E':  if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) or
               (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := #0;
    end;
    if Meal = #0 then exit;
  end;

  // get the available late times for this meal
  case Meal of
  'B': AvailTimes := Pieces(DietParams.BTimes, U, 4, 6);
  'E': AvailTimes := Pieces(DietParams.ETimes, U, 4, 6);
  'N': AvailTimes := Pieces(DietParams.NTimes, U, 4, 6);
  end;
  SetAvailTimes(TimePart, TimeCount, AvailTimes);
  if TimeCount = 0 then Exit;

  // setup form to get the selected late tray
  frmODDietLT := TfrmODDietLT.Create(Application);
  try
    ResizeFormToFont(TForm(frmODDietLT));
    with frmODDietLT do
    begin
      FOutpatient := IsOutpatient;
      if Length(Piece(AvailTimes, U, 1)) > 0 then radLT1.Caption := Piece(AvailTimes, U, 1);
      if Length(Piece(AvailTimes, U, 2)) > 0 then radLT2.Caption := Piece(AvailTimes, U, 2);
      if Length(Piece(AvailTimes, U, 3)) > 0 then radLT3.Caption := Piece(AvailTimes, U, 3);
      radLT1.Visible := Length(radLT1.Caption) > 0;
      radLT2.Visible := Length(radLT2.Caption) > 0;
      radLT3.Visible := Length(radLT3.Caption) > 0;
      radLT1.Checked := TimeCount = 1;
      chkBagged.Visible := DietParams.Bagged;
      with lblMealCutOff do case Meal of
//    'B': Caption := 'You have missed the breakfast cut-off.';  <-- original line.  //kt 8/8/2007
      'B': Caption := DKLangConstW('fODDietLT_You_have_missed_the_breakfast_cutxoffx'); //kt added 8/8/2007
//    'E': Caption := 'You have missed the evening cut-off.';  <-- original line.  //kt 8/8/2007
      'E': Caption := DKLangConstW('fODDietLT_You_have_missed_the_evening_cutxoffx'); //kt added 8/8/2007
//    'N': Caption := 'You have missed the noon cut-off.';  <-- original line.  //kt 8/8/2007
      'N': Caption := DKLangConstW('fODDietLT_You_have_missed_the_noon_cutxoffx'); //kt added 8/8/2007
      end;
      // display the form
      ShowModal;
      if YesPressed then
      begin
        with radLT1 do if Checked then LateTrayFields.LateTime := Caption;
        with radLT2 do if Checked then LateTrayFields.LateTime := Caption;
        with radLT3 do if Checked then LateTrayFields.LateTime := Caption;
        LateTrayFields.LateMeal := Meal;
        LateTrayFields.IsBagged := chkBagged.Checked;
      end;
    end; {with frmODDietLT}
  finally
    frmODDietLT.Release;
  end;
end;

// ---------- frmODDietLT procedures ---------------
procedure TfrmODDietLT.FormCreate(Sender: TObject);
begin
  inherited;
  YesPressed := False;
end;

procedure TfrmODDietLT.cmdYesClick(Sender: TObject);
begin
  SetupVars;  //kt added 8/8/2007 to replace constants with vars.
  inherited;
  if not FOutpatient then
    if (radLT1.Checked = False) and (radLT2.Checked = False) and (radLT3.Checked = False) then
    begin
      InfoBox(TX_MEAL_REQ, TC_MEAL_REQ, MB_OK);
      Exit;
    end;
  YesPressed := True;
  Close;
end;

procedure TfrmODDietLT.cmdNoClick(Sender: TObject);
begin
  inherited;
  Close;
end;

end.