2256 lines
77 KiB
Plaintext
2256 lines
77 KiB
Plaintext
unit fODDiet;
|
|
{$O-}
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
fODBase, ComCtrls, ExtCtrls, StdCtrls, Grids, ORCtrls, ORDtTm, ORFn, uConst;
|
|
|
|
type
|
|
TfrmODDiet = class(TfrmODBase)
|
|
nbkDiet: TPageControl;
|
|
pgeDiet: TTabSheet;
|
|
lblDietAvail: TLabel;
|
|
lblDietSelect: TLabel;
|
|
lblComment: TLabel;
|
|
lblStart: TLabel;
|
|
lblStop: TLabel;
|
|
lblDelivery: TLabel;
|
|
cboDietAvail: TORComboBox;
|
|
lstDietSelect: TORListBox;
|
|
cmdRemove: TButton;
|
|
txtDietComment: TCaptionEdit;
|
|
calDietStart: TORDateBox;
|
|
calDietStop: TORDateBox;
|
|
cboDelivery: TORComboBox;
|
|
pgeTubefeeding: TTabSheet;
|
|
lblTFProductList: TLabel;
|
|
lblTFComment: TLabel;
|
|
lblTFStrength: TLabel;
|
|
lblTFQuantity: TLabel;
|
|
lblTFProduct: TLabel;
|
|
cboProduct: TORComboBox;
|
|
txtTFComment: TCaptionEdit;
|
|
grdSelected: TCaptionStringGrid;
|
|
cmdTFRemove: TButton;
|
|
pgeEarlyLate: TTabSheet;
|
|
pgeIsolations: TTabSheet;
|
|
pgeAdditional: TTabSheet;
|
|
chkCancelTubefeeding: TCheckBox;
|
|
chkCancelTrays: TCheckBox;
|
|
txtQuantity: TCaptionEdit;
|
|
cboStrength: TCaptionComboBox;
|
|
lblTFAmount: TLabel;
|
|
grpMeal: TKeyClickRadioGroup;
|
|
grpMealTime: TGroupBox;
|
|
lblELStart: TLabel;
|
|
calELStart: TORDateBox;
|
|
lblELStop: TLabel;
|
|
calELStop: TORDateBox;
|
|
grpDoW: TGroupBox;
|
|
chkMonday: TCheckBox;
|
|
chkTuesday: TCheckBox;
|
|
chkWednesday: TCheckBox;
|
|
chkThursday: TCheckBox;
|
|
chkFriday: TCheckBox;
|
|
chkSaturday: TCheckBox;
|
|
chkSunday: TCheckBox;
|
|
chkBagged: TCheckBox;
|
|
radET1: TRadioButton;
|
|
radET2: TRadioButton;
|
|
radET3: TRadioButton;
|
|
radLT1: TRadioButton;
|
|
radLT2: TRadioButton;
|
|
radLT3: TRadioButton;
|
|
lblNoTimes: TLabel;
|
|
txtAOComment: TCaptionEdit;
|
|
lblAddlOrder: TLabel;
|
|
lstIsolation: TORListBox;
|
|
lblIsolation: TLabel;
|
|
lblIPComment: TLabel;
|
|
txtIPComment: TCaptionEdit;
|
|
lblIPCurrent: TLabel;
|
|
txtIPCurrent: TCaptionEdit;
|
|
pgeOutPt: TTabSheet;
|
|
grpOPMeal: TKeyClickRadioGroup;
|
|
grpOPDoW: TGroupBox;
|
|
chkOPMonday: TCheckBox;
|
|
chkOPTuesday: TCheckBox;
|
|
chkOPWednesday: TCheckBox;
|
|
chkOPThursday: TCheckBox;
|
|
chkOPFriday: TCheckBox;
|
|
chkOPSaturday: TCheckBox;
|
|
chkOPSunday: TCheckBox;
|
|
lblOPStart: TLabel;
|
|
calOPStart: TORDateBox;
|
|
lblOPStop: TLabel;
|
|
calOPStop: TORDateBox;
|
|
lblOPDietAvail: TLabel;
|
|
cboOPDietAvail: TORComboBox;
|
|
lblOPComment: TLabel;
|
|
txtOPDietComment: TCaptionEdit;
|
|
lblOPDelivery: TLabel;
|
|
cboOPDelivery: TORComboBox;
|
|
lblOPSelect: TLabel;
|
|
lstOPDietSelect: TORListBox;
|
|
cmdOPRemove: TButton;
|
|
chkOPCancelTubefeeding: TCheckBox;
|
|
calOPTFStart: TORDateBox;
|
|
lblOPTFStart: TLabel;
|
|
lblOPAOStart: TLabel;
|
|
calOPAOStart: TORDateBox;
|
|
cboOPAORecurringMeals: TORComboBox;
|
|
cboOPTFRecurringMeals: TORComboBox;
|
|
cboOPELRecurringMeals: TORComboBox;
|
|
procedure nbkDietChanging(Sender: TObject;
|
|
var AllowChange: Boolean);
|
|
procedure nbkDietChange(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure cboDietAvailNeedData(Sender: TObject;
|
|
const StartFrom: String; Direction, InsertAt: Integer);
|
|
procedure cboDietAvailMouseClick(Sender: TObject);
|
|
procedure cboDietAvailExit(Sender: TObject);
|
|
procedure cmdRemoveClick(Sender: TObject);
|
|
procedure DietChange(Sender: TObject);
|
|
procedure cmdAcceptClick(Sender: TObject);
|
|
procedure cboProductMouseClick(Sender: TObject);
|
|
procedure cboProductExit(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormResize(Sender: TObject);
|
|
procedure grdSelectedSelectCell(Sender: TObject; Col, Row: Integer;
|
|
var CanSelect: Boolean);
|
|
procedure txtQuantityChange(Sender: TObject);
|
|
procedure txtQuantityExit(Sender: TObject);
|
|
procedure cboStrengthChange(Sender: TObject);
|
|
procedure cboStrengthExit(Sender: TObject);
|
|
procedure TFChange(Sender: TObject);
|
|
procedure cmdTFRemoveClick(Sender: TObject);
|
|
procedure grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
|
|
State: TGridDrawState);
|
|
procedure cboStrengthKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure cboStrengthEnter(Sender: TObject);
|
|
procedure txtQuantityKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure txtQuantityEnter(Sender: TObject);
|
|
procedure grpMealClick(Sender: TObject);
|
|
procedure calELStartExit(Sender: TObject);
|
|
procedure calELStopChange(Sender: TObject);
|
|
procedure ELChange(Sender: TObject);
|
|
procedure calELStartEnter(Sender: TObject);
|
|
procedure calELStartChange(Sender: TObject);
|
|
procedure IPChange(Sender: TObject);
|
|
procedure AOChange(Sender: TObject);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure cboOPDietAvailMouseClick(Sender: TObject);
|
|
procedure cboOPDietAvailExit(Sender: TObject);
|
|
procedure calOPStartExit(Sender: TObject);
|
|
procedure calOPStopChange(Sender: TObject);
|
|
procedure calOPStartEnter(Sender: TObject);
|
|
procedure calOPStartChange(Sender: TObject);
|
|
procedure OPChange(Sender: TObject);
|
|
procedure grpOPMealClick(Sender: TObject);
|
|
procedure cmdOPRemoveClick(Sender: TObject);
|
|
procedure cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
private
|
|
FNextCol: Integer;
|
|
FNextRow: Integer;
|
|
FChangeStop: Boolean;
|
|
FIsolationID: string;
|
|
FTabChanging: Boolean;
|
|
procedure DietCheckForNPO;
|
|
procedure DietCheckForTF;
|
|
function GetMealTime: string;
|
|
function GetDaysOfWeek: string;
|
|
function IsEarlyTray: Boolean;
|
|
procedure ResetControlsDO;
|
|
procedure ResetControlsTF;
|
|
procedure ResetControlsEL;
|
|
procedure ResetControlsIP;
|
|
procedure ResetControlsAO;
|
|
procedure SetEnableDOW(AllowUse: Boolean);
|
|
procedure SetNextCell(ACol, ARow: Integer);
|
|
procedure SetValuesFromResponsesDO;
|
|
procedure SetValuesFromResponsesTF;
|
|
procedure SetValuesFromResponsesEL;
|
|
procedure SetValuesFromResponsesIP;
|
|
procedure SetValuesFromResponsesAO;
|
|
procedure TFMoveToNextCell;
|
|
procedure TFClearGrid;
|
|
procedure TFSetAmountForRow(ARow: Integer);
|
|
function TFStrengthCode(const x: string): Integer;
|
|
// Outpatient meal additions
|
|
function FMDOW(AnFMDate: TFMDateTime): integer;
|
|
function FMDays(AStart, AEnd: TFMDateTime): string;
|
|
function GetOPDaysOfWeek: string;
|
|
procedure SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
|
|
procedure ResetControlsOP;
|
|
procedure SetValuesFromResponsesOP;
|
|
function GetOPMealWindow: string;
|
|
procedure OPDietCheckForNPO;
|
|
procedure OPDietCheckForTF;
|
|
function PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
|
|
protected
|
|
procedure InitDialog; override;
|
|
procedure Validate(var AnErrMsg: string); override;
|
|
public
|
|
procedure SetupDialog(OrderAction: Integer; const ID: string); override;
|
|
end;
|
|
|
|
var
|
|
frmODDiet: TfrmODDiet;
|
|
uDialogName: string;
|
|
uFHAUTH: boolean;
|
|
uRecurringMealList: TStringList;
|
|
|
|
implementation
|
|
|
|
{$R *.DFM}
|
|
|
|
uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, uAccessibleStringGrid, DateUtils;
|
|
|
|
const
|
|
TX_DIET_REG = 'A regular diet may not be combined with other diets.';
|
|
TX_DIET_NPO = 'NPO may not be combined with other diets.';
|
|
TX_DIET_LIM = 'A maximum of 5 diet modifications may be selected.';
|
|
TX_DIET_DUP = 'This diet has already been selected.';
|
|
TX_DIET_PRC = 'This diet conflicts with ';
|
|
TC_DIET_ERR = 'Unable to Add Diet';
|
|
TX_INPT_ONLY = 'This type of diet may be entered for inpatients only.';
|
|
TC_INPT_ONLY = 'Ordering Restriction';
|
|
TX_CANCEL_TF = 'Cancel the current tubefeeding order?' + CRLF + CRLF;
|
|
TC_CANCEL_TF = 'Cancel Tubefeeding';
|
|
TX_NO_DIET = 'At least one diet must be selected.';
|
|
TX_BAD_START = 'The effective date is not valid.';
|
|
TX_BAD_STOP = 'The expiration date is not valid.';
|
|
TX_STOPSTART = 'The expiration date must be after the effective date.';
|
|
TX_MINMAX = 'At least 1 product must be selected (maximum: 5).';
|
|
TX_TFQTY = 'A quantity must be entered for ';
|
|
TX_TFAMT = 'The quantity is invalid for ';
|
|
TX_TF5000 = 'The total quantity ordered may not exceed 5000ml.';
|
|
TX_HLPQTY = CRLF + 'The following may be entered for quantity:' + CRLF +
|
|
' Units may be K for Kcals, C for cc''s, M for ml, O for oz. or U for units (e.g. cans).' + CRLF +
|
|
' Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H, or Q6H.' + CRLF +
|
|
' May also input 100CC/HR X 16 for 16 hours. Valid quantity for powder form' + CRLF +
|
|
' product can be "# GRAMS" as 20 G, GRAMS, or GMS, or as 1 PKG or 1 U and the' + CRLF +
|
|
' frequency (e.g. 20 GRAMS/DAY or 1 PKG/TID).';
|
|
TX_ELMEAL = 'A meal must be selected.';
|
|
TX_ELTIME = 'A meal time must be selected.';
|
|
TX_ELNOSTART = 'A valid start date must be entered.';
|
|
TX_ELNOSTOP = 'A valid end date must be entered.';
|
|
TX_ELSTARTLT = 'The start date may not be earlier than today.';
|
|
TX_ELSTOPLT = 'The end date may not be earlier than today.';
|
|
TX_ELSTOPSTART = 'The end date may not be earlier than the start date.';
|
|
TX_ELSTART30 = 'The start date may not be more than 30 days in the future.';
|
|
TX_ELSTOP30 = 'The end date may not be more than 30 days in the future.';
|
|
TX_ELDOW = 'The days of the week must be selected for time ranges greater than 1 day.';
|
|
TX_ELPAST = 'The selected meal time has already passed.';
|
|
TX_IPNONE = 'An isolation type must be selected.';
|
|
TX_AONONE = 'Text for additional order has not been entered.';
|
|
TX_ACCEPT = 'Accept the following order?' + CRLF + CRLF;
|
|
TX_CONTINUE = 'Continue editing the following order?' + CRLF + CRLF;
|
|
TX_DISCARD = CRLF + CRLF + 'Answering NO will discard all changes.';
|
|
TC_ACCEPT = 'Unsaved Order';
|
|
TX_EL_SAVE_ERR = 'An error occurred while saving this late tray order.';
|
|
TC_EL_SAVE_ERR = 'Error Saving Late Tray Order';
|
|
// Outpatient meal additions
|
|
TX_OPMEAL = 'A meal must be selected.';
|
|
TX_OPNOSTART = 'A valid start date must be entered.';
|
|
TX_OPNOSTOP = 'A valid end date must be entered.';
|
|
TX_OPSTARTLT = 'The start date may not be earlier than today.';
|
|
TX_OPSTOPLT = 'The end date may not be earlier than today.';
|
|
TX_OPSTOPSTART = 'The end date may not be earlier than the start date.';
|
|
TX_OPSTART_MAX1 = 'The start date may not be more than ';
|
|
TX_OPSTART_MAX2 = ' days in the future.';
|
|
TX_OPSTOP_MAX1 = 'The end date may not be more than ';
|
|
TX_OPSTOP_MAX2 = ' days in the future.';
|
|
TX_OPDOW = 'The days of the week must be selected for time ranges greater than 1 day.';
|
|
TX_OPPAST = 'The selected meal time has already passed.';
|
|
TX_OP_SAVE_ERR = 'An error occurred while saving this outpatient meal order.';
|
|
TC_OP_SAVE_ERR = 'Error Saving Outpatient Meal Order';
|
|
TX_OP_NO_DIET = 'One and only one diet must be selected.';
|
|
TX_OP_BAD_START = 'The effective date is not valid.';
|
|
TX_OP_BAD_STOP = 'The expiration date is not valid.';
|
|
//TX_OP_DIET_REG = 'A regular diet may not be combined with other diets.';
|
|
//TX_OP_DIET_NPO = 'NPO may not be combined with other diets.';
|
|
//TX_OP_DIET_LIM = 'A maximum of 1 diet may be selected.';
|
|
//TX_OP_DIET_DUP = 'This diet has already been selected.';
|
|
//TX_OP_DIET_PRC = 'This diet conflicts with ';
|
|
TC_OP_DIET_ERR = 'Unable to Add Diet';
|
|
TX_OUTPT_ONLY = 'This type of diet may be entered for outpatients only.';
|
|
TC_OUTPT_ONLY = 'Ordering Restriction';
|
|
TX_NO_PARAMS = 'Placing Early or Late tray orders is not allowed until the IRM diet package' + CRLF +
|
|
'coordinator enters times for E/L trays for this location.';
|
|
TC_NO_PARAMS = 'Unable to Order Early/Late Tray';
|
|
TX_NOSTART = 'A valid start date must be entered.';
|
|
TC_NOSTART = 'Start date required';
|
|
TX_NOT_THIS_LOC = 'This location has not been configured to' + CRLF +
|
|
'allow ordering of meals for outpatients.' + CRLF + CRLF +
|
|
'Please contact your IRM diet package coordinator.';
|
|
TC_NOT_THIS_LOC = 'Unable to order from this location';
|
|
TX_NO_OUTPT_ORDERS = 'Diet orders may only be entered for inpatients.';
|
|
TC_NO_OUTPT_ORDERS = 'Ordering Restriction';
|
|
TX_NO_MEALS_DEFINED = 'No diet types have been defined to be orderable for outpatients.' + CRLF + CRLF +
|
|
'Please contact your IRM diet package coordinator.';
|
|
TC_NO_MEALS_DEFINED = 'Unable to order outpatient meals';
|
|
|
|
FMDayLetters: array[1..7] of string[1] = ('M', 'T', 'W', 'R', 'F', 'S', 'X');
|
|
|
|
type
|
|
TTFProduct = class
|
|
private
|
|
IEN: Integer;
|
|
Name: string;
|
|
end;
|
|
|
|
var
|
|
uDietParams: TDietParams;
|
|
|
|
procedure TfrmODDiet.FormCreate(Sender: TObject);
|
|
var
|
|
ALocation: string; //ptr to #44 hospital location
|
|
begin
|
|
inherited;
|
|
AbortOrder := False;
|
|
uRecurringMealList := TStringList.Create;
|
|
if OrderForInpatient then
|
|
begin
|
|
pgeDiet.TabVisible := True;
|
|
pgeOutPt.TabVisible := False;
|
|
end
|
|
else if OutpatientPatchInstalled then // put here to only call RPCs if outpatient - remove "IF" later
|
|
begin
|
|
pgeDiet.TabVisible := False;
|
|
pgeOutPt.TabVisible := True;
|
|
end
|
|
else // this block will go away after FH patch installed everywhere
|
|
begin
|
|
InfoBox(TX_NO_OUTPT_ORDERS, TC_NO_OUTPT_ORDERS, MB_OK);
|
|
AbortOrder := True;
|
|
Exit;
|
|
end;
|
|
|
|
FillerID := 'FH'; // does 'on Display' order check **KCM**
|
|
ALocation := '0';
|
|
if Self.EvtID > 0 then
|
|
ALocation := GetEventLoc1(IntToStr(Self.EvtID));
|
|
if StrToIntDef(ALocation, 0) < 1 then
|
|
ALocation := IntToStr(Encounter.Location);
|
|
if (not OrderForInpatient) and OutpatientPatchInstalled and (not OutpatientLocationConfigured(ALocation)) then
|
|
begin
|
|
InfoBox(TX_NOT_THIS_LOC, TC_NOT_THIS_LOC, MB_OK or MB_ICONINFORMATION);
|
|
AbortOrder := True;
|
|
end
|
|
else
|
|
begin
|
|
LoadDietParams(uDietParams, ALocation);
|
|
if pgeOutPt.TabVisible then
|
|
with uDietParams, cboOPDelivery do
|
|
begin
|
|
if Tray then Items.Add('T^Tray');
|
|
if Cafeteria then Items.Add('C^Cafeteria');
|
|
if DiningRm then Items.Add('D^Dining Room');
|
|
ItemIndex := 0;
|
|
chkBagged.Visible := uDietParams.Bagged;
|
|
end
|
|
else
|
|
with uDietParams, cboDelivery do
|
|
begin
|
|
if Tray then Items.Add('T^Tray');
|
|
if Cafeteria then Items.Add('C^Cafeteria');
|
|
if DiningRm then Items.Add('D^Dining Room');
|
|
ItemIndex := 0;
|
|
chkBagged.Visible := uDietParams.Bagged;
|
|
end;
|
|
end;
|
|
TAccessibleStringGrid.WrapControl(grdSelected);
|
|
end;
|
|
|
|
procedure TfrmODDiet.FormDestroy(Sender: TObject);
|
|
begin
|
|
TAccessibleStringGrid.UnwrapControl(grdSelected);
|
|
TFClearGrid;
|
|
uRecurringMealList.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrmODDiet.FormResize(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
with grdSelected do
|
|
begin
|
|
ColWidths[1] := Canvas.TextWidth('XFULLX') + GetSystemMetrics(SM_CXVSCROLL);
|
|
ColWidths[2] := Canvas.TextWidth('100 GRAMS/HOUR X 24');
|
|
ColWidths[3] := Canvas.TextWidth('55000ml');
|
|
ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - ColWidths[3] - 3;
|
|
lblTFStrength.Left := Left + ColWidths[0] + 3;
|
|
lblTFQuantity.Left := Left + ColWidths[0] + ColWidths[1] + 5;
|
|
lblTFAmount.Left := Left + ColWidths[0] + ColWidths[1] + ColWidths[2] + 7;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.InitDialog;
|
|
begin
|
|
inherited;
|
|
// handle all initialization at the tab level
|
|
// if FTabChanging, then nbkDietChange is about to be called anyway
|
|
if not FTabChanging then nbkDietChange(Self);
|
|
end;
|
|
|
|
procedure TfrmODDiet.SetupDialog(OrderAction: Integer; const ID: string);
|
|
begin
|
|
if AbortOrder then exit;
|
|
inherited;
|
|
uDialogName := ExternalName(DialogIEN, 101.41);
|
|
case DietDialogType(DisplayGroup) of
|
|
'D': begin
|
|
if not OrderForInpatient then
|
|
begin
|
|
InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
|
|
Close;
|
|
Exit;
|
|
end;
|
|
pgeDiet.TabVisible := True;
|
|
pgeOutPt.TabVisible := False;
|
|
nbkDiet.ActivePage := pgeDiet;
|
|
nbkDietChange(Self);
|
|
if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
|
|
end;
|
|
'N': begin
|
|
if not OrderForInpatient then
|
|
begin
|
|
InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
|
|
Close;
|
|
Exit;
|
|
end;
|
|
nbkDiet.ActivePage := pgeDiet;
|
|
nbkDietChange(Self);
|
|
if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
|
|
end;
|
|
'T': begin
|
|
if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
|
|
begin
|
|
Close;
|
|
Exit;
|
|
end;
|
|
nbkDiet.ActivePage := pgeTubefeeding;
|
|
nbkDietChange(Self);
|
|
if OrderAction <> ORDER_NEW then SetValuesFromResponsesTF;
|
|
end;
|
|
'E': begin
|
|
if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
|
|
begin
|
|
Close;
|
|
Exit;
|
|
end;
|
|
nbkDiet.ActivePage := pgeEarlyLate;
|
|
nbkDietChange(Self);
|
|
if OrderAction <> ORDER_NEW then SetValuesFromResponsesEL;
|
|
end;
|
|
'P': begin
|
|
nbkDiet.ActivePage := pgeIsolations;
|
|
nbkDietChange(Self);
|
|
if OrderAction <> ORDER_NEW then SetValuesFromResponsesIP;
|
|
end;
|
|
'A': begin
|
|
if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
|
|
begin
|
|
Close;
|
|
Exit;
|
|
end;
|
|
nbkDiet.ActivePage := pgeAdditional;
|
|
nbkDietChange(Self);
|
|
if OrderAction <> ORDER_NEW then SetValuesFromResponsesAO;
|
|
end;
|
|
'M': begin
|
|
if OrderForInpatient then
|
|
begin
|
|
InfoBox(TX_OUTPT_ONLY, TC_OUTPT_ONLY, MB_OK);
|
|
Close;
|
|
Exit;
|
|
end;
|
|
uFHAUTH := UserHasFHAUTHKey; // is this really needed for other than printing?
|
|
pgeDiet.TabVisible := False;
|
|
pgeOutPt.TabVisible := True;
|
|
nbkDiet.ActivePage := pgeOutPt;
|
|
nbkDietChange(Self);
|
|
if OrderAction <> ORDER_NEW then SetValuesFromResponsesOP;
|
|
end
|
|
else
|
|
begin
|
|
if not OrderForInpatient then
|
|
begin
|
|
InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
|
|
Close;
|
|
Exit;
|
|
end;
|
|
pgeDiet.TabVisible := True;
|
|
pgeOutPt.TabVisible := False;
|
|
nbkDiet.ActivePage := pgeDiet;
|
|
nbkDietChange(Self);
|
|
if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
|
|
ActiveControl := cboOPDietAvail;
|
|
end;
|
|
end;
|
|
if OrderAction = ORDER_NEW then SetFocusedControl(nbkDiet);
|
|
end;
|
|
|
|
procedure TfrmODDiet.Validate(var AnErrMsg: string);
|
|
var
|
|
ErrMsg: string;
|
|
i, Sum: Integer;
|
|
|
|
procedure SetError(const x: string);
|
|
begin
|
|
if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
|
|
AnErrMsg := AnErrMsg + x;
|
|
end;
|
|
|
|
function MealTimePassed: Boolean;
|
|
var
|
|
x: string;
|
|
ATime: Integer;
|
|
begin
|
|
Result := False;
|
|
if calELStart.FMDateTime <> FMToday then Exit;
|
|
x := GetMealTime;
|
|
if Pos(':', x) = 0 then Exit;
|
|
ATime := StrToIntDef(Piece(x, ':', 1) + Copy(Piece(x, ':', 2), 1, 2), 0);
|
|
if (Pos('P', x) > 0) and (ATime < 1200) then ATime := ATime + 1200;
|
|
if (Pos('A', x) > 0) and (ATime > 1200) then ATime := ATime - 1200;
|
|
if (ATime / 10000) < Frac(FMNow) then Result := True;
|
|
end;
|
|
|
|
function OPMealTimePassed: Boolean;
|
|
var
|
|
WindowTimes: string;
|
|
EndWindow: integer;
|
|
x: extended;
|
|
begin
|
|
Result := False;
|
|
if calOPStart.FMDateTime <> FMToday then Exit;
|
|
WindowTimes := GetOPMealWindow;
|
|
if WindowTimes = U then exit;
|
|
EndWindow := StrToIntDef(Piece(WindowTimes, U, 2), 0);
|
|
x := Frac(calOPStart.FMDateTime);
|
|
if x = 0 then x := Frac(FMNow) * 10000;
|
|
if x > EndWindow then Result := True;
|
|
end;
|
|
|
|
begin
|
|
// do the appropriate validation depending on the currently selected tab
|
|
if nbkDiet.ActivePage = pgeDiet then
|
|
begin
|
|
if lstDietSelect.Items.Count < 1 then SetError(TX_NO_DIET);
|
|
if not calDietStart.IsValid then SetError(TX_BAD_START);
|
|
with calDietStop do
|
|
begin
|
|
Validate(ErrMsg);
|
|
if Length(ErrMsg) > 0 then SetError(TX_BAD_STOP);
|
|
if (Length(Text) > 0) and (FMDateTime <= calDietStart.FMDateTime)
|
|
then SetError(TX_STOPSTART);
|
|
end; {with calDietStop}
|
|
end; {pgeDiet}
|
|
if nbkDiet.ActivePage = pgeTubeFeeding then
|
|
begin
|
|
Sum := 0;
|
|
with grdSelected do for i := 0 to RowCount - 1 do if Objects[0, i] <> nil then Inc(Sum);
|
|
if (Sum < 1) or (Sum > 5) then SetError(TX_MINMAX);
|
|
Sum := 0;
|
|
with grdSelected do for i := 0 to RowCount - 1 do if Objects[0, i] <> nil then
|
|
begin
|
|
if Length(Cells[2, i]) = 0 then SetError(TX_TFQTY + Cells[0, i]);
|
|
if (Length(Cells[2, i]) > 0) and (Length(Cells[3, i]) = 0)
|
|
then SetError(TX_TFAMT + Cells[0, i] + TX_HLPQTY);
|
|
Sum := Sum + StrToIntDef(Piece(Cells[3, i], 'c', 1), 0);
|
|
end;
|
|
if Sum > 5000 then SetError(TX_TF5000);
|
|
if not OrderForInpatient then
|
|
if not calOPTFStart.IsValid then SetError(TX_BAD_START);
|
|
end;
|
|
if nbkDiet.ActivePage = pgeEarlyLate then
|
|
begin
|
|
if grpMeal.ItemIndex = 3 then SetError(TX_ELMEAL);
|
|
if not calELStart.IsValid then SetError(TX_ELNOSTART);
|
|
if calELStart.FMDateTime < FMToday then SetError(TX_ELSTARTLT);
|
|
if calELStart.FMDateTime > FMDateTimeOffsetBy(FMToday, 30) then SetError(TX_ELSTART30);
|
|
if OrderForInpatient then
|
|
begin
|
|
if GetMealTime = '' then SetError(TX_ELTIME);
|
|
if not calELStop.IsValid then SetError(TX_ELNOSTOP);
|
|
if calELStop.FMDateTime < FMToday then SetError(TX_ELSTOPLT);
|
|
if calELStop.FMDateTime < calELStart.FMDateTime then SetError(TX_ELSTOPSTART);
|
|
if calELStop.FMDateTime > FMDateTimeOffsetBy(FMToday, 30) then SetError(TX_ELSTOP30);
|
|
end;
|
|
if grpDOW.Enabled and (GetDaysOfWeek = '') then SetError(TX_ELDOW);
|
|
if MealTimePassed then SetError(TX_ELPAST);
|
|
end;
|
|
if nbkDiet.ActivePage = pgeIsolations then
|
|
begin
|
|
if lstIsolation.ItemIndex < 0 then SetError(TX_IPNONE);
|
|
end;
|
|
if nbkDiet.ActivePage = pgeAdditional then
|
|
begin
|
|
if not ContainsVisibleChar(txtAOComment.Text) then SetError(TX_AONONE);
|
|
if not OrderForInpatient then
|
|
if not calOPAOStart.IsValid then SetError(TX_BAD_START);
|
|
end;
|
|
if nbkDiet.ActivePage = pgeOutPt then
|
|
begin
|
|
if grpOPMeal.ItemIndex = 3 then SetError(TX_OPMEAL);
|
|
if lstOPDietSelect.Items.Count < 1 then SetError(TX_OP_NO_DIET);
|
|
if OPMealTimePassed then SetError(TX_OPPAST);
|
|
if uDialogName = 'FHW OP MEAL' then
|
|
begin
|
|
if not calOPStart.IsValid then SetError(TX_OP_BAD_START);
|
|
with calOPStop do
|
|
begin
|
|
Validate(ErrMsg);
|
|
if Length(ErrMsg) > 0 then SetError(TX_OP_BAD_STOP);
|
|
if (Length(Text) > 0) and (FMDateTime < calOPStart.FMDateTime)
|
|
then SetError(TX_OPSTOPSTART);
|
|
end; {with calOPDietStop}
|
|
if calOPStart.FMDateTime > FMDateTimeOffsetBy(FMToday, uDietParams.OPMaxDays)
|
|
then SetError(TX_OPSTART_MAX1 + IntToStr(uDietParams.OPMaxDays) +
|
|
TX_OPSTART_MAX2);
|
|
if calOPStop.FMDateTime > FMDateTimeOffsetBy(FMToday, uDietParams.OPMaxDays)
|
|
then SetError(TX_OPSTOP_MAX1 + IntToStr(uDietParams.OPMaxDays) +
|
|
TX_OPSTOP_MAX2);
|
|
if grpOPDOW.Enabled and (GetOPDaysOfWeek = '')
|
|
then SetError(TX_OPDOW);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ notebook tabs - general ------------------------------------------------------------------- }
|
|
|
|
procedure TfrmODDiet.nbkDietChanging(Sender: TObject; var AllowChange: Boolean);
|
|
begin
|
|
inherited;
|
|
with Responses do if (Length(CopyOrder) > 0) or (Length(EditOrder) > 0) then
|
|
begin
|
|
AllowChange := False;
|
|
Exit;
|
|
end;
|
|
FTabChanging := True;
|
|
if Length(memOrder.Text) > 0 then
|
|
begin
|
|
if nbkDiet.ActivePage = pgeOutpt then
|
|
begin
|
|
if InfoBox(TX_CONTINUE + memOrder.Text + TX_DISCARD, TC_ACCEPT, MB_YESNO) = ID_YES then
|
|
begin
|
|
AllowChange := FALSE;
|
|
end else
|
|
begin
|
|
memOrder.Text := '';
|
|
memOrder.Lines.Clear;
|
|
Responses.Clear;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if InfoBox(TX_ACCEPT + memOrder.Text, TC_ACCEPT, MB_YESNO) = ID_YES then
|
|
begin
|
|
cmdAcceptClick(Self);
|
|
AllowChange := AcceptOK;
|
|
end else
|
|
begin
|
|
memOrder.Text := '';
|
|
memOrder.Lines.Clear;
|
|
Responses.Clear;
|
|
end;
|
|
end
|
|
end;
|
|
FTabChanging := False;
|
|
end;
|
|
|
|
procedure TfrmODDiet.nbkDietChange(Sender: TObject);
|
|
var
|
|
x, CxMsg: string ;
|
|
i: integer;
|
|
AStringList: TStringList;
|
|
const
|
|
// TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet:' + CRLF + CRLF;
|
|
TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
|
|
'you specify a start date for when the new diet should replace the current' + CRLF +
|
|
'diet:' + CRLF + CRLF;
|
|
TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
|
|
begin
|
|
inherited;
|
|
// much of the logic here can be eliminated if ClearDialogControls starts clearing containers
|
|
if AbortOrder then
|
|
begin
|
|
cmdQuitClick(Self);
|
|
exit;
|
|
end;
|
|
StatusText('Loading Dialog Definition');
|
|
if Sender <> Self then Responses.Clear;
|
|
Changing := True; // Changing set!
|
|
if nbkDiet.ActivePage = pgeDiet then
|
|
begin
|
|
AllowQuickOrder := True;
|
|
x := CurrentDietText;
|
|
if Piece(x, #13, 1) <> 'Current Diet: ' then
|
|
begin
|
|
AStringList := TStringList.Create;
|
|
try
|
|
AStringList.Text := x;
|
|
CxMsg := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
|
|
+ #9 + Copy(AStringList[0], 16, 99) + CRLF;
|
|
if AStringList.Count > 1 then
|
|
begin
|
|
CxMsg := CxMsg + CRLF + CRLF +
|
|
TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
|
|
+ #9 + Copy(AStringList[1], 22, 99) + CRLF;
|
|
if AStringList.Count > 2 then
|
|
for i := 2 to AStringList.Count - 1 do
|
|
CxMsg := CxMsg + #9 + TrimLeft(AStringList[i]) + CRLF;
|
|
end;
|
|
finally
|
|
AStringList.Free;
|
|
end;
|
|
end;
|
|
if CxMsg <> '' then
|
|
begin
|
|
if InfoBox(CxMsg + CRLF +
|
|
'Are you sure?', 'Confirm', MB_ICONWARNING or MB_YESNO) = ID_NO then
|
|
begin
|
|
AbortOrder := True;
|
|
cmdQuitClick(Self);
|
|
exit;
|
|
end;
|
|
end;
|
|
OrderMessage(x);
|
|
Responses.Dialog := 'FHW1'; // Diet Order
|
|
DisplayGroup := DisplayGroupForDialog('FHW1');
|
|
LoadDietQuickList(cboDietAvail.Items, 'DO');
|
|
cboDietAvail.InsertSeparator;
|
|
cboDietAvail.InitLongList('');
|
|
chkCancelTubefeeding.State := cbGrayed;
|
|
chkCancelTubefeeding.Visible := False;
|
|
ResetControlsDO;
|
|
end;
|
|
if nbkDiet.ActivePage = pgeTubefeeding then
|
|
begin
|
|
if not OrderForInpatient then
|
|
begin
|
|
if not PatientHasRecurringMeals(uRecurringMealList) then
|
|
begin
|
|
Changing := False;
|
|
nbkDiet.ActivePage := pgeOutPt;
|
|
nbkDietChange(nbkDiet);
|
|
Exit;
|
|
end
|
|
else
|
|
cboOPTFRecurringMeals.Items.Assign(uRecurringMealList);
|
|
end;
|
|
cboOPTFRecurringMeals.Visible := not OrderForInpatient;
|
|
calOPTFStart.Visible := False;
|
|
lblOPTFStart.Visible := not OrderForInpatient;
|
|
AllowQuickOrder := True;
|
|
if Length(uDietParams.CurTF) > 0
|
|
then OrderMessage(TextForOrder(uDietParams.CurTF))
|
|
else OrderMessage('');
|
|
Responses.Dialog := 'FHW8'; // Tubefeeding
|
|
DisplayGroup := DisplayGroupForDialog('FHW8');
|
|
with cboProduct do if Items.Count = 0 then
|
|
begin
|
|
LoadDietQuickList(Items, 'TF');
|
|
if Items.Count > 0 then
|
|
begin
|
|
Items.Add(LLS_LINE);
|
|
Items.Add(LLS_SPACE);
|
|
end;
|
|
AppendTFProducts(Items);
|
|
end;
|
|
cboProduct.Text := '';
|
|
ResetControlsTF;
|
|
end;
|
|
if nbkDiet.ActivePage = pgeEarlyLate then
|
|
begin
|
|
if not OrderForInpatient then
|
|
begin
|
|
if not PatientHasRecurringMeals(uRecurringMealList) then
|
|
begin
|
|
Changing := False;
|
|
nbkDiet.ActivePage := pgeOutPt;
|
|
nbkDietChange(nbkDiet);
|
|
Exit;
|
|
end
|
|
else
|
|
cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
|
|
end
|
|
else if (StrToIntDef(uDietParams.EarlyIEN, 0) = 0) or (StrToIntDef(uDietParams.LateIEN, 0) = 0) then
|
|
begin
|
|
InfoBox(TX_NO_PARAMS, TC_NO_PARAMS, MB_ICONERROR or MB_OK);
|
|
if pgeEarlyLate <> nil then
|
|
nbkDiet.SelectNextPage(False);
|
|
Changing := False;
|
|
Exit;
|
|
end;
|
|
cboOPELRecurringMeals.Visible := not OrderForInpatient;
|
|
cboOPELRecurringMeals.TabStop := not OrderForInpatient;
|
|
calELStart.Visible := OrderForInpatient;
|
|
calELStart.TabStop := OrderForInpatient;
|
|
calELStop.Visible := OrderForInpatient;
|
|
lblELStop.Visible := OrderForInpatient;
|
|
grpDOW.Visible := OrderForInpatient;
|
|
grpDOW.Enabled := OrderForInpatient;
|
|
AllowQuickOrder := False;
|
|
OrderMessage('');
|
|
Responses.Dialog := 'FHW2'; // Early/Late Tray
|
|
DisplayGroup := DisplayGroupForDialog('FHW2');
|
|
ResetControlsEL;
|
|
end;
|
|
if nbkDiet.ActivePage = pgeIsolations then
|
|
begin
|
|
AllowQuickOrder := False;
|
|
OrderMessage('');
|
|
Responses.Dialog := 'FHW3'; // Isolations
|
|
DisplayGroup := DisplayGroupForDialog('FHW3');
|
|
if lstIsolation.Items.Count = 0 then LoadIsolations(lstIsolation.Items);
|
|
txtIPCurrent.Text := CurrentIsolation;
|
|
FIsolationID := IsolationID;
|
|
ResetControlsIP;
|
|
end;
|
|
if nbkDiet.ActivePage = pgeAdditional then
|
|
begin
|
|
if not OrderForInpatient then
|
|
begin
|
|
if not PatientHasRecurringMeals(uRecurringMealList) then
|
|
begin
|
|
Changing := False;
|
|
nbkDiet.ActivePage := pgeOutPt;
|
|
nbkDietChange(nbkDiet);
|
|
Exit;
|
|
end
|
|
else
|
|
cboOPAORecurringMeals.Items.Assign(uRecurringMealList);
|
|
end;
|
|
cboOPAORecurringMeals.Visible := not OrderForInpatient;
|
|
calOPAOStart.Visible := False; //not OrderForInpatient;
|
|
lblOPAOStart.Visible := not OrderForInpatient;
|
|
AllowQuickOrder := False;
|
|
OrderMessage('');
|
|
Responses.Dialog := 'FHW7'; // Additional Order
|
|
DisplayGroup := DisplayGroupForDialog('FHW7');
|
|
ResetControlsAO;
|
|
end;
|
|
if nbkDiet.ActivePage = pgeOutPt then
|
|
begin
|
|
x := CurrentDietText;
|
|
if Length(Piece(x, #$D, 1)) > Length('Current Diet: ') then
|
|
OrderMessage(x)
|
|
else
|
|
OrderMessage('');
|
|
if (uDialogName <> 'FHW SPECIAL MEAL') and (uDialogName <> 'FHW OP MEAL') then
|
|
uDialogName := 'FHW OP MEAL';
|
|
Responses.Dialog := uDialogName;
|
|
DisplayGroup := DisplayGroupForDialog(uDialogName);
|
|
if uDialogName = 'FHW SPECIAL MEAL' then // Special meal
|
|
begin
|
|
AllowQuickOrder := False;
|
|
ResetControlsOP;
|
|
cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
|
|
{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
|
|
chkOPCancelTubefeeding.State := cbGrayed;
|
|
chkOPCancelTubefeeding.Visible := False;
|
|
grpOPMeal.Caption := 'Special Meal';
|
|
pgeTubefeeding.TabVisible := False;
|
|
pgeIsolations.TabVisible := False;
|
|
pgeAdditional.TabVisible := False;
|
|
pgeEarlyLate.TabVisible := False;
|
|
cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
|
|
cboOPDietAvailMouseClick(Self);
|
|
Changing := False;
|
|
end
|
|
else if uDialogName = 'FHW OP MEAL' then // Recurring meal
|
|
begin
|
|
AllowQuickOrder := True;
|
|
ResetControlsOP;
|
|
LoadDietQuickList(cboOPDietAvail.Items, 'MEAL'); // use D.G. short name here
|
|
cboOPDietAvail.InsertSeparator;
|
|
cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
|
|
cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
|
|
{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
|
|
chkOPCancelTubefeeding.State := cbGrayed;
|
|
chkOPCancelTubefeeding.Visible := False;
|
|
grpOPMeal.Caption := 'Recurring Meal';
|
|
SetEnableOPDOW(False, -1);
|
|
cboOPDietAvailMouseClick(Self);
|
|
Changing := False;
|
|
end;
|
|
end;
|
|
Changing := False; // Changing reset
|
|
StatusText('');
|
|
end;
|
|
|
|
{ Diet Order tab ---------------------------------------------------------------------------- }
|
|
|
|
procedure TfrmODDiet.DietCheckForNPO;
|
|
begin
|
|
if Piece(lstDietSelect.Items[0], U, 2) = 'NPO' then
|
|
begin
|
|
lblDelivery.Visible := False;
|
|
cboDelivery.Visible := False;
|
|
lblComment.Visible := True; // <-- these changes added for 11a to suppress
|
|
txtDietComment.Visible := True; // <-- prompting of special instructions except
|
|
end else // <-- for NPO
|
|
begin // <--
|
|
lblComment.Visible := False; // <--
|
|
txtDietComment.Visible := False; // <--
|
|
txtDietComment.Text := ''; // <--
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.DietCheckForTF;
|
|
var
|
|
x: string;
|
|
begin
|
|
with lstDietSelect do
|
|
begin
|
|
if (Items.Count = 1) and (Piece(Items[0], U, 2) <> 'NPO')
|
|
and (Length(uDietParams.CurTF) > 0) then
|
|
begin
|
|
x := TextForOrder(uDietParams.CurTF);
|
|
if InfoBox(TX_CANCEL_TF + x, TC_CANCEL_TF, MB_YESNO) = IDYES then
|
|
begin
|
|
chkCancelTubeFeeding.State := cbChecked;
|
|
chkCancelTubeFeeding.Visible := True;
|
|
end
|
|
else chkCancelTubeFeeding.State := cbUnchecked;
|
|
end; {if (Items...}
|
|
end; {with lstDietSelect}
|
|
end;
|
|
|
|
procedure TfrmODDiet.ResetControlsDO;
|
|
begin
|
|
lstDietSelect.Clear;
|
|
calDietStart.Text := 'Now';
|
|
calDietStop.Text := '';
|
|
lblDelivery.Visible := True;
|
|
cboDelivery.Visible := True;
|
|
txtDietComment.Text := ''; // <-- suppress except for NPO
|
|
txtDietComment.Visible := False; // <--
|
|
lblComment.Visible := False; // <--
|
|
end;
|
|
|
|
procedure TfrmODDiet.SetValuesFromResponsesDO;
|
|
var
|
|
AnInstance: Integer;
|
|
AResponse: TResponse;
|
|
ADiet: string;
|
|
begin
|
|
Changing := True; // Changing set!!
|
|
ResetControlsDO;
|
|
with Responses do
|
|
begin
|
|
AnInstance := NextInstance('ORDERABLE', 0);
|
|
while AnInstance > 0 do
|
|
begin
|
|
AResponse := FindResponseByName('ORDERABLE', AnInstance);
|
|
if AResponse <> nil then
|
|
begin
|
|
ADiet := DietAttributes(StrToIntDef(AResponse.IValue,0));
|
|
if Piece(ADiet,'^',1)='0' then
|
|
begin
|
|
InfoBox(Piece(ADiet,'^',2), TC_DIET_ERR, MB_OK);
|
|
cboDietAvail.ItemIndex := -1;
|
|
Changing := False;
|
|
Exit;
|
|
end;
|
|
lstDietSelect.Items.Add(ADiet);
|
|
end;
|
|
AnInstance := NextInstance('ORDERABLE', AnInstance);
|
|
end; {while AnInstance - ORDERABLE}
|
|
SetControl(calDietStart, 'START', 1);
|
|
SetControl(calDietStop, 'STOP', 1);
|
|
SetControl(cboDelivery, 'DELIVERY', 1);
|
|
SetControl(txtDietComment, 'COMMENT', 1);
|
|
end;
|
|
DietCheckForNPO;
|
|
DietCheckForTF;
|
|
Changing := False; // Changing reset
|
|
DietChange(Self);
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboDietAvailNeedData(Sender: TObject; const StartFrom: string;
|
|
Direction, InsertAt: Integer);
|
|
begin
|
|
inherited;
|
|
cboDietAvail.ForDataUse(SubSetOfDiets(StartFrom, Direction));
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboDietAvailMouseClick(Sender: TObject);
|
|
var
|
|
NewDiet, ErrMsg: string;
|
|
DupDiet: Boolean;
|
|
i: Integer;
|
|
|
|
procedure SetError(const AnError: string);
|
|
begin
|
|
if Length(ErrMsg) > 0 then Exit;
|
|
ErrMsg := AnError;
|
|
end;
|
|
|
|
begin
|
|
inherited;
|
|
if CharAt(cboDietAvail.ItemID, 1) = 'Q' then // setup quick order
|
|
begin
|
|
Responses.QuickOrder := ExtractInteger(cboDietAvail.ItemID);
|
|
SetValuesFromResponsesDO;
|
|
cboDietAvail.ItemIndex := -1;
|
|
Exit;
|
|
end;
|
|
if cboDietAvail.ItemIEN > 0 then with lstDietSelect do
|
|
begin
|
|
ErrMsg := '';
|
|
if Items.Count > 0 then // disallow other diets with Regular & NPO
|
|
begin
|
|
if cboDietAvail.ItemIEN = uDietParams.RegIEN then SetError(TX_DIET_REG);
|
|
if GetIEN(0) = uDietParams.RegIEN then SetError(TX_DIET_REG);
|
|
if cboDietAvail.ItemIEN = uDietParams.NPOIEN then SetError(TX_DIET_NPO);
|
|
if GetIEN(0) = uDietParams.NPOIEN then SetError(TX_DIET_NPO);
|
|
end;
|
|
if Items.Count = 5 then SetError(TX_DIET_LIM); // maximum of 5 diet modifications
|
|
DupDiet := False;
|
|
for i := 0 to Items.Count - 1 do if cboDietAvail.ItemIEN = GetIEN(i) then DupDiet := True;
|
|
if DupDiet then SetError(TX_DIET_DUP); // each diet mod must be unique
|
|
NewDiet := DietAttributes(cboDietAvail.ItemIEN);
|
|
if Piece(NewDiet,'^',1)='0' then
|
|
begin
|
|
InfoBox(Piece(NewDiet,'^',2),TC_DIET_ERR, MB_OK);
|
|
cboDietAvail.ItemIndex := -1;
|
|
Exit;
|
|
end;
|
|
for i := 0 to Items.Count - 1 do // check to make sure unique precedence
|
|
if Piece(Items[i], U, 4) = Piece(NewDiet, U, 4)
|
|
then SetError(TX_DIET_PRC + Piece(Items[i], U, 2));
|
|
if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TC_DIET_ERR, MB_OK) else
|
|
begin
|
|
lstDietSelect.Items.Add(NewDiet);
|
|
DietCheckForNPO;
|
|
DietCheckForTF;
|
|
OrderMessage(OIMessage(StrToIntDef(Piece(NewDiet, U, 1), 0)));
|
|
DietChange(Sender);
|
|
end; {else of if Length}
|
|
end; {if cboDietAvail}
|
|
cboDietAvail.ItemIndex := -1;
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboDietAvailExit(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if (cboDietAvail.ItemIEN > 0) or (CharAt(cboDietAvail.ItemID, 1) = 'Q') then
|
|
cboDietAvailMouseClick(Self);
|
|
end;
|
|
|
|
procedure TfrmODDiet.cmdRemoveClick(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
with lstDietSelect do if ItemIndex > -1 then Items.Delete(ItemIndex);
|
|
DietChange(Sender);
|
|
with lstDietSelect do if Items.Count = 0 then
|
|
begin
|
|
chkCancelTubefeeding.State := cbGrayed;
|
|
chkCancelTubefeeding.Visible := False;
|
|
lblDelivery.Visible := True;
|
|
cboDelivery.Visible := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.DietChange(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited;
|
|
if Changing then Exit;
|
|
if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
|
|
with calDietStart do {if Length(Text) > 0 then} Responses.Update('START', 1, Text, Text);
|
|
with calDietStop do {if Length(Text) > 0 then} Responses.Update('STOP', 1, Text, Text);
|
|
with lstDietSelect do for i := 0 to Items.Count - 1 do
|
|
Responses.Update('ORDERABLE', i+1, Piece(Items[i], U, 1), Piece(Items[i], U, 2));
|
|
with txtDietComment do {if Length(Text) > 0 then} Responses.Update('COMMENT', 1, Text, Text);
|
|
with cboDelivery do if Visible then Responses.Update('DELIVERY', 1, ItemID, Text);
|
|
with chkCancelTubefeeding do case State of
|
|
cbChecked: Responses.Update('CANCEL', 1, '1', 'YES');
|
|
cbUnchecked: Responses.Update('CANCEL', 1, '0', 'NO');
|
|
end;
|
|
with lstDietSelect do if (Items.Count = 1) and (GetIEN(0) = uDietParams.NPOIEN) then
|
|
begin
|
|
if Frac(calDietStart.FMDateTime) > 0.2358 then Responses.VarTrailing := 'at Midnight';
|
|
end
|
|
else Responses.VarTrailing := 'Diet';
|
|
memOrder.Text := Responses.OrderText;
|
|
end;
|
|
|
|
{ Tubefeeding tab --------------------------------------------------------------------------- }
|
|
|
|
procedure TfrmODDiet.ResetControlsTF;
|
|
begin
|
|
TFClearGrid;
|
|
chkCancelTrays.Checked := False;
|
|
calOPTFStart.Text := '';
|
|
txtTFComment.Text := '';
|
|
end;
|
|
|
|
procedure TfrmODDiet.SetValuesFromResponsesTF;
|
|
var
|
|
AnInstance: Integer;
|
|
AResponse: TResponse;
|
|
AProduct: TTFProduct;
|
|
begin
|
|
Changing := True; // Changing set!!
|
|
ResetControlsTF;
|
|
with Responses do
|
|
begin
|
|
AnInstance := NextInstance('ORDERABLE', 0);
|
|
while AnInstance > 0 do
|
|
begin
|
|
AResponse := FindResponseByName('ORDERABLE', AnInstance);
|
|
if AResponse <> nil then
|
|
begin
|
|
AProduct := TTFProduct.Create;
|
|
AProduct.IEN := StrToIntDef(AResponse.IValue, 0);
|
|
AProduct.Name := AResponse.EValue;
|
|
with grdSelected do
|
|
begin
|
|
if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
|
|
Objects[0, RowCount - 1] := AProduct;
|
|
Cells[0, RowCount - 1] := AProduct.Name;
|
|
AResponse := FindResponseByName('STRENGTH', AnInstance);
|
|
if AResponse <> nil then Cells[1, RowCount - 1] := AResponse.EValue;
|
|
AResponse := FindResponseByName('INSTR', AnInstance);
|
|
if AResponse <> nil then Cells[2, RowCount - 1] := AResponse.EValue;
|
|
TFSetAmountForRow(RowCount - 1);
|
|
end;
|
|
end;
|
|
AnInstance := NextInstance('ORDERABLE', AnInstance);
|
|
end; {while AnInstance - ORDERABLE}
|
|
AResponse := FindResponseByName('CANCEL', 1);
|
|
if AResponse <> nil then chkCancelTrays.Checked := AResponse.IValue = '1';
|
|
if not OrderForInpatient then
|
|
begin
|
|
SetControl(cboOPTFRecurringMeals, 'DATETIME', 1);
|
|
SetControl(calOPTFStart, 'DATETIME', 1);
|
|
end;
|
|
SetControl(txtTFComment, 'COMMENT', 1);
|
|
end;
|
|
Changing := False; // Changing reset
|
|
TFChange(Self);
|
|
end;
|
|
|
|
procedure TfrmODDiet.TFClearGrid;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with grdSelected do for i := 0 to RowCount - 1 do
|
|
begin
|
|
TTFProduct(Objects[0, i]).Free;
|
|
Rows[i].Clear;
|
|
end;
|
|
grdSelected.RowCount := 1;
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboProductMouseClick(Sender: TObject);
|
|
var
|
|
AProduct: TTFProduct;
|
|
begin
|
|
inherited;
|
|
// check quick order
|
|
if CharAt(cboProduct.ItemID, 1) = 'Q' then // setup quick order
|
|
begin
|
|
Responses.QuickOrder := ExtractInteger(cboProduct.ItemID);
|
|
SetValuesFromResponsesTF;
|
|
cboProduct.ItemIndex := -1;
|
|
Exit;
|
|
end;
|
|
if cboProduct.ItemIEN <= 0 then Exit;
|
|
AProduct := TTFProduct.Create;
|
|
AProduct.IEN := cboProduct.ItemIEN;
|
|
AProduct.Name := Piece(cboProduct.Items[cboProduct.ItemIndex], U, 3);
|
|
cboProduct.ItemIndex := -1;
|
|
with grdSelected do
|
|
begin
|
|
if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
|
|
Objects[0, RowCount - 1] := AProduct;
|
|
Cells[0, RowCount - 1] := AProduct.Name;
|
|
Cells[1, RowCount - 1] := 'FULL';
|
|
Row := RowCount - 1;
|
|
Col := 1;
|
|
end;
|
|
OrderMessage(OIMessage(AProduct.IEN));
|
|
TFChange(Sender);
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboProductExit(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if (cboProduct.ItemIEN > 0) or (CharAt(cboProduct.ItemID, 1) = 'Q') then
|
|
cboProductMouseClick(Self);
|
|
end;
|
|
|
|
procedure TfrmODDiet.grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
|
|
State: TGridDrawState);
|
|
begin
|
|
inherited;
|
|
if Sender = ActiveControl then Exit;
|
|
if not (gdSelected in State) then Exit;
|
|
with Sender as TStringGrid do
|
|
begin
|
|
Canvas.Brush.Color := Color;
|
|
Canvas.Font := Font;
|
|
Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.grdSelectedSelectCell(Sender: TObject; Col, Row: Integer;
|
|
var CanSelect: Boolean);
|
|
|
|
procedure PlaceControl(AControl: TWinControl);
|
|
var
|
|
ARect: TRect;
|
|
begin
|
|
with AControl do
|
|
begin
|
|
ARect := grdSelected.CellRect(Col, Row);
|
|
SetBounds(ARect.Left + grdSelected.Left + 1, ARect.Top + grdSelected.Top + 1,
|
|
ARect.Right - ARect.Left + 1, ARect.Bottom - ARect.Top + 1);
|
|
BringToFront;
|
|
Show;
|
|
SetFocus;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited;
|
|
if (Col <> 1) and (Col <> 2) then Exit;
|
|
if csDestroying in ComponentState then Exit;
|
|
if Col = 1 then
|
|
begin
|
|
cboStrength.ItemIndex :=cboStrength.Items.IndexOf(grdSelected.Cells[Col, Row]);
|
|
cboStrength.Tag := (Col * 256) + Row;
|
|
PlaceControl(cboStrength);
|
|
end;
|
|
if Col = 2 then
|
|
begin
|
|
txtQuantity.Text := grdSelected.Cells[Col, Row];
|
|
txtQuantity.Tag := (Col * 256) + Row;
|
|
PlaceControl(txtQuantity);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.SetNextCell(ACol, ARow: Integer);
|
|
begin
|
|
FNextCol := ACol;
|
|
FNextRow := ARow;
|
|
end;
|
|
|
|
procedure TfrmODDiet.TFMoveToNextCell;
|
|
var
|
|
NextCol, NextRow: Integer;
|
|
begin
|
|
if (FNextCol < 0) or (FNextRow < 0) then Exit;
|
|
if (ActiveControl = grdSelected) and not (csLButtonDown in grdSelected.ControlState) then
|
|
begin
|
|
NextCol := FNextCol;
|
|
NextRow := FNextRow;
|
|
with grdSelected do if NextCol <> Col then Col := NextCol;
|
|
with grdSelected do if NextRow <> Row then Row := NextRow;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.TFSetAmountForRow(ARow: Integer);
|
|
var
|
|
Product, Strength: Integer;
|
|
x: string;
|
|
begin
|
|
with grdSelected do
|
|
begin
|
|
if Objects[0, ARow] <> nil
|
|
then Product := TTFProduct(Objects[0, ARow]).IEN
|
|
else Product := 0;
|
|
Strength := TFStrengthCode(Cells[1, ARow]);
|
|
x := ExpandedQuantity(Product, Strength, Cells[2, ARow]);
|
|
if Length(x) > 0 then
|
|
begin
|
|
grdSelected.Cells[2, ARow] := Piece(x, U, 2);
|
|
grdSelected.Cells[3, ARow] := Piece(x, U, 1) + 'ml';
|
|
end
|
|
else grdSelected.Cells[3, ARow] := '';
|
|
end;
|
|
end;
|
|
|
|
function TfrmODDiet.TFStrengthCode(const x: string): Integer;
|
|
begin
|
|
Result := 0;
|
|
if x = '1/4' then Result := 1
|
|
else if x = '1/2' then Result := 2
|
|
else if x = '3/4' then Result := 3
|
|
else if x = 'FULL' then Result := 4;
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboStrengthEnter(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
SetNextCell(2, grdSelected.Row);
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboStrengthKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited;
|
|
with grdSelected do
|
|
case Key of
|
|
VK_LEFT: SetNextCell(0, Row);
|
|
VK_RIGHT: SetNextCell(2, Row);
|
|
end;
|
|
if Key in [VK_LEFT, VK_RIGHT] then
|
|
begin
|
|
Key := 0;
|
|
if not (csDestroying in ComponentState) then grdSelected.SetFocus;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboStrengthChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
with cboStrength do
|
|
begin
|
|
if Tag < 0 then Exit;
|
|
grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
|
|
end;
|
|
TFChange(Sender);
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboStrengthExit(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
with cboStrength do
|
|
begin
|
|
grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
|
|
TFSetAmountForRow(Tag mod 256);
|
|
Tag := -1;
|
|
Hide;
|
|
end;
|
|
TFChange(Sender);
|
|
TFMoveToNextCell;
|
|
end;
|
|
|
|
procedure TfrmODDiet.txtQuantityEnter(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
SetNextCell(-1, -1);
|
|
end;
|
|
|
|
procedure TfrmODDiet.txtQuantityKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited;
|
|
with grdSelected, txtQuantity do
|
|
case Key of
|
|
VK_UP: SetNextCell(Col, HigherOf(Row - 1, 0));
|
|
VK_DOWN: SetNextCell(Col, LowerOf(Row + 1, RowCount - 1));
|
|
VK_LEFT: if (SelLength = 0) and (SelStart = 0) then SetNextCell(1, Row);
|
|
VK_RIGHT: if (SelLength = 0) and (SelStart = Length(Text)) then SetNextCell(3, Row);
|
|
VK_END: if (SelLength = 0) and (SelStart = Length(Text)) then SetNextCell(3, Row);
|
|
VK_HOME: if (SelLength = 0) and (SelStart = 0) then SetNextCell(0, Row);
|
|
VK_PRIOR: SetNextCell(Col, 0);
|
|
VK_NEXT: SetNextCell(Col, RowCount - 1);
|
|
end;
|
|
if FNextCol > -1 then
|
|
begin
|
|
Key := 0;
|
|
if not (csDestroying in ComponentState) then grdSelected.SetFocus;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.txtQuantityChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
with txtQuantity do
|
|
begin
|
|
if Tag < 0 then Exit;
|
|
grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
|
|
end;
|
|
TFChange(Sender);
|
|
end;
|
|
|
|
procedure TfrmODDiet.txtQuantityExit(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
with txtQuantity do
|
|
begin
|
|
grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
|
|
TFSetAmountForRow(Tag mod 256);
|
|
Tag := -1;
|
|
Hide;
|
|
end;
|
|
TFChange(Sender);
|
|
TFMoveToNextCell;
|
|
end;
|
|
|
|
procedure TfrmODDiet.cmdTFRemoveClick(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited;
|
|
with grdSelected do
|
|
begin
|
|
if Row < 0 then Exit;
|
|
if Objects[0, Row] <> nil then TTFProduct(Objects[0, Row]).Free;
|
|
for i := Row to RowCount - 2 do Rows[i] := Rows[i + 1];
|
|
Rows[RowCount - 1].Clear;
|
|
RowCount := RowCount - 1;
|
|
end;
|
|
TFChange(Sender);
|
|
end;
|
|
|
|
procedure TfrmODDiet.TFChange(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
AProduct: TTFProduct;
|
|
|
|
begin
|
|
inherited;
|
|
if Changing then Exit;
|
|
if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
|
|
with grdSelected do for i := 0 to RowCount - 1 do
|
|
begin
|
|
AProduct := TTFProduct(Objects[0, i]);
|
|
if AProduct = nil then Continue;
|
|
with AProduct do if IEN > 0
|
|
then Responses.Update('ORDERABLE', i+1, IntToStr(IEN), Name);
|
|
if TFStrengthCode(Cells[1,i]) > 0
|
|
then Responses.Update('STRENGTH', i+1, IntToStr(TFStrengthCode(Cells[1,i])), Cells[1,i]);
|
|
if Length(Cells[2,i]) > 0
|
|
then Responses.Update('INSTR', i+1, Cells[2,i], Cells[2,i]);
|
|
end; {with grdSelected}
|
|
with txtTFComment do if Text <> ''
|
|
then Responses.Update('COMMENT', 1, Text, Text);
|
|
with chkCancelTrays do if Checked
|
|
then Responses.Update('CANCEL', 1, '1', 'Yes')
|
|
else Responses.Update('CANCEL', 1, '0', 'No');
|
|
if not OrderForInpatient then
|
|
begin
|
|
calOPTFStart.FMDateTime := StrToFloatDef(cboOPTFRecurringMeals.ItemID, 0);
|
|
Responses.Update('DATETIME', 1, FloatToStr(calOPTFStart.FMDateTime), calOPTFStart.Text);
|
|
end;
|
|
memOrder.Text := Responses.OrderText;
|
|
end;
|
|
|
|
{ Early/Late Tray tab ----------------------------------------------------------------------- }
|
|
|
|
procedure TfrmODDiet.ResetControlsEL;
|
|
begin
|
|
grpMeal.ItemIndex := 3;
|
|
grpMeal.TabStop := True;
|
|
grpMealTime.TabStop := False;
|
|
radET1.Visible := False;
|
|
radET2.Visible := False;
|
|
radET3.Visible := False;
|
|
radLT1.Visible := False;
|
|
radLT2.Visible := False;
|
|
radLT3.Visible := False;
|
|
lblNoTimes.Visible := False;
|
|
calELStart.Text := '';
|
|
calELStop.Text := '';
|
|
chkMonday.Checked := False;
|
|
chkTuesday.Checked := False;
|
|
chkWednesday.Checked := False;
|
|
chkThursday.Checked := False;
|
|
chkFriday.Checked := False;
|
|
chkSaturday.Checked := False;
|
|
chkSunday.Checked := False;
|
|
chkBagged.Checked := False;
|
|
end;
|
|
|
|
procedure TfrmODDiet.SetValuesFromResponsesEL;
|
|
var
|
|
AResponse: TResponse;
|
|
begin
|
|
Changing := True;
|
|
ResetControlsEL;
|
|
with Responses do
|
|
begin
|
|
AResponse := FindResponseByName('MEAL', 1);
|
|
if AResponse <> nil then
|
|
begin
|
|
if AResponse.IValue = 'B' then grpMeal.ItemIndex := 0;
|
|
if AResponse.IValue = 'N' then grpMeal.ItemIndex := 1;
|
|
if AResponse.IValue = 'E' then grpMeal.ItemIndex := 2;
|
|
end;
|
|
if grpMeal.ItemIndex <> 3 then grpMealClick(Self);
|
|
AResponse := FindResponseByName('TIME', 1);
|
|
if AResponse <> nil then
|
|
begin
|
|
if radET1.Caption = AResponse.IValue then radET1.Checked := True;
|
|
if radET2.Caption = AResponse.IValue then radET2.Checked := True;
|
|
if radET3.Caption = AResponse.IValue then radET3.Checked := True;
|
|
if radLT1.Caption = AResponse.IValue then radLT1.Checked := True;
|
|
if radLT2.Caption = AResponse.IValue then radLT2.Checked := True;
|
|
if radLT3.Caption = AResponse.IValue then radLT3.Checked := True;
|
|
end;
|
|
if not OrderForInpatient then
|
|
SetControl(cboOPELRecurringMeals, 'START', 1)
|
|
else
|
|
begin
|
|
SetControl(calELStart, 'START', 1);
|
|
SetControl(calELStop, 'STOP', 1);
|
|
end;
|
|
calELStopChange(Self);
|
|
AResponse := FindResponseByName('SCHEDULE', 1);
|
|
if AResponse <> nil then
|
|
begin
|
|
chkMonday.Checked := Pos('M', AResponse.IValue) > 0;
|
|
chkTuesday.Checked := Pos('T', AResponse.IValue) > 0;
|
|
chkWednesday.Checked := Pos('W', AResponse.IValue) > 0;
|
|
chkThursday.Checked := Pos('R', AResponse.IValue) > 0;
|
|
chkFriday.Checked := Pos('F', AResponse.IValue) > 0;
|
|
chkSaturday.Checked := Pos('S', AResponse.IValue) > 0;
|
|
chkSunday.Checked := Pos('X', AResponse.IValue) > 0;
|
|
end;
|
|
AResponse := FindResponseByName('YN', 1);
|
|
if AResponse <> nil then chkBagged.Checked := AResponse.IValue = '1';
|
|
end; {with Responses}
|
|
Changing := False;
|
|
ELChange(Self);
|
|
end;
|
|
|
|
function TfrmODDiet.GetMealTime: string;
|
|
begin
|
|
Result := '';
|
|
if radET1.Checked then Result := radET1.Caption;
|
|
if radET2.Checked then Result := radET2.Caption;
|
|
if radET3.Checked then Result := radET3.Caption;
|
|
if radLT1.Checked then Result := radLT1.Caption;
|
|
if radLT2.Checked then Result := radLT2.Caption;
|
|
if radLT3.Checked then Result := radLT3.Caption;
|
|
end;
|
|
|
|
function TfrmODDiet.GetDaysOfWeek: string;
|
|
begin
|
|
Result := '';
|
|
if chkMonday.Checked then Result := Result + 'M';
|
|
if chkTuesday.Checked then Result := Result + 'T';
|
|
if chkWednesday.Checked then Result := Result + 'W';
|
|
if chkThursday.Checked then Result := Result + 'R';
|
|
if chkFriday.Checked then Result := Result + 'F';
|
|
if chkSaturday.Checked then Result := Result + 'S';
|
|
if chkSunday.Checked then Result := Result + 'X';
|
|
end;
|
|
|
|
function TfrmODDiet.IsEarlyTray: Boolean;
|
|
begin
|
|
Result := True;
|
|
if radLT1.Checked then Result := False;
|
|
if radLT2.Checked then Result := False;
|
|
if radLT3.Checked then Result := False;
|
|
end;
|
|
|
|
procedure TfrmODDiet.grpMealClick(Sender: TObject);
|
|
|
|
procedure SetMealTimes(const x: string);
|
|
|
|
procedure ActivateButton( Button: TRadioButton; const MealTime: string;
|
|
var MoreActivated: boolean);
|
|
var
|
|
Activate: boolean;
|
|
begin
|
|
Button.Caption := MealTime;
|
|
Activate := Length(MealTime) > 0;
|
|
Button.Visible := Activate;
|
|
Button.Checked := Activate and not MoreActivated;
|
|
MoreActivated := MoreActivated or Activate;
|
|
end;
|
|
|
|
var
|
|
HasTimes: Boolean;
|
|
begin
|
|
HasTimes := False;
|
|
ActivateButton(radET1, Piece(x, U, 1), HasTimes);
|
|
ActivateButton(radET2, Piece(x, U, 2), HasTimes);
|
|
ActivateButton(radET3, Piece(x, U, 3), HasTimes);
|
|
ActivateButton(radLT1, Piece(x, U, 4), HasTimes);
|
|
ActivateButton(radLT2, Piece(x, U, 5), HasTimes);
|
|
ActivateButton(radLT3, Piece(x, U, 6), HasTimes);
|
|
lblNoTimes.Visible := not HasTimes;
|
|
end;
|
|
var
|
|
AMeal: string;
|
|
begin
|
|
inherited;
|
|
Changing := True;
|
|
case grpMeal.ItemIndex of
|
|
0: begin
|
|
SetMealTimes(uDietParams.BTimes);
|
|
AMeal := 'B';
|
|
end;
|
|
1: begin
|
|
SetMealTimes(uDietParams.NTimes);
|
|
AMeal := 'N';
|
|
end;
|
|
2: begin
|
|
SetMealTimes(uDietParams.ETimes);
|
|
AMeal := 'E';
|
|
end;
|
|
else
|
|
begin
|
|
SetMealTimes('');
|
|
AMeal := '';
|
|
end;
|
|
end;
|
|
if not OrderForInpatient then
|
|
begin
|
|
if AMeal = '' then
|
|
begin
|
|
uRecurringMealList.Clear;
|
|
cboOPELRecurringMeals.Clear;
|
|
end
|
|
else if not PatientHasRecurringMeals(uRecurringMealList, AMeal) then
|
|
begin
|
|
uRecurringMealList.Clear;
|
|
cboOPELRecurringMeals.Clear;
|
|
grpMeal.ItemIndex := 3;
|
|
end
|
|
else
|
|
cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
|
|
end;
|
|
Changing := False;
|
|
ELChange(grpMeal);
|
|
end;
|
|
|
|
|
|
procedure TfrmODDiet.SetEnableDOW(AllowUse: Boolean);
|
|
begin
|
|
grpDOW.Enabled := AllowUse;
|
|
chkMonday.Enabled := AllowUse;
|
|
chkTuesday.Enabled := AllowUse;
|
|
chkWednesday.Enabled := AllowUse;
|
|
chkThursday.Enabled := AllowUse;
|
|
chkFriday.Enabled := AllowUse;
|
|
chkSaturday.Enabled := AllowUse;
|
|
chkSunday.Enabled := AllowUse;
|
|
end;
|
|
|
|
procedure TfrmODDiet.calELStartEnter(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
FChangeStop := Length(calELStop.Text) = 0;
|
|
end;
|
|
|
|
procedure TfrmODDiet.calELStartChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if FChangeStop then
|
|
calELStop.Text := calELStart.Text
|
|
else
|
|
ELChange(Sender);
|
|
end;
|
|
|
|
procedure TfrmODDiet.calELStartExit(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if not OrderForInpatient then SetEnableDOW(False)
|
|
else if (Length(calELStop.Text) > 0) and (calELStop.Text = calELStart.Text)
|
|
then SetEnableDOW(False)
|
|
else SetEnableDOW(True);
|
|
end;
|
|
|
|
procedure TfrmODDiet.calELStopChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if (Length(calELStop.Text) > 0) and (calELStop.FMDateTime = calELStart.FMDateTime)
|
|
then SetEnableDOW(False)
|
|
else SetEnableDOW(True);
|
|
ELChange(Sender);
|
|
end;
|
|
|
|
procedure TfrmODDiet.ELChange(Sender: TObject);
|
|
var
|
|
x: string;
|
|
begin
|
|
inherited;
|
|
if Changing then Exit;
|
|
if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
|
|
case grpMeal.ItemIndex of
|
|
0: Responses.Update('MEAL', 1, 'B', 'BREAKFAST');
|
|
1: Responses.Update('MEAL', 1, 'N', 'NOON');
|
|
2: Responses.Update('MEAL', 1, 'E', 'EVENING');
|
|
end;
|
|
x := GetMealTime;
|
|
if Length(x) > 0 then
|
|
begin
|
|
Responses.Update('TIME', 1, x, x);
|
|
if IsEarlyTray
|
|
then Responses.Update('ORDERABLE', 1, uDietParams.EarlyIEN, 'EARLY TRAY')
|
|
else Responses.Update('ORDERABLE', 1, uDietParams.LateIEN, 'LATE TRAY');
|
|
end;
|
|
if not OrderForInpatient then
|
|
begin
|
|
calELStart.FMDateTime := StrToFloatDef(cboOPELRecurringMeals.ItemID, 0);
|
|
calELStop.FMDateTime := calELStart.FMDateTime;
|
|
end;
|
|
with calELStart do if Length(Text) > 0 then Responses.Update('START', 1, Text, Text);
|
|
with calELStop do if Length(Text) > 0 then Responses.Update('STOP', 1, Text, Text);
|
|
x := GetDaysOfWeek;
|
|
if Length(x) > 0 then Responses.Update('SCHEDULE', 1, x, x);
|
|
if chkBagged.Checked
|
|
then Responses.Update('YN', 1, '1', 'YES')
|
|
else Responses.Update('YN', 1, '0', 'NO');
|
|
memOrder.Text := Responses.OrderText;
|
|
end;
|
|
|
|
{ Isolation Precautions tab ----------------------------------------------------------------- }
|
|
|
|
procedure TfrmODDiet.ResetControlsIP;
|
|
begin
|
|
lstIsolation.ItemIndex := -1;
|
|
txtIPComment.Text := '';
|
|
end;
|
|
|
|
procedure TfrmODDiet.SetValuesFromResponsesIP;
|
|
begin
|
|
Changing := True;
|
|
ResetControlsIP;
|
|
Responses.SetControl(lstIsolation, 'ISOLATION', 1);
|
|
Responses.SetControl(txtIPComment, 'COMMENT', 1);
|
|
Changing := False;
|
|
IPChange(Self);
|
|
end;
|
|
|
|
procedure TfrmODDiet.IPChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if Changing then Exit;
|
|
if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
|
|
Responses.Update('ORDERABLE', 1, FIsolationID, 'Isolation Procedures');
|
|
with lstIsolation do if ItemIEN > 0
|
|
then Responses.Update('ISOLATION', 1, ItemID, DisplayText[ItemIndex]);
|
|
with txtIPComment do if Text <> ''
|
|
then Responses.Update('COMMENT', 1, Text, Text);
|
|
memOrder.Text := Responses.OrderText;
|
|
end;
|
|
|
|
{ Additional Diet Order tab ----------------------------------------------------------------- }
|
|
|
|
procedure TfrmODDiet.ResetControlsAO;
|
|
begin
|
|
txtAOComment.Text := '';
|
|
calOPAOStart.Text := '';
|
|
end;
|
|
|
|
procedure TfrmODDiet.SetValuesFromResponsesAO;
|
|
begin
|
|
Changing := True;
|
|
ResetControlsAO;
|
|
Responses.SetControl(txtAOComment, 'COMMENT', 1);
|
|
//Responses.SetControl(calOPAOStart, 'DATETIME', 1);
|
|
Responses.SetControl(cboOPAORecurringMeals, 'DATETIME', 1);
|
|
Changing := False;
|
|
AOChange(Self);
|
|
end;
|
|
|
|
procedure TfrmODDiet.AOChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if Changing then Exit;
|
|
with txtAOComment do if Text <> ''
|
|
then Responses.Update('COMMENT', 1, Text, Text);
|
|
if not OrderForInpatient then
|
|
begin
|
|
calOPAOStart.FMDateTime := StrToFloatDef(cboOPAORecurringMeals.ItemID, 0);
|
|
Responses.Update('DATETIME', 1, FloatToStr(calOPAOStart.FMDateTime), calOPAOStart.Text);
|
|
end;
|
|
memOrder.Text := Responses.OrderText;
|
|
end;
|
|
|
|
|
|
{ Outpatient Meals Order tab ----------------------------------------------------------------- }
|
|
|
|
procedure TfrmODDiet.cboOPDietAvailMouseClick(Sender: TObject);
|
|
var
|
|
NewDiet,ErrMsg: string;
|
|
|
|
procedure SetError(const AnError: string);
|
|
begin
|
|
if Length(ErrMsg) > 0 then Exit;
|
|
ErrMsg := AnError;
|
|
end;
|
|
|
|
begin
|
|
inherited;
|
|
if cboOPDietAvail.Items.Count = 0 then
|
|
begin
|
|
InfoBox(TX_NO_MEALS_DEFINED, TC_NO_MEALS_DEFINED, MB_OK or MB_ICONINFORMATION);
|
|
AbortOrder := True;
|
|
exit;
|
|
end ;
|
|
if CharAt(cboOPDietAvail.ItemID, 1) = 'Q' then // setup quick order
|
|
begin
|
|
Responses.QuickOrder := ExtractInteger(cboOPDietAvail.ItemID);
|
|
SetValuesFromResponsesOP;
|
|
cboOPDietAvail.ItemIndex := -1;
|
|
Exit;
|
|
end;
|
|
if cboOPDietAvail.ItemIEN > 0 then with lstOPDietSelect do
|
|
begin
|
|
ErrMsg := '';
|
|
NewDiet := DietAttributes(cboOPDietAvail.ItemIEN);
|
|
if Piece(NewDiet,'^',1)='0' then
|
|
begin
|
|
InfoBox(Piece(NewDiet,'^',2),TC_OP_DIET_ERR, MB_OK);
|
|
cboOPDietAvail.ItemIndex := -1;
|
|
Exit;
|
|
end;
|
|
lstOPDietSelect.Items.Clear;
|
|
lstOPDietSelect.Items.Add(NewDiet);
|
|
{ TODO -oRich V. -cOutpatient Meals : Will these be selectable for an outpatient meal? }
|
|
OPDietCheckForNPO;
|
|
{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
|
|
OPDietCheckForTF;
|
|
OrderMessage(OIMessage(StrToIntDef(Piece(NewDiet, U, 1), 0)));
|
|
OPChange(Sender);
|
|
end; {if cboOPDietAvail}
|
|
OPChange(Sender);
|
|
cboOPDietAvail.ItemIndex := -1;
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboOPDietAvailExit(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if (cboOPDietAvail.ItemIEN > 0) or (CharAt(cboOPDietAvail.ItemID, 1) = 'Q') then
|
|
cboOPDietAvailMouseClick(Self);
|
|
end;
|
|
|
|
procedure TfrmODDiet.ResetControlsOP;
|
|
begin
|
|
lstOPDietSelect.Clear;
|
|
cboOPDietAvail.ItemIndex := -1;
|
|
grpOPMeal.ItemIndex := 3;
|
|
grpOPMeal.TabStop := True;
|
|
chkOPMonday.Checked := False;
|
|
chkOPTuesday.Checked := False;
|
|
chkOPWednesday.Checked := False;
|
|
chkOPThursday.Checked := False;
|
|
chkOPFriday.Checked := False;
|
|
chkOPSaturday.Checked := False;
|
|
chkOPSunday.Checked := False;
|
|
lblOPComment.Visible := False;
|
|
txtOPDietComment.Visible := False;
|
|
txtOPDietComment.Text := '';
|
|
if uDialogName = 'FHW OP MEAL' then
|
|
begin
|
|
calOPStart.Text := '';
|
|
calOPStop.Text := '';
|
|
calOPStart.Enabled := True;
|
|
calOPStop.Enabled := True;
|
|
lblOPStart.Enabled := True;
|
|
lblOPStop.Enabled := True;
|
|
grpOPDOW.Visible := True;
|
|
end
|
|
else if uDialogName = 'FHW SPECIAL MEAL' then
|
|
begin
|
|
calOPStart.Text := 'TODAY';
|
|
calOPStop.Text := 'TODAY';
|
|
calOPStart.Enabled := False;
|
|
calOPStop.Enabled := False;
|
|
lblOPStart.Enabled := False;
|
|
lblOPStop.Enabled := False;
|
|
grpOPDOW.Visible := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.SetValuesFromResponsesOP;
|
|
var
|
|
AResponse: TResponse;
|
|
ADiet: string;
|
|
begin
|
|
Changing := True;
|
|
ResetControlsOP;
|
|
with Responses do
|
|
begin
|
|
AResponse := FindResponseByName('ORDERABLE', 1);
|
|
if AResponse <> nil then
|
|
begin
|
|
ADiet := DietAttributes(StrToIntDef(AResponse.IValue,0));
|
|
if Piece(ADiet,'^',1)='0' then
|
|
begin
|
|
InfoBox(Piece(ADiet,'^',2), TC_OP_DIET_ERR, MB_OK);
|
|
cboOPDietAvail.ItemIndex := -1;
|
|
Changing := False;
|
|
Exit;
|
|
end;
|
|
SetControl(cboOPDietAvail, 'ORDERABLE', 1);
|
|
lstOPDietSelect.Items.Add(ADiet);
|
|
end;
|
|
SetControl(cboOPDelivery, 'DELIVERY', 1);
|
|
AResponse := FindResponseByName('MEAL', 1);
|
|
if AResponse <> nil then
|
|
begin
|
|
if AResponse.IValue = 'B' then grpOPMeal.ItemIndex := 0;
|
|
if AResponse.IValue = 'N' then grpOPMeal.ItemIndex := 1;
|
|
if AResponse.IValue = 'E' then grpOPMeal.ItemIndex := 2;
|
|
end;
|
|
SetControl(calOPStart, 'START', 1);
|
|
SetControl(calOPStop, 'STOP', 1);
|
|
calOPStopChange(Self);
|
|
AResponse := FindResponseByName('SCHEDULE', 1);
|
|
if AResponse <> nil then
|
|
begin
|
|
chkOPMonday.Checked := Pos('M', AResponse.IValue) > 0;
|
|
chkOPTuesday.Checked := Pos('T', AResponse.IValue) > 0;
|
|
chkOPWednesday.Checked := Pos('W', AResponse.IValue) > 0;
|
|
chkOPThursday.Checked := Pos('R', AResponse.IValue) > 0;
|
|
chkOPFriday.Checked := Pos('F', AResponse.IValue) > 0;
|
|
chkOPSaturday.Checked := Pos('S', AResponse.IValue) > 0;
|
|
chkOPSunday.Checked := Pos('X', AResponse.IValue) > 0;
|
|
end;
|
|
SetControl(txtOPDietComment, 'COMMENT', 1);
|
|
end; {with Responses}
|
|
OPDietCheckForNPO;
|
|
OPDietCheckForTF;
|
|
Changing := False;
|
|
OPChange(Self);
|
|
end;
|
|
|
|
procedure TfrmODDiet.calOPStartEnter(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
FChangeStop := Length(calOPStop.Text) = 0;
|
|
end;
|
|
|
|
procedure TfrmODDiet.calOPStartChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if Changing then exit;
|
|
if FChangeStop then
|
|
calOPStop.Text := calOPStart.Text
|
|
else
|
|
OPChange(Sender);
|
|
end;
|
|
|
|
function TfrmODDiet.FMDOW(AnFMDate: TFMDateTime): integer;
|
|
var
|
|
WinDate: TDateTime;
|
|
x: integer;
|
|
begin
|
|
WinDate := FMDateTimeToDateTime(AnFMDate);
|
|
x := DayOfTheWeek(WinDate);
|
|
Result := x;
|
|
end;
|
|
|
|
function TfrmODDiet.FMDays(AStart, AEnd: TFMDateTime): string;
|
|
var
|
|
AWinStart, AWinEnd: TDateTime;
|
|
i: double;
|
|
Days: string;
|
|
begin
|
|
AWinStart := FMDateTimeToDateTime(AStart);
|
|
AWinEnd := FMDateTimeToDateTime(AEnd);
|
|
i := AWinStart;
|
|
repeat
|
|
Days := Days + FMDayLetters[DayOfTheWeek(i)];
|
|
i := i + 1;
|
|
until i > AWinEnd;
|
|
Result := Days;
|
|
end;
|
|
|
|
procedure TfrmODDiet.calOPStartExit(Sender: TObject);
|
|
var
|
|
Days: string;
|
|
begin
|
|
inherited;
|
|
if not (calOPStart.FMDateTime > 0) then
|
|
begin
|
|
SetEnableOPDOW(False, -1);
|
|
Exit ;
|
|
end;
|
|
if (Length(calOPStop.Text) > 0) and (calOPStop.Text = calOPStart.Text) then
|
|
SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
|
|
else
|
|
begin
|
|
Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
|
|
SetEnableOPDOW(True, -1, Days);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.calOPStopChange(Sender: TObject);
|
|
var
|
|
Days: string;
|
|
begin
|
|
inherited;
|
|
if Changing then exit;
|
|
if not (calOPStop.FMDateTime > 0) then
|
|
begin
|
|
SetEnableOPDOW(False, -1);
|
|
Exit ;
|
|
end;
|
|
if (Length(calOPStop.Text) > 0) and (calOPStop.FMDateTime = calOPStart.FMDateTime) then
|
|
SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
|
|
else
|
|
begin
|
|
Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
|
|
SetEnableOPDOW(True, -1, Days);
|
|
end;
|
|
OPChange(Sender);
|
|
end;
|
|
|
|
procedure TfrmODDiet.OPChange(Sender: TObject);
|
|
var
|
|
x: string;
|
|
//i: integer;
|
|
begin
|
|
inherited;
|
|
if Changing then Exit;
|
|
if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
|
|
// Per NFS, only one selection allowed from any of 10-15 available OP diets
|
|
with lstOPDietSelect do if Items.Count > 0 then
|
|
Responses.Update('ORDERABLE', 1, Piece(Items[0], U, 1), Piece(Items[0], U, 2));
|
|
case grpOPMeal.ItemIndex of
|
|
0: Responses.Update('MEAL', 1, 'B', 'BREAKFAST');
|
|
1: Responses.Update('MEAL', 1, 'N', 'NOON');
|
|
2: Responses.Update('MEAL', 1, 'E', 'EVENING');
|
|
end;
|
|
with calOPStart do (*if Length(Text) > 0 then*) Responses.Update('START', 1, Text, Text);
|
|
with calOPStop do (*if Length(Text) > 0 then*) Responses.Update('STOP', 1, Text, Text);
|
|
if uDialogName = 'FHW OP MEAL' then
|
|
begin
|
|
x := GetOPDaysOfWeek;
|
|
if Length(x) = 0 then x := 'ONCE';
|
|
Responses.Update('SCHEDULE', 1, x, x);
|
|
end;
|
|
with txtOPDietComment do {if Length(Text) > 0 then} Responses.Update('COMMENT', 1, Text, Text);
|
|
with cboOPDelivery do if Visible then Responses.Update('DELIVERY', 1, ItemID, Text);
|
|
{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
|
|
(* with chkOPCancelTubefeeding do case State of
|
|
cbChecked: Responses.Update('CANCEL', 1, '1', 'YES');
|
|
cbUnchecked: Responses.Update('CANCEL', 1, '0', 'NO');
|
|
end;*)
|
|
Responses.VarTrailing := 'Meal';
|
|
memOrder.Text := Responses.OrderText;
|
|
end;
|
|
|
|
procedure TfrmODDiet.grpOPMealClick(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
OPChange(Sender);
|
|
end;
|
|
|
|
procedure TfrmODDiet.SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
|
|
var
|
|
i: integer;
|
|
begin
|
|
if (not AllowUse) and (OneTimeDay > -1) then
|
|
begin
|
|
for i := 0 to grpOPDOW.ControlCount - 1 do
|
|
begin
|
|
if grpOPDOW.Controls[i] is TCheckBox then
|
|
TCheckBox(grpOPDOW.Controls[i]).Checked := False;
|
|
end;
|
|
//TCheckBox(grpOPDOW.Controls[OneTimeDay - 1]).Checked := True; CQ #8305
|
|
end;
|
|
grpOPDOW.Enabled := AllowUse;
|
|
chkOPMonday.Enabled := AllowUse and (Pos('M', DaysToCheck) > 0);
|
|
chkOPTuesday.Enabled := AllowUse and (Pos('T', DaysToCheck) > 0);
|
|
chkOPWednesday.Enabled := AllowUse and (Pos('W', DaysToCheck) > 0);
|
|
chkOPThursday.Enabled := AllowUse and (Pos('R', DaysToCheck) > 0);
|
|
chkOPFriday.Enabled := AllowUse and (Pos('F', DaysToCheck) > 0);
|
|
chkOPSaturday.Enabled := AllowUse and (Pos('S', DaysToCheck) > 0);
|
|
chkOPSunday.Enabled := AllowUse and (Pos('X', DaysToCheck) > 0);
|
|
end;
|
|
|
|
function TfrmODDiet.GetOPDaysOfWeek: string;
|
|
begin
|
|
Result := '';
|
|
if chkOPMonday.Checked then Result := Result + 'M';
|
|
if chkOPTuesday.Checked then Result := Result + 'T';
|
|
if chkOPWednesday.Checked then Result := Result + 'W';
|
|
if chkOPThursday.Checked then Result := Result + 'R';
|
|
if chkOPFriday.Checked then Result := Result + 'F';
|
|
if chkOPSaturday.Checked then Result := Result + 'S';
|
|
if chkOPSunday.Checked then Result := Result + 'X';
|
|
end;
|
|
|
|
procedure TfrmODDiet.cmdOPRemoveClick(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
with lstOPDietSelect do if ItemIndex > -1 then Items.Delete(ItemIndex);
|
|
OPChange(Sender);
|
|
with lstOPDietSelect do if Items.Count = 0 then
|
|
begin
|
|
lblOPDelivery.Visible := True;
|
|
cboOPDelivery.Visible := True;
|
|
{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
|
|
chkOPCancelTubefeeding.State := cbGrayed;
|
|
chkOPCancelTubefeeding.Visible := False;
|
|
end;
|
|
end;
|
|
|
|
function TfrmODDiet.GetOPMealWindow: string;
|
|
begin
|
|
case grpOPMeal.ItemIndex of
|
|
0: Result := Pieces(uDietParams.Alarms, U, 1, 2);
|
|
1: Result := Pieces(uDietParams.Alarms, U, 3, 4);
|
|
2: Result := Pieces(uDietParams.Alarms, U, 5, 6);
|
|
else
|
|
Result := U;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.OPDietCheckForNPO;
|
|
begin
|
|
{ TODO -oRich V. -cOutpatient Meals : Need NFS input on this section (NPO and special instructions.) }
|
|
if Piece(lstOPDietSelect.Items[0], U, 2) = 'NPO' then
|
|
begin
|
|
lblOPDelivery.Visible := False;
|
|
cboOPDelivery.Visible := False;
|
|
lblOPComment.Visible := True;
|
|
txtOPDietComment.Visible := True;
|
|
end else
|
|
begin
|
|
lblOPComment.Visible := False;
|
|
txtOPDietComment.Visible := False;
|
|
txtOPDietComment.Text := '';
|
|
end;
|
|
end;
|
|
|
|
{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
|
|
procedure TfrmODDiet.OPDietCheckForTF;
|
|
var
|
|
x: string;
|
|
begin
|
|
with lstOPDietSelect do
|
|
begin
|
|
if (Items.Count = 1) and (Piece(Items[0], U, 2) <> 'NPO')
|
|
and (Length(uDietParams.CurTF) > 0) then
|
|
begin
|
|
x := TextForOrder(uDietParams.CurTF);
|
|
if InfoBox(TX_CANCEL_TF + x, TC_CANCEL_TF, MB_YESNO) = IDYES then
|
|
begin
|
|
chkOPCancelTubeFeeding.State := cbChecked;
|
|
chkOPCancelTubeFeeding.Visible := True;
|
|
end
|
|
else chkOPCancelTubeFeeding.State := cbUnchecked;
|
|
end; {if (Items...}
|
|
end; {with lstOPDietSelect}
|
|
end;
|
|
|
|
{ Common Buttons ---------------------------------------------------------------------------- }
|
|
|
|
procedure TfrmODDiet.cmdAcceptClick(Sender: TObject);
|
|
var
|
|
DCOrder: TOrder;
|
|
AResponse, AnotherResponse: TResponse;
|
|
LateTrayFields: TLateTrayFields;
|
|
NewOrder: TOrder;
|
|
CanSign: Integer;
|
|
begin
|
|
// these actions should be before inherited, so that InitDialog doesn't clear properties
|
|
LateTrayFields.LateMeal := #0; // #0 so only create late order if LT dialog invoked
|
|
if nbkDiet.ActivePage = pgeDiet then
|
|
begin
|
|
// create dc tubefeeding order
|
|
if chkCancelTubeFeeding.State = cbChecked then
|
|
begin
|
|
DCOrder := TOrder.Create;
|
|
DCOrder.ID := uDietParams.CurTF;
|
|
SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_DC, Integer(DCOrder));
|
|
DCOrder.Free;
|
|
end;
|
|
// check if late tray should be ordered
|
|
AResponse := Responses.FindResponseByName('ORDERABLE', 1);
|
|
if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
|
|
begin
|
|
AResponse := Responses.FindResponseByName('START', 1);
|
|
if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False);
|
|
end;
|
|
end;
|
|
{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
|
|
if nbkDiet.ActivePage = pgeOutPt then
|
|
begin
|
|
// create dc tubefeeding order
|
|
if chkOPCancelTubeFeeding.State = cbChecked then
|
|
begin
|
|
DCOrder := TOrder.Create;
|
|
DCOrder.ID := uDietParams.CurTF;
|
|
SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_DC, Integer(DCOrder));
|
|
DCOrder.Free;
|
|
end;
|
|
// check if late tray should be ordered
|
|
AResponse := Responses.FindResponseByName('ORDERABLE', 1);
|
|
if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
|
|
begin
|
|
AResponse := Responses.FindResponseByName('START', 1);
|
|
AnotherResponse := Responses.FindResponseByName('MEAL', 1);
|
|
if (AResponse <> nil) and (AnotherResponse <> nil) then
|
|
CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1));
|
|
end;
|
|
end;
|
|
inherited;
|
|
with LateTrayFields do if LateMeal <> #0 then
|
|
begin
|
|
NewOrder := TOrder.Create;
|
|
OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged);
|
|
if NewOrder.ID <> '' then
|
|
begin
|
|
if OrderForInpatient then
|
|
begin
|
|
if (Encounter.Provider = User.DUZ) and User.CanSignOrders
|
|
then CanSign := CH_SIGN_YES
|
|
else CanSign := CH_SIGN_NA;
|
|
end
|
|
else
|
|
begin
|
|
CanSign := CH_SIGN_NA;
|
|
end;
|
|
Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
|
|
SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
|
|
end
|
|
else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK);
|
|
NewOrder.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
inherited;
|
|
if (Key = VK_TAB) then begin
|
|
if (ssCtrl in Shift) then begin
|
|
if not (ActiveControl is TCustomMemo) or not TMemo(ActiveControl).WantTabs then begin
|
|
nbkDiet.SelectNextPage( not (ssShift in Shift));
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODDiet.cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
inherited;
|
|
if Key = VK_RETURN then cboOPDietAvailMouseClick(Self);
|
|
end;
|
|
|
|
function TfrmODDiet.PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
|
|
const
|
|
TX_NO_RECURRING_MEALS = 'For outpatients, this type of order requires association with an existing recurring' + CRLF +
|
|
'meal order. There are currently no active recurring meal orders for this patient.' + CRLF + CRLF +
|
|
'Those orders must be signed and released before they can be linked to this item.';
|
|
TC_NO_RECURRING_MEALS = 'Unable to order ' ;
|
|
begin
|
|
MealList.Clear;
|
|
GetCurrentRecurringOPMeals(MealList, MealType);
|
|
if MealList.Count = 0 then
|
|
begin
|
|
InfoBox(TX_NO_RECURRING_MEALS, TC_NO_RECURRING_MEALS + nbkDiet.ActivePage.Caption, MB_OK);
|
|
Result := False;
|
|
end
|
|
else
|
|
Result := True;
|
|
end;
|
|
|
|
end.
|
|
|