source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODDietLT.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: 8.6 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODDietLT;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fAutoSz, ExtCtrls, StdCtrls, ORFn, DKLang;
9
10type
11 TfrmODDietLT = class(TfrmAutoSz)
12 lblMealCutoff: TStaticText;
13 Label2: TStaticText;
14 GroupBox1: TGroupBox;
15 cmdYes: TButton;
16 cmdNo: TButton;
17 radLT1: TRadioButton;
18 radLT2: TRadioButton;
19 radLT3: TRadioButton;
20 chkBagged: TCheckBox;
21 Bevel1: TBevel;
22 DKLanguageController2: TDKLanguageController;
23 procedure cmdYesClick(Sender: TObject);
24 procedure cmdNoClick(Sender: TObject);
25 procedure FormCreate(Sender: TObject);
26 private
27 //kt Begin Mod (change Consts to Vars) 8/8/2007
28 TX_MEAL_REQ : string; //kt
29 TC_MEAL_REQ : string; //kt
30 //kt End Mod -------------------
31 FOutpatient: boolean;
32 YesPressed: Boolean;
33 procedure SetupVars; //kt
34 public
35 { Public declarations }
36 end;
37
38 TLateTrayFields = record
39 LateMeal: Char;
40 LateTime: string;
41 IsBagged: Boolean;
42 end;
43
44procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
45
46implementation
47
48{$R *.DFM}
49
50uses rCore, uCore, rODDiet, uConst, rOrders;
51
52//const
53//TX_MEAL_REQ = 'A meal time must be selected.'; <-- original line. //kt 8/8/2007
54//TC_MEAL_REQ = 'No Meal Time Selected'; <-- original line. //kt 8/8/2007
55
56
57
58procedure TfrmODDietLT.SetupVars;
59//kt Added entire function to replace constant declarations 8/8/2007
60begin
61 TX_MEAL_REQ := DKLangConstW('fODDietLT_A_meal_time_must_be_selectedx');
62 TC_MEAL_REQ := DKLangConstW('fODDietLT_No_Meal_Time_Selected');
63end;
64
65procedure CheckLateTray(const StartTime: string; var LateTrayFields: TLateTrayFields; IsOutpatient: boolean; AMeal: char = #0);
66var
67 frmODDietLT: TfrmODDietLT;
68 DietParams: TDietParams;
69 FMTime: TFMDateTime;
70 TimePart: Extended;
71 Meal: Char;
72 AvailTimes,ALocation: string;
73 TimeCount: Integer;
74
75 function AMPMToFMTime(const x: string): Extended;
76 var
77 IntTime: Integer;
78 begin
79 Result := 0;
80 if Pos(':', x) = 0 then Exit;
81 IntTime := StrToIntDef(Piece(x, ':', 1) + Copy(Piece(x, ':', 2), 1, 2), 0);
82 if (Pos('P', x) > 0) and (IntTime < 1200) then IntTime := IntTime + 1200;
83 if (Pos('A', x) > 0) and (IntTime > 1200) then IntTime := IntTime - 1200;
84 Result := IntTime / 10000;
85 end;
86
87 function FMTimeToAMPM(x: Extended): string;
88 var
89 TimePart: extended;
90 AMPMTime, Suffix: string;
91 begin
92 TimePart := Frac(x);
93 if TimePart > 0.1159 then
94 begin
95 if TimePart > 0.1259 then x := x - 0.12;
96 Suffix := 'P'
97 end
98 else Suffix := 'A';
99 AMPMTime := FormatFMDateTime('hh:nn', x);
100 Result := AMPMTime + Suffix;
101 end;
102
103 procedure SetAvailTimes(ATime: Extended; var ACount: Integer; var TimeList: string);
104 var
105 i: Integer;
106 ReturnList: string;
107 begin
108 ACount := 0;
109 ReturnList := '';
110 for i := 1 to 3 do
111 if AMPMToFMTime(Piece(TimeList, U, i)) > ATime then
112 begin
113 if Length(ReturnList) > 0 then ReturnList := ReturnList + U;
114 ReturnList := ReturnList + Piece(TimeList, U, i);
115 Inc(ACount);
116 end;
117 TimeList := ReturnList;
118 end;
119
120begin
121 // initialize LateTrayFields
122 LateTrayFields.LateMeal := #0;
123 LateTrayFields.LateTime := '';
124 LateTrayFields.IsBagged := False;
125 // make sure the start time is today and not in the future
126 FMTime := StrToFMDateTime(StartTime);
127 if FMTime < 0 then Exit;
128 if Int(FMTime) <> FMToday then Exit;
129 TimePart := Frac(FMTime);
130 if TimePart = 0 then TimePart := Frac(FMNow);
131 if TimePart > Frac(FMNow) then Exit;
132 Meal := #0;
133 ALocation := IntToStr(Encounter.Location);
134 LoadDietParams(DietParams,ALocation);
135 // check to see if falling within the alarm range of a meal
136 if not IsOutpatient then
137 begin
138 if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) and
139 (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := 'B';
140 if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) and
141 (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := 'N';
142 if (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) and
143 (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := 'E';
144 if Meal = #0 then Exit;
145 end
146 else // for outpatients
147 begin
148(* From Rich Knoepfle, NFS developer
149//If 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). <-- original line. //kt 8/8/2007
150If they order a breakfast and it is after the LATE BREAKFAST ALARM END, I donDKLangConstW('fODDietLT_t_allow_them_to_do_itx__xFor_special_meals_I_don')t allow them to order something for the following day). //kt added 8/8/2007
151If it's before the LATE BREAKFAST ALARM BEGIN than I accept the order.
152If it's between the LATE BREAKFAST ALARM BEGIN and ALARM END then I ask if they want to order a Late breakfast tray.
153*)
154 Meal := AMeal;
155 case AMeal of
156 'B': if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 1), 0) / 10000)) or
157 (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 2), 0) / 10000)) then Meal := #0;
158 'N': if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 3), 0) / 10000)) or
159 (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 4), 0) / 10000)) then Meal := #0;
160 'E': if (TimePart < (StrToIntDef(Piece(DietParams.Alarms, U, 5), 0) / 10000)) or
161 (TimePart > (StrToIntDef(Piece(DietParams.Alarms, U, 6), 0) / 10000)) then Meal := #0;
162 end;
163 if Meal = #0 then exit;
164 end;
165
166 // get the available late times for this meal
167 case Meal of
168 'B': AvailTimes := Pieces(DietParams.BTimes, U, 4, 6);
169 'E': AvailTimes := Pieces(DietParams.ETimes, U, 4, 6);
170 'N': AvailTimes := Pieces(DietParams.NTimes, U, 4, 6);
171 end;
172 SetAvailTimes(TimePart, TimeCount, AvailTimes);
173 if TimeCount = 0 then Exit;
174
175 // setup form to get the selected late tray
176 frmODDietLT := TfrmODDietLT.Create(Application);
177 try
178 ResizeFormToFont(TForm(frmODDietLT));
179 with frmODDietLT do
180 begin
181 FOutpatient := IsOutpatient;
182 if Length(Piece(AvailTimes, U, 1)) > 0 then radLT1.Caption := Piece(AvailTimes, U, 1);
183 if Length(Piece(AvailTimes, U, 2)) > 0 then radLT2.Caption := Piece(AvailTimes, U, 2);
184 if Length(Piece(AvailTimes, U, 3)) > 0 then radLT3.Caption := Piece(AvailTimes, U, 3);
185 radLT1.Visible := Length(radLT1.Caption) > 0;
186 radLT2.Visible := Length(radLT2.Caption) > 0;
187 radLT3.Visible := Length(radLT3.Caption) > 0;
188 radLT1.Checked := TimeCount = 1;
189 chkBagged.Visible := DietParams.Bagged;
190 with lblMealCutOff do case Meal of
191// 'B': Caption := 'You have missed the breakfast cut-off.'; <-- original line. //kt 8/8/2007
192 'B': Caption := DKLangConstW('fODDietLT_You_have_missed_the_breakfast_cutxoffx'); //kt added 8/8/2007
193// 'E': Caption := 'You have missed the evening cut-off.'; <-- original line. //kt 8/8/2007
194 'E': Caption := DKLangConstW('fODDietLT_You_have_missed_the_evening_cutxoffx'); //kt added 8/8/2007
195// 'N': Caption := 'You have missed the noon cut-off.'; <-- original line. //kt 8/8/2007
196 'N': Caption := DKLangConstW('fODDietLT_You_have_missed_the_noon_cutxoffx'); //kt added 8/8/2007
197 end;
198 // display the form
199 ShowModal;
200 if YesPressed then
201 begin
202 with radLT1 do if Checked then LateTrayFields.LateTime := Caption;
203 with radLT2 do if Checked then LateTrayFields.LateTime := Caption;
204 with radLT3 do if Checked then LateTrayFields.LateTime := Caption;
205 LateTrayFields.LateMeal := Meal;
206 LateTrayFields.IsBagged := chkBagged.Checked;
207 end;
208 end; {with frmODDietLT}
209 finally
210 frmODDietLT.Release;
211 end;
212end;
213
214// ---------- frmODDietLT procedures ---------------
215procedure TfrmODDietLT.FormCreate(Sender: TObject);
216begin
217 inherited;
218 YesPressed := False;
219end;
220
221procedure TfrmODDietLT.cmdYesClick(Sender: TObject);
222begin
223 SetupVars; //kt added 8/8/2007 to replace constants with vars.
224 inherited;
225 if not FOutpatient then
226 if (radLT1.Checked = False) and (radLT2.Checked = False) and (radLT3.Checked = False) then
227 begin
228 InfoBox(TX_MEAL_REQ, TC_MEAL_REQ, MB_OK);
229 Exit;
230 end;
231 YesPressed := True;
232 Close;
233end;
234
235procedure TfrmODDietLT.cmdNoClick(Sender: TObject);
236begin
237 inherited;
238 Close;
239end;
240
241end.
Note: See TracBrowser for help on using the repository browser.