1 | unit fMedCopy;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | StdCtrls, ORDtTm, ORCtrls, ORFn, rOrders, uCore, rCore, mEvntDelay, fAutoSz,
|
---|
8 | ExtCtrls, UConst, fBase508Form, VA508AccessibilityManager;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TfrmMedCopy = class(TfrmBase508Form)
|
---|
12 | pnlTop: TPanel;
|
---|
13 | lblPtInfo: TVA508StaticText;
|
---|
14 | pnlInpatient: TPanel;
|
---|
15 | lblInstruction: TStaticText;
|
---|
16 | Image1: TImage;
|
---|
17 | lblInstruction2: TStaticText;
|
---|
18 | pnlMiddle: TPanel;
|
---|
19 | gboxMain: TGroupBox;
|
---|
20 | radDelayed: TRadioButton;
|
---|
21 | radRelease: TRadioButton;
|
---|
22 | cmdOK: TButton;
|
---|
23 | cmdCancel: TButton;
|
---|
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 radReleaseClick(Sender: TObject);
|
---|
31 | procedure fraEvntDelayListcboEvntListChange(Sender: TObject);
|
---|
32 | procedure UMStillDelay(var message: TMessage); message UM_STILLDELAY;
|
---|
33 | procedure fraEvntDelayListmlstEventsDblClick(Sender: TObject);
|
---|
34 | procedure fraEvntDelayListmlstEventsChange(Sender: TObject);
|
---|
35 | procedure FormKeyDown(Sender: TObject; var Key: Word;
|
---|
36 | Shift: TShiftState);
|
---|
37 |
|
---|
38 | private
|
---|
39 | FDelayEvent: TOrderDelayEvent;
|
---|
40 | FOKPressed: Boolean;
|
---|
41 | procedure AdjustFormSize;
|
---|
42 | public
|
---|
43 | { Public declarations }
|
---|
44 | end;
|
---|
45 |
|
---|
46 | function SetDelayEventForMed(const RadCap: string; var ADelayEvent: TOrderDelayEvent;
|
---|
47 | var IsNewEvent: Boolean; LimitEvent: Char): Boolean;
|
---|
48 | var
|
---|
49 | frmMedCopy: TfrmMedCopy;
|
---|
50 |
|
---|
51 | implementation
|
---|
52 | {$R *.DFM}
|
---|
53 |
|
---|
54 | uses fODBase, fOrdersTS, fOrders, VAUtils;
|
---|
55 |
|
---|
56 | const
|
---|
57 | TX_SEL_DATE = 'An effective date (approximate) must be selected for discharge orders.';
|
---|
58 | TC_SEL_DATE = 'Missing Effective Date';
|
---|
59 |
|
---|
60 | function SetDelayEventForMed(const RadCap: string; var ADelayEvent: TOrderDelayEvent;
|
---|
61 | var IsNewEvent: Boolean; LimitEvent: Char): Boolean;
|
---|
62 | const
|
---|
63 | TX_RELEASE1 = 'Release ';
|
---|
64 | TX_RELEASE2 = ' orders immediately';
|
---|
65 | TX_DELAYED1 = 'Delay release of ';
|
---|
66 | TX_DELAYED2 = ' orders until';
|
---|
67 | var
|
---|
68 | EvtInfo,PtEvtID,AnEvtDlg: string;
|
---|
69 | SpeCap, CurrTS: string;
|
---|
70 |
|
---|
71 | procedure Highlight(APtEvtID: string);
|
---|
72 | var
|
---|
73 | j: integer;
|
---|
74 | begin
|
---|
75 | frmOrders.InitOrderSheetsForEvtDelay;
|
---|
76 | for j := 0 to frmOrders.lstSheets.Items.Count - 1 do
|
---|
77 | begin
|
---|
78 | if Piece(frmOrders.lstSheets.Items[j],'^',1)=APtEvtID then
|
---|
79 | begin
|
---|
80 | frmOrders.lstSheets.ItemIndex := j;
|
---|
81 | break;
|
---|
82 | end;
|
---|
83 | end;
|
---|
84 | end;
|
---|
85 |
|
---|
86 | function DisplayEvntDialog(AEvtDlg: String; AnEvent: TOrderDelayEvent): boolean;
|
---|
87 | var
|
---|
88 | DlgData: string;
|
---|
89 | begin
|
---|
90 | DlgData := GetDlgData(AEvtDlg);
|
---|
91 | frmOrders.NeedShowModal := True;
|
---|
92 | frmOrders.IsDefaultDlg := True;
|
---|
93 | Result := frmOrders.PlaceOrderForDefaultDialog(DlgData, True, AnEvent);
|
---|
94 | frmOrders.IsDefaultDlg := False;
|
---|
95 | frmOrders.NeedShowModal := False;
|
---|
96 | end;
|
---|
97 |
|
---|
98 | begin
|
---|
99 | if LimitEvent = 'C' then
|
---|
100 | begin
|
---|
101 | Result := True;
|
---|
102 | ADelayEvent.EventType := 'C';
|
---|
103 | ADelayEvent.Specialty := 0;
|
---|
104 | ADelayEvent.Effective := 0;
|
---|
105 | Exit;
|
---|
106 | end;
|
---|
107 | Result := False;
|
---|
108 | frmMedCopy := TfrmMedCopy.Create(Application);
|
---|
109 | try
|
---|
110 | if (LimitEvent = 'A') and (not Patient.Inpatient) then
|
---|
111 | begin
|
---|
112 | frmMedCopy.radDelayed.Checked := True;
|
---|
113 | frmMedCopy.radRelease.Enabled := False;
|
---|
114 | end;
|
---|
115 | ResizeAnchoredFormToFont(frmMedCopy);
|
---|
116 | frmMedCopy.AdjustFormSize;
|
---|
117 | CurrTS := Piece(GetCurrentSpec(Patient.DFN),'^',1);
|
---|
118 | if Length(CurrTS)>0 then
|
---|
119 | SpeCap := #13 + ' The current treating specialty is ' + CurrTS
|
---|
120 | else
|
---|
121 | SpeCap := #13 + ' No treating specialty is available.';
|
---|
122 | if Patient.Inpatient then
|
---|
123 | frmMedCopy.lblPtInfo.Caption := ' ' + Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap
|
---|
124 | else
|
---|
125 | begin
|
---|
126 | if (Encounter.Location > 0) then
|
---|
127 | frmMedCopy.lblPtInfo.Caption := Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap
|
---|
128 | else
|
---|
129 | frmMedCopy.lblPtInfo.Caption := Patient.Name + ' currently is an outpatient.' + SpeCap;
|
---|
130 | end;
|
---|
131 | frmMedCopy.AdjustFormSize;
|
---|
132 | frmMedCopy.fraEvntDelayList.EvntLimit := LimitEvent;
|
---|
133 | if Pos('transfer',RadCap)>0 then
|
---|
134 | frmMedCopy.Caption := 'Transfer Medication Orders';
|
---|
135 | frmMedCopy.radRelease.Caption := TX_RELEASE1 + RadCap + TX_RELEASE2;
|
---|
136 | frmMedCopy.radDelayed.Caption := TX_DELAYED1 + RadCap + TX_DELAYED2;
|
---|
137 | if LimitEvent='D' then
|
---|
138 | begin
|
---|
139 | frmMedCopy.pnlInpatient.Visible := False;
|
---|
140 | frmMedCopy.AdjustFormSize;
|
---|
141 | end;
|
---|
142 | frmMedCopy.ShowModal;
|
---|
143 | if (frmMedCopy.FOKPressed) and (frmMedCopy.radRelease.Checked) then
|
---|
144 | begin
|
---|
145 | if (frmMedCopy.radRelease.Checked) and (LimitEvent = 'D') then
|
---|
146 | XfInToOutNow := True
|
---|
147 | else XfInToOutNow := False;
|
---|
148 | ADelayEvent := frmMedCopy.FDelayEvent;
|
---|
149 | Result := True;
|
---|
150 | end
|
---|
151 | else if (frmMedCopy.FOKPressed) and (frmMedCopy.radDelayed.Checked) then
|
---|
152 | begin
|
---|
153 | EvtInfo := frmMedCopy.fraEvntDelayList.mlstEvents.Items[frmMedCopy.fraEvntDelayList.mlstEvents.ItemIndex];
|
---|
154 | ADelayEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1);
|
---|
155 | ADelayEvent.EventIFN := StrToInt64Def(Piece(EvtInfo,'^',1),0);
|
---|
156 | if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then
|
---|
157 | begin
|
---|
158 | ADelayEvent.TheParent.Assign(Piece(EvtInfo,'^',13));
|
---|
159 | ADelayEvent.EventType := ADelayEvent.TheParent.ParentType;
|
---|
160 | end;
|
---|
161 | ADelayEvent.EventName := frmMedCopy.fraEvntDelayList.mlstEvents.DisplayText[frmMedCopy.fraEvntDelayList.mlstEvents.ItemIndex];
|
---|
162 | ADelayEvent.Specialty := 0;
|
---|
163 | if frmMedCopy.fraEvntDelayList.orDateBox.Visible then
|
---|
164 | ADelayEvent.Effective := frmMedCopy.fraEvntDelayList.orDateBox.FMDateTime
|
---|
165 | else
|
---|
166 | ADelayEvent.Effective := 0;
|
---|
167 | IsNewEvent := False;
|
---|
168 | if TypeOfExistedEvent(Patient.DFN,ADelayEvent.EventIFN) = 0 then
|
---|
169 | begin
|
---|
170 | IsNewEvent := True;
|
---|
171 | if ADelayEvent.TheParent.ParentIFN > 0 then
|
---|
172 | begin
|
---|
173 | if StrToIntDef(ADelayEvent.TheParent.ParentDlg,0)>0 then
|
---|
174 | AnEvtDlg := ADelayEvent.TheParent.ParentDlg;
|
---|
175 | end
|
---|
176 | else
|
---|
177 | AnEvtDlg := Piece(EvtInfo,'^',5);
|
---|
178 | end;
|
---|
179 | if (StrToIntDef(AnEvtDlg,0)>0) and (IsNewEvent) then
|
---|
180 | if not DisplayEvntDialog(AnEvtDlg, ADelayEvent) then
|
---|
181 | begin
|
---|
182 | frmOrders.lstSheets.ItemIndex := 0;
|
---|
183 | frmOrders.lstSheetsClick(nil);
|
---|
184 | Result := False;
|
---|
185 | Exit;
|
---|
186 | end;
|
---|
187 | if not isExistedEvent(Patient.DFN, IntToStr(ADelayEvent.EventIFN), PtEvtID) then
|
---|
188 | begin
|
---|
189 | IsNewEvent := True;
|
---|
190 | if (ADelayEvent.TheParent.ParentIFN > 0) and (TypeOfExistedEvent(Patient.DFN,ADelayEvent.EventIFN) = 0 ) then
|
---|
191 | SaveEvtForOrder(Patient.DFN,ADelayEvent.TheParent.ParentIFN,'');
|
---|
192 | SaveEvtForOrder(Patient.DFN,ADelayEvent.EventIFN,'');
|
---|
193 | if isExistedEvent(Patient.DFN, IntToStr(ADelayEvent.EventIFN),PtEvtID) then
|
---|
194 | begin
|
---|
195 | Highlight(PtEvtID);
|
---|
196 | ADelayEvent.IsNewEvent := False;
|
---|
197 | ADelayEvent.PtEventIFN := StrToIntDef(PtEvtID,0);
|
---|
198 | end;
|
---|
199 | end else
|
---|
200 | begin
|
---|
201 | Highlight(PtEvtID);
|
---|
202 | ADelayEvent.PtEventIFN := StrToIntDef(PtEvtID,0);
|
---|
203 | ADelayEvent.IsNewEvent := False;
|
---|
204 | end;
|
---|
205 |
|
---|
206 | if frmOrders.lstSheets.ItemIndex > -1 then
|
---|
207 | begin
|
---|
208 | frmOrders.AskForCancel := False;
|
---|
209 | frmOrders.lstSheetsClick(nil);
|
---|
210 | frmOrders.AskForCancel := True;
|
---|
211 | end;
|
---|
212 | Result := True;
|
---|
213 | end;
|
---|
214 | finally
|
---|
215 | frmMedCopy.fraEvntDelayList.ResetProperty;
|
---|
216 | frmMedCopy.Release;
|
---|
217 | end;
|
---|
218 | end;
|
---|
219 |
|
---|
220 | procedure TfrmMedCopy.FormCreate(Sender: TObject);
|
---|
221 | begin
|
---|
222 | inherited;
|
---|
223 | FOKPressed := False;
|
---|
224 | FDelayEvent.EventType := #0;
|
---|
225 | FDelayEvent.EventIFN := 0;
|
---|
226 | radRelease.Checked := True;
|
---|
227 | if not Patient.Inpatient then
|
---|
228 | pnlInpatient.Visible := False;
|
---|
229 | AdjustFormSize;
|
---|
230 | end;
|
---|
231 |
|
---|
232 | procedure TfrmMedCopy.cmdOKClick(Sender: TObject);
|
---|
233 | var
|
---|
234 | today : TFMDateTime;
|
---|
235 | begin
|
---|
236 | inherited;
|
---|
237 | today := FMToday;
|
---|
238 | if (radDelayed.Checked) and (fraEvntDelayList.mlstEvents.ItemIndex < 0) then
|
---|
239 | begin
|
---|
240 | InfoBox('A release event must be selected.', 'No Selection Made', MB_OK);
|
---|
241 | Exit;
|
---|
242 | end;
|
---|
243 | if (radRelease.Checked) and (Pos('copied',radRelease.Caption)>0) then
|
---|
244 | begin
|
---|
245 | ImmdCopyAct := True;
|
---|
246 | FDelayEvent.EventType := 'C';
|
---|
247 | FDelayEvent.Specialty := 0;
|
---|
248 | FDelayEvent.Effective := 0;
|
---|
249 | end
|
---|
250 | else if (radRelease.Checked) and (Pos('transfer',radRelease.Caption)>0) then
|
---|
251 | begin
|
---|
252 | FDelayEvent.EventType := 'D';
|
---|
253 | FDelayEvent.Specialty := 0;
|
---|
254 | FDelayEvent.Effective := today;
|
---|
255 | end;
|
---|
256 | FOKPressed := True;
|
---|
257 | Close;
|
---|
258 | end;
|
---|
259 |
|
---|
260 | procedure TfrmMedCopy.AdjustFormSize;
|
---|
261 | var
|
---|
262 | y: integer;
|
---|
263 | begin
|
---|
264 | y := lblPtInfo.Height + 8; // allow for font changes
|
---|
265 | if pnlInpatient.Visible then
|
---|
266 | begin
|
---|
267 | lblInstruction2.top := lblInstruction.Height; // allow for font change
|
---|
268 | pnlInpatient.Height := lblInstruction2.top + lblInstruction2.Height;
|
---|
269 | inc(y,pnlInpatient.Height);
|
---|
270 | end;
|
---|
271 | pnlTop.Height := y;
|
---|
272 | inc(y, pnlMiddle.Height);
|
---|
273 | if fraEvntDelayList.Visible then
|
---|
274 | begin
|
---|
275 | inc(y, fraEvntDelayList.Height);
|
---|
276 | end;
|
---|
277 | VertScrollBar.Range := y;
|
---|
278 | ClientHeight := y;
|
---|
279 | end;
|
---|
280 |
|
---|
281 | procedure TfrmMedCopy.cmdCancelClick(Sender: TObject);
|
---|
282 | begin
|
---|
283 | inherited;
|
---|
284 | Close;
|
---|
285 | end;
|
---|
286 |
|
---|
287 | procedure TfrmMedCopy.radDelayedClick(Sender: TObject);
|
---|
288 | const
|
---|
289 | WarningMSG = 'If you''re writing medication orders to transfer these from Inpatient' +
|
---|
290 | ' to Outpatient, please use the ''release immediately'' choice. These will be' +
|
---|
291 | ' readied in advance by Pharmacy for the patient''s expected discharge date.';
|
---|
292 | begin
|
---|
293 | inherited;
|
---|
294 | frmMedCopy.fraEvntDelayList.UserDefaultEvent := StrToIntDef(GetDefaultEvt(IntToStr(User.DUZ)),0);
|
---|
295 | fraEvntDelayList.DisplayEvntDelayList;
|
---|
296 | if fraEvntDelayList.mlstEvents.Items.Count < 1 then
|
---|
297 | begin
|
---|
298 | ShowMsg(WarningMSG);
|
---|
299 | radRelease.Checked := True;
|
---|
300 | end else
|
---|
301 | begin
|
---|
302 | fraEvntDelayList.Visible := True;
|
---|
303 | end;
|
---|
304 | AdjustFormSize;
|
---|
305 | end;
|
---|
306 |
|
---|
307 | procedure TfrmMedCopy.radReleaseClick(Sender: TObject);
|
---|
308 | begin
|
---|
309 | inherited;
|
---|
310 | fraEvntDelayList.Visible := False;
|
---|
311 | AdjustFormSize;
|
---|
312 | end;
|
---|
313 |
|
---|
314 | procedure TfrmMedCopy.fraEvntDelayListcboEvntListChange(Sender: TObject);
|
---|
315 | begin
|
---|
316 | inherited;
|
---|
317 | fraEvntDelayList.mlstEventsChange(Sender);
|
---|
318 | if fraEvntDelayList.MatchedCancel then Close
|
---|
319 | end;
|
---|
320 |
|
---|
321 | procedure TfrmMedCopy.UMStillDelay(var message: TMessage);
|
---|
322 | begin
|
---|
323 | CmdOKClick(Application);
|
---|
324 | end;
|
---|
325 |
|
---|
326 | procedure TfrmMedCopy.fraEvntDelayListmlstEventsDblClick(Sender: TObject);
|
---|
327 | begin
|
---|
328 | if fraEvntDelayList.mlstEvents.ItemID > 0 then
|
---|
329 | cmdOKClick(Self);
|
---|
330 | end;
|
---|
331 |
|
---|
332 | procedure TfrmMedCopy.fraEvntDelayListmlstEventsChange(Sender: TObject);
|
---|
333 | begin
|
---|
334 | fraEvntDelayList.mlstEventsChange(Sender);
|
---|
335 | if fraEvntDelayList.MatchedCancel then
|
---|
336 | begin
|
---|
337 | FOKPressed := False;
|
---|
338 | Close;
|
---|
339 | Exit;
|
---|
340 | end;
|
---|
341 | end;
|
---|
342 |
|
---|
343 | procedure TfrmMedCopy.FormKeyDown(Sender: TObject; var Key: Word;
|
---|
344 | Shift: TShiftState);
|
---|
345 | begin
|
---|
346 | inherited;
|
---|
347 | if Key = VK_RETURN then
|
---|
348 | cmdOKClick(Self);
|
---|
349 | end;
|
---|
350 |
|
---|
351 | end.
|
---|