source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODDiet.pas@ 1717

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

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