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

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

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