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

Last change on this file since 730 was 456, checked in by Kevin Toppenberg, 16 years ago

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