source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fODDietLT.pas@ 1703

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

Upgrade to version 27

File size: 9.5 KB
Line 
1unit fODDietLT;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, ExtCtrls, StdCtrls, ORFn, fODBase, rODBase, VA508AccessibilityManager;
8
9type
10 TfrmODDietLT = class(TfrmAutoSz)
11 lblMealCutoff: TStaticText;
12 Label2: TStaticText;
13 GroupBox1: TGroupBox;
14 cmdYes: TButton;
15 cmdNo: TButton;
16 radLT1: TRadioButton;
17 radLT2: TRadioButton;
18 radLT3: TRadioButton;
19 chkBagged: TCheckBox;
20 Bevel1: TBevel;
21 procedure cmdYesClick(Sender: TObject);
22 procedure cmdNoClick(Sender: TObject);
23 procedure FormCreate(Sender: TObject);
24 private
25 FOutpatient: boolean;
26 YesPressed: Boolean;
27 public
28 { Public declarations }
29 end;
30
31 TLateTrayFields = record
32 LateMeal: Char;
33 LateTime: string;
34 IsBagged: Boolean;
35 end;
36
37procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
38procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields);
39procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean);
40
41implementation
42
43{$R *.DFM}
44
45uses rCore, uCore, rODDiet, uConst, rOrders;
46
47const
48 TX_MEAL_REQ = 'A meal time must be selected.';
49 TC_MEAL_REQ = 'No Meal Time Selected';
50
51procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
52var
53 frmODDietLT: TfrmODDietLT;
54 DietParams: TDietParams;
55 FMTime: TFMDateTime;
56 TimePart: Extended;
57 Meal: Char;
58 AvailTimes,ALocation: string;
59 TimeCount: Integer;
60
61 function AMPMToFMTime(const x: string): Extended;
62 var
63 IntTime: Integer;
64 begin
65 Result := 0;
66 if Pos(':', x) = 0 then Exit;
67 IntTime := StrToIntDef(Piece(x, ':', 1) + Copy(Piece(x, ':', 2), 1, 2), 0);
68 if (Pos('P', x) > 0) and (IntTime < 1200) then IntTime := IntTime + 1200;
69 if (Pos('A', x) > 0) and (IntTime > 1200) then IntTime := IntTime - 1200;
70 Result := IntTime / 10000;
71 end;
72
73 function FMTimeToAMPM(x: Extended): string;
74 var
75 TimePart: extended;
76 AMPMTime, Suffix: string;
77 begin
78 TimePart := Frac(x);
79 if TimePart > 0.1159 then
80 begin
81 if TimePart > 0.1259 then x := x - 0.12;
82 Suffix := 'P'
83 end
84 else Suffix := 'A';
85 AMPMTime := FormatFMDateTime('hh:nn', x);
86 Result := AMPMTime + Suffix;
87 end;
88
89 procedure SetAvailTimes(ATime: Extended; var ACount: Integer; var TimeList: string);
90 var
91 i: Integer;
92 ReturnList: string;
93 begin
94 ACount := 0;
95 ReturnList := '';
96 for i := 1 to 3 do
97 if AMPMToFMTime(Piece(TimeList, U, i)) > ATime then
98 begin
99 if Length(ReturnList) > 0 then ReturnList := ReturnList + U;
100 ReturnList := ReturnList + Piece(TimeList, U, i);
101 Inc(ACount);
102 end;
103 TimeList := ReturnList;
104 end;
105
106begin
107 // initialize LateTrayFields
108 LateTrayFields.LateMeal := #0;
109 LateTrayFields.LateTime := '';
110 LateTrayFields.IsBagged := False;
111 // make sure the start time is today and not in the future
112 FMTime := StrToFMDateTime(StartTime);
113 if FMTime < 0 then Exit;
114 if Int(FMTime) <> FMToday then Exit;
115 TimePart := Frac(FMTime);
116 if TimePart = 0 then TimePart := Frac(FMNow);
117 if TimePart > Frac(FMNow) then Exit;
118 Meal := #0;
119 ALocation := IntToStr(Encounter.Location);
120 LoadDietParams(DietParams,ALocation);
121 // check to see if falling within the alarm range of a meal
122 if not IsOutpatient then
123 begin
124 if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) and
125 (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := 'B';
126 if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) and
127 (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := 'N';
128 if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) and
129 (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := 'E';
130 if Meal = #0 then Exit;
131 end
132 else // for outpatients
133 begin
134(* From Rich Knoepfle, NFS developer
135If they order a breakfast and it is after the LATE BREAKFAST ALARM END, I don't allow them to do it. (For special meals I don't allow them to order something for the following day).
136If it's before the LATE BREAKFAST ALARM BEGIN than I accept the order.
137If it's between the LATE BREAKFAST ALARM BEGIN and ALARM END then I ask if they want to order a Late breakfast tray.
138*)
139 Meal := AMeal;
140 case AMeal of
141 'B': if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) or
142 (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := #0;
143 'N': if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) or
144 (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := #0;
145 'E': if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) or
146 (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := #0;
147 end;
148 if Meal = #0 then exit;
149 end;
150
151 // get the available late times for this meal
152 case Meal of
153 'B': AvailTimes := Pieces(DietParams.BTimes, U, 4, 6);
154 'E': AvailTimes := Pieces(DietParams.ETimes, U, 4, 6);
155 'N': AvailTimes := Pieces(DietParams.NTimes, U, 4, 6);
156 end;
157 SetAvailTimes(TimePart, TimeCount, AvailTimes);
158 if TimeCount = 0 then Exit;
159
160 // setup form to get the selected late tray
161 frmODDietLT := TfrmODDietLT.Create(Application);
162 try
163 ResizeFormToFont(TForm(frmODDietLT));
164 with frmODDietLT do
165 begin
166 FOutpatient := IsOutpatient;
167 if Length(Piece(AvailTimes, U, 1)) > 0 then radLT1.Caption := Piece(AvailTimes, U, 1);
168 if Length(Piece(AvailTimes, U, 2)) > 0 then radLT2.Caption := Piece(AvailTimes, U, 2);
169 if Length(Piece(AvailTimes, U, 3)) > 0 then radLT3.Caption := Piece(AvailTimes, U, 3);
170 radLT1.Visible := Length(radLT1.Caption) > 0;
171 radLT2.Visible := Length(radLT2.Caption) > 0;
172 radLT3.Visible := Length(radLT3.Caption) > 0;
173 radLT1.Checked := TimeCount = 1;
174 chkBagged.Visible := DietParams.Bagged;
175 with lblMealCutOff do case Meal of
176 'B': Caption := 'You have missed the breakfast cut-off.';
177 'E': Caption := 'You have missed the evening cut-off.';
178 'N': Caption := 'You have missed the noon cut-off.';
179 end;
180 // display the form
181 ShowModal;
182 if YesPressed then
183 begin
184 with radLT1 do if Checked then LateTrayFields.LateTime := Caption;
185 with radLT2 do if Checked then LateTrayFields.LateTime := Caption;
186 with radLT3 do if Checked then LateTrayFields.LateTime := Caption;
187 LateTrayFields.LateMeal := Meal;
188 LateTrayFields.IsBagged := chkBagged.Checked;
189 end;
190 end; {with frmODDietLT}
191 finally
192 frmODDietLT.Release;
193 end;
194end;
195
196procedure LateTrayCheck(SomeResponses: TResponses; EventId: integer; IsOutpatient: boolean; var LateTrayFields: TLateTrayFields);
197var
198 AResponse, AnotherResponse: TResponse;
199begin
200 if IsOutpatient then
201 begin
202 AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1);
203 if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
204 begin
205 AResponse := SomeResponses.FindResponseByName('START', 1);
206 AnotherResponse := SomeResponses.FindResponseByName('MEAL', 1);
207 if (AResponse <> nil) and (AnotherResponse <> nil) then
208 CheckLateTray(AResponse.IValue, LateTrayFields, True, CharAt(AnotherResponse.IValue, 1));
209 end;
210 end
211 else
212 begin
213 AResponse := SomeResponses.FindResponseByName('ORDERABLE', 1);
214 if (EventID = 0) and (AResponse <> nil) and (Copy(AResponse.EValue, 1, 3) <> 'NPO') then
215 begin
216 AResponse := SomeResponses.FindResponseByName('START', 1);
217 if AResponse <> nil then CheckLateTray(AResponse.IValue, LateTrayFields, False);
218 end;
219 end;
220end;
221
222procedure LateTrayOrder(LateTrayFields: TLateTrayFields; IsInpatient: boolean);
223const
224 TX_EL_SAVE_ERR = 'An error occurred while saving this late tray order.';
225 TC_EL_SAVE_ERR = 'Error Saving Late Tray Order';
226var
227 NewOrder: TOrder;
228 CanSign: integer;
229begin
230 NewOrder := TOrder.Create;
231 try
232 with LateTrayFields do OrderLateTray(NewOrder, LateMeal, LateTime, IsBagged);
233 if NewOrder.ID <> '' then
234 begin
235 if IsInpatient then
236 begin
237 if (Encounter.Provider = User.DUZ) and User.CanSignOrders
238 then CanSign := CH_SIGN_YES
239 else CanSign := CH_SIGN_NA;
240 end
241 else
242 begin
243 CanSign := CH_SIGN_NA;
244 end;
245 Changes.Add(CH_ORD, NewOrder.ID, NewOrder.Text, '', CanSign);
246 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_NEW, Integer(NewOrder))
247 end
248 else InfoBox(TX_EL_SAVE_ERR, TC_EL_SAVE_ERR, MB_OK);
249 finally
250 NewOrder.Free;
251 end;
252end;
253
254// ---------- frmODDietLT procedures ---------------
255procedure TfrmODDietLT.FormCreate(Sender: TObject);
256begin
257 inherited;
258 YesPressed := False;
259end;
260
261procedure TfrmODDietLT.cmdYesClick(Sender: TObject);
262begin
263 inherited;
264 if not FOutpatient then
265 if (radLT1.Checked = False) and (radLT2.Checked = False) and (radLT3.Checked = False) then
266 begin
267 InfoBox(TX_MEAL_REQ, TC_MEAL_REQ, MB_OK);
268 Exit;
269 end;
270 YesPressed := True;
271 Close;
272end;
273
274procedure TfrmODDietLT.cmdNoClick(Sender: TObject);
275begin
276 inherited;
277 Close;
278end;
279
280end.
Note: See TracBrowser for help on using the repository browser.