source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrdersTS.pas@ 1641

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 13.0 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOrdersTS;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst,
9 DKLang;
10
11type
12 TfrmOrdersTS = class(TfrmAutoSz)
13 pnlMiddle: TPanel;
14 pnlTop: TPanel;
15 lblPtInfo: TLabel;
16 grpChoice: TGroupBox;
17 radReleaseNow: TRadioButton;
18 radDelayed: TRadioButton;
19 pnldif: TPanel;
20 Image1: TImage;
21 cmdOK: TButton;
22 cmdCancel: TButton;
23 Label1: TLabel;
24 Label2: TLabel;
25 Panel1: TPanel;
26 fraEvntDelayList: TfraEvntDelayList;
27 procedure cmdOKClick(Sender: TObject);
28 procedure cmdCancelClick(Sender: TObject);
29 procedure FormCreate(Sender: TObject);
30 procedure radDelayedClick(Sender: TObject);
31 procedure radReleaseNowClick(Sender: TObject);
32 procedure fraEvntDelayListcboEvntListChange(Sender: TObject);
33 procedure UMStillDelay(var message: TMessage); message UM_STILLDELAY;
34 procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject);
35 procedure FormClose(Sender: TObject; var Action: TCloseAction);
36 procedure fraEvntDelayListmlstEventsChange(Sender: TObject);
37 procedure FormKeyDown(Sender: TObject; var Key: Word;
38 Shift: TShiftState);
39 private
40 OKPressed: Boolean;
41 FResult : Boolean;
42 FImmediatelyRelease: boolean;
43 FCurrSpecialty: string;
44 F1stClick: Boolean;
45 end;
46
47function ShowDelayedEventsTreatingSepecialty(const ARadCaption: string; var AnEvent: TOrderDelayEvent;
48 var ADlgLst: TStringlist; var ReleaseNow: boolean; AnLimitEvent: Char = #0): Boolean;
49
50var
51 frmOrdersTS: TfrmOrdersTS;
52
53implementation
54
55uses ucore,fOrders, rMisc;
56
57{$R *.DFM}
58
59//const
60//TX_TRANSFER1= 'You selected the Transfer delayed event'; <-- original line. //kt 8/8/2007
61//TX_TRANSFER = 'The release of orders entered ' + <-- original line. //kt 8/8/2007
62// 'will be delayed until the patient is transferred to the ' + <-- original line. //kt 8/8/2007
63// 'following specialty.'; <-- original line. //kt 8/8/2007
64//TX_ADMIT1 = 'You selected the Admit delayed event'; <-- original line. //kt 8/8/2007
65//TX_ADMIT = 'The release of orders entered ' + <-- original line. //kt 8/8/2007
66// 'will be delayed until the patient is admitted to the ' + <-- original line. //kt 8/8/2007
67// 'following specialty.'; <-- original line. //kt 8/8/2007
68//TX_XISTEVT1 = 'Delayed orders already exist for event Delayed '; <-- original line. //kt 8/8/2007
69//TX_XISTEVT2 = #13 + 'Do you want to view those orders?'; <-- original line. //kt 8/8/2007
70//TX_MCHEVT1 = ' is already assigned to '; <-- original line. //kt 8/8/2007
71//TX_MCHEVT2 = #13 + 'Do you still want to write delayed orders?'; <-- original line. //kt 8/8/2007
72
73var
74 TX_TRANSFER1 : string; //kt
75 TX_TRANSFER : string; //kt
76 TX_ADMIT1 : string; //kt
77 TX_ADMIT : string; //kt
78 TX_XISTEVT1 : string; //kt
79 TX_XISTEVT2 : string; //kt
80 TX_MCHEVT1 : string; //kt
81 TX_MCHEVT2 : string; //kt
82
83
84procedure SetupVars;
85//kt Added entire function to replace constant declarations 8/8/2007
86begin
87 TX_TRANSFER1:= DKLangConstW('fOrdersTS_You_selected_the_Transfer_delayed_event');
88 TX_TRANSFER := DKLangConstW('fOrdersTS_The_release_of_orders_entered') +
89 DKLangConstW('fOrdersTS_will_be_delayed_until_the_patient_is_transferred_to_the') +
90 DKLangConstW('fOrdersTS_following_specialtyx');
91 TX_ADMIT1 := DKLangConstW('fOrdersTS_You_selected_the_Admit_delayed_event');
92 TX_ADMIT := DKLangConstW('fOrdersTS_The_release_of_orders_entered') +
93 DKLangConstW('fOrdersTS_will_be_delayed_until_the_patient_is_admitted_to_the') +
94 DKLangConstW('fOrdersTS_following_specialtyx');
95 TX_XISTEVT1 := DKLangConstW('fOrdersTS_Delayed_orders_already_exist_for_event_Delayed');
96 TX_XISTEVT2 := #13 + DKLangConstW('fOrdersTS_Do_you_want_to_view_those_ordersx');
97 TX_MCHEVT1 := DKLangConstW('fOrdersTS_is_already_assigned_to');
98 TX_MCHEVT2 := #13 + DKLangConstW('fOrdersTS_Do_you_still_want_to_write_delayed_ordersx');
99end;
100
101function ShowDelayedEventsTreatingSepecialty(const ARadCaption: string; var AnEvent: TOrderDelayEvent;
102 var ADlgLst: TStringlist; var ReleaseNow: boolean; AnLimitEvent: Char = #0): Boolean;
103var
104 EvtInfo,speCap: string;
105begin
106 frmOrdersTS := TfrmOrdersTS.Create(Application);
107 frmOrdersTS.FCurrSpecialty := Piece(GetCurrentSpec(Patient.DFN),'^',1);
108 frmOrdersTS.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0);
109 SetFormPosition(frmOrdersTS);
110 //frmOrdersTs.fraEvntDelayList.Top := frmOrdersTS.Height -
111 Result := frmOrdersTS.FResult;
112 if Length(ARadCapTion)>0 then
113 frmOrdersTS.radDelayed.Caption := ARadCaption;
114 try
115 ResizeFormToFont(TForm(frmOrdersTS));
116 if Length(frmOrdersTS.FCurrSpecialty)>0 then
117// SpeCap := #13 + 'The current treating specialty is ' + frmOrdersTS.FCurrSpecialty <-- original line. //kt 8/8/2007
118 SpeCap := #13 + DKLangConstW('fOrdersTS_The_current_treating_specialty_is') + frmOrdersTS.FCurrSpecialty //kt added 8/8/2007
119 else
120// SpeCap := #13 + 'No treating specialty is available.'; <-- original line. //kt 8/8/2007
121 SpeCap := #13 + DKLangConstW('fOrdersTS_No_treating_specialty_is_availablex'); //kt added 8/8/2007
122 if Patient.Inpatient then
123// frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap <-- original line. //kt 8/8/2007
124 frmOrdersTS.lblPtInfo.Caption := Patient.Name + DKLangConstW('fOrdersTS_is_currently_admitted_to') + Encounter.LocationName + SpeCap //kt added 8/8/2007
125 else
126 begin
127 if (EnCounter.Location > 0) then
128// frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' is currently on ' + Encounter.LocationName + SpeCap <-- original line. //kt 8/8/2007
129 frmOrdersTS.lblPtInfo.Caption := Patient.Name + DKLangConstW('fOrdersTS_is_currently_on') + Encounter.LocationName + SpeCap //kt added 8/8/2007
130 else
131// frmOrdersTS.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap; <-- original line. //kt 8/8/2007
132 frmOrdersTS.lblPtInfo.Caption := Patient.Name + DKLangConstW('fOrdersTS_currently_is_an_outpatientx') + SpeCap; //kt added 8/8/2007
133 end;
134 if not (AnLimitEvent in ['A','D','T','M','O']) then
135 AnLimitEvent := #0;
136 frmOrdersTs.fraEvntDelayList.EvntLimit := AnLimitEvent;
137 if AnEvent.EventIFN > 0 then
138 begin
139 frmOrdersTS.fraEvntDelayList.DefaultEvent := AnEvent.EventIFN;
140 frmOrdersTS.radDelayed.Checked := True;
141 end else
142 begin
143 frmOrdersTS.radReleaseNow.Enabled := True;
144 frmOrdersTS.radReleaseNow.Checked := False;
145 frmOrdersTS.radDelayed.Checked := False;
146 end;
147 frmOrdersTS.radDelayed.Checked := True;
148 frmOrdersTS.ShowModal;
149 if frmOrdersTS.FImmediatelyRelease then
150 begin
151 AnEvent.EventIFN := 0;
152 AnEvent.EventName := '';
153 AnEvent.Specialty := 0;
154 AnEvent.Effective := 0;
155 ReleaseNow := frmOrdersTS.FImmediatelyRelease;
156 Result := frmOrdersTS.FResult;
157 end;
158 if (frmOrdersTS.OKPressed) and (frmOrdersTS.radDelayed.Checked) then
159 begin
160 EvtInfo := frmOrdersTS.fraEvntDelayList.mlstEvents.Items[frmOrdersTS.fraEvntDelayList.mlstEvents.ItemIndex];
161 AnEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1);
162 AnEvent.EventIFN := StrToInt64Def(Piece(EvtInfo,'^',1),0);
163 AnEvent.TheParent := TParentEvent.Create;
164 if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then
165 begin
166 AnEvent.TheParent.Assign(Piece(EvtInfo,'^',13));
167 if AnEvent.EventType = #0 then
168 AnEvent.EventType := AnEvent.TheParent.ParentType;
169 end;
170 AnEvent.EventName := frmOrdersTS.fraEvntDelayList.mlstEvents.DisplayText[frmOrdersTS.fraEvntDelayList.mlstEvents.ItemIndex];
171 AnEvent.Specialty := 0;
172 if frmOrdersTS.fraEvntDelayList.orDateBox.Visible then
173 AnEvent.Effective := frmOrdersTS.fraEvntDelayList.orDateBox.FMDateTime
174 else
175 AnEvent.Effective := 0;
176 ADlgLst.Clear;
177 if StrToIntDef(AnEvent.TheParent.ParentDlg,0)>0 then
178 ADlgLst.Add(AnEvent.TheParent.ParentDlg)
179 else if Length(Piece(EvtInfo,'^',5))>0 then
180 ADlgLst.Add(Piece(EvtInfo,'^',5));
181 if Length(Piece(EvtInfo,'^',6))>0 then
182 ADlgLst.Add(Piece(EvtInfo,'^',6)+ '^SET');
183 Result := frmOrdersTS.FResult;
184 end;
185 finally
186 frmOrdersTS.Release;
187 frmOrdersTS.FImmediatelyRelease := False;
188 frmOrdersTS.FCurrSpecialty := '';
189 frmOrdersTS.fraEvntDelayList.ResetProperty;
190 end;
191end;
192
193procedure TfrmOrdersTS.FormCreate(Sender: TObject);
194begin
195 inherited;
196 if not Patient.Inpatient then
197 pnldif.Visible := False;
198 OKPressed := False;
199 FResult := False;
200 FImmediatelyRelease := False;
201 F1stClick := True;
202 FCurrSpecialty := '';
203end;
204
205procedure TfrmOrdersTS.cmdOKClick(Sender: TObject);
206begin
207 inherited;
208 if grpChoice.Tag = 0 then
209 begin
210// InfoBox('A release event has not been selected.', 'No Selection Made', MB_OK); <-- original line. //kt 8/8/2007
211 InfoBox(DKLangConstW('fOrdersTS_A_release_event_has_not_been_selectedx'), DKLangConstW('fOrdersTS_No_Selection_Made'), MB_OK); //kt added 8/8/2007
212 Exit;
213 end;
214 if( not (fraEvntDelayList.mlstEvents.ItemIndex >= 0) ) and (radDelayed.Checked) then
215 begin
216// InfoBox('A release event must be selected.', 'No Selection Made', MB_OK); <-- original line. //kt 8/8/2007
217 InfoBox(DKLangConstW('fOrdersTS_A_release_event_must_be_selectedx'), DKLangConstW('fOrdersTS_No_Selection_Made'), MB_OK); //kt added 8/8/2007
218 Exit;
219 end;
220 if (fraEvntDelayList.mlstEvents.ItemIndex >= 0) and F1stClick then
221 begin
222 fraEvntDelayList.CheckMatch;
223 if fraEvntDelayList.MatchedCancel then
224 begin
225 OKPressed := False;
226 Close;
227 Exit;
228 end;
229 end;
230 OKPressed := True;
231 FResult := True;
232 Close;
233end;
234
235procedure TfrmOrdersTS.cmdCancelClick(Sender: TObject);
236begin
237 inherited;
238 FResult := False;
239 Close;
240end;
241
242procedure TfrmOrdersTS.radDelayedClick(Sender: TObject);
243begin
244 inherited;
245 fraEvntDelayList.Visible := True;
246 fraEvntDelayList.DisplayEvntDelayList;
247 grpChoice.Tag := 1;
248end;
249
250procedure TfrmOrdersTS.radReleaseNowClick(Sender: TObject);
251begin
252 inherited;
253 grpChoice.Tag := 1;
254//if InfoBox('Would you like to close this window and return to the Orders Tab?', <-- original line. //kt 8/8/2007
255 if InfoBox(DKLangConstW('fOrdersTS_Would_you_like_to_close_this_window_and_return_to_the_Orders_Tabx'), //kt added 8/8/2007
256// 'Confirmation', MB_OKCANCEL or MB_ICONQUESTION) = IDOK then <-- original line. //kt 8/8/2007
257 DKLangConstW('fOrdersTS_Confirmation'), MB_OKCANCEL or MB_ICONQUESTION) = IDOK then //kt added 8/8/2007
258 begin
259 FImmediatelyRelease := True;
260 FResult := False;
261 Close;
262 end
263 else
264 begin
265 fraEvntDelayList.mlstEvents.Items.Clear;
266 FImmediatelyRelease := False;
267 radReleaseNow.Checked := False;
268 radDelayed.Checked := True;
269 end;
270end;
271
272procedure TfrmOrdersTS.fraEvntDelayListcboEvntListChange(Sender: TObject);
273begin
274 inherited;
275 fraEvntDelayList.mlstEventsChange(Sender);
276 F1stClick := False;
277 if fraEvntDelayList.MatchedCancel then Close
278end;
279
280procedure TfrmOrdersTS.UMStillDelay(var message: TMessage);
281begin
282 inherited;
283 if grpChoice.Tag = 0 then
284 begin
285// InfoBox('A release event has not been selected.', 'No Selection Made', MB_OK); <-- original line. //kt 8/8/2007
286 InfoBox(DKLangConstW('fOrdersTS_A_release_event_has_not_been_selectedx'), DKLangConstW('fOrdersTS_No_Selection_Made'), MB_OK); //kt added 8/8/2007
287 Exit;
288 end;
289 if(not (fraEvntDelayList.mlstEvents.ItemIndex >= 0)) and (radDelayed.Checked) then
290 begin
291// InfoBox('A release event must be selected.', 'No Selection Made', MB_OK); <-- original line. //kt 8/8/2007
292 InfoBox(DKLangConstW('fOrdersTS_A_release_event_must_be_selectedx'), DKLangConstW('fOrdersTS_No_Selection_Made'), MB_OK); //kt added 8/8/2007
293 Exit;
294 end;
295 OKPressed := True;
296 FResult := True;
297 Close;
298end;
299
300procedure TfrmOrdersTS.fraEvntDelayListmlstEventsDblClick(Sender: TObject);
301begin
302 inherited;
303 if fraEvntDelayList.mlstEvents.ItemID > 0 then
304 cmdOKClick(Self);
305end;
306
307procedure TfrmOrdersTS.FormClose(Sender: TObject;
308 var Action: TCloseAction);
309begin
310 inherited;
311 SaveUserBounds(Self);
312 Action := caFree;
313end;
314
315procedure TfrmOrdersTS.fraEvntDelayListmlstEventsChange(Sender: TObject);
316begin
317 inherited;
318 fraEvntDelayList.mlstEventsChange(Sender);
319 if fraEvntDelayList.MatchedCancel then
320 begin
321 OKPressed := False;
322 Close;
323 Exit;
324 end;
325end;
326
327procedure TfrmOrdersTS.FormKeyDown(Sender: TObject; var Key: Word;
328 Shift: TShiftState);
329begin
330 inherited;
331 if Key = VK_RETURN then
332 cmdOKClick(Self);
333end;
334
335end.
Note: See TracBrowser for help on using the repository browser.