source: cprs/branches/foia-cprs/CPRS-Chart/fMedCopy.pas@ 617

Last change on this file since 617 was 459, checked in by Kevin Toppenberg, 16 years ago

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