source: cprs/trunk/CPRS-Chart/Orders/fOrdersTS.pas@ 1495

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

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