source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODDietLT.pas@ 1742

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

Uploading from OR_30_258

File size: 7.3 KB
RevLine 
[459]1unit fODDietLT;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, ExtCtrls, StdCtrls, ORFn;
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);
38
39implementation
40
41{$R *.DFM}
42
43uses rCore, uCore, rODDiet, uConst, rOrders;
44
45const
46 TX_MEAL_REQ = 'A meal time must be selected.';
47 TC_MEAL_REQ = 'No Meal Time Selected';
48
49procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
50var
51 frmODDietLT: TfrmODDietLT;
52 DietParams: TDietParams;
53 FMTime: TFMDateTime;
54 TimePart: Extended;
55 Meal: Char;
56 AvailTimes,ALocation: string;
57 TimeCount: Integer;
58
59 function AMPMToFMTime(const x: string): Extended;
60 var
61 IntTime: Integer;
62 begin
63 Result := 0;
64 if Pos(':', x) = 0 then Exit;
65 IntTime := StrToIntDef(Piece(x, ':', 1) + Copy(Piece(x, ':', 2), 1, 2), 0);
66 if (Pos('P', x) > 0) and (IntTime < 1200) then IntTime := IntTime + 1200;
67 if (Pos('A', x) > 0) and (IntTime > 1200) then IntTime := IntTime - 1200;
68 Result := IntTime / 10000;
69 end;
70
71 function FMTimeToAMPM(x: Extended): string;
72 var
73 TimePart: extended;
74 AMPMTime, Suffix: string;
75 begin
76 TimePart := Frac(x);
[460]77 if TimePart > 0.1159 then
[459]78 begin
[460]79 if TimePart > 0.1259 then x := x - 0.12;
[459]80 Suffix := 'P'
81 end
82 else Suffix := 'A';
83 AMPMTime := FormatFMDateTime('hh:nn', x);
84 Result := AMPMTime + Suffix;
85 end;
86
87 procedure SetAvailTimes(ATime: Extended; var ACount: Integer; var TimeList: string);
88 var
89 i: Integer;
90 ReturnList: string;
91 begin
92 ACount := 0;
93 ReturnList := '';
94 for i := 1 to 3 do
95 if AMPMToFMTime(Piece(TimeList, U, i)) > ATime then
96 begin
97 if Length(ReturnList) > 0 then ReturnList := ReturnList + U;
98 ReturnList := ReturnList + Piece(TimeList, U, i);
99 Inc(ACount);
100 end;
101 TimeList := ReturnList;
102 end;
103
104begin
105 // initialize LateTrayFields
106 LateTrayFields.LateMeal := #0;
107 LateTrayFields.LateTime := '';
108 LateTrayFields.IsBagged := False;
109 // make sure the start time is today and not in the future
110 FMTime := StrToFMDateTime(StartTime);
111 if FMTime < 0 then Exit;
112 if Int(FMTime) <> FMToday then Exit;
113 TimePart := Frac(FMTime);
114 if TimePart = 0 then TimePart := Frac(FMNow);
115 if TimePart > Frac(FMNow) then Exit;
116 Meal := #0;
117 ALocation := IntToStr(Encounter.Location);
118 LoadDietParams(DietParams,ALocation);
119 // check to see if falling within the alarm range of a meal
120 if not IsOutpatient then
121 begin
122 if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) and
123 (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := 'B';
124 if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) and
125 (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := 'N';
126 if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) and
127 (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := 'E';
128 if Meal = #0 then Exit;
129 end
130 else // for outpatients
131 begin
[460]132(* From Rich Knoepfle, NFS developer
133If 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).
134If it's before the LATE BREAKFAST ALARM BEGIN than I accept the order.
135If it's between the LATE BREAKFAST ALARM BEGIN and ALARM END then I ask if they want to order a Late breakfast tray.
136*)
[459]137 Meal := AMeal;
138 case AMeal of
[460]139 'B': if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) or
140 (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := #0;
141 'N': if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) or
142 (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := #0;
143 'E': if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) or
144 (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := #0;
[459]145 end;
146 if Meal = #0 then exit;
147 end;
[460]148
149 // get the available late times for this meal
150 case Meal of
151 'B': AvailTimes := Pieces(DietParams.BTimes, U, 4, 6);
152 'E': AvailTimes := Pieces(DietParams.ETimes, U, 4, 6);
153 'N': AvailTimes := Pieces(DietParams.NTimes, U, 4, 6);
154 end;
155 SetAvailTimes(TimePart, TimeCount, AvailTimes);
156 if TimeCount = 0 then Exit;
157
[459]158 // setup form to get the selected late tray
159 frmODDietLT := TfrmODDietLT.Create(Application);
160 try
161 ResizeFormToFont(TForm(frmODDietLT));
162 with frmODDietLT do
163 begin
164 FOutpatient := IsOutpatient;
[460]165 if Length(Piece(AvailTimes, U, 1)) > 0 then radLT1.Caption := Piece(AvailTimes, U, 1);
166 if Length(Piece(AvailTimes, U, 2)) > 0 then radLT2.Caption := Piece(AvailTimes, U, 2);
167 if Length(Piece(AvailTimes, U, 3)) > 0 then radLT3.Caption := Piece(AvailTimes, U, 3);
168 radLT1.Visible := Length(radLT1.Caption) > 0;
169 radLT2.Visible := Length(radLT2.Caption) > 0;
170 radLT3.Visible := Length(radLT3.Caption) > 0;
171 radLT1.Checked := TimeCount = 1;
[459]172 chkBagged.Visible := DietParams.Bagged;
173 with lblMealCutOff do case Meal of
174 'B': Caption := 'You have missed the breakfast cut-off.';
175 'E': Caption := 'You have missed the evening cut-off.';
176 'N': Caption := 'You have missed the noon cut-off.';
177 end;
178 // display the form
179 ShowModal;
180 if YesPressed then
181 begin
[460]182 with radLT1 do if Checked then LateTrayFields.LateTime := Caption;
183 with radLT2 do if Checked then LateTrayFields.LateTime := Caption;
184 with radLT3 do if Checked then LateTrayFields.LateTime := Caption;
[459]185 LateTrayFields.LateMeal := Meal;
186 LateTrayFields.IsBagged := chkBagged.Checked;
[460]187 end;
[459]188 end; {with frmODDietLT}
189 finally
190 frmODDietLT.Release;
191 end;
192end;
193
194// ---------- frmODDietLT procedures ---------------
195procedure TfrmODDietLT.FormCreate(Sender: TObject);
196begin
197 inherited;
198 YesPressed := False;
199end;
200
201procedure TfrmODDietLT.cmdYesClick(Sender: TObject);
202begin
203 inherited;
204 if not FOutpatient then
205 if (radLT1.Checked = False) and (radLT2.Checked = False) and (radLT3.Checked = False) then
206 begin
207 InfoBox(TX_MEAL_REQ, TC_MEAL_REQ, MB_OK);
208 Exit;
209 end;
210 YesPressed := True;
211 Close;
212end;
213
214procedure TfrmODDietLT.cmdNoClick(Sender: TObject);
215begin
216 inherited;
217 Close;
218end;
219
220end.
Note: See TracBrowser for help on using the repository browser.