Context Navigation

fODDiet.pas@ 1115

Last change on this file since 1115 was 460, checked in by Kevin Toppenberg, 17 years ago
Uploading from OR_30_258
File size: 76.9 KB

Rev	Line
[459]	1	unit fODDiet;
	2	{$O-}
	3	interface
	4
	5	uses
	6	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	7	fODBase, ComCtrls, ExtCtrls, StdCtrls, Grids, ORCtrls, ORDtTm, ORFn, uConst;
	8
	9	type
	10	TfrmODDiet = class(TfrmODBase)
	11	nbkDiet: TPageControl;
	12	pgeDiet: TTabSheet;
	13	lblDietAvail: TLabel;
	14	lblDietSelect: TLabel;
	15	lblComment: TLabel;
	16	lblStart: TLabel;
	17	lblStop: TLabel;
	18	lblDelivery: TLabel;
	19	cboDietAvail: TORComboBox;
	20	lstDietSelect: TORListBox;
	21	cmdRemove: TButton;
	22	txtDietComment: TCaptionEdit;
	23	calDietStart: TORDateBox;
	24	calDietStop: TORDateBox;
	25	cboDelivery: TORComboBox;
	26	pgeTubefeeding: TTabSheet;
	27	lblTFProductList: TLabel;
	28	lblTFComment: TLabel;
	29	lblTFStrength: TLabel;
	30	lblTFQuantity: TLabel;
	31	lblTFProduct: TLabel;
	32	cboProduct: TORComboBox;
	33	txtTFComment: TCaptionEdit;
	34	grdSelected: TCaptionStringGrid;
	35	cmdTFRemove: TButton;
	36	pgeEarlyLate: TTabSheet;
	37	pgeIsolations: TTabSheet;
	38	pgeAdditional: TTabSheet;
	39	chkCancelTubefeeding: TCheckBox;
	40	chkCancelTrays: TCheckBox;
	41	txtQuantity: TCaptionEdit;
	42	cboStrength: TCaptionComboBox;
	43	lblTFAmount: TLabel;
	44	grpMeal: TKeyClickRadioGroup;
	45	grpMealTime: TGroupBox;
	46	lblELStart: TLabel;
	47	calELStart: TORDateBox;
	48	lblELStop: TLabel;
	49	calELStop: TORDateBox;
	50	grpDoW: TGroupBox;
	51	chkMonday: TCheckBox;
	52	chkTuesday: TCheckBox;
	53	chkWednesday: TCheckBox;
	54	chkThursday: TCheckBox;
	55	chkFriday: TCheckBox;
	56	chkSaturday: TCheckBox;
	57	chkSunday: TCheckBox;
	58	chkBagged: TCheckBox;
	59	radET1: TRadioButton;
	60	radET2: TRadioButton;
	61	radET3: TRadioButton;
	62	radLT1: TRadioButton;
	63	radLT2: TRadioButton;
	64	radLT3: TRadioButton;
	65	lblNoTimes: TLabel;
	66	txtAOComment: TCaptionEdit;
	67	lblAddlOrder: TLabel;
	68	lstIsolation: TORListBox;
	69	lblIsolation: TLabel;
	70	lblIPComment: TLabel;
	71	txtIPComment: TCaptionEdit;
	72	lblIPCurrent: TLabel;
	73	txtIPCurrent: TCaptionEdit;
	74	pgeOutPt: TTabSheet;
	75	grpOPMeal: TKeyClickRadioGroup;
	76	grpOPDoW: TGroupBox;
	77	chkOPMonday: TCheckBox;
	78	chkOPTuesday: TCheckBox;
	79	chkOPWednesday: TCheckBox;
	80	chkOPThursday: TCheckBox;
	81	chkOPFriday: TCheckBox;
	82	chkOPSaturday: TCheckBox;
	83	chkOPSunday: TCheckBox;
	84	lblOPStart: TLabel;
	85	calOPStart: TORDateBox;
	86	lblOPStop: TLabel;
	87	calOPStop: TORDateBox;
	88	lblOPDietAvail: TLabel;
	89	cboOPDietAvail: TORComboBox;
	90	lblOPComment: TLabel;
	91	txtOPDietComment: TCaptionEdit;
	92	lblOPDelivery: TLabel;
	93	cboOPDelivery: TORComboBox;
	94	lblOPSelect: TLabel;
	95	lstOPDietSelect: TORListBox;
	96	cmdOPRemove: TButton;
	97	chkOPCancelTubefeeding: TCheckBox;
[460]	98	calOPTFStart: TORDateBox;
	99	lblOPTFStart: TLabel;
	100	lblOPAOStart: TLabel;
	101	calOPAOStart: TORDateBox;
	102	cboOPAORecurringMeals: TORComboBox;
	103	cboOPTFRecurringMeals: TORComboBox;
	104	cboOPELRecurringMeals: TORComboBox;
[459]	105	procedure nbkDietChanging(Sender: TObject;
	106	var AllowChange: Boolean);
	107	procedure nbkDietChange(Sender: TObject);
	108	procedure FormCreate(Sender: TObject);
	109	procedure cboDietAvailNeedData(Sender: TObject;
	110	const StartFrom: String; Direction, InsertAt: Integer);
	111	procedure cboDietAvailMouseClick(Sender: TObject);
	112	procedure cboDietAvailExit(Sender: TObject);
	113	procedure cmdRemoveClick(Sender: TObject);
	114	procedure DietChange(Sender: TObject);
	115	procedure cmdAcceptClick(Sender: TObject);
	116	procedure cboProductMouseClick(Sender: TObject);
	117	procedure cboProductExit(Sender: TObject);
	118	procedure FormDestroy(Sender: TObject);
	119	procedure FormResize(Sender: TObject);
	120	procedure grdSelectedSelectCell(Sender: TObject; Col, Row: Integer;
	121	var CanSelect: Boolean);
	122	procedure txtQuantityChange(Sender: TObject);
	123	procedure txtQuantityExit(Sender: TObject);
	124	procedure cboStrengthChange(Sender: TObject);
	125	procedure cboStrengthExit(Sender: TObject);
	126	procedure TFChange(Sender: TObject);
	127	procedure cmdTFRemoveClick(Sender: TObject);
	128	procedure grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
	129	State: TGridDrawState);
	130	procedure cboStrengthKeyDown(Sender: TObject; var Key: Word;
	131	Shift: TShiftState);
	132	procedure cboStrengthEnter(Sender: TObject);
	133	procedure txtQuantityKeyDown(Sender: TObject; var Key: Word;
	134	Shift: TShiftState);
	135	procedure txtQuantityEnter(Sender: TObject);
	136	procedure grpMealClick(Sender: TObject);
	137	procedure calELStartExit(Sender: TObject);
	138	procedure calELStopChange(Sender: TObject);
	139	procedure ELChange(Sender: TObject);
	140	procedure calELStartEnter(Sender: TObject);
	141	procedure calELStartChange(Sender: TObject);
	142	procedure IPChange(Sender: TObject);
	143	procedure AOChange(Sender: TObject);
	144	procedure FormKeyDown(Sender: TObject; var Key: Word;
	145	Shift: TShiftState);
	146	procedure cboOPDietAvailMouseClick(Sender: TObject);
	147	procedure cboOPDietAvailExit(Sender: TObject);
	148	procedure calOPStartExit(Sender: TObject);
	149	procedure calOPStopChange(Sender: TObject);
	150	procedure calOPStartEnter(Sender: TObject);
	151	procedure calOPStartChange(Sender: TObject);
	152	procedure OPChange(Sender: TObject);
	153	procedure grpOPMealClick(Sender: TObject);
	154	procedure cmdOPRemoveClick(Sender: TObject);
[460]	155	procedure cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
	156	Shift: TShiftState);
[459]	157	private
	158	FNextCol: Integer;
	159	FNextRow: Integer;
	160	FChangeStop: Boolean;
	161	FIsolationID: string;
	162	FTabChanging: Boolean;
	163	procedure DietCheckForNPO;
	164	procedure DietCheckForTF;
	165	function GetMealTime: string;
	166	function GetDaysOfWeek: string;
	167	function IsEarlyTray: Boolean;
	168	procedure ResetControlsDO;
	169	procedure ResetControlsTF;
	170	procedure ResetControlsEL;
	171	procedure ResetControlsIP;
	172	procedure ResetControlsAO;
	173	procedure SetEnableDOW(AllowUse: Boolean);
	174	procedure SetNextCell(ACol, ARow: Integer);
	175	procedure SetValuesFromResponsesDO;
	176	procedure SetValuesFromResponsesTF;
	177	procedure SetValuesFromResponsesEL;
	178	procedure SetValuesFromResponsesIP;
	179	procedure SetValuesFromResponsesAO;
	180	procedure TFMoveToNextCell;
	181	procedure TFClearGrid;
	182	procedure TFSetAmountForRow(ARow: Integer);
	183	function TFStrengthCode(const x: string): Integer;
	184	// Outpatient meal additions
[460]	185	function FMDOW(AnFMDate: TFMDateTime): integer;
	186	function FMDays(AStart, AEnd: TFMDateTime): string;
[459]	187	function GetOPDaysOfWeek: string;
[460]	188	procedure SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
[459]	189	procedure ResetControlsOP;
	190	procedure SetValuesFromResponsesOP;
	191	function GetOPMealWindow: string;
	192	procedure OPDietCheckForNPO;
	193	procedure OPDietCheckForTF;
[460]	194	function PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
[459]	195	protected
	196	procedure InitDialog; override;
	197	procedure Validate(var AnErrMsg: string); override;
	198	public
	199	procedure SetupDialog(OrderAction: Integer; const ID: string); override;
	200	end;
	201
	202	var
	203	frmODDiet: TfrmODDiet;
	204	uDialogName: string;
	205	uFHAUTH: boolean;
[460]	206	uRecurringMealList: TStringList;
[459]	207
	208	implementation
	209
	210	{$R *.DFM}
	211
[460]	212	uses uCore, rODBase, rODDiet, rCore, rOrders, fODDietLT, uAccessibleStringGrid, DateUtils;
[459]	213
	214	const
	215	TX_DIET_REG = 'A regular diet may not be combined with other diets.';
	216	TX_DIET_NPO = 'NPO may not be combined with other diets.';
	217	TX_DIET_LIM = 'A maximum of 5 diet modifications may be selected.';
	218	TX_DIET_DUP = 'This diet has already been selected.';
	219	TX_DIET_PRC = 'This diet conflicts with ';
	220	TC_DIET_ERR = 'Unable to Add Diet';
[460]	221	TX_INPT_ONLY = 'This type of diet may be entered for inpatients only.';
[459]	222	TC_INPT_ONLY = 'Ordering Restriction';
	223	TX_CANCEL_TF = 'Cancel the current tubefeeding order?' + CRLF + CRLF;
	224	TC_CANCEL_TF = 'Cancel Tubefeeding';
	225	TX_NO_DIET = 'At least one diet must be selected.';
	226	TX_BAD_START = 'The effective date is not valid.';
	227	TX_BAD_STOP = 'The expiration date is not valid.';
	228	TX_STOPSTART = 'The expiration date must be after the effective date.';
	229	TX_MINMAX = 'At least 1 product must be selected (maximum: 5).';
	230	TX_TFQTY = 'A quantity must be entered for ';
	231	TX_TFAMT = 'The quantity is invalid for ';
[460]	232	TX_TF5000 = 'The total quantity ordered may not exceed 5000ml.';
[459]	233	TX_HLPQTY = CRLF + 'The following may be entered for quantity:' + CRLF +
[460]	234	' Units may be K for Kcals, C for cc''s, M for ml, O for oz. or U for units (e.g. cans).' + CRLF +
[459]	235	' Frequency may be DAY, HOUR, QD, QH, BID, TID, QID, Q2H, Q3H, Q4H, or Q6H.' + CRLF +
	236	' May also input 100CC/HR X 16 for 16 hours. Valid quantity for powder form' + CRLF +
	237	' product can be "# GRAMS" as 20 G, GRAMS, or GMS, or as 1 PKG or 1 U and the' + CRLF +
	238	' frequency (e.g. 20 GRAMS/DAY or 1 PKG/TID).';
	239	TX_ELMEAL = 'A meal must be selected.';
	240	TX_ELTIME = 'A meal time must be selected.';
	241	TX_ELNOSTART = 'A valid start date must be entered.';
	242	TX_ELNOSTOP = 'A valid end date must be entered.';
	243	TX_ELSTARTLT = 'The start date may not be earlier than today.';
	244	TX_ELSTOPLT = 'The end date may not be earlier than today.';
	245	TX_ELSTOPSTART = 'The end date may not be earlier than the start date.';
	246	TX_ELSTART30 = 'The start date may not be more than 30 days in the future.';
	247	TX_ELSTOP30 = 'The end date may not be more than 30 days in the future.';
	248	TX_ELDOW = 'The days of the week must be selected for time ranges greater than 1 day.';
	249	TX_ELPAST = 'The selected meal time has already passed.';
	250	TX_IPNONE = 'An isolation type must be selected.';
	251	TX_AONONE = 'Text for additional order has not been entered.';
	252	TX_ACCEPT = 'Accept the following order?' + CRLF + CRLF;
[460]	253	TX_CONTINUE = 'Continue editing the following order?' + CRLF + CRLF;
	254	TX_DISCARD = CRLF + CRLF + 'Answering NO will discard all changes.';
[459]	255	TC_ACCEPT = 'Unsaved Order';
	256	TX_EL_SAVE_ERR = 'An error occurred while saving this late tray order.';
	257	TC_EL_SAVE_ERR = 'Error Saving Late Tray Order';
	258	// Outpatient meal additions
	259	TX_OPMEAL = 'A meal must be selected.';
	260	TX_OPNOSTART = 'A valid start date must be entered.';
	261	TX_OPNOSTOP = 'A valid end date must be entered.';
	262	TX_OPSTARTLT = 'The start date may not be earlier than today.';
	263	TX_OPSTOPLT = 'The end date may not be earlier than today.';
	264	TX_OPSTOPSTART = 'The end date may not be earlier than the start date.';
	265	TX_OPSTART_MAX1 = 'The start date may not be more than ';
	266	TX_OPSTART_MAX2 = ' days in the future.';
	267	TX_OPSTOP_MAX1 = 'The end date may not be more than ';
	268	TX_OPSTOP_MAX2 = ' days in the future.';
	269	TX_OPDOW = 'The days of the week must be selected for time ranges greater than 1 day.';
	270	TX_OPPAST = 'The selected meal time has already passed.';
	271	TX_OP_SAVE_ERR = 'An error occurred while saving this outpatient meal order.';
	272	TC_OP_SAVE_ERR = 'Error Saving Outpatient Meal Order';
	273	TX_OP_NO_DIET = 'One and only one diet must be selected.';
	274	TX_OP_BAD_START = 'The effective date is not valid.';
	275	TX_OP_BAD_STOP = 'The expiration date is not valid.';
	276	//TX_OP_DIET_REG = 'A regular diet may not be combined with other diets.';
	277	//TX_OP_DIET_NPO = 'NPO may not be combined with other diets.';
	278	//TX_OP_DIET_LIM = 'A maximum of 1 diet may be selected.';
	279	//TX_OP_DIET_DUP = 'This diet has already been selected.';
	280	//TX_OP_DIET_PRC = 'This diet conflicts with ';
	281	TC_OP_DIET_ERR = 'Unable to Add Diet';
	282	TX_OUTPT_ONLY = 'This type of diet may be entered for outpatients only.';
	283	TC_OUTPT_ONLY = 'Ordering Restriction';
	284	TX_NO_PARAMS = 'Placing Early or Late tray orders is not allowed until the IRM diet package' + CRLF +
	285	'coordinator enters times for E/L trays for this location.';
	286	TC_NO_PARAMS = 'Unable to Order Early/Late Tray';
[460]	287	TX_NOSTART = 'A valid start date must be entered.';
	288	TC_NOSTART = 'Start date required';
	289	TX_NOT_THIS_LOC = 'This location has not been configured to' + CRLF +
	290	'allow ordering of meals for outpatients.' + CRLF + CRLF +
	291	'Please contact your IRM diet package coordinator.';
	292	TC_NOT_THIS_LOC = 'Unable to order from this location';
	293	TX_NO_OUTPT_ORDERS = 'Diet orders may only be entered for inpatients.';
	294	TC_NO_OUTPT_ORDERS = 'Ordering Restriction';
	295	TX_NO_MEALS_DEFINED = 'No diet types have been defined to be orderable for outpatients.' + CRLF + CRLF +
	296	'Please contact your IRM diet package coordinator.';
	297	TC_NO_MEALS_DEFINED = 'Unable to order outpatient meals';
[459]	298
[460]	299	FMDayLetters: array[1..7] of string[1] = ('M', 'T', 'W', 'R', 'F', 'S', 'X');
	300
[459]	301	type
	302	TTFProduct = class
	303	private
	304	IEN: Integer;
	305	Name: string;
	306	end;
	307
	308	var
	309	uDietParams: TDietParams;
	310
	311	procedure TfrmODDiet.FormCreate(Sender: TObject);
	312	var
	313	ALocation: string; //ptr to #44 hospital location
	314	begin
	315	inherited;
[460]	316	AbortOrder := False;
	317	uRecurringMealList := TStringList.Create;
[459]	318	if OrderForInpatient then
	319	begin
	320	pgeDiet.TabVisible := True;
	321	pgeOutPt.TabVisible := False;
	322	end
	323	else if OutpatientPatchInstalled then // put here to only call RPCs if outpatient - remove "IF" later
	324	begin
	325	pgeDiet.TabVisible := False;
	326	pgeOutPt.TabVisible := True;
	327	end
	328	else // this block will go away after FH patch installed everywhere
	329	begin
[460]	330	InfoBox(TX_NO_OUTPT_ORDERS, TC_NO_OUTPT_ORDERS, MB_OK);
	331	AbortOrder := True;
[459]	332	Exit;
	333	end;
	334
	335	FillerID := 'FH'; // does 'on Display' order check KCM
	336	ALocation := '0';
	337	if Self.EvtID > 0 then
	338	ALocation := GetEventLoc1(IntToStr(Self.EvtID));
	339	if StrToIntDef(ALocation, 0) < 1 then
	340	ALocation := IntToStr(Encounter.Location);
[460]	341	if (not OrderForInpatient) and OutpatientPatchInstalled and (not OutpatientLocationConfigured(ALocation)) then
[459]	342	begin
[460]	343	InfoBox(TX_NOT_THIS_LOC, TC_NOT_THIS_LOC, MB_OK or MB_ICONINFORMATION);
	344	AbortOrder := True;
[459]	345	end
	346	else
	347	begin
[460]	348	LoadDietParams(uDietParams, ALocation);
	349	if pgeOutPt.TabVisible then
	350	with uDietParams, cboOPDelivery do
	351	begin
	352	if Tray then Items.Add('T^Tray');
	353	if Cafeteria then Items.Add('C^Cafeteria');
	354	if DiningRm then Items.Add('D^Dining Room');
	355	ItemIndex := 0;
	356	chkBagged.Visible := uDietParams.Bagged;
	357	end
	358	else
	359	with uDietParams, cboDelivery do
	360	begin
	361	if Tray then Items.Add('T^Tray');
	362	if Cafeteria then Items.Add('C^Cafeteria');
	363	if DiningRm then Items.Add('D^Dining Room');
	364	ItemIndex := 0;
	365	chkBagged.Visible := uDietParams.Bagged;
	366	end;
[459]	367	end;
	368	TAccessibleStringGrid.WrapControl(grdSelected);
	369	end;
	370
	371	procedure TfrmODDiet.FormDestroy(Sender: TObject);
	372	begin
	373	TAccessibleStringGrid.UnwrapControl(grdSelected);
	374	TFClearGrid;
[460]	375	uRecurringMealList.Free;
[459]	376	inherited;
	377	end;
	378
	379	procedure TfrmODDiet.FormResize(Sender: TObject);
	380	begin
	381	inherited;
	382	with grdSelected do
	383	begin
	384	ColWidths[1] := Canvas.TextWidth('XFULLX') + GetSystemMetrics(SM_CXVSCROLL);
	385	ColWidths[2] := Canvas.TextWidth('100 GRAMS/HOUR X 24');
[460]	386	ColWidths[3] := Canvas.TextWidth('55000ml');
[459]	387	ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - ColWidths[3] - 3;
	388	lblTFStrength.Left := Left + ColWidths[0] + 3;
	389	lblTFQuantity.Left := Left + ColWidths[0] + ColWidths[1] + 5;
	390	lblTFAmount.Left := Left + ColWidths[0] + ColWidths[1] + ColWidths[2] + 7;
	391	end;
	392	end;
	393
	394	procedure TfrmODDiet.InitDialog;
	395	begin
	396	inherited;
	397	// handle all initialization at the tab level
	398	// if FTabChanging, then nbkDietChange is about to be called anyway
	399	if not FTabChanging then nbkDietChange(Self);
	400	end;
	401
	402	procedure TfrmODDiet.SetupDialog(OrderAction: Integer; const ID: string);
	403	begin
[460]	404	if AbortOrder then exit;
[459]	405	inherited;
	406	uDialogName := ExternalName(DialogIEN, 101.41);
	407	case DietDialogType(DisplayGroup) of
	408	'D': begin
	409	if not OrderForInpatient then
	410	begin
	411	InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
	412	Close;
	413	Exit;
	414	end;
	415	pgeDiet.TabVisible := True;
	416	pgeOutPt.TabVisible := False;
	417	nbkDiet.ActivePage := pgeDiet;
	418	nbkDietChange(Self);
	419	if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
	420	end;
	421	'N': begin
	422	if not OrderForInpatient then
	423	begin
	424	InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
	425	Close;
	426	Exit;
	427	end;
	428	nbkDiet.ActivePage := pgeDiet;
	429	nbkDietChange(Self);
	430	if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
	431	end;
	432	'T': begin
[460]	433	if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
	434	begin
	435	Close;
	436	Exit;
	437	end;
[459]	438	nbkDiet.ActivePage := pgeTubefeeding;
	439	nbkDietChange(Self);
	440	if OrderAction <> ORDER_NEW then SetValuesFromResponsesTF;
	441	end;
	442	'E': begin
[460]	443	if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
	444	begin
	445	Close;
	446	Exit;
	447	end;
[459]	448	nbkDiet.ActivePage := pgeEarlyLate;
	449	nbkDietChange(Self);
	450	if OrderAction <> ORDER_NEW then SetValuesFromResponsesEL;
	451	end;
	452	'P': begin
	453	nbkDiet.ActivePage := pgeIsolations;
	454	nbkDietChange(Self);
	455	if OrderAction <> ORDER_NEW then SetValuesFromResponsesIP;
	456	end;
	457	'A': begin
[460]	458	if (not OrderForInpatient) and (not PatientHasRecurringMeals(uRecurringMealList)) then
	459	begin
	460	Close;
	461	Exit;
	462	end;
[459]	463	nbkDiet.ActivePage := pgeAdditional;
	464	nbkDietChange(Self);
	465	if OrderAction <> ORDER_NEW then SetValuesFromResponsesAO;
	466	end;
	467	'M': begin
	468	if OrderForInpatient then
	469	begin
	470	InfoBox(TX_OUTPT_ONLY, TC_OUTPT_ONLY, MB_OK);
	471	Close;
	472	Exit;
	473	end;
	474	uFHAUTH := UserHasFHAUTHKey; // is this really needed for other than printing?
	475	pgeDiet.TabVisible := False;
	476	pgeOutPt.TabVisible := True;
	477	nbkDiet.ActivePage := pgeOutPt;
	478	nbkDietChange(Self);
	479	if OrderAction <> ORDER_NEW then SetValuesFromResponsesOP;
	480	end
	481	else
	482	begin
	483	if not OrderForInpatient then
	484	begin
	485	InfoBox(TX_INPT_ONLY, TC_INPT_ONLY, MB_OK);
	486	Close;
	487	Exit;
	488	end;
	489	pgeDiet.TabVisible := True;
	490	pgeOutPt.TabVisible := False;
	491	nbkDiet.ActivePage := pgeDiet;
	492	nbkDietChange(Self);
	493	if OrderAction <> ORDER_NEW then SetValuesFromResponsesDO;
[460]	494	ActiveControl := cboOPDietAvail;
[459]	495	end;
	496	end;
	497	if OrderAction = ORDER_NEW then SetFocusedControl(nbkDiet);
	498	end;
	499
	500	procedure TfrmODDiet.Validate(var AnErrMsg: string);
	501	var
	502	ErrMsg: string;
	503	i, Sum: Integer;
	504
	505	procedure SetError(const x: string);
	506	begin
	507	if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
	508	AnErrMsg := AnErrMsg + x;
	509	end;
	510
	511	function MealTimePassed: Boolean;
	512	var
	513	x: string;
	514	ATime: Integer;
	515	begin
	516	Result := False;
	517	if calELStart.FMDateTime <> FMToday then Exit;
	518	x := GetMealTime;
	519	if Pos(':', x) = 0 then Exit;
	520	ATime := StrToIntDef(Piece(x, ':', 1) + Copy(Piece(x, ':', 2), 1, 2), 0);
	521	if (Pos('P', x) > 0) and (ATime < 1200) then ATime := ATime + 1200;
	522	if (Pos('A', x) > 0) and (ATime > 1200) then ATime := ATime - 1200;
	523	if (ATime / 10000) < Frac(FMNow) then Result := True;
	524	end;
	525
	526	function OPMealTimePassed: Boolean;
	527	var
	528	WindowTimes: string;
	529	EndWindow: integer;
	530	x: extended;
	531	begin
	532	Result := False;
	533	if calOPStart.FMDateTime <> FMToday then Exit;
	534	WindowTimes := GetOPMealWindow;
	535	if WindowTimes = U then exit;
	536	EndWindow := StrToIntDef(Piece(WindowTimes, U, 2), 0);
	537	x := Frac(calOPStart.FMDateTime);
	538	if x = 0 then x := Frac(FMNow) * 10000;
	539	if x > EndWindow then Result := True;
	540	end;
	541
	542	begin
	543	// do the appropriate validation depending on the currently selected tab
	544	if nbkDiet.ActivePage = pgeDiet then
	545	begin
	546	if lstDietSelect.Items.Count < 1 then SetError(TX_NO_DIET);
	547	if not calDietStart.IsValid then SetError(TX_BAD_START);
	548	with calDietStop do
	549	begin
	550	Validate(ErrMsg);
	551	if Length(ErrMsg) > 0 then SetError(TX_BAD_STOP);
	552	if (Length(Text) > 0) and (FMDateTime <= calDietStart.FMDateTime)
	553	then SetError(TX_STOPSTART);
	554	end; {with calDietStop}
	555	end; {pgeDiet}
	556	if nbkDiet.ActivePage = pgeTubeFeeding then
	557	begin
	558	Sum := 0;
	559	with grdSelected do for i := 0 to RowCount - 1 do if Objects[0, i] <> nil then Inc(Sum);
	560	if (Sum < 1) or (Sum > 5) then SetError(TX_MINMAX);
	561	Sum := 0;
	562	with grdSelected do for i := 0 to RowCount - 1 do if Objects[0, i] <> nil then
	563	begin
	564	if Length(Cells[2, i]) = 0 then SetError(TX_TFQTY + Cells[0, i]);
	565	if (Length(Cells[2, i]) > 0) and (Length(Cells[3, i]) = 0)
	566	then SetError(TX_TFAMT + Cells[0, i] + TX_HLPQTY);
	567	Sum := Sum + StrToIntDef(Piece(Cells[3, i], 'c', 1), 0);
	568	end;
	569	if Sum > 5000 then SetError(TX_TF5000);
[460]	570	if not OrderForInpatient then
	571	if not calOPTFStart.IsValid then SetError(TX_BAD_START);
[459]	572	end;
	573	if nbkDiet.ActivePage = pgeEarlyLate then
	574	begin
	575	if grpMeal.ItemIndex = 3 then SetError(TX_ELMEAL);
	576	if not calELStart.IsValid then SetError(TX_ELNOSTART);
	577	if calELStart.FMDateTime < FMToday then SetError(TX_ELSTARTLT);
	578	if calELStart.FMDateTime > FMDateTimeOffsetBy(FMToday, 30) then SetError(TX_ELSTART30);
[460]	579	if OrderForInpatient then
	580	begin
	581	if GetMealTime = '' then SetError(TX_ELTIME);
	582	if not calELStop.IsValid then SetError(TX_ELNOSTOP);
	583	if calELStop.FMDateTime < FMToday then SetError(TX_ELSTOPLT);
	584	if calELStop.FMDateTime < calELStart.FMDateTime then SetError(TX_ELSTOPSTART);
	585	if calELStop.FMDateTime > FMDateTimeOffsetBy(FMToday, 30) then SetError(TX_ELSTOP30);
	586	end;
[459]	587	if grpDOW.Enabled and (GetDaysOfWeek = '') then SetError(TX_ELDOW);
	588	if MealTimePassed then SetError(TX_ELPAST);
	589	end;
	590	if nbkDiet.ActivePage = pgeIsolations then
	591	begin
	592	if lstIsolation.ItemIndex < 0 then SetError(TX_IPNONE);
	593	end;
	594	if nbkDiet.ActivePage = pgeAdditional then
	595	begin
	596	if not ContainsVisibleChar(txtAOComment.Text) then SetError(TX_AONONE);
[460]	597	if not OrderForInpatient then
	598	if not calOPAOStart.IsValid then SetError(TX_BAD_START);
[459]	599	end;
	600	if nbkDiet.ActivePage = pgeOutPt then
	601	begin
	602	if grpOPMeal.ItemIndex = 3 then SetError(TX_OPMEAL);
	603	if lstOPDietSelect.Items.Count < 1 then SetError(TX_OP_NO_DIET);
	604	if OPMealTimePassed then SetError(TX_OPPAST);
	605	if uDialogName = 'FHW OP MEAL' then
	606	begin
	607	if not calOPStart.IsValid then SetError(TX_OP_BAD_START);
	608	with calOPStop do
	609	begin
	610	Validate(ErrMsg);
	611	if Length(ErrMsg) > 0 then SetError(TX_OP_BAD_STOP);
	612	if (Length(Text) > 0) and (FMDateTime < calOPStart.FMDateTime)
	613	then SetError(TX_OPSTOPSTART);
	614	end; {with calOPDietStop}
	615	if calOPStart.FMDateTime > FMDateTimeOffsetBy(FMToday, uDietParams.OPMaxDays)
	616	then SetError(TX_OPSTART_MAX1 + IntToStr(uDietParams.OPMaxDays) +
	617	TX_OPSTART_MAX2);
	618	if calOPStop.FMDateTime > FMDateTimeOffsetBy(FMToday, uDietParams.OPMaxDays)
	619	then SetError(TX_OPSTOP_MAX1 + IntToStr(uDietParams.OPMaxDays) +
	620	TX_OPSTOP_MAX2);
	621	if grpOPDOW.Enabled and (GetOPDaysOfWeek = '')
	622	then SetError(TX_OPDOW);
	623	end;
	624	end;
	625	end;
	626
	627	{ notebook tabs - general ------------------------------------------------------------------- }
	628
	629	procedure TfrmODDiet.nbkDietChanging(Sender: TObject; var AllowChange: Boolean);
	630	begin
	631	inherited;
	632	with Responses do if (Length(CopyOrder) > 0) or (Length(EditOrder) > 0) then
	633	begin
	634	AllowChange := False;
	635	Exit;
	636	end;
	637	FTabChanging := True;
	638	if Length(memOrder.Text) > 0 then
	639	begin
[460]	640	if nbkDiet.ActivePage = pgeOutpt then
	641	begin
	642	if InfoBox(TX_CONTINUE + memOrder.Text + TX_DISCARD, TC_ACCEPT, MB_YESNO) = ID_YES then
	643	begin
	644	AllowChange := FALSE;
	645	end else
	646	begin
	647	memOrder.Text := '';
	648	memOrder.Lines.Clear;
	649	Responses.Clear;
	650	end;
	651	end
	652	else
	653	begin
	654	if InfoBox(TX_ACCEPT + memOrder.Text, TC_ACCEPT, MB_YESNO) = ID_YES then
	655	begin
	656	cmdAcceptClick(Self);
	657	AllowChange := AcceptOK;
	658	end else
	659	begin
	660	memOrder.Text := '';
	661	memOrder.Lines.Clear;
	662	Responses.Clear;
	663	end;
	664	end
[459]	665	end;
	666	FTabChanging := False;
	667	end;
	668
	669	procedure TfrmODDiet.nbkDietChange(Sender: TObject);
[460]	670	var
	671	x, CxMsg: string ;
	672	i: integer;
	673	AStringList: TStringList;
	674	const
	675	// TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet:' + CRLF + CRLF;
	676	TX_CX_CUR = 'A new diet order will CANCEL and REPLACE this current diet now unless' + CRLF +
	677	'you specify a start date for when the new diet should replace the current' + CRLF +
	678	'diet:' + CRLF + CRLF;
	679	TX_CX_FUT = 'A new diet order with no expiration date will CANCEL and REPLACE these diets:' + CRLF + CRLF;
[459]	680	begin
	681	inherited;
	682	// much of the logic here can be eliminated if ClearDialogControls starts clearing containers
[460]	683	if AbortOrder then
	684	begin
	685	cmdQuitClick(Self);
	686	exit;
	687	end;
[459]	688	StatusText('Loading Dialog Definition');
	689	if Sender <> Self then Responses.Clear;
	690	Changing := True; // Changing set!
	691	if nbkDiet.ActivePage = pgeDiet then
	692	begin
	693	AllowQuickOrder := True;
[460]	694	x := CurrentDietText;
	695	if Piece(x, #13, 1) <> 'Current Diet: ' then
	696	begin
	697	AStringList := TStringList.Create;
	698	try
	699	AStringList.Text := x;
	700	CxMsg := TX_CX_CUR + #9 + Piece(AStringList[0], ':', 1) + ':' + CRLF + CRLF
	701	+ #9 + Copy(AStringList[0], 16, 99) + CRLF;
	702	if AStringList.Count > 1 then
	703	begin
	704	CxMsg := CxMsg + CRLF + CRLF +
	705	TX_CX_FUT + #9 + Piece(AStringList[1], ':', 1) + ':' + CRLF + CRLF
	706	+ #9 + Copy(AStringList[1], 22, 99) + CRLF;
	707	if AStringList.Count > 2 then
	708	for i := 2 to AStringList.Count - 1 do
	709	CxMsg := CxMsg + #9 + TrimLeft(AStringList[i]) + CRLF;
	710	end;
	711	finally
	712	AStringList.Free;
	713	end;
	714	end;
	715	if CxMsg <> '' then
	716	begin
	717	if InfoBox(CxMsg + CRLF +
	718	'Are you sure?', 'Confirm', MB_ICONWARNING or MB_YESNO) = ID_NO then
	719	begin
	720	AbortOrder := True;
	721	cmdQuitClick(Self);
	722	exit;
	723	end;
	724	end;
	725	OrderMessage(x);
[459]	726	Responses.Dialog := 'FHW1'; // Diet Order
	727	DisplayGroup := DisplayGroupForDialog('FHW1');
	728	LoadDietQuickList(cboDietAvail.Items, 'DO');
	729	cboDietAvail.InsertSeparator;
	730	cboDietAvail.InitLongList('');
	731	chkCancelTubefeeding.State := cbGrayed;
	732	chkCancelTubefeeding.Visible := False;
	733	ResetControlsDO;
	734	end;
	735	if nbkDiet.ActivePage = pgeTubefeeding then
	736	begin
	737	if not OrderForInpatient then
	738	begin
[460]	739	if not PatientHasRecurringMeals(uRecurringMealList) then
	740	begin
	741	Changing := False;
	742	nbkDiet.ActivePage := pgeOutPt;
	743	nbkDietChange(nbkDiet);
	744	Exit;
	745	end
	746	else
	747	cboOPTFRecurringMeals.Items.Assign(uRecurringMealList);
[459]	748	end;
[460]	749	cboOPTFRecurringMeals.Visible := not OrderForInpatient;
	750	calOPTFStart.Visible := False;
	751	lblOPTFStart.Visible := not OrderForInpatient;
[459]	752	AllowQuickOrder := True;
	753	if Length(uDietParams.CurTF) > 0
	754	then OrderMessage(TextForOrder(uDietParams.CurTF))
	755	else OrderMessage('');
	756	Responses.Dialog := 'FHW8'; // Tubefeeding
	757	DisplayGroup := DisplayGroupForDialog('FHW8');
	758	with cboProduct do if Items.Count = 0 then
	759	begin
	760	LoadDietQuickList(Items, 'TF');
	761	if Items.Count > 0 then
	762	begin
	763	Items.Add(LLS_LINE);
	764	Items.Add(LLS_SPACE);
	765	end;
	766	AppendTFProducts(Items);
	767	end;
	768	cboProduct.Text := '';
	769	ResetControlsTF;
	770	end;
	771	if nbkDiet.ActivePage = pgeEarlyLate then
	772	begin
	773	if not OrderForInpatient then
[460]	774	begin
	775	if not PatientHasRecurringMeals(uRecurringMealList) then
	776	begin
	777	Changing := False;
	778	nbkDiet.ActivePage := pgeOutPt;
	779	nbkDietChange(nbkDiet);
	780	Exit;
	781	end
	782	else
	783	cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
	784	end
[459]	785	else if (StrToIntDef(uDietParams.EarlyIEN, 0) = 0) or (StrToIntDef(uDietParams.LateIEN, 0) = 0) then
[460]	786	begin
	787	InfoBox(TX_NO_PARAMS, TC_NO_PARAMS, MB_ICONERROR or MB_OK);
	788	if pgeEarlyLate <> nil then
	789	nbkDiet.SelectNextPage(False);
	790	Changing := False;
	791	Exit;
	792	end;
	793	cboOPELRecurringMeals.Visible := not OrderForInpatient;
	794	cboOPELRecurringMeals.TabStop := not OrderForInpatient;
	795	calELStart.Visible := OrderForInpatient;
	796	calELStart.TabStop := OrderForInpatient;
	797	calELStop.Visible := OrderForInpatient;
	798	lblELStop.Visible := OrderForInpatient;
	799	grpDOW.Visible := OrderForInpatient;
	800	grpDOW.Enabled := OrderForInpatient;
[459]	801	AllowQuickOrder := False;
	802	OrderMessage('');
	803	Responses.Dialog := 'FHW2'; // Early/Late Tray
	804	DisplayGroup := DisplayGroupForDialog('FHW2');
	805	ResetControlsEL;
	806	end;
	807	if nbkDiet.ActivePage = pgeIsolations then
	808	begin
	809	AllowQuickOrder := False;
	810	OrderMessage('');
	811	Responses.Dialog := 'FHW3'; // Isolations
	812	DisplayGroup := DisplayGroupForDialog('FHW3');
	813	if lstIsolation.Items.Count = 0 then LoadIsolations(lstIsolation.Items);
	814	txtIPCurrent.Text := CurrentIsolation;
	815	FIsolationID := IsolationID;
	816	ResetControlsIP;
	817	end;
	818	if nbkDiet.ActivePage = pgeAdditional then
	819	begin
[460]	820	if not OrderForInpatient then
[459]	821	begin
[460]	822	if not PatientHasRecurringMeals(uRecurringMealList) then
	823	begin
	824	Changing := False;
	825	nbkDiet.ActivePage := pgeOutPt;
	826	nbkDietChange(nbkDiet);
	827	Exit;
	828	end
	829	else
	830	cboOPAORecurringMeals.Items.Assign(uRecurringMealList);
[459]	831	end;
[460]	832	cboOPAORecurringMeals.Visible := not OrderForInpatient;
	833	calOPAOStart.Visible := False; //not OrderForInpatient;
	834	lblOPAOStart.Visible := not OrderForInpatient;
[459]	835	AllowQuickOrder := False;
	836	OrderMessage('');
	837	Responses.Dialog := 'FHW7'; // Additional Order
	838	DisplayGroup := DisplayGroupForDialog('FHW7');
	839	ResetControlsAO;
	840	end;
	841	if nbkDiet.ActivePage = pgeOutPt then
	842	begin
[460]	843	x := CurrentDietText;
	844	if Length(Piece(x, #$D, 1)) > Length('Current Diet: ') then
	845	OrderMessage(x)
	846	else
	847	OrderMessage('');
	848	if (uDialogName <> 'FHW SPECIAL MEAL') and (uDialogName <> 'FHW OP MEAL') then
	849	uDialogName := 'FHW OP MEAL';
[459]	850	Responses.Dialog := uDialogName;
	851	DisplayGroup := DisplayGroupForDialog(uDialogName);
[460]	852	if uDialogName = 'FHW SPECIAL MEAL' then // Special meal
[459]	853	begin
	854	AllowQuickOrder := False;
	855	ResetControlsOP;
[460]	856	cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
[459]	857	{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
	858	chkOPCancelTubefeeding.State := cbGrayed;
	859	chkOPCancelTubefeeding.Visible := False;
	860	grpOPMeal.Caption := 'Special Meal';
	861	pgeTubefeeding.TabVisible := False;
	862	pgeIsolations.TabVisible := False;
	863	pgeAdditional.TabVisible := False;
	864	pgeEarlyLate.TabVisible := False;
[460]	865	cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
[459]	866	cboOPDietAvailMouseClick(Self);
[460]	867	Changing := False;
	868	end
	869	else if uDialogName = 'FHW OP MEAL' then // Recurring meal
	870	begin
	871	AllowQuickOrder := True;
	872	ResetControlsOP;
	873	LoadDietQuickList(cboOPDietAvail.Items, 'MEAL'); // use D.G. short name here
	874	cboOPDietAvail.InsertSeparator;
	875	cboOPDietAvail.Items.AddStrings(SubsetOfOPDiets);
	876	cboOPDietAvail.SelectByIEN(uDietParams.OPDefaultDiet);
	877	{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
	878	chkOPCancelTubefeeding.State := cbGrayed;
	879	chkOPCancelTubefeeding.Visible := False;
	880	grpOPMeal.Caption := 'Recurring Meal';
	881	SetEnableOPDOW(False, -1);
	882	cboOPDietAvailMouseClick(Self);
	883	Changing := False;
[459]	884	end;
	885	end;
	886	Changing := False; // Changing reset
	887	StatusText('');
	888	end;
	889
	890	{ Diet Order tab ---------------------------------------------------------------------------- }
	891
	892	procedure TfrmODDiet.DietCheckForNPO;
	893	begin
	894	if Piece(lstDietSelect.Items[0], U, 2) = 'NPO' then
	895	begin
	896	lblDelivery.Visible := False;
	897	cboDelivery.Visible := False;
	898	lblComment.Visible := True; // <-- these changes added for 11a to suppress
	899	txtDietComment.Visible := True; // <-- prompting of special instructions except
	900	end else // <-- for NPO
	901	begin // <--
	902	lblComment.Visible := False; // <--
	903	txtDietComment.Visible := False; // <--
	904	txtDietComment.Text := ''; // <--
	905	end;
	906	end;
	907
	908	procedure TfrmODDiet.DietCheckForTF;
	909	var
	910	x: string;
	911	begin
	912	with lstDietSelect do
	913	begin
	914	if (Items.Count = 1) and (Piece(Items[0], U, 2) <> 'NPO')
	915	and (Length(uDietParams.CurTF) > 0) then
	916	begin
	917	x := TextForOrder(uDietParams.CurTF);
	918	if InfoBox(TX_CANCEL_TF + x, TC_CANCEL_TF, MB_YESNO) = IDYES then
	919	begin
	920	chkCancelTubeFeeding.State := cbChecked;
	921	chkCancelTubeFeeding.Visible := True;
	922	end
	923	else chkCancelTubeFeeding.State := cbUnchecked;
	924	end; {if (Items...}
	925	end; {with lstDietSelect}
	926	end;
	927
	928	procedure TfrmODDiet.ResetControlsDO;
	929	begin
	930	lstDietSelect.Clear;
	931	calDietStart.Text := 'Now';
	932	calDietStop.Text := '';
	933	lblDelivery.Visible := True;
	934	cboDelivery.Visible := True;
	935	txtDietComment.Text := ''; // <-- suppress except for NPO
	936	txtDietComment.Visible := False; // <--
	937	lblComment.Visible := False; // <--
	938	end;
	939
	940	procedure TfrmODDiet.SetValuesFromResponsesDO;
	941	var
	942	AnInstance: Integer;
	943	AResponse: TResponse;
	944	ADiet: string;
	945	begin
	946	Changing := True; // Changing set!!
	947	ResetControlsDO;
	948	with Responses do
	949	begin
	950	AnInstance := NextInstance('ORDERABLE', 0);
	951	while AnInstance > 0 do
	952	begin
	953	AResponse := FindResponseByName('ORDERABLE', AnInstance);
	954	if AResponse <> nil then
	955	begin
	956	ADiet := DietAttributes(StrToIntDef(AResponse.IValue,0));
	957	if Piece(ADiet,'^',1)='0' then
	958	begin
	959	InfoBox(Piece(ADiet,'^',2), TC_DIET_ERR, MB_OK);
	960	cboDietAvail.ItemIndex := -1;
[460]	961	Changing := False;
[459]	962	Exit;
	963	end;
	964	lstDietSelect.Items.Add(ADiet);
	965	end;
	966	AnInstance := NextInstance('ORDERABLE', AnInstance);
	967	end; {while AnInstance - ORDERABLE}
	968	SetControl(calDietStart, 'START', 1);
	969	SetControl(calDietStop, 'STOP', 1);
	970	SetControl(cboDelivery, 'DELIVERY', 1);
	971	SetControl(txtDietComment, 'COMMENT', 1);
	972	end;
	973	DietCheckForNPO;
	974	DietCheckForTF;
	975	Changing := False; // Changing reset
	976	DietChange(Self);
	977	end;
	978
	979	procedure TfrmODDiet.cboDietAvailNeedData(Sender: TObject; const StartFrom: string;
	980	Direction, InsertAt: Integer);
	981	begin
	982	inherited;
	983	cboDietAvail.ForDataUse(SubSetOfDiets(StartFrom, Direction));
	984	end;
	985
	986	procedure TfrmODDiet.cboDietAvailMouseClick(Sender: TObject);
	987	var
	988	NewDiet, ErrMsg: string;
	989	DupDiet: Boolean;
	990	i: Integer;
	991
	992	procedure SetError(const AnError: string);
	993	begin
	994	if Length(ErrMsg) > 0 then Exit;
	995	ErrMsg := AnError;
	996	end;
	997
	998	begin
	999	inherited;
	1000	if CharAt(cboDietAvail.ItemID, 1) = 'Q' then // setup quick order
	1001	begin
	1002	Responses.QuickOrder := ExtractInteger(cboDietAvail.ItemID);
	1003	SetValuesFromResponsesDO;
	1004	cboDietAvail.ItemIndex := -1;
	1005	Exit;
	1006	end;
	1007	if cboDietAvail.ItemIEN > 0 then with lstDietSelect do
	1008	begin
	1009	ErrMsg := '';
	1010	if Items.Count > 0 then // disallow other diets with Regular & NPO
	1011	begin
	1012	if cboDietAvail.ItemIEN = uDietParams.RegIEN then SetError(TX_DIET_REG);
	1013	if GetIEN(0) = uDietParams.RegIEN then SetError(TX_DIET_REG);
	1014	if cboDietAvail.ItemIEN = uDietParams.NPOIEN then SetError(TX_DIET_NPO);
	1015	if GetIEN(0) = uDietParams.NPOIEN then SetError(TX_DIET_NPO);
	1016	end;
	1017	if Items.Count = 5 then SetError(TX_DIET_LIM); // maximum of 5 diet modifications
	1018	DupDiet := False;
	1019	for i := 0 to Items.Count - 1 do if cboDietAvail.ItemIEN = GetIEN(i) then DupDiet := True;
	1020	if DupDiet then SetError(TX_DIET_DUP); // each diet mod must be unique
	1021	NewDiet := DietAttributes(cboDietAvail.ItemIEN);
	1022	if Piece(NewDiet,'^',1)='0' then
	1023	begin
	1024	InfoBox(Piece(NewDiet,'^',2),TC_DIET_ERR, MB_OK);
	1025	cboDietAvail.ItemIndex := -1;
	1026	Exit;
	1027	end;
	1028	for i := 0 to Items.Count - 1 do // check to make sure unique precedence
	1029	if Piece(Items[i], U, 4) = Piece(NewDiet, U, 4)
	1030	then SetError(TX_DIET_PRC + Piece(Items[i], U, 2));
	1031	if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TC_DIET_ERR, MB_OK) else
	1032	begin
	1033	lstDietSelect.Items.Add(NewDiet);
	1034	DietCheckForNPO;
	1035	DietCheckForTF;
	1036	OrderMessage(OIMessage(StrToIntDef(Piece(NewDiet, U, 1), 0)));
	1037	DietChange(Sender);
	1038	end; {else of if Length}
	1039	end; {if cboDietAvail}
	1040	cboDietAvail.ItemIndex := -1;
	1041	end;
	1042
	1043	procedure TfrmODDiet.cboDietAvailExit(Sender: TObject);
	1044	begin
	1045	inherited;
	1046	if (cboDietAvail.ItemIEN > 0) or (CharAt(cboDietAvail.ItemID, 1) = 'Q') then
	1047	cboDietAvailMouseClick(Self);
	1048	end;
	1049
	1050	procedure TfrmODDiet.cmdRemoveClick(Sender: TObject);
	1051	begin
	1052	inherited;
	1053	with lstDietSelect do if ItemIndex > -1 then Items.Delete(ItemIndex);
	1054	DietChange(Sender);
	1055	with lstDietSelect do if Items.Count = 0 then
	1056	begin
	1057	chkCancelTubefeeding.State := cbGrayed;
	1058	chkCancelTubefeeding.Visible := False;
	1059	lblDelivery.Visible := True;
	1060	cboDelivery.Visible := True;
	1061	end;
	1062	end;
	1063
	1064	procedure TfrmODDiet.DietChange(Sender: TObject);
	1065	var
	1066	i: Integer;
	1067	begin
	1068	inherited;
	1069	if Changing then Exit;
	1070	if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
	1071	with calDietStart do {if Length(Text) > 0 then} Responses.Update('START', 1, Text, Text);
	1072	with calDietStop do {if Length(Text) > 0 then} Responses.Update('STOP', 1, Text, Text);
	1073	with lstDietSelect do for i := 0 to Items.Count - 1 do
	1074	Responses.Update('ORDERABLE', i+1, Piece(Items[i], U, 1), Piece(Items[i], U, 2));
	1075	with txtDietComment do {if Length(Text) > 0 then} Responses.Update('COMMENT', 1, Text, Text);
	1076	with cboDelivery do if Visible then Responses.Update('DELIVERY', 1, ItemID, Text);
	1077	with chkCancelTubefeeding do case State of
	1078	cbChecked: Responses.Update('CANCEL', 1, '1', 'YES');
	1079	cbUnchecked: Responses.Update('CANCEL', 1, '0', 'NO');
	1080	end;
	1081	with lstDietSelect do if (Items.Count = 1) and (GetIEN(0) = uDietParams.NPOIEN) then
	1082	begin
	1083	if Frac(calDietStart.FMDateTime) > 0.2358 then Responses.VarTrailing := 'at Midnight';
	1084	end
	1085	else Responses.VarTrailing := 'Diet';
	1086	memOrder.Text := Responses.OrderText;
	1087	end;
	1088
	1089	{ Tubefeeding tab --------------------------------------------------------------------------- }
	1090
	1091	procedure TfrmODDiet.ResetControlsTF;
	1092	begin
	1093	TFClearGrid;
	1094	chkCancelTrays.Checked := False;
[460]	1095	calOPTFStart.Text := '';
[459]	1096	txtTFComment.Text := '';
	1097	end;
	1098
	1099	procedure TfrmODDiet.SetValuesFromResponsesTF;
	1100	var
	1101	AnInstance: Integer;
	1102	AResponse: TResponse;
	1103	AProduct: TTFProduct;
	1104	begin
	1105	Changing := True; // Changing set!!
	1106	ResetControlsTF;
	1107	with Responses do
	1108	begin
	1109	AnInstance := NextInstance('ORDERABLE', 0);
	1110	while AnInstance > 0 do
	1111	begin
	1112	AResponse := FindResponseByName('ORDERABLE', AnInstance);
	1113	if AResponse <> nil then
	1114	begin
	1115	AProduct := TTFProduct.Create;
	1116	AProduct.IEN := StrToIntDef(AResponse.IValue, 0);
	1117	AProduct.Name := AResponse.EValue;
	1118	with grdSelected do
	1119	begin
	1120	if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
	1121	Objects[0, RowCount - 1] := AProduct;
	1122	Cells[0, RowCount - 1] := AProduct.Name;
	1123	AResponse := FindResponseByName('STRENGTH', AnInstance);
	1124	if AResponse <> nil then Cells[1, RowCount - 1] := AResponse.EValue;
	1125	AResponse := FindResponseByName('INSTR', AnInstance);
	1126	if AResponse <> nil then Cells[2, RowCount - 1] := AResponse.EValue;
	1127	TFSetAmountForRow(RowCount - 1);
	1128	end;
	1129	end;
	1130	AnInstance := NextInstance('ORDERABLE', AnInstance);
	1131	end; {while AnInstance - ORDERABLE}
	1132	AResponse := FindResponseByName('CANCEL', 1);
	1133	if AResponse <> nil then chkCancelTrays.Checked := AResponse.IValue = '1';
[460]	1134	if not OrderForInpatient then
	1135	begin
	1136	SetControl(cboOPTFRecurringMeals, 'DATETIME', 1);
	1137	SetControl(calOPTFStart, 'DATETIME', 1);
	1138	end;
[459]	1139	SetControl(txtTFComment, 'COMMENT', 1);
	1140	end;
	1141	Changing := False; // Changing reset
	1142	TFChange(Self);
	1143	end;
	1144
	1145	procedure TfrmODDiet.TFClearGrid;
	1146	var
	1147	i: Integer;
	1148	begin
	1149	with grdSelected do for i := 0 to RowCount - 1 do
	1150	begin
	1151	TTFProduct(Objects[0, i]).Free;
	1152	Rows[i].Clear;
	1153	end;
	1154	grdSelected.RowCount := 1;
	1155	end;
	1156
	1157	procedure TfrmODDiet.cboProductMouseClick(Sender: TObject);
	1158	var
	1159	AProduct: TTFProduct;
	1160	begin
	1161	inherited;
	1162	// check quick order
	1163	if CharAt(cboProduct.ItemID, 1) = 'Q' then // setup quick order
	1164	begin
	1165	Responses.QuickOrder := ExtractInteger(cboProduct.ItemID);
	1166	SetValuesFromResponsesTF;
	1167	cboProduct.ItemIndex := -1;
	1168	Exit;
	1169	end;
	1170	if cboProduct.ItemIEN <= 0 then Exit;
	1171	AProduct := TTFProduct.Create;
	1172	AProduct.IEN := cboProduct.ItemIEN;
	1173	AProduct.Name := Piece(cboProduct.Items[cboProduct.ItemIndex], U, 3);
	1174	cboProduct.ItemIndex := -1;
	1175	with grdSelected do
	1176	begin
	1177	if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
	1178	Objects[0, RowCount - 1] := AProduct;
	1179	Cells[0, RowCount - 1] := AProduct.Name;
	1180	Cells[1, RowCount - 1] := 'FULL';
	1181	Row := RowCount - 1;
	1182	Col := 1;
	1183	end;
	1184	OrderMessage(OIMessage(AProduct.IEN));
	1185	TFChange(Sender);
	1186	end;
	1187
	1188	procedure TfrmODDiet.cboProductExit(Sender: TObject);
	1189	begin
	1190	inherited;
	1191	if (cboProduct.ItemIEN > 0) or (CharAt(cboProduct.ItemID, 1) = 'Q') then
	1192	cboProductMouseClick(Self);
	1193	end;
	1194
	1195	procedure TfrmODDiet.grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
	1196	State: TGridDrawState);
	1197	begin
	1198	inherited;
	1199	if Sender = ActiveControl then Exit;
	1200	if not (gdSelected in State) then Exit;
	1201	with Sender as TStringGrid do
	1202	begin
	1203	Canvas.Brush.Color := Color;
	1204	Canvas.Font := Font;
	1205	Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]);
	1206	end;
	1207	end;
	1208
	1209	procedure TfrmODDiet.grdSelectedSelectCell(Sender: TObject; Col, Row: Integer;
	1210	var CanSelect: Boolean);
	1211
	1212	procedure PlaceControl(AControl: TWinControl);
	1213	var
	1214	ARect: TRect;
	1215	begin
	1216	with AControl do
	1217	begin
	1218	ARect := grdSelected.CellRect(Col, Row);
	1219	SetBounds(ARect.Left + grdSelected.Left + 1, ARect.Top + grdSelected.Top + 1,
	1220	ARect.Right - ARect.Left + 1, ARect.Bottom - ARect.Top + 1);
	1221	BringToFront;
	1222	Show;
	1223	SetFocus;
	1224	end;
	1225	end;
	1226
	1227	begin
	1228	inherited;
	1229	if (Col <> 1) and (Col <> 2) then Exit;
	1230	if csDestroying in ComponentState then Exit;
	1231	if Col = 1 then
	1232	begin
	1233	cboStrength.ItemIndex :=cboStrength.Items.IndexOf(grdSelected.Cells[Col, Row]);
	1234	cboStrength.Tag := (Col * 256) + Row;
	1235	PlaceControl(cboStrength);
	1236	end;
	1237	if Col = 2 then
	1238	begin
	1239	txtQuantity.Text := grdSelected.Cells[Col, Row];
	1240	txtQuantity.Tag := (Col * 256) + Row;
	1241	PlaceControl(txtQuantity);
	1242	end;
	1243	end;
	1244
	1245	procedure TfrmODDiet.SetNextCell(ACol, ARow: Integer);
	1246	begin
	1247	FNextCol := ACol;
	1248	FNextRow := ARow;
	1249	end;
	1250
	1251	procedure TfrmODDiet.TFMoveToNextCell;
	1252	var
	1253	NextCol, NextRow: Integer;
	1254	begin
	1255	if (FNextCol < 0) or (FNextRow < 0) then Exit;
	1256	if (ActiveControl = grdSelected) and not (csLButtonDown in grdSelected.ControlState) then
	1257	begin
	1258	NextCol := FNextCol;
	1259	NextRow := FNextRow;
	1260	with grdSelected do if NextCol <> Col then Col := NextCol;
	1261	with grdSelected do if NextRow <> Row then Row := NextRow;
	1262	end;
	1263	end;
	1264
	1265	procedure TfrmODDiet.TFSetAmountForRow(ARow: Integer);
	1266	var
	1267	Product, Strength: Integer;
	1268	x: string;
	1269	begin
	1270	with grdSelected do
	1271	begin
	1272	if Objects[0, ARow] <> nil
	1273	then Product := TTFProduct(Objects[0, ARow]).IEN
	1274	else Product := 0;
	1275	Strength := TFStrengthCode(Cells[1, ARow]);
	1276	x := ExpandedQuantity(Product, Strength, Cells[2, ARow]);
	1277	if Length(x) > 0 then
	1278	begin
	1279	grdSelected.Cells[2, ARow] := Piece(x, U, 2);
[460]	1280	grdSelected.Cells[3, ARow] := Piece(x, U, 1) + 'ml';
[459]	1281	end
	1282	else grdSelected.Cells[3, ARow] := '';
	1283	end;
	1284	end;
	1285
	1286	function TfrmODDiet.TFStrengthCode(const x: string): Integer;
	1287	begin
	1288	Result := 0;
	1289	if x = '1/4' then Result := 1
	1290	else if x = '1/2' then Result := 2
	1291	else if x = '3/4' then Result := 3
	1292	else if x = 'FULL' then Result := 4;
	1293	end;
	1294
	1295	procedure TfrmODDiet.cboStrengthEnter(Sender: TObject);
	1296	begin
	1297	inherited;
	1298	SetNextCell(2, grdSelected.Row);
	1299	end;
	1300
	1301	procedure TfrmODDiet.cboStrengthKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
	1302	begin
	1303	inherited;
	1304	with grdSelected do
	1305	case Key of
	1306	VK_LEFT: SetNextCell(0, Row);
	1307	VK_RIGHT: SetNextCell(2, Row);
	1308	end;
	1309	if Key in [VK_LEFT, VK_RIGHT] then
	1310	begin
	1311	Key := 0;
	1312	if not (csDestroying in ComponentState) then grdSelected.SetFocus;
	1313	end;
	1314	end;
	1315
	1316	procedure TfrmODDiet.cboStrengthChange(Sender: TObject);
	1317	begin
	1318	inherited;
	1319	with cboStrength do
	1320	begin
	1321	if Tag < 0 then Exit;
	1322	grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
	1323	end;
	1324	TFChange(Sender);
	1325	end;
	1326
	1327	procedure TfrmODDiet.cboStrengthExit(Sender: TObject);
	1328	begin
	1329	inherited;
	1330	with cboStrength do
	1331	begin
	1332	grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
	1333	TFSetAmountForRow(Tag mod 256);
	1334	Tag := -1;
	1335	Hide;
	1336	end;
	1337	TFChange(Sender);
	1338	TFMoveToNextCell;
	1339	end;
	1340
	1341	procedure TfrmODDiet.txtQuantityEnter(Sender: TObject);
	1342	begin
	1343	inherited;
	1344	SetNextCell(-1, -1);
	1345	end;
	1346
	1347	procedure TfrmODDiet.txtQuantityKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
	1348	begin
	1349	inherited;
	1350	with grdSelected, txtQuantity do
	1351	case Key of
	1352	VK_UP: SetNextCell(Col, HigherOf(Row - 1, 0));
	1353	VK_DOWN: SetNextCell(Col, LowerOf(Row + 1, RowCount - 1));
	1354	VK_LEFT: if (SelLength = 0) and (SelStart = 0) then SetNextCell(1, Row);
	1355	VK_RIGHT: if (SelLength = 0) and (SelStart = Length(Text)) then SetNextCell(3, Row);
	1356	VK_END: if (SelLength = 0) and (SelStart = Length(Text)) then SetNextCell(3, Row);
	1357	VK_HOME: if (SelLength = 0) and (SelStart = 0) then SetNextCell(0, Row);
	1358	VK_PRIOR: SetNextCell(Col, 0);
	1359	VK_NEXT: SetNextCell(Col, RowCount - 1);
	1360	end;
	1361	if FNextCol > -1 then
	1362	begin
	1363	Key := 0;
	1364	if not (csDestroying in ComponentState) then grdSelected.SetFocus;
	1365	end;
	1366	end;
	1367
	1368	procedure TfrmODDiet.txtQuantityChange(Sender: TObject);
	1369	begin
	1370	inherited;
	1371	with txtQuantity do
	1372	begin
	1373	if Tag < 0 then Exit;
	1374	grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
	1375	end;
	1376	TFChange(Sender);
	1377	end;
	1378
	1379	procedure TfrmODDiet.txtQuantityExit(Sender: TObject);
	1380	begin
	1381	inherited;
	1382	with txtQuantity do
	1383	begin
	1384	grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
	1385	TFSetAmountForRow(Tag mod 256);
	1386	Tag := -1;
	1387	Hide;
	1388	end;
	1389	TFChange(Sender);
	1390	TFMoveToNextCell;
	1391	end;
	1392
	1393	procedure TfrmODDiet.cmdTFRemoveClick(Sender: TObject);
	1394	var
	1395	i: Integer;
	1396	begin
	1397	inherited;
	1398	with grdSelected do
	1399	begin
	1400	if Row < 0 then Exit;
	1401	if Objects[0, Row] <> nil then TTFProduct(Objects[0, Row]).Free;
	1402	for i := Row to RowCount - 2 do Rows[i] := Rows[i + 1];
	1403	Rows[RowCount - 1].Clear;
	1404	RowCount := RowCount - 1;
	1405	end;
	1406	TFChange(Sender);
	1407	end;
	1408
	1409	procedure TfrmODDiet.TFChange(Sender: TObject);
	1410	var
	1411	i: Integer;
	1412	AProduct: TTFProduct;
	1413
	1414	begin
	1415	inherited;
	1416	if Changing then Exit;
	1417	if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
	1418	with grdSelected do for i := 0 to RowCount - 1 do
	1419	begin
	1420	AProduct := TTFProduct(Objects[0, i]);
	1421	if AProduct = nil then Continue;
	1422	with AProduct do if IEN > 0
	1423	then Responses.Update('ORDERABLE', i+1, IntToStr(IEN), Name);
	1424	if TFStrengthCode(Cells[1,i]) > 0
	1425	then Responses.Update('STRENGTH', i+1, IntToStr(TFStrengthCode(Cells[1,i])), Cells[1,i]);
	1426	if Length(Cells[2,i]) > 0
	1427	then Responses.Update('INSTR', i+1, Cells[2,i], Cells[2,i]);
	1428	end; {with grdSelected}
	1429	with txtTFComment do if Text <> ''
	1430	then Responses.Update('COMMENT', 1, Text, Text);
	1431	with chkCancelTrays do if Checked
	1432	then Responses.Update('CANCEL', 1, '1', 'Yes')
	1433	else Responses.Update('CANCEL', 1, '0', 'No');
[460]	1434	if not OrderForInpatient then
	1435	begin
	1436	calOPTFStart.FMDateTime := StrToFloatDef(cboOPTFRecurringMeals.ItemID, 0);
	1437	Responses.Update('DATETIME', 1, FloatToStr(calOPTFStart.FMDateTime), calOPTFStart.Text);
	1438	end;
[459]	1439	memOrder.Text := Responses.OrderText;
	1440	end;
	1441
	1442	{ Early/Late Tray tab ----------------------------------------------------------------------- }
	1443
	1444	procedure TfrmODDiet.ResetControlsEL;
	1445	begin
	1446	grpMeal.ItemIndex := 3;
	1447	grpMeal.TabStop := True;
	1448	grpMealTime.TabStop := False;
	1449	radET1.Visible := False;
	1450	radET2.Visible := False;
	1451	radET3.Visible := False;
	1452	radLT1.Visible := False;
	1453	radLT2.Visible := False;
	1454	radLT3.Visible := False;
	1455	lblNoTimes.Visible := False;
	1456	calELStart.Text := '';
	1457	calELStop.Text := '';
	1458	chkMonday.Checked := False;
	1459	chkTuesday.Checked := False;
	1460	chkWednesday.Checked := False;
	1461	chkThursday.Checked := False;
	1462	chkFriday.Checked := False;
	1463	chkSaturday.Checked := False;
	1464	chkSunday.Checked := False;
	1465	chkBagged.Checked := False;
	1466	end;
	1467
	1468	procedure TfrmODDiet.SetValuesFromResponsesEL;
	1469	var
	1470	AResponse: TResponse;
	1471	begin
	1472	Changing := True;
	1473	ResetControlsEL;
	1474	with Responses do
	1475	begin
	1476	AResponse := FindResponseByName('MEAL', 1);
	1477	if AResponse <> nil then
	1478	begin
	1479	if AResponse.IValue = 'B' then grpMeal.ItemIndex := 0;
	1480	if AResponse.IValue = 'N' then grpMeal.ItemIndex := 1;
	1481	if AResponse.IValue = 'E' then grpMeal.ItemIndex := 2;
	1482	end;
	1483	if grpMeal.ItemIndex <> 3 then grpMealClick(Self);
	1484	AResponse := FindResponseByName('TIME', 1);
	1485	if AResponse <> nil then
	1486	begin
	1487	if radET1.Caption = AResponse.IValue then radET1.Checked := True;
	1488	if radET2.Caption = AResponse.IValue then radET2.Checked := True;
	1489	if radET3.Caption = AResponse.IValue then radET3.Checked := True;
	1490	if radLT1.Caption = AResponse.IValue then radLT1.Checked := True;
	1491	if radLT2.Caption = AResponse.IValue then radLT2.Checked := True;
	1492	if radLT3.Caption = AResponse.IValue then radLT3.Checked := True;
	1493	end;
[460]	1494	if not OrderForInpatient then
	1495	SetControl(cboOPELRecurringMeals, 'START', 1)
	1496	else
	1497	begin
	1498	SetControl(calELStart, 'START', 1);
	1499	SetControl(calELStop, 'STOP', 1);
	1500	end;
[459]	1501	calELStopChange(Self);
	1502	AResponse := FindResponseByName('SCHEDULE', 1);
	1503	if AResponse <> nil then
	1504	begin
	1505	chkMonday.Checked := Pos('M', AResponse.IValue) > 0;
	1506	chkTuesday.Checked := Pos('T', AResponse.IValue) > 0;
	1507	chkWednesday.Checked := Pos('W', AResponse.IValue) > 0;
	1508	chkThursday.Checked := Pos('R', AResponse.IValue) > 0;
	1509	chkFriday.Checked := Pos('F', AResponse.IValue) > 0;
	1510	chkSaturday.Checked := Pos('S', AResponse.IValue) > 0;
	1511	chkSunday.Checked := Pos('X', AResponse.IValue) > 0;
	1512	end;
	1513	AResponse := FindResponseByName('YN', 1);
	1514	if AResponse <> nil then chkBagged.Checked := AResponse.IValue = '1';
	1515	end; {with Responses}
	1516	Changing := False;
	1517	ELChange(Self);
	1518	end;
	1519
	1520	function TfrmODDiet.GetMealTime: string;
	1521	begin
	1522	Result := '';
	1523	if radET1.Checked then Result := radET1.Caption;
	1524	if radET2.Checked then Result := radET2.Caption;
	1525	if radET3.Checked then Result := radET3.Caption;
	1526	if radLT1.Checked then Result := radLT1.Caption;
	1527	if radLT2.Checked then Result := radLT2.Caption;
	1528	if radLT3.Checked then Result := radLT3.Caption;
	1529	end;
	1530
	1531	function TfrmODDiet.GetDaysOfWeek: string;
	1532	begin
	1533	Result := '';
	1534	if chkMonday.Checked then Result := Result + 'M';
	1535	if chkTuesday.Checked then Result := Result + 'T';
	1536	if chkWednesday.Checked then Result := Result + 'W';
	1537	if chkThursday.Checked then Result := Result + 'R';
	1538	if chkFriday.Checked then Result := Result + 'F';
	1539	if chkSaturday.Checked then Result := Result + 'S';
	1540	if chkSunday.Checked then Result := Result + 'X';
	1541	end;
	1542
	1543	function TfrmODDiet.IsEarlyTray: Boolean;
	1544	begin
	1545	Result := True;
	1546	if radLT1.Checked then Result := False;
	1547	if radLT2.Checked then Result := False;
	1548	if radLT3.Checked then Result := False;
	1549	end;
	1550
	1551	procedure TfrmODDiet.grpMealClick(Sender: TObject);
	1552
	1553	procedure SetMealTimes(const x: string);
	1554
	1555	procedure ActivateButton( Button: TRadioButton; const MealTime: string;
	1556	var MoreActivated: boolean);
	1557	var
	1558	Activate: boolean;
	1559	begin
	1560	Button.Caption := MealTime;
	1561	Activate := Length(MealTime) > 0;
	1562	Button.Visible := Activate;
	1563	Button.Checked := Activate and not MoreActivated;
	1564	MoreActivated := MoreActivated or Activate;
	1565	end;
	1566
	1567	var
	1568	HasTimes: Boolean;
	1569	begin
	1570	HasTimes := False;
	1571	ActivateButton(radET1, Piece(x, U, 1), HasTimes);
	1572	ActivateButton(radET2, Piece(x, U, 2), HasTimes);
	1573	ActivateButton(radET3, Piece(x, U, 3), HasTimes);
	1574	ActivateButton(radLT1, Piece(x, U, 4), HasTimes);
	1575	ActivateButton(radLT2, Piece(x, U, 5), HasTimes);
	1576	ActivateButton(radLT3, Piece(x, U, 6), HasTimes);
	1577	lblNoTimes.Visible := not HasTimes;
	1578	end;
[460]	1579	var
	1580	AMeal: string;
[459]	1581	begin
	1582	inherited;
[460]	1583	Changing := True;
[459]	1584	case grpMeal.ItemIndex of
[460]	1585	0: begin
	1586	SetMealTimes(uDietParams.BTimes);
	1587	AMeal := 'B';
	1588	end;
	1589	1: begin
	1590	SetMealTimes(uDietParams.NTimes);
	1591	AMeal := 'N';
	1592	end;
	1593	2: begin
	1594	SetMealTimes(uDietParams.ETimes);
	1595	AMeal := 'E';
	1596	end;
	1597	else
	1598	begin
	1599	SetMealTimes('');
	1600	AMeal := '';
	1601	end;
[459]	1602	end;
[460]	1603	if not OrderForInpatient then
	1604	begin
	1605	if AMeal = '' then
	1606	begin
	1607	uRecurringMealList.Clear;
	1608	cboOPELRecurringMeals.Clear;
	1609	end
	1610	else if not PatientHasRecurringMeals(uRecurringMealList, AMeal) then
	1611	begin
	1612	uRecurringMealList.Clear;
	1613	cboOPELRecurringMeals.Clear;
	1614	grpMeal.ItemIndex := 3;
	1615	end
	1616	else
	1617	cboOPELRecurringMeals.Items.Assign(uRecurringMealList);
	1618	end;
	1619	Changing := False;
	1620	ELChange(grpMeal);
[459]	1621	end;
	1622
	1623
	1624	procedure TfrmODDiet.SetEnableDOW(AllowUse: Boolean);
	1625	begin
	1626	grpDOW.Enabled := AllowUse;
	1627	chkMonday.Enabled := AllowUse;
	1628	chkTuesday.Enabled := AllowUse;
	1629	chkWednesday.Enabled := AllowUse;
	1630	chkThursday.Enabled := AllowUse;
	1631	chkFriday.Enabled := AllowUse;
	1632	chkSaturday.Enabled := AllowUse;
	1633	chkSunday.Enabled := AllowUse;
	1634	end;
	1635
	1636	procedure TfrmODDiet.calELStartEnter(Sender: TObject);
	1637	begin
	1638	inherited;
	1639	FChangeStop := Length(calELStop.Text) = 0;
	1640	end;
	1641
	1642	procedure TfrmODDiet.calELStartChange(Sender: TObject);
	1643	begin
	1644	inherited;
	1645	if FChangeStop then
	1646	calELStop.Text := calELStart.Text
	1647	else
	1648	ELChange(Sender);
	1649	end;
	1650
	1651	procedure TfrmODDiet.calELStartExit(Sender: TObject);
	1652	begin
	1653	inherited;
[460]	1654	if not OrderForInpatient then SetEnableDOW(False)
	1655	else if (Length(calELStop.Text) > 0) and (calELStop.Text = calELStart.Text)
[459]	1656	then SetEnableDOW(False)
	1657	else SetEnableDOW(True);
	1658	end;
	1659
	1660	procedure TfrmODDiet.calELStopChange(Sender: TObject);
	1661	begin
	1662	inherited;
	1663	if (Length(calELStop.Text) > 0) and (calELStop.FMDateTime = calELStart.FMDateTime)
	1664	then SetEnableDOW(False)
	1665	else SetEnableDOW(True);
	1666	ELChange(Sender);
	1667	end;
	1668
	1669	procedure TfrmODDiet.ELChange(Sender: TObject);
	1670	var
	1671	x: string;
	1672	begin
	1673	inherited;
	1674	if Changing then Exit;
	1675	if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
	1676	case grpMeal.ItemIndex of
	1677	0: Responses.Update('MEAL', 1, 'B', 'BREAKFAST');
	1678	1: Responses.Update('MEAL', 1, 'N', 'NOON');
	1679	2: Responses.Update('MEAL', 1, 'E', 'EVENING');
	1680	end;
	1681	x := GetMealTime;
	1682	if Length(x) > 0 then
	1683	begin
	1684	Responses.Update('TIME', 1, x, x);
	1685	if IsEarlyTray
	1686	then Responses.Update('ORDERABLE', 1, uDietParams.EarlyIEN, 'EARLY TRAY')
	1687	else Responses.Update('ORDERABLE', 1, uDietParams.LateIEN, 'LATE TRAY');
	1688	end;
[460]	1689	if not OrderForInpatient then
	1690	begin
	1691	calELStart.FMDateTime := StrToFloatDef(cboOPELRecurringMeals.ItemID, 0);
	1692	calELStop.FMDateTime := calELStart.FMDateTime;
	1693	end;
[459]	1694	with calELStart do if Length(Text) > 0 then Responses.Update('START', 1, Text, Text);
	1695	with calELStop do if Length(Text) > 0 then Responses.Update('STOP', 1, Text, Text);
	1696	x := GetDaysOfWeek;
	1697	if Length(x) > 0 then Responses.Update('SCHEDULE', 1, x, x);
	1698	if chkBagged.Checked
	1699	then Responses.Update('YN', 1, '1', 'YES')
	1700	else Responses.Update('YN', 1, '0', 'NO');
	1701	memOrder.Text := Responses.OrderText;
	1702	end;
	1703
	1704	{ Isolation Precautions tab ----------------------------------------------------------------- }
	1705
	1706	procedure TfrmODDiet.ResetControlsIP;
	1707	begin
	1708	lstIsolation.ItemIndex := -1;
	1709	txtIPComment.Text := '';
	1710	end;
	1711
	1712	procedure TfrmODDiet.SetValuesFromResponsesIP;
	1713	begin
	1714	Changing := True;
	1715	ResetControlsIP;
	1716	Responses.SetControl(lstIsolation, 'ISOLATION', 1);
	1717	Responses.SetControl(txtIPComment, 'COMMENT', 1);
	1718	Changing := False;
	1719	IPChange(Self);
	1720	end;
	1721
	1722	procedure TfrmODDiet.IPChange(Sender: TObject);
	1723	begin
	1724	inherited;
	1725	if Changing then Exit;
	1726	if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
	1727	Responses.Update('ORDERABLE', 1, FIsolationID, 'Isolation Procedures');
	1728	with lstIsolation do if ItemIEN > 0
	1729	then Responses.Update('ISOLATION', 1, ItemID, DisplayText[ItemIndex]);
	1730	with txtIPComment do if Text <> ''
	1731	then Responses.Update('COMMENT', 1, Text, Text);
	1732	memOrder.Text := Responses.OrderText;
	1733	end;
	1734
	1735	{ Additional Diet Order tab ----------------------------------------------------------------- }
	1736
	1737	procedure TfrmODDiet.ResetControlsAO;
	1738	begin
	1739	txtAOComment.Text := '';
[460]	1740	calOPAOStart.Text := '';
[459]	1741	end;
	1742
	1743	procedure TfrmODDiet.SetValuesFromResponsesAO;
	1744	begin
	1745	Changing := True;
	1746	ResetControlsAO;
	1747	Responses.SetControl(txtAOComment, 'COMMENT', 1);
[460]	1748	//Responses.SetControl(calOPAOStart, 'DATETIME', 1);
	1749	Responses.SetControl(cboOPAORecurringMeals, 'DATETIME', 1);
[459]	1750	Changing := False;
	1751	AOChange(Self);
	1752	end;
	1753
	1754	procedure TfrmODDiet.AOChange(Sender: TObject);
	1755	begin
	1756	inherited;
	1757	if Changing then Exit;
	1758	with txtAOComment do if Text <> ''
	1759	then Responses.Update('COMMENT', 1, Text, Text);
[460]	1760	if not OrderForInpatient then
	1761	begin
	1762	calOPAOStart.FMDateTime := StrToFloatDef(cboOPAORecurringMeals.ItemID, 0);
	1763	Responses.Update('DATETIME', 1, FloatToStr(calOPAOStart.FMDateTime), calOPAOStart.Text);
	1764	end;
[459]	1765	memOrder.Text := Responses.OrderText;
	1766	end;
	1767
[460]	1768
[459]	1769	{ Outpatient Meals Order tab ----------------------------------------------------------------- }
	1770
	1771	procedure TfrmODDiet.cboOPDietAvailMouseClick(Sender: TObject);
	1772	var
	1773	NewDiet,ErrMsg: string;
	1774
	1775	procedure SetError(const AnError: string);
	1776	begin
	1777	if Length(ErrMsg) > 0 then Exit;
	1778	ErrMsg := AnError;
	1779	end;
	1780
	1781	begin
	1782	inherited;
[460]	1783	if cboOPDietAvail.Items.Count = 0 then
	1784	begin
	1785	InfoBox(TX_NO_MEALS_DEFINED, TC_NO_MEALS_DEFINED, MB_OK or MB_ICONINFORMATION);
	1786	AbortOrder := True;
	1787	exit;
	1788	end ;
[459]	1789	if CharAt(cboOPDietAvail.ItemID, 1) = 'Q' then // setup quick order
	1790	begin
	1791	Responses.QuickOrder := ExtractInteger(cboOPDietAvail.ItemID);
	1792	SetValuesFromResponsesOP;
	1793	cboOPDietAvail.ItemIndex := -1;
	1794	Exit;
	1795	end;
	1796	if cboOPDietAvail.ItemIEN > 0 then with lstOPDietSelect do
	1797	begin
	1798	ErrMsg := '';
	1799	NewDiet := DietAttributes(cboOPDietAvail.ItemIEN);
	1800	if Piece(NewDiet,'^',1)='0' then
	1801	begin
	1802	InfoBox(Piece(NewDiet,'^',2),TC_OP_DIET_ERR, MB_OK);
	1803	cboOPDietAvail.ItemIndex := -1;
	1804	Exit;
	1805	end;
	1806	lstOPDietSelect.Items.Clear;
	1807	lstOPDietSelect.Items.Add(NewDiet);
	1808	{ TODO -oRich V. -cOutpatient Meals : Will these be selectable for an outpatient meal? }
	1809	OPDietCheckForNPO;
	1810	{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
	1811	OPDietCheckForTF;
	1812	OrderMessage(OIMessage(StrToIntDef(Piece(NewDiet, U, 1), 0)));
	1813	OPChange(Sender);
	1814	end; {if cboOPDietAvail}
[460]	1815	OPChange(Sender);
[459]	1816	cboOPDietAvail.ItemIndex := -1;
	1817	end;
	1818
	1819	procedure TfrmODDiet.cboOPDietAvailExit(Sender: TObject);
	1820	begin
	1821	inherited;
	1822	if (cboOPDietAvail.ItemIEN > 0) or (CharAt(cboOPDietAvail.ItemID, 1) = 'Q') then
	1823	cboOPDietAvailMouseClick(Self);
	1824	end;
	1825
	1826	procedure TfrmODDiet.ResetControlsOP;
	1827	begin
	1828	lstOPDietSelect.Clear;
	1829	cboOPDietAvail.ItemIndex := -1;
	1830	grpOPMeal.ItemIndex := 3;
	1831	grpOPMeal.TabStop := True;
	1832	chkOPMonday.Checked := False;
	1833	chkOPTuesday.Checked := False;
	1834	chkOPWednesday.Checked := False;
	1835	chkOPThursday.Checked := False;
	1836	chkOPFriday.Checked := False;
	1837	chkOPSaturday.Checked := False;
	1838	chkOPSunday.Checked := False;
	1839	lblOPComment.Visible := False;
	1840	txtOPDietComment.Visible := False;
	1841	txtOPDietComment.Text := '';
	1842	if uDialogName = 'FHW OP MEAL' then
	1843	begin
	1844	calOPStart.Text := '';
	1845	calOPStop.Text := '';
	1846	calOPStart.Enabled := True;
	1847	calOPStop.Enabled := True;
	1848	lblOPStart.Enabled := True;
	1849	lblOPStop.Enabled := True;
	1850	grpOPDOW.Visible := True;
	1851	end
	1852	else if uDialogName = 'FHW SPECIAL MEAL' then
	1853	begin
	1854	calOPStart.Text := 'TODAY';
	1855	calOPStop.Text := 'TODAY';
	1856	calOPStart.Enabled := False;
	1857	calOPStop.Enabled := False;
	1858	lblOPStart.Enabled := False;
	1859	lblOPStop.Enabled := False;
	1860	grpOPDOW.Visible := False;
	1861	end;
	1862	end;
	1863
	1864	procedure TfrmODDiet.SetValuesFromResponsesOP;
	1865	var
	1866	AResponse: TResponse;
	1867	ADiet: string;
	1868	begin
	1869	Changing := True;
	1870	ResetControlsOP;
	1871	with Responses do
	1872	begin
	1873	AResponse := FindResponseByName('ORDERABLE', 1);
	1874	if AResponse <> nil then
	1875	begin
	1876	ADiet := DietAttributes(StrToIntDef(AResponse.IValue,0));
	1877	if Piece(ADiet,'^',1)='0' then
	1878	begin
	1879	InfoBox(Piece(ADiet,'^',2), TC_OP_DIET_ERR, MB_OK);
	1880	cboOPDietAvail.ItemIndex := -1;
[460]	1881	Changing := False;
[459]	1882	Exit;
	1883	end;
	1884	SetControl(cboOPDietAvail, 'ORDERABLE', 1);
	1885	lstOPDietSelect.Items.Add(ADiet);
	1886	end;
	1887	SetControl(cboOPDelivery, 'DELIVERY', 1);
	1888	AResponse := FindResponseByName('MEAL', 1);
	1889	if AResponse <> nil then
	1890	begin
	1891	if AResponse.IValue = 'B' then grpOPMeal.ItemIndex := 0;
	1892	if AResponse.IValue = 'N' then grpOPMeal.ItemIndex := 1;
	1893	if AResponse.IValue = 'E' then grpOPMeal.ItemIndex := 2;
	1894	end;
	1895	SetControl(calOPStart, 'START', 1);
	1896	SetControl(calOPStop, 'STOP', 1);
	1897	calOPStopChange(Self);
	1898	AResponse := FindResponseByName('SCHEDULE', 1);
	1899	if AResponse <> nil then
	1900	begin
	1901	chkOPMonday.Checked := Pos('M', AResponse.IValue) > 0;
	1902	chkOPTuesday.Checked := Pos('T', AResponse.IValue) > 0;
	1903	chkOPWednesday.Checked := Pos('W', AResponse.IValue) > 0;
	1904	chkOPThursday.Checked := Pos('R', AResponse.IValue) > 0;
	1905	chkOPFriday.Checked := Pos('F', AResponse.IValue) > 0;
	1906	chkOPSaturday.Checked := Pos('S', AResponse.IValue) > 0;
	1907	chkOPSunday.Checked := Pos('X', AResponse.IValue) > 0;
	1908	end;
	1909	SetControl(txtOPDietComment, 'COMMENT', 1);
	1910	end; {with Responses}
	1911	OPDietCheckForNPO;
	1912	OPDietCheckForTF;
	1913	Changing := False;
	1914	OPChange(Self);
	1915	end;
	1916
	1917	procedure TfrmODDiet.calOPStartEnter(Sender: TObject);
	1918	begin
	1919	inherited;
	1920	FChangeStop := Length(calOPStop.Text) = 0;
	1921	end;
	1922
	1923	procedure TfrmODDiet.calOPStartChange(Sender: TObject);
	1924	begin
	1925	inherited;
[460]	1926	if Changing then exit;
[459]	1927	if FChangeStop then
	1928	calOPStop.Text := calOPStart.Text
	1929	else
	1930	OPChange(Sender);
	1931	end;
	1932
[460]	1933	function TfrmODDiet.FMDOW(AnFMDate: TFMDateTime): integer;
	1934	var
	1935	WinDate: TDateTime;
	1936	x: integer;
	1937	begin
	1938	WinDate := FMDateTimeToDateTime(AnFMDate);
	1939	x := DayOfTheWeek(WinDate);
	1940	Result := x;
	1941	end;
	1942
	1943	function TfrmODDiet.FMDays(AStart, AEnd: TFMDateTime): string;
	1944	var
	1945	AWinStart, AWinEnd: TDateTime;
	1946	i: double;
	1947	Days: string;
	1948	begin
	1949	AWinStart := FMDateTimeToDateTime(AStart);
	1950	AWinEnd := FMDateTimeToDateTime(AEnd);
	1951	i := AWinStart;
	1952	repeat
	1953	Days := Days + FMDayLetters[DayOfTheWeek(i)];
	1954	i := i + 1;
	1955	until i > AWinEnd;
	1956	Result := Days;
	1957	end;
	1958
[459]	1959	procedure TfrmODDiet.calOPStartExit(Sender: TObject);
[460]	1960	var
	1961	Days: string;
[459]	1962	begin
	1963	inherited;
[460]	1964	if not (calOPStart.FMDateTime > 0) then
	1965	begin
	1966	SetEnableOPDOW(False, -1);
	1967	Exit ;
	1968	end;
	1969	if (Length(calOPStop.Text) > 0) and (calOPStop.Text = calOPStart.Text) then
	1970	SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
	1971	else
	1972	begin
	1973	Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
	1974	SetEnableOPDOW(True, -1, Days);
	1975	end;
[459]	1976	end;
	1977
	1978	procedure TfrmODDiet.calOPStopChange(Sender: TObject);
[460]	1979	var
	1980	Days: string;
[459]	1981	begin
	1982	inherited;
[460]	1983	if Changing then exit;
	1984	if not (calOPStop.FMDateTime > 0) then
	1985	begin
	1986	SetEnableOPDOW(False, -1);
	1987	Exit ;
	1988	end;
	1989	if (Length(calOPStop.Text) > 0) and (calOPStop.FMDateTime = calOPStart.FMDateTime) then
	1990	SetEnableOPDOW(False, FMDOW(calOPStart.FMDateTime))
	1991	else
	1992	begin
	1993	Days := FMDays(calOPStart.FMDateTime, calOPStop.FMDateTime);
	1994	SetEnableOPDOW(True, -1, Days);
	1995	end;
[459]	1996	OPChange(Sender);
	1997	end;
	1998
	1999	procedure TfrmODDiet.OPChange(Sender: TObject);
	2000	var
	2001	x: string;
	2002	//i: integer;
	2003	begin
	2004	inherited;
	2005	if Changing then Exit;
	2006	if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
[460]	2007	// Per NFS, only one selection allowed from any of 10-15 available OP diets
[459]	2008	with lstOPDietSelect do if Items.Count > 0 then
	2009	Responses.Update('ORDERABLE', 1, Piece(Items[0], U, 1), Piece(Items[0], U, 2));
	2010	case grpOPMeal.ItemIndex of
	2011	0: Responses.Update('MEAL', 1, 'B', 'BREAKFAST');
	2012	1: Responses.Update('MEAL', 1, 'N', 'NOON');
	2013	2: Responses.Update('MEAL', 1, 'E', 'EVENING');
	2014	end;
	2015	with calOPStart do (if Length(Text) > 0 then) Responses.Update('START', 1, Text, Text);
	2016	with calOPStop do (if Length(Text) > 0 then) Responses.Update('STOP', 1, Text, Text);
	2017	if uDialogName = 'FHW OP MEAL' then
	2018	begin
	2019	x := GetOPDaysOfWeek;
[460]	2020	if Length(x) = 0 then x := 'ONCE';
	2021	Responses.Update('SCHEDULE', 1, x, x);
[459]	2022	end;
	2023	with txtOPDietComment do {if Length(Text) > 0 then} Responses.Update('COMMENT', 1, Text, Text);
	2024	with cboOPDelivery do if Visible then Responses.Update('DELIVERY', 1, ItemID, Text);
	2025	{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
	2026	(* with chkOPCancelTubefeeding do case State of
	2027	cbChecked: Responses.Update('CANCEL', 1, '1', 'YES');
	2028	cbUnchecked: Responses.Update('CANCEL', 1, '0', 'NO');
	2029	end;*)
	2030	Responses.VarTrailing := 'Meal';
	2031	memOrder.Text := Responses.OrderText;
	2032	end;
	2033
	2034	procedure TfrmODDiet.grpOPMealClick(Sender: TObject);
	2035	begin
	2036	inherited;
	2037	OPChange(Sender);
	2038	end;
	2039
[460]	2040	procedure TfrmODDiet.SetEnableOPDOW(AllowUse: Boolean; OneTimeDay: integer; DaysToCheck: string = '');
	2041	var
	2042	i: integer;
[459]	2043	begin
[460]	2044	if (not AllowUse) and (OneTimeDay > -1) then
	2045	begin
	2046	for i := 0 to grpOPDOW.ControlCount - 1 do
	2047	begin
	2048	if grpOPDOW.Controls[i] is TCheckBox then
	2049	TCheckBox(grpOPDOW.Controls[i]).Checked := False;
	2050	end;
	2051	//TCheckBox(grpOPDOW.Controls[OneTimeDay - 1]).Checked := True; CQ #8305
	2052	end;
[459]	2053	grpOPDOW.Enabled := AllowUse;
[460]	2054	chkOPMonday.Enabled := AllowUse and (Pos('M', DaysToCheck) > 0);
	2055	chkOPTuesday.Enabled := AllowUse and (Pos('T', DaysToCheck) > 0);
	2056	chkOPWednesday.Enabled := AllowUse and (Pos('W', DaysToCheck) > 0);
	2057	chkOPThursday.Enabled := AllowUse and (Pos('R', DaysToCheck) > 0);
	2058	chkOPFriday.Enabled := AllowUse and (Pos('F', DaysToCheck) > 0);
	2059	chkOPSaturday.Enabled := AllowUse and (Pos('S', DaysToCheck) > 0);
	2060	chkOPSunday.Enabled := AllowUse and (Pos('X', DaysToCheck) > 0);
[459]	2061	end;
	2062
	2063	function TfrmODDiet.GetOPDaysOfWeek: string;
	2064	begin
	2065	Result := '';
	2066	if chkOPMonday.Checked then Result := Result + 'M';
	2067	if chkOPTuesday.Checked then Result := Result + 'T';
	2068	if chkOPWednesday.Checked then Result := Result + 'W';
	2069	if chkOPThursday.Checked then Result := Result + 'R';
	2070	if chkOPFriday.Checked then Result := Result + 'F';
	2071	if chkOPSaturday.Checked then Result := Result + 'S';
	2072	if chkOPSunday.Checked then Result := Result + 'X';
	2073	end;
	2074
	2075	procedure TfrmODDiet.cmdOPRemoveClick(Sender: TObject);
	2076	begin
	2077	inherited;
	2078	with lstOPDietSelect do if ItemIndex > -1 then Items.Delete(ItemIndex);
	2079	OPChange(Sender);
	2080	with lstOPDietSelect do if Items.Count = 0 then
	2081	begin
	2082	lblOPDelivery.Visible := True;
	2083	cboOPDelivery.Visible := True;
	2084	{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
	2085	chkOPCancelTubefeeding.State := cbGrayed;
	2086	chkOPCancelTubefeeding.Visible := False;
	2087	end;
	2088	end;
	2089
	2090	function TfrmODDiet.GetOPMealWindow: string;
	2091	begin
	2092	case grpOPMeal.ItemIndex of
	2093	0: Result := Pieces(uDietParams.Alarms, U, 1, 2);
	2094	1: Result := Pieces(uDietParams.Alarms, U, 3, 4);
	2095	2: Result := Pieces(uDietParams.Alarms, U, 5, 6);
	2096	else
	2097	Result := U;
	2098	end;
	2099	end;
	2100
	2101	procedure TfrmODDiet.OPDietCheckForNPO;
	2102	begin
	2103	{ TODO -oRich V. -cOutpatient Meals : Need NFS input on this section (NPO and special instructions.) }
	2104	if Piece(lstOPDietSelect.Items[0], U, 2) = 'NPO' then
	2105	begin
	2106	lblOPDelivery.Visible := False;
	2107	cboOPDelivery.Visible := False;
	2108	lblOPComment.Visible := True;
	2109	txtOPDietComment.Visible := True;
	2110	end else
	2111	begin
	2112	lblOPComment.Visible := False;
	2113	txtOPDietComment.Visible := False;
	2114	txtOPDietComment.Text := '';
	2115	end;
	2116	end;
	2117
	2118	{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
	2119	procedure TfrmODDiet.OPDietCheckForTF;
	2120	var
	2121	x: string;
	2122	begin
	2123	with lstOPDietSelect do
	2124	begin
	2125	if (Items.Count = 1) and (Piece(Items[0], U, 2) <> 'NPO')
	2126	and (Length(uDietParams.CurTF) > 0) then
	2127	begin
	2128	x := TextForOrder(uDietParams.CurTF);
	2129	if InfoBox(TX_CANCEL_TF + x, TC_CANCEL_TF, MB_YESNO) = IDYES then
	2130	begin
	2131	chkOPCancelTubeFeeding.State := cbChecked;
	2132	chkOPCancelTubeFeeding.Visible := True;
	2133	end
	2134	else chkOPCancelTubeFeeding.State := cbUnchecked;
	2135	end; {if (Items...}
	2136	end; {with lstOPDietSelect}
	2137	end;
	2138
	2139	{ Common Buttons ---------------------------------------------------------------------------- }
	2140
	2141	procedure TfrmODDiet.cmdAcceptClick(Sender: TObject);
	2142	var
	2143	DCOrder: TOrder;
	2144	AResponse, AnotherResponse: TResponse;
	2145	LateTrayFields: TLateTrayFields;
	2146	NewOrder: TOrder;
	2147	CanSign: Integer;
	2148	begin
	2149	// these actions should be before inherited, so that InitDialog doesn't clear properties
	2150	LateTrayFields.LateMeal := #0; // #0 so only create late order if LT dialog invoked
	2151	if nbkDiet.ActivePage = pgeDiet then
	2152	begin
	2153	// create dc tubefeeding order
	2154	if chkCancelTubeFeeding.State = cbChecked then
	2155	begin
	2156	DCOrder := TOrder.Create;
	2157	DCOrder.ID := uDietParams.CurTF;
	2158	SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_DC, Integer(DCOrder));
	2159	DCOrder.Free;
	2160	end;
	2161	// check if late tray should be ordered
	2162	AResponse := Responses.FindResponseByName('ORDERABLE', 1);
[460]	2163	if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
[459]	2164	begin
	2165	AResponse := Responses.FindResponseByName('START', 1);
	2166	if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False);
	2167	end;
	2168	end;
	2169	{ TODO -oRich V. -cOutpatient Meals : Need to DC Tubefeeding order for OP meals? }
	2170	if nbkDiet.ActivePage = pgeOutPt then
	2171	begin
	2172	// create dc tubefeeding order
	2173	if chkOPCancelTubeFeeding.State = cbChecked then
	2174	begin
	2175	DCOrder := TOrder.Create;
	2176	DCOrder.ID := uDietParams.CurTF;
	2177	SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_DC, Integer(DCOrder));
	2178	DCOrder.Free;
	2179	end;
	2180	// check if late tray should be ordered
	2181	AResponse := Responses.FindResponseByName('ORDERABLE', 1);
[460]	2182	if (Self.EvtID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
[459]	2183	begin
	2184	AResponse := Responses.FindResponseByName('START', 1);
	2185	AnotherResponse := Responses.FindResponseByName('MEAL', 1);
	2186	if (AResponse <> nil) and (AnotherResponse <> nil) then
	2187	CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1));
	2188	end;
	2189	end;
	2190	inherited;
	2191	with LateTrayFields do if LateMeal <> #0 then
	2192	begin
	2193	NewOrder := TOrder.Create;
	2194	OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged);
	2195	if NewOrder.ID <> '' then
	2196	begin
[460]	2197	if OrderForInpatient then
	2198	begin
	2199	if (Encounter.Provider = User.DUZ) and User.CanSignOrders
	2200	then CanSign := CH_SIGN_YES
	2201	else CanSign := CH_SIGN_NA;
	2202	end
	2203	else
	2204	begin
	2205	CanSign := CH_SIGN_NA;
	2206	end;
[459]	2207	Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
	2208	SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
	2209	end
	2210	else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK);
	2211	NewOrder.Free;
	2212	end;
	2213	end;
	2214
	2215	procedure TfrmODDiet.FormKeyDown(Sender: TObject; var Key: Word;
	2216	Shift: TShiftState);
	2217	begin
	2218	inherited;
	2219	if (Key = VK_TAB) then begin
	2220	if (ssCtrl in Shift) then begin
	2221	if not (ActiveControl is TCustomMemo) or not TMemo(ActiveControl).WantTabs then begin
	2222	nbkDiet.SelectNextPage( not (ssShift in Shift));
	2223	Key := 0;
	2224	end;
	2225	end;
	2226	end;
	2227	end;
	2228
[460]	2229	procedure TfrmODDiet.cboOPDietAvailKeyDown(Sender: TObject; var Key: Word;
	2230	Shift: TShiftState);
	2231	begin
	2232	inherited;
	2233	if Key = VK_RETURN then cboOPDietAvailMouseClick(Self);
	2234	end;
	2235
	2236	function TfrmODDiet.PatientHasRecurringMeals(var MealList: TStringList; MealType: string = ''): boolean;
	2237	const
	2238	TX_NO_RECURRING_MEALS = 'For outpatients, this type of order requires association with an existing recurring' + CRLF +
	2239	'meal order. There are currently no active recurring meal orders for this patient.' + CRLF + CRLF +
	2240	'Those orders must be signed and released before they can be linked to this item.';
	2241	TC_NO_RECURRING_MEALS = 'Unable to order ' ;
	2242	begin
	2243	MealList.Clear;
	2244	GetCurrentRecurringOPMeals(MealList, MealType);
	2245	if MealList.Count = 0 then
	2246	begin
	2247	InfoBox(TX_NO_RECURRING_MEALS, TC_NO_RECURRING_MEALS + nbkDiet.ActivePage.Caption, MB_OK);
	2248	Result := False;
	2249	end
	2250	else
	2251	Result := True;
	2252	end;
	2253
[459]	2254	end.
	2255

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODDiet.pas@ 1115

Download in other formats: