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.