source: cprs/trunk/CPRS-Chart/Orders/fODDiet.pas@ 1310

Last change on this file since 1310 was 829, checked in by Kevin Toppenberg, 15 years ago

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