1 | unit fOrdersTS;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | fAutoSz, StdCtrls, ORCtrls, ORFn, ExtCtrls, rOrders, ORDtTm, mEvntDelay,uConst,
|
---|
8 | VA508AccessibilityManager;
|
---|
9 |
|
---|
10 | type
|
---|
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 |
|
---|
46 | function ShowDelayedEventsTreatingSepecialty(const ARadCaption: string; var AnEvent: TOrderDelayEvent;
|
---|
47 | var ADlgLst: TStringlist; var ReleaseNow: boolean; AnLimitEvent: Char = #0): Boolean;
|
---|
48 |
|
---|
49 | var
|
---|
50 | frmOrdersTS: TfrmOrdersTS;
|
---|
51 |
|
---|
52 | implementation
|
---|
53 |
|
---|
54 | uses ucore,fOrders, rMisc;
|
---|
55 |
|
---|
56 | {$R *.DFM}
|
---|
57 |
|
---|
58 | const
|
---|
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 |
|
---|
73 | function ShowDelayedEventsTreatingSepecialty(const ARadCaption: string; var AnEvent: TOrderDelayEvent;
|
---|
74 | var ADlgLst: TStringlist; var ReleaseNow: boolean; AnLimitEvent: Char = #0): Boolean;
|
---|
75 | var
|
---|
76 | EvtInfo,speCap: string;
|
---|
77 | begin
|
---|
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;
|
---|
158 | end;
|
---|
159 |
|
---|
160 | procedure TfrmOrdersTS.FormCreate(Sender: TObject);
|
---|
161 | begin
|
---|
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 := '';
|
---|
170 | end;
|
---|
171 |
|
---|
172 | procedure TfrmOrdersTS.cmdOKClick(Sender: TObject);
|
---|
173 | begin
|
---|
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;
|
---|
198 | end;
|
---|
199 |
|
---|
200 | procedure TfrmOrdersTS.cmdCancelClick(Sender: TObject);
|
---|
201 | begin
|
---|
202 | inherited;
|
---|
203 | FResult := False;
|
---|
204 | Close;
|
---|
205 | end;
|
---|
206 |
|
---|
207 | procedure TfrmOrdersTS.radDelayedClick(Sender: TObject);
|
---|
208 | begin
|
---|
209 | inherited;
|
---|
210 | fraEvntDelayList.Visible := True;
|
---|
211 | fraEvntDelayList.DisplayEvntDelayList;
|
---|
212 | grpChoice.Tag := 1;
|
---|
213 | end;
|
---|
214 |
|
---|
215 | procedure TfrmOrdersTS.radReleaseNowClick(Sender: TObject);
|
---|
216 | begin
|
---|
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;
|
---|
233 | end;
|
---|
234 |
|
---|
235 | procedure TfrmOrdersTS.fraEvntDelayListcboEvntListChange(Sender: TObject);
|
---|
236 | begin
|
---|
237 | inherited;
|
---|
238 | fraEvntDelayList.mlstEventsChange(Sender);
|
---|
239 | F1stClick := False;
|
---|
240 | if fraEvntDelayList.MatchedCancel then Close
|
---|
241 | end;
|
---|
242 |
|
---|
243 | procedure TfrmOrdersTS.UMStillDelay(var message: TMessage);
|
---|
244 | begin
|
---|
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;
|
---|
259 | end;
|
---|
260 |
|
---|
261 | procedure TfrmOrdersTS.fraEvntDelayListmlstEventsDblClick(Sender: TObject);
|
---|
262 | begin
|
---|
263 | inherited;
|
---|
264 | if fraEvntDelayList.mlstEvents.ItemID > 0 then
|
---|
265 | cmdOKClick(Self);
|
---|
266 | end;
|
---|
267 |
|
---|
268 | procedure TfrmOrdersTS.FormClose(Sender: TObject;
|
---|
269 | var Action: TCloseAction);
|
---|
270 | begin
|
---|
271 | inherited;
|
---|
272 | SaveUserBounds(Self);
|
---|
273 | Action := caFree;
|
---|
274 | end;
|
---|
275 |
|
---|
276 | procedure TfrmOrdersTS.fraEvntDelayListmlstEventsChange(Sender: TObject);
|
---|
277 | begin
|
---|
278 | inherited;
|
---|
279 | fraEvntDelayList.mlstEventsChange(Sender);
|
---|
280 | if fraEvntDelayList.MatchedCancel then
|
---|
281 | begin
|
---|
282 | OKPressed := False;
|
---|
283 | Close;
|
---|
284 | Exit;
|
---|
285 | end;
|
---|
286 | end;
|
---|
287 |
|
---|
288 | procedure TfrmOrdersTS.FormKeyDown(Sender: TObject; var Key: Word;
|
---|
289 | Shift: TShiftState);
|
---|
290 | begin
|
---|
291 | inherited;
|
---|
292 | if Key = VK_RETURN then
|
---|
293 | cmdOKClick(Self);
|
---|
294 | end;
|
---|
295 |
|
---|
296 | end.
|
---|