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

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

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