close Warning: Can't use blame annotator: 
svn blame failed on cprs/trunk/CPRS-Chart/fMedCopy.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

Upgrading to version 27
File size: 11.0 KB
RevLine 
1unit fMedCopy;
2
3interface
4
5uses
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
10type
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
46function SetDelayEventForMed(const RadCap: string; var ADelayEvent: TOrderDelayEvent;
47 var IsNewEvent: Boolean; LimitEvent: Char): Boolean;
48var
49 frmMedCopy: TfrmMedCopy;
50
51implementation
52{$R *.DFM}
53
54uses fODBase, fOrdersTS, fOrders, VAUtils;
55
56const
57 TX_SEL_DATE = 'An effective date (approximate) must be selected for discharge orders.';
58 TC_SEL_DATE = 'Missing Effective Date';
59
60function SetDelayEventForMed(const RadCap: string; var ADelayEvent: TOrderDelayEvent;
61 var IsNewEvent: Boolean; LimitEvent: Char): Boolean;
62const
63 TX_RELEASE1 = 'Release ';
64 TX_RELEASE2 = ' orders immediately';
65 TX_DELAYED1 = 'Delay release of ';
66 TX_DELAYED2 = ' orders until';
67var
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
98begin
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;
218end;
219
220procedure TfrmMedCopy.FormCreate(Sender: TObject);
221begin
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;
230end;
231
232procedure TfrmMedCopy.cmdOKClick(Sender: TObject);
233var
234 today : TFMDateTime;
235begin
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;
258end;
259
260procedure TfrmMedCopy.AdjustFormSize;
261var
262 y: integer;
263begin
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;
279end;
280
281procedure TfrmMedCopy.cmdCancelClick(Sender: TObject);
282begin
283 inherited;
284 Close;
285end;
286
287procedure TfrmMedCopy.radDelayedClick(Sender: TObject);
288const
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.';
292begin
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;
305end;
306
307procedure TfrmMedCopy.radReleaseClick(Sender: TObject);
308begin
309 inherited;
310 fraEvntDelayList.Visible := False;
311 AdjustFormSize;
312end;
313
314procedure TfrmMedCopy.fraEvntDelayListcboEvntListChange(Sender: TObject);
315begin
316 inherited;
317 fraEvntDelayList.mlstEventsChange(Sender);
318 if fraEvntDelayList.MatchedCancel then Close
319end;
320
321procedure TfrmMedCopy.UMStillDelay(var message: TMessage);
322begin
323 CmdOKClick(Application);
324end;
325
326procedure TfrmMedCopy.fraEvntDelayListmlstEventsDblClick(Sender: TObject);
327begin
328 if fraEvntDelayList.mlstEvents.ItemID > 0 then
329 cmdOKClick(Self);
330end;
331
332procedure TfrmMedCopy.fraEvntDelayListmlstEventsChange(Sender: TObject);
333begin
334 fraEvntDelayList.mlstEventsChange(Sender);
335 if fraEvntDelayList.MatchedCancel then
336 begin
337 FOKPressed := False;
338 Close;
339 Exit;
340 end;
341end;
342
343procedure TfrmMedCopy.FormKeyDown(Sender: TObject; var Key: Word;
344 Shift: TShiftState);
345begin
346 inherited;
347 if Key = VK_RETURN then
348 cmdOKClick(Self);
349end;
350
351end.
Note: See TracBrowser for help on using the repository browser.