source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODDietLT.pas@ 459

unit fODDietLT;

interface

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

type
  TfrmODDietLT = class(TfrmAutoSz)
    lblMealCutoff: TStaticText;
    Label2: TStaticText;
    GroupBox1: TGroupBox;
    cmdYes: TButton;
    cmdNo: TButton;
    radLT1: TRadioButton;
    radLT2: TRadioButton;
    radLT3: TRadioButton;
    chkBagged: TCheckBox;
    Bevel1: TBevel;
    procedure cmdYesClick(Sender: TObject);
    procedure cmdNoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FOutpatient: boolean;
    YesPressed: Boolean;
  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.';
  TC_MEAL_REQ = 'No Meal Time Selected';

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.12 then
    begin
      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;
    // 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;
  end
  else  // for outpatients
  begin
    Meal := AMeal;
    case AMeal of
      'B':  if TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000) then Meal := #0;
      'N':  if TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000) then Meal := #0;
      'E':  if TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000) then Meal := #0;
    end;
    if Meal = #0 then exit;
  end;
  // setup form to get the selected late tray
  frmODDietLT := TfrmODDietLT.Create(Application);
  try
    ResizeFormToFont(TForm(frmODDietLT));
    with frmODDietLT do
    begin
      FOutpatient := IsOutpatient;
      if not IsOutpatient then
      begin
        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;
      end
      else GroupBox1.Visible := False;
      chkBagged.Visible := DietParams.Bagged;
      with lblMealCutOff do case Meal of
      'B': Caption := 'You have missed the breakfast cut-off.';
      'E': Caption := 'You have missed the evening cut-off.';
      'N': Caption := 'You have missed the noon cut-off.';
      end;
      // display the form
      ShowModal;
      if YesPressed then
      begin
        if not IsOutpatient 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;
        end
        else
          LateTrayFields.LateTime := FMTimeToAMPM(FMToday + TimePart);
        LateTrayFields.LateMeal := Meal;
        LateTrayFields.IsBagged := chkBagged.Checked;
      end; {if YesPressed}
    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
  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.