source: cprs/branches/tmg-cprs/CPRS-Chart/fMedCopy.pas@ 1085

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

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