source: cprs/trunk/CPRS-Chart/Orders/fOrdersCV.pas@ 872

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

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