source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrdersCV.pas@ 525

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 17.4 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fOrdersCV;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 StdCtrls, ExtCtrls, ORCtrls, ORFn, fAutoSZ, uOrders, rOrders, DKLang;
9
10type
11 TfrmChgEvent = class(TfrmAutoSz)
12 pnlTop: TPanel;
13 lblPtInfo: TLabel;
14 pnlBottom: TPanel;
15 cboSpecialty: TORComboBox;
16 btnCancel: TButton;
17 btnAction: TButton;
18 DKLanguageController1: TDKLanguageController;
19 DKLanguageController2: TDKLanguageController;
20 procedure FormCreate(Sender: TObject);
21 procedure cboSpecialtyChange(Sender: TObject);
22 procedure btnActionClick(Sender: TObject);
23 procedure btnCancelClick(Sender: TObject);
24 procedure cboSpecialtyDblClick(Sender: TObject);
25 procedure FormClose(Sender: TObject; var Action: TCloseAction);
26 private
27 { Private declarations }
28 FDefaultEvntIFN: Integer;
29 FDefaultPtEvntIFN: Integer;
30 FCurrSpecialty : string;
31 FDefaultIndex: String;
32 FOKPress: boolean;
33 FLastIndex: Integer;
34
35 procedure updateChanges(Const AnOrderIDList: TStringList; Const AnEventName: String);
36
37 public
38 { Public declarations }
39 procedure LoadSpecialtyList;
40 procedure Highlight(APtEvtID: string);
41 procedure FilterOutEmptyPtEvt;
42 property CurrSpecialty: string read FCurrSpecialty write FCurrSpecialty;
43 property DefaultIndex: string read FDefaultIndex write FDefaultIndex;
44 property OKPress: boolean read FOKPress write FOKPress;
45
46 end;
47
48function ExecuteChangeEvt(SelectedList: TList; var DoesDestEvtOccur: boolean;
49 var DestPtEvtID: integer; var DestPtEvtName: string): boolean;
50
51
52implementation
53
54{$R *.DFM}
55
56uses uCore, uConst, forders, fODChangeEvtDisp, rMisc;
57
58function ExecuteChangeEvt(SelectedList: TList; var DoesDestEvtOccur: boolean;
59 var DestPtEvtID: integer; var DestPtEvtName: string): boolean;
60
61//const
62//CHANGE_CAP = 'The release event for the following orders will be changed to: '; <-- original line. //kt 8/8/2007
63//REMOVE_CAP = 'The release event will be deleted for the following orders: '; <-- original line. //kt 8/8/2007
64
65 var
66 CHANGE_CAP : string; //kt
67 REMOVE_CAP : string; //kt
68
69var
70 i: integer;
71 frmChgEvent : TfrmChgEvent;
72 AnOrder: TOrder;
73 AnOrderIDList: TStringList;
74 EvtInfo,AnEvtDlg: string;
75 AnEvent: TOrderDelayEvent;
76 ThePtEvtID, TheDefaultPtEvtID, TheDefaultEvtInfo, SpeCap: string;
77 IsNewEvent: boolean;
78 ExistedPtEvtId: integer;
79
80 function DisplayEvntDialog(AEvtDlg: String; AnEvent: TOrderDelayEvent): boolean;
81 var
82 DlgData: string;
83 begin
84 DlgData := GetDlgData(AEvtDlg);
85 frmOrders.NeedShowModal := True;
86 frmOrders.IsDefaultDlg := True;
87 Result := frmOrders.PlaceOrderForDefaultDialog(DlgData, True, AnEvent);
88 frmOrders.IsDefaultDlg := False;
89 frmOrders.NeedShowModal := False;
90 end;
91
92 function FindMatchedPtEvtID(EventName: string): integer;
93 var
94 cnt: integer;
95 viewName: string;
96 begin
97 Result := 0;
98 for cnt := 0 to frmOrders.lstSheets.Items.Count - 1 do
99 begin
100 viewName := Piece(frmOrders.lstSheets.Items[cnt],'^',2);
101 if AnsiCompareText(EventName,viewName)=0 then
102 begin
103 Result := StrToIntDef(Piece(frmOrders.lstSheets.Items[cnt],'^',1),0);
104 break;
105 end;
106 end;
107
108 end;
109begin
110 CHANGE_CAP := DKLangConstW('fOrdersCV_The_release_event_for_the_following_orders_will_be_changed_tox');
111 REMOVE_CAP := DKLangConstW('fOrdersCV_The_release_event_will_be_deleted_for_the_following_ordersx');
112 Result := False;
113 IsNewEvent := False;
114 AnEvent.EventType := #0;
115 AnEvent.EventIFN := 0;
116 AnEvent.EventName := '';
117 AnEvent.Specialty := 0;
118 AnEvent.Effective := 0;
119 AnEvent.PtEventIFN := 0;
120 AnEvent.TheParent := TParentEvent.Create;
121 AnEvent.IsNewEvent := False;
122
123 if SelectedList.Count = 0 then Exit;
124 frmChgEvent := TfrmChgEvent.Create(Application);
125 SetFormPosition(frmChgEvent);
126 frmChgEvent.CurrSpecialty := Piece(GetCurrentSpec(Patient.DFN),'^',1);
127 if Length(frmChgEvent.CurrSpecialty)>0 then
128// SpeCap := #13 + ' The current treating specialty is ' + frmChgEvent.CurrSpecialty <-- original line. //kt 8/8/2007
129 SpeCap := #13 + DKLangConstW('fOrdersCV_The_current_treating_specialty_is') + frmChgEvent.CurrSpecialty //kt added 8/8/2007
130 else
131// SpeCap := #13 + ' No treating specialty is available.'; <-- original line. //kt 8/8/2007
132 SpeCap := #13 + DKLangConstW('fOrdersCV_No_treating_specialty_is_availablex'); //kt added 8/8/2007
133 ResizeFormToFont(TForm(frmChgEvent));
134 SetFormPosition(frmChgEvent);
135 if Patient.Inpatient then
136// frmChgEvent.lblPtInfo.Caption := ' ' + Patient.Name + ' is currently admitted to ' + Encounter.LocationName + SpeCap <-- original line. //kt 8/8/2007
137 frmChgEvent.lblPtInfo.Caption := ' ' + Patient.Name + DKLangConstW('fOrdersCV_is_currently_admitted_to') + Encounter.LocationName + SpeCap //kt added 8/8/2007
138 else
139// frmChgEvent.lblPtInfo.Caption := ' ' + Patient.Name + ' is currently at ' + Encounter.LocationName + SpeCap; <-- original line. //kt 8/8/2007
140 frmChgEvent.lblPtInfo.Caption := ' ' + Patient.Name + DKLangConstW('fOrdersCV_is_currently_at') + Encounter.LocationName + SpeCap; //kt added 8/8/2007
141 frmChgEvent.cboSpecialty.Caption := frmChgEvent.lblPtInfo.Caption;
142 ThePtEvtID := '';
143 AnOrder := TOrder(selectedList[0]);
144 TheDefaultPtEvtID := GetOrderPtEvtID(AnOrder.ID);
145 if Length(TheDefaultPtEvtID)>0 then
146 begin
147 frmChgEvent.FDefaultPtEvntIFN := StrToIntDef(TheDefaultPtEvtId,0);
148 TheDefaultEvtInfo := EventInfo(TheDefaultPtEvtID);
149 frmChgEvent.FDefaultEvntIFN := StrToIntDef(Piece(TheDefaultEvtInfo,'^',2),0);
150 end;
151 frmChgEvent.LoadSpecialtyList;
152 frmChgEvent.ShowModal;
153 if frmChgEvent.OKPress then
154 begin
155// if frmChgEvent.btnAction.Caption = 'Change' then <-- original line. //kt 8/8/2007
156 if frmChgEvent.btnAction.Caption = DKLangConstW('fOrdersCV_Change') then //kt added 8/8/2007
157 begin
158 AnOrderIDList := TStringList.Create;
159 for i := 0 to selectedList.Count - 1 do
160 begin
161 AnOrder := TOrder(selectedList[i]);
162 AnOrderIDList.Add(AnOrder.ID);
163 end;
164 EvtInfo := frmChgEvent.cboSpecialty.Items[frmChgEvent.cboSpecialty.ItemIndex];
165 AnEvent.EventType := CharAt(Piece(EvtInfo,'^',3),1);
166 AnEvent.EventIFN := StrToInt64Def(Piece(EvtInfo,'^',1),0);
167 if StrToInt64Def(Piece(EvtInfo,'^',13),0) > 0 then
168 begin
169 AnEvent.TheParent.Assign(Piece(EvtInfo,'^',13));
170 AnEvent.EventType := AnEvent.TheParent.ParentType;
171 end;
172 AnEvent.EventName := Piece(EvtInfo,'^',9);
173// ExistedPtEvtId := FindMatchedPtEvtID('Delayed ' + AnEvent.EventName + ' Orders'); <-- original line. //kt 8/8/2007
174 ExistedPtEvtId := FindMatchedPtEvtID(DKLangConstW('fOrdersCV_Delayed') + AnEvent.EventName + DKLangConstW('fOrdersCV_Orders')); //kt added 8/8/2007
175 if (ExistedPtEvtId>0) and IsCompletedPtEvt(ExistedPtEvtId) then
176 begin
177 DoesDestEvtOccur := True;
178 DestPtEvtId := ExistedPtEvtId;
179 DestPtEvtName := AnEvent.EventName;
180 ChangeEvent(AnOrderIDList, '');
181 Result := True;
182 Exit;
183 end;
184
185 if Length(AnEvent.EventName) < 1 then
186 AnEvent.EventName := Piece(EvtInfo,'^',2);
187 AnEvent.Specialty := 0;
188 if TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0 then
189 begin
190 IsNewEvent := True;
191 if AnEvent.TheParent.ParentIFN > 0 then
192 begin
193 if StrToIntDef(AnEvent.TheParent.ParentDlg,0)>0 then
194 AnEvtDlg := AnEvent.TheParent.ParentDlg;
195 end
196 else
197 AnEvtDlg := Piece(EvtInfo,'^',5);
198 end;
199 if (StrToIntDef(AnEvtDlg,0)>0) and (IsNewEvent) then
200 if not DisplayEvntDialog(AnEvtDlg, AnEvent) then
201 begin
202 frmOrders.lstSheets.ItemIndex := 0;
203 frmOrders.lstSheetsClick(nil);
204 Result := False;
205 Exit;
206 end;
207 if not isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN), ThePtEvtID) then
208 begin
209 if (AnEvent.TheParent.ParentIFN > 0) and (TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0 )then
210 SaveEvtForOrder(Patient.DFN, AnEvent.TheParent.ParentIFN, '');
211 SaveEvtForOrder(Patient.DFN,AnEvent.EventIFN,'');
212 if isExistedEvent(Patient.DFN, IntToStr(AnEvent.EventIFN),ThePtEvtID) then
213 begin
214 AnEvent.IsNewEvent := False;
215 AnEvent.PtEventIFN := StrToIntDef(ThePtEvtID,0);
216 end;
217 end;
218 ChangeEvent(AnOrderIDList, ThePtEvtID);
219// frmChgEvent.updateChanges(AnOrderIDList,'Delayed ' + AnEvent.EventName); <-- original line. //kt 8/8/2007
220 frmChgEvent.updateChanges(AnOrderIDList,DKLangConstW('fOrdersCV_Delayed') + AnEvent.EventName); //kt added 8/8/2007
221 frmChgEvent.Highlight(ThePtEvtID);
222 if frmOrders.lstSheets.ItemIndex >= 0 then
223 frmOrders.lstSheetsClick(Nil);
224 end else
225 begin
226 if not DispOrdersForEventChange(SelectedList, REMOVE_CAP) then exit;
227 AnOrderIDList := TStringList.Create;
228 for i := 0 to selectedList.Count - 1 do
229 begin
230 AnOrder := TOrder(selectedList[i]);
231 AnOrderIDList.Add(AnOrder.ID);
232 end;
233 ChangeEvent(AnOrderIDList,'');
234 frmChgEvent.updateChanges(AnOrderIDList,'');
235 frmChgEvent.FilterOutEmptyPtEvt;
236 frmOrders.InitOrderSheetsForEvtDelay;
237 frmOrders.lstSheets.ItemIndex := 0;
238 frmOrders.lstSheetsClick(Nil);
239 end;
240 Result := True;
241 end else
242 Result := False;
243end;
244
245{ TfrmChgEvent }
246
247procedure TfrmChgEvent.LoadSpecialtyList;
248var
249 i: integer;
250 tempStr: string;
251begin
252 inherited;
253 cboSpecialty.Items.Clear;
254 if Patient.Inpatient then
255 begin
256 ListSpecialtiesED(#0,cboSpecialty.Items);
257 end
258 else ListSpecialtiesED('A',cboSpecialty.Items);
259 if FDefaultEvntIFN > 0 then
260 begin
261 for i := 0 to cboSpecialty.Items.Count - 1 do
262 begin
263 if Piece(cboSpecialty.Items[i],'^',1)=IntToStr(FDefaultEvntIFN) then
264 begin
265 tempStr := cboSpecialty.Items[i];
266 cboSpecialty.Items.Insert(0,tempStr);
267 cboSpecialty.Items.Insert(1,'^^^^^^^^__________________________________________________________________________________');
268 cboSpecialty.ItemIndex := 0;
269 FDefaultIndex := Piece(tempStr,'^',1);
270 btnAction.Visible := True;
271// btnAction.Caption := 'Remove'; <-- original line. //kt 8/8/2007
272 btnAction.Caption := DKLangConstW('fOrdersCV_Remove'); //kt added 8/8/2007
273 break;
274 end;
275 end;
276 if cboSpecialty.ItemIndex < 0 then
277 btnAction.Visible := False;
278 end;
279end;
280
281procedure TfrmChgEvent.FormCreate(Sender: TObject);
282begin
283 inherited;
284 FDefaultEvntIFN := 0;
285 FDefaultPtEvntIFN := 0;
286 FCurrSpecialty := '';
287 FDefaultIndex := '';
288 FOKPress := False;
289 FLastIndex := 0;
290
291end;
292
293procedure TfrmChgEvent.cboSpecialtyChange(Sender: TObject);
294//const
295//TX_MCHEVT1 = ' is already assigned to '; <-- original line. //kt 8/8/2007
296//TX_MCHEVT2 = #13 + 'Do you still want to write delayed orders?'; <-- original line. //kt 8/8/2007
297var
298 AnEvtID, AnEvtType: string;
299 AnEvtName,ATsName: string;
300 i: integer;
301 NMRec : TNextMoveRec;
302 TX_MCHEVT1 : string; //kt
303 TX_MCHEVT2 : string; //kt
304
305 begin
306 inherited;
307 TX_MCHEVT1 := DKLangConstW('fOrdersCV_is_already_assigned_to'); //kt added 8/8/2007
308 TX_MCHEVT2 := #13 + DKLangConstW('fOrdersCV_Do_you_still_want_to_write_delayed_ordersx'); //kt added 8/8/2007
309 NextMove(NMRec, FLastIndex, cboSpecialty.ItemIndex); //Logic added for 508 1/31/03
310 FLastIndex := NMRec.LastIndex ;
311 if (cboSpecialty.text = '') or (cboSpecialty.ItemIndex = -1) then
312 begin
313 btnAction.visible := False;
314 btnAction.Caption := '';
315 end
316 else if (Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',1) <> FDefaultIndex) then
317 begin
318 btnAction.Visible := True;
319// btnAction.Caption := 'Change'; <-- original line. //kt 8/8/2007
320 btnAction.Caption := DKLangConstW('fOrdersCV_Change'); //kt added 8/8/2007
321 end
322 else
323 begin
324 btnAction.Visible := True;
325// btnAction.Caption := 'Remove'; <-- original line. //kt 8/8/2007
326 btnAction.Caption := DKLangConstW('fOrdersCV_Remove'); //kt added 8/8/2007
327 end;
328 if cboSpecialty.ItemIndex >= 0 then
329 begin
330 AnEvtID := Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',1);
331 AnEvtType := Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',3);
332 AnEvtName := Piece(cboSpecialty.Items[cboSpecialty.ItemIndex],'^',9)
333 end else
334 begin
335 AnEvtID := '';
336 AnEvtType := '';
337 AnEvtName := '';
338 end;
339 ATsName := CurrSpecialty;
340 if (StrToIntDef(AnEvtID,0)>0) and (isMatchedEvent(Patient.DFN,AnEvtID,ATsName)) then
341 begin
342// if InfoBox(Patient.Name + TX_MCHEVT1 + CurrSpecialty + ' on ' + Encounter.LocationName + TX_MCHEVT2, <-- original line. //kt 8/8/2007
343 if InfoBox(Patient.Name + TX_MCHEVT1 + CurrSpecialty + DKLangConstW('fOrdersCV_on') + Encounter.LocationName + TX_MCHEVT2, //kt added 8/8/2007
344// 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDOK then <-- original line. //kt 8/8/2007
345 DKLangConstW('fOrdersCV_Warning'), MB_OKCANCEL or MB_ICONWARNING) = IDOK then //kt added 8/8/2007
346 btnActionClick(Self)
347 else
348 begin
349 if Length(FDefaultIndex) > 0 then
350 begin
351 for i := 0 to cboSpecialty.Items.Count - 1 do
352 begin
353 if Piece(cboSpecialty.items[i],'^',1)=FDefaultIndex then
354 begin
355 cboSpecialty.ItemIndex := cboSpecialty.ItemIndex + NMRec.NextStep; //Added this code for 508 compliance GRE 01/30/03
356 break;
357 end;
358 end;
359// btnAction.Caption := 'Remove'; <-- original line. //kt 8/8/2007
360 btnAction.Caption := DKLangConstW('fOrdersCV_Remove'); //kt added 8/8/2007
361 end else
362 begin
363 cboSpecialty.ItemIndex := 0;
364// btnAction.Caption := 'Change'; <-- original line. //kt 8/8/2007
365 btnAction.Caption := DKLangConstW('fOrdersCV_Change'); //kt added 8/8/2007
366 end;
367 end;
368 end;
369end;
370
371procedure TfrmChgEvent.btnActionClick(Sender: TObject);
372//const
373//TX_REASON_REQ = 'A Delayed Event must be selected.'; <-- original line. //kt 8/8/2007
374//TX_REMOVE = 'Are you sure you want to remove the release event from these orders?'; <-- original line. //kt 8/8/2007
375//TX_CHANGE = 'Are you sure you want to change the release event for these orders?'; <-- original line. //kt 8/8/2007
376
377var
378TX_REASON_REQ : string; //kt
379TX_REMOVE : string; //kt
380TX_CHANGE : string; //kt
381
382begin
383 inherited;
384 TX_REASON_REQ := DKLangConstW('fOrdersCV_A_Delayed_Event_must_be_selectedx'); //kt added 8/8/2007
385 TX_REMOVE := DKLangConstW('fOrdersCV_Are_you_sure_you_want_to_remove_the_release_event_from_these_ordersx'); //kt added 8/8/2007
386 TX_CHANGE := DKLangConstW('fOrdersCV_Are_you_sure_you_want_to_change_the_release_event_for_these_ordersx'); //kt added 8/8/2007
387 if cboSpecialty.ItemIndex < 0 then
388 begin
389// InfoBox(TX_REASON_REQ, 'No Selection made', MB_OK); <-- original line. //kt 8/8/2007
390 InfoBox(TX_REASON_REQ, DKLangConstW('fOrdersCV_No_Selection_made'), MB_OK); //kt added 8/8/2007
391 Exit;
392 end;
393 OKPress := True;
394 Close;
395end;
396
397procedure TfrmChgEvent.btnCancelClick(Sender: TObject);
398begin
399 Close;
400end;
401procedure TfrmChgEvent.cboSpecialtyDblClick(Sender: TObject);
402begin
403 inherited;
404 if cboSpecialty.ItemIndex > -1 then
405 btnActionClick(Self);
406end;
407
408procedure TfrmChgEvent.FormClose(Sender: TObject;
409 var Action: TCloseAction);
410begin
411 inherited;
412 SaveUserBounds(Self);
413 Action := caFree;
414end;
415
416procedure TfrmChgEvent.updateChanges(const AnOrderIDList: TStringList; const AnEventName: String);
417var
418 jx,TempSigSts: integer;
419 theChangeItem: TChangeItem;
420 TempText: string;
421begin
422 for jx := 0 to AnOrderIDList.Count - 1 do
423 begin
424 theChangeItem := Changes.Locate(CH_ORD,AnOrderIDList[jx]);
425 if theChangeItem = nil then
426 begin
427 TempText := RetrieveOrderText(AnOrderIDList[jx]);
428 Changes.Add(CH_ORD,AnOrderIDList[jx],TempText,AnEventName,1);
429 end
430 else
431 begin
432 TempText := theChangeItem.Text;
433 TempSigSts := theChangeItem.SignState;
434 Changes.Remove(CH_ORD,AnOrderIDList[jx]);
435 Changes.Add(CH_ORD,AnOrderIDList[jx],TempText, AnEventName, TempSigSts);
436 end;
437 end;
438 if FDefaultPtEvntIFN>0 then
439 begin
440 if PtEvtEmpty(IntToStr(FDefaultPtEvntIFN)) then
441 begin
442 DeletePtEvent(IntToStr(FDefaultPtEvntIFN));
443 frmOrders.ChangesUpdate(IntToStr(FDefaultPtEvntIFN));
444 end;
445 end;
446end;
447
448procedure TfrmChgEvent.Highlight(APtEvtID: string);
449var
450 jjj: integer;
451begin
452 FilterOutEmptyPtEvt;
453 frmOrders.InitOrderSheetsForEvtDelay;
454 for jjj := 0 to frmOrders.lstSheets.Items.Count - 1 do
455 begin
456 if Piece(frmOrders.lstSheets.Items[jjj],'^',1)=APtEvtID then
457 begin
458 frmOrders.lstSheets.ItemIndex := jjj;
459 break;
460 end;
461 end;
462end;
463
464procedure TfrmChgEvent.FilterOutEmptyPtEvt;
465var
466 TmpStr: string;
467 hhh: integer;
468 AaPtEvtList: TStringList;
469begin
470 AaPtEvtList := TStringList.Create;
471 LoadOrderSheetsED(AaPtEvtList);
472 for hhh := 0 to AaPtEvtList.Count - 1 do
473 begin
474 if StrToIntDef(Piece(AaPtEvtList[hhh],'^',1),0)>0 then
475 begin
476 if DeleteEmptyEvt(Piece(AaPtEvtList[hhh],'^',1),TmpStr, False) then
477 frmOrders.ChangesUpdate(Piece(AaPtEvtList[hhh],'^',1));
478 end;
479 end;
480end;
481
482end.
Note: See TracBrowser for help on using the repository browser.