source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fODDiet.pas@ 1797

Last change on this file since 1797 was 1693, checked in by healthsevak, 10 years ago

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