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

Last change on this file since 1707 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28
File size: 9.7 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: TVA508StaticText;
15 grpChoice: TGroupBox;
16 radReleaseNow: TRadioButton;
17 radDelayed: TRadioButton;
18 pnldif: TPanel;
19 Image1: TImage;
20 cmdOK: TButton;
21 cmdCancel: TButton;
22 lblUseAdmit: TVA508StaticText;
23 lblUseTransfer: TVA508StaticText;
24 pnlBottom: 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);
173var
174 tempStr: String;
175begin
176 inherited;
177 if grpChoice.Tag = 0 then
178 begin
179 InfoBox('A release event has not been selected.', 'No Selection Made', MB_OK);
180 Exit;
181 end;
182 if( not (fraEvntDelayList.mlstEvents.ItemIndex >= 0) ) and (radDelayed.Checked) then
183 begin
184 InfoBox('A release event must be selected.', 'No Selection Made', MB_OK);
185 Exit;
186 end;
187
188 tempStr := fraEvntDelayList.mlstEvents.Items.ValueFromIndex[fraEvntDelayList.mlstEvents.ItemIndex];
189
190 if(fraEvntDelayList.mlstEvents.ItemIndex >= 0) and (Length(Piece(tempStr,'^',2))<1)then
191 begin
192 InfoBox('Invalid release event selected.', 'No Selection Made', MB_OK);
193 Exit;
194 end;
195
196 if (fraEvntDelayList.mlstEvents.ItemIndex >= 0) and F1stClick then
197 begin
198 fraEvntDelayList.CheckMatch;
199 if fraEvntDelayList.MatchedCancel then
200 begin
201 OKPressed := False;
202 Close;
203 Exit;
204 end;
205 end;
206 OKPressed := True;
207 FResult := True;
208 Close;
209end;
210
211procedure TfrmOrdersTS.cmdCancelClick(Sender: TObject);
212begin
213 inherited;
214 FResult := False;
215 Close;
216end;
217
218procedure TfrmOrdersTS.radDelayedClick(Sender: TObject);
219begin
220 inherited;
221 fraEvntDelayList.Visible := True;
222 fraEvntDelayList.DisplayEvntDelayList;
223 grpChoice.Tag := 1;
224end;
225
226procedure TfrmOrdersTS.radReleaseNowClick(Sender: TObject);
227begin
228 inherited;
229 grpChoice.Tag := 1;
230 if InfoBox('Would you like to close this window and return to the Orders Tab?',
231 'Confirmation', MB_OKCANCEL or MB_ICONQUESTION) = IDOK then
232 begin
233 FImmediatelyRelease := True;
234 FResult := False;
235 Close;
236 end
237 else
238 begin
239 fraEvntDelayList.mlstEvents.Items.Clear;
240 FImmediatelyRelease := False;
241 radReleaseNow.Checked := False;
242 radDelayed.Checked := True;
243 end;
244end;
245
246procedure TfrmOrdersTS.fraEvntDelayListcboEvntListChange(Sender: TObject);
247begin
248 inherited;
249 fraEvntDelayList.mlstEventsChange(Sender);
250 F1stClick := False;
251 if fraEvntDelayList.MatchedCancel then Close
252end;
253
254procedure TfrmOrdersTS.UMStillDelay(var message: TMessage);
255begin
256 inherited;
257 if grpChoice.Tag = 0 then
258 begin
259 InfoBox('A release event has not been selected.', 'No Selection Made', MB_OK);
260 Exit;
261 end;
262 if(not (fraEvntDelayList.mlstEvents.ItemIndex >= 0)) and (radDelayed.Checked) then
263 begin
264 InfoBox('A release event must be selected.', 'No Selection Made', MB_OK);
265 Exit;
266 end;
267 OKPressed := True;
268 FResult := True;
269 Close;
270end;
271
272procedure TfrmOrdersTS.fraEvntDelayListmlstEventsDblClick(Sender: TObject);
273begin
274 inherited;
275 if fraEvntDelayList.mlstEvents.ItemID > 0 then
276 cmdOKClick(Self);
277end;
278
279procedure TfrmOrdersTS.FormClose(Sender: TObject;
280 var Action: TCloseAction);
281begin
282 inherited;
283 SaveUserBounds(Self);
284 Action := caFree;
285end;
286
287procedure TfrmOrdersTS.fraEvntDelayListmlstEventsChange(Sender: TObject);
288begin
289 inherited;
290 fraEvntDelayList.mlstEventsChange(Sender);
291 if fraEvntDelayList.MatchedCancel then
292 begin
293 OKPressed := False;
294 Close;
295 Exit;
296 end;
297end;
298
299procedure TfrmOrdersTS.FormKeyDown(Sender: TObject; var Key: Word;
300 Shift: TShiftState);
301begin
302 inherited;
303 if Key = VK_RETURN then
304 cmdOKClick(Self);
305end;
306
307end.
Note: See TracBrowser for help on using the repository browser.