source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrdersTS.pas@ 1115

Last change on this file since 1115 was 459, checked in by Kevin Toppenberg, 17 years ago

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