source: cprs/branches/foia-cprs/CPRS-Chart/fMeds.pas@ 459

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

Adding foia-cprs branch
File size: 51.4 KB
Line 
1unit fMeds;
2
3{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
4
5interface
6
7uses
8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9 fPage, StdCtrls, Menus, ORCtrls, ORFn, ExtCtrls, ComCtrls, rOrders, uConst,
10 rMeds, ORNet;
11
12type
13 TChildOD = class
14 public
15 ChildID: string;
16 ParentID: string;
17 constructor Create;
18 end;
19 TfrmMeds = class(TfrmPage)
20 mnuMeds: TMainMenu;
21 mnuView: TMenuItem;
22 mnuViewChart: TMenuItem;
23 mnuChartReports: TMenuItem;
24 mnuChartLabs: TMenuItem;
25 mnuChartDCSumm: TMenuItem;
26 mnuChartCslts: TMenuItem;
27 mnuChartNotes: TMenuItem;
28 mnuChartOrders: TMenuItem;
29 mnuChartMeds: TMenuItem;
30 mnuChartProbs: TMenuItem;
31 mnuChartCover: TMenuItem;
32 mnuAct: TMenuItem;
33 mnuActNew: TMenuItem;
34 Z1: TMenuItem;
35 mnuActChange: TMenuItem;
36 mnuActDC: TMenuItem;
37 mnuActHold: TMenuItem;
38 mnuActRenew: TMenuItem;
39 Z2: TMenuItem;
40 mnuViewActive: TMenuItem;
41 mnuViewExpiring: TMenuItem;
42 Z3: TMenuItem;
43 mnuViewSortClass: TMenuItem;
44 mnuViewSortName: TMenuItem;
45 Z4: TMenuItem;
46 mnuViewDetail: TMenuItem;
47 popMed: TPopupMenu;
48 popMedDetails: TMenuItem;
49 N1: TMenuItem;
50 popMedChange: TMenuItem;
51 popMedDC: TMenuItem;
52 popMedRenew: TMenuItem;
53 N2: TMenuItem;
54 popMedNew: TMenuItem;
55 mnuActCopy: TMenuItem;
56 mnuActRefill: TMenuItem;
57 mnuActTransfer: TMenuItem;
58 popMedRefill: TMenuItem;
59 mnuChartSurgery: TMenuItem;
60 mnuViewHistory: TMenuItem;
61 popMedHistory: TMenuItem;
62 pnlBottom: TORAutoPanel;
63 splitBottom: TSplitter;
64 pnlMedIn: TPanel;
65 lstMedsIn: TCaptionListBox;
66 hdrMedsIn: THeaderControl;
67 pnlNonVA: TPanel;
68 lstMedsNonVA: TCaptionListBox;
69 hdrMedsNonVA: THeaderControl;
70 splitTop: TSplitter;
71 pnlTop: TORAutoPanel;
72 lstMedsOut: TCaptionListBox;
73 hdrMedsOut: THeaderControl;
74 procedure mnuChartTabClick(Sender: TObject);
75 procedure FormCreate(Sender: TObject);
76 procedure FormDestroy(Sender: TObject);
77 procedure lstMedsMeasureItem(Control: TWinControl; Index: Integer;
78 var AHeight: Integer);
79 procedure lstMedsDrawItem(Control: TWinControl; Index: Integer;
80 Rect: TRect; State: TOwnerDrawState);
81 procedure mnuViewDetailClick(Sender: TObject);
82 procedure lstMedsExit(Sender: TObject);
83 procedure lstMedsDblClick(Sender: TObject);
84 procedure lstMedsInClick(Sender: TObject);
85 procedure lstMedsOutClick(Sender: TObject);
86 procedure hdrMedsOutSectionResize(HeaderControl: THeaderControl;
87 Section: THeaderSection);
88 procedure hdrMedsInSectionResize(HeaderControl: THeaderControl;
89 Section: THeaderSection);
90 procedure mnuActDCClick(Sender: TObject);
91 procedure mnuActHoldClick(Sender: TObject);
92 procedure mnuActRenewClick(Sender: TObject);
93 procedure mnuActChangeClick(Sender: TObject);
94 procedure mnuActCopyClick(Sender: TObject);
95 procedure mnuActNewClick(Sender: TObject);
96 procedure mnuActRefillClick(Sender: TObject);
97 procedure mnuActClick(Sender: TObject);
98 procedure pnlMedOut1Resize(Sender: TObject);
99 procedure mnuViewHistoryClick(Sender: TObject);
100 procedure popMedPopup(Sender: TObject);
101 procedure mnuViewClick(Sender: TObject);
102 procedure lstMedsNonVAClick(Sender: TObject);
103 procedure lstMedsNonVADblClick(Sender: TObject);
104 procedure lstMedsNonVAExit(Sender: TObject);
105 procedure hdrMedsNonVASectionResize(HeaderControl: THeaderControl;
106 Section: THeaderSection);
107 procedure FormResize(Sender: TObject);
108 procedure hdrMedsOutResize(Sender: TObject);
109 procedure hdrMedsNonVAResize(Sender: TObject);
110 procedure hdrMedsInResize(Sender: TObject);
111 procedure FormShow(Sender: TObject);
112 procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
113 Shift: TShiftState; X, Y: Integer);
114 procedure splitBottomMoved(Sender: TObject);
115 procedure splitTopMoved(Sender: TObject);
116 private
117 FIterating: Boolean;
118 FActionOnMedsTab: Boolean;
119 FParentComplexOrderID: string;
120 uMedListIn: TList;
121 uMedListOut: TList;
122 uMedListNonVA: TList;
123 uPendingChanges: TStringList;
124 uDGrp: array[0..6] of Integer;
125 uPharmacyOrdersIn: TStringList;
126 uPharmacyOrdersOut: TStringList;
127 uNonVAOrdersOut: TStringList;
128 ChildODList: TStringList;
129 function ListSelected(const ErrMsg: string): TListBox;
130 procedure ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string);
131 procedure MakeSelectedList(AListBox: TListBox; AList: TList; ActName: String = '');
132 procedure SynchListToOrders(AListBox: TListBox; AList: TList);
133 function GetActionText(const AMed: TMedListRec): string;
134 function GetInstructText(const AMed: TMedListRec; var Detail: string): string;
135 function GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string;
136 function GetPlainText(Control: TWinControl; Index: integer): string;
137 function GetHeader(Control: TWinControl): THeaderControl;
138 function GetMedList(Control: TWinControl): TList;
139 function GetPharmacyOrders(Control: TWinControl): TStringList;
140 public
141 function PctOfTotalHeight(thisPanel: TPanel) : integer;
142 procedure RefreshMedLists;
143 procedure ClearPtData; override;
144 procedure DisplayPage; override;
145 procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override;
146 procedure SetFontSize( FontSize: integer); override;
147 property ActionOnMedsTab: boolean read FActionOnMedsTab;
148 property ParentComplexOrderID: string read FParentComplexOrderID write FParentComplexOrderID;
149 procedure InitfMedsSize;
150 end;
151
152var
153 frmMeds: TfrmMeds;
154// LargePanelPortion: Integer;
155// SmallPanelPortion: integer;
156 MedOutSize: double;
157 s: string;
158 LargePanelSize: integer;
159 SmallPanelSize : integer;
160 MedNonVAPanelSize: integer;
161
162 totalHeight: integer;
163 MedOutPctOfTotalHeight: integer;
164 NonVAPctOfTotalHeight: integer;
165 MedInpctOfTotalHeight : integer;
166
167 resizedTotalHeight: integer;
168 resizedMedOutPanelHeight: Extended;
169 resizedNonVAPanelHeight: Extended;
170 resizedMedInPanelHeight: Extended;
171
172 splitterTop: TSplitter;
173 splitterBottom: TSplitter;
174
175implementation
176
177uses uCore, fFrame, fRptBox, uOrders, fODBase, fOrdersDC, fOrdersHold,
178 fOrdersRenew, fOMNavA, fOrdersRefill, fMedCopy, fOrders, fODChild, rODBase;
179
180{$R *.DFM}
181
182const
183 COL_MEDNAME = 1;
184 DG_OUT = 0;
185 DG_IN = 1;
186 DG_UD = 2;
187 DG_IV = 3;
188 DG_TPN = 4;
189 DG_NVA = 5;
190 DG_IMO = 6;
191 FMT_INDENT = 12;
192 TAG_OUTPT = 1;
193 TAG_INPT = 2;
194 TAG_NONVA = 3;
195 TX_NOSEL = 'No orders are highlighted. Highlight the orders' + CRLF +
196 'you wish to take action on.';
197 TC_NOSEL = 'No Orders Selected';
198 TX_NO_DC = CRLF + CRLF + '- cannot be discontinued.' + CRLF + CRLF + 'Reason: ';
199 TC_NO_DC = 'Unable to Discontinue';
200 TX_NO_RENEW = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
201 TC_NO_RENEW = 'Unable to Renew Order';
202 TX_NO_HOLD = CRLF + CRLF + '- cannot be placed on hold.' + CRLF + CRLF + 'Reason: ';
203 TC_NO_HOLD = 'Unable to Hold';
204 TX_NO_COPY = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ';
205 TC_NO_COPY = 'Unable to Copy Order';
206 TX_NO_CHANGE = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
207 TC_NO_CHANGE = 'Unable to Change Order';
208 TX_NO_REFILL = CRLF + CRLF + '- cannot be refilled.' + CRLF + CRLF + 'Reason: ';
209 TC_NO_REFILL = 'Unable to Refill Order';
210 MEDS_SPLIT_FORM = 'frmMedsSplit';
211
212{ TPage common methods --------------------------------------------------------------------- }
213
214procedure TfrmMeds.ClearPtData;
215begin
216 inherited ClearPtData;
217 lstMedsIn.Clear;
218 lstMedsOut.Clear;
219 lstMedsNonVA.Clear;
220 ClearMedList(uMedListIn);
221 ClearMedList(uMedListOut);
222 ClearMedList(uMedListNonVA);
223 uPendingChanges.Clear;
224 uPharmacyOrdersIn.Clear;
225 uPharmacyOrdersOut.Clear;
226 uMedListNonVA.Clear;
227
228end;
229
230procedure TfrmMeds.DisplayPage;
231const
232 RATIO_SMALL = 0.13; //0.1866;
233begin
234 inherited DisplayPage;
235
236 frmFrame.ShowHideChartTabMenus(mnuViewChart);
237
238 if InitPage and User.NoOrdering then
239 begin
240 mnuAct.Enabled := False;
241 popMedChange.Enabled := False;
242 popMedDC.Enabled := False;
243 popMedRenew.Enabled := False;
244 popMedNew.Enabled := False;
245
246 end;
247
248 //Swap Inpatient/Outpatient list display positions depending in inpatient/outpatient status
249 if InitPage and User.DisableHold then
250 mnuActHold.Visible := False;
251
252 if Patient.Inpatient then
253 begin
254 splitBottom.Align := alNone;
255 hdrMedsIn.Align := alNone;
256
257 lstMedsIn.Parent := pnlTop;
258 lstMedsIn.Align := alClient;
259 lstMedsOut.Parent := pnlMedIn;
260
261 hdrMedsIn.Parent := pnlTop;
262 hdrMedsIn.Align := alTop;
263
264 hdrMedsOut.Parent := pnlMedIn;
265 splitBottom.Align := alBottom;
266 end
267 else
268 begin
269 splitBottom.Align := alNone;
270 hdrMedsIn.Align := alNone;
271
272 lstMedsIn.Parent := pnlMedIn;
273 lstMedsOut.Parent := pnlTop;
274 lstMedsOut.Align := alClient;
275
276 hdrMedsIn.Parent := pnlMedIn;
277 hdrMedsIn.Align := alTop;
278
279 hdrMedsOut.Parent := pnlTop;
280 splitBottom.Align := alBottom;
281 end;
282
283
284 RefreshMedLists;
285
286end;
287
288procedure TfrmMeds.mnuChartTabClick(Sender: TObject);
289begin
290 inherited;
291 frmFrame.mnuChartTabClick(Sender);
292end;
293
294procedure TfrmMeds.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
295var
296 AMedList: TList;
297 AStringList: TStringList;
298 NewMedRec: TMedListRec;
299 i, idx, Match: Integer;
300 j: integer;
301 AChildList: TStringlist;
302 CplxOrderID: string;
303
304 procedure SetCurrentOrderID;
305 var
306 i: Integer;
307 AMedRec: TMedListRec;
308 begin
309 with AMedList do for i := 0 to Count - 1 do
310 begin
311 AMedRec := TMedListRec(AMedList[i]);
312 if Piece(AMedRec.OrderID, ';', 1) = Piece(AnOrder.ActionOn, ';', 1) then
313 begin
314 end;
315 end;
316 end;
317
318 function IndexForCurrentID(const AnID: string): Integer;
319 var
320 i: Integer;
321 begin
322 Result := -1;
323 for i := 0 to uPendingChanges.Count - 1 do
324 if Piece(uPendingChanges[i], U, 2) = AnID then Result := i;
325 if Result < 0 then
326 for i := 0 to uPendingChanges.Count - 1 do
327 if Piece(uPendingChanges[i], '=', 1) = Piece(AnID, ';', 1) then Result := i;
328 end;
329
330begin
331 AMedList := nil;
332 if AnOrder <> nil then
333 begin
334 if uDGrp[DG_OUT] = AnOrder.DGroup then AMedList := uMedListOut;
335 for i := 1 to 6 do if uDGrp[i] = AnOrder.DGroup then AMedList := uMedListIn;
336 end;
337 case OrderAction of
338 ORDER_NEW: { sent by accept order on new order }
339 if AMedList <> nil then
340 begin
341 // check this out carefully!!
342 NewMedRec := TMedListRec.Create;
343 NewMedRec.OrderID := AnOrder.ID;
344 NewMedRec.Instruct := AnOrder.Text;
345 NewMedRec.Inpatient := AMedList = uMedListIn;
346 AMedList.Insert(0, NewMedRec);
347 if AMedList = uMedListIn then
348 begin
349 lstMedsIn.Items.Insert(0, GetPlainText(lstMedsIn,0));
350 uPharmacyOrdersIn.Insert(0, U + AnOrder.ID);
351 end
352 else
353 begin
354 if AMedList = uMedListOut then
355 begin
356 lstMedsOut.Items.Insert(0, GetPlainText(lstMedsOut,0));
357 uPharmacyOrdersOut.Insert(0, U + AnOrder.ID);
358 end
359 else
360 begin
361 if AMedList = uMedListNonVA then
362 begin
363 lstMedsNonVA.Items.Insert(0, GetPlainText(lstMedsNonVA,0));
364 uNonVAOrdersOut.Insert(0, U + AnOrder.ID);
365 end;
366 end;
367 end;
368 uPendingChanges.Add(Piece(AnOrder.ID, ';', 1) + '=NW^' + AnOrder.ID);
369 end;
370 ORDER_DC: { sent by a diet to cancel a tubefeeding - do nothing };
371 ORDER_EDIT: { sent by accept on edit order }
372 if AMedList <> nil then
373 begin
374 Match := IndexForCurrentID(AnOrder.EditOf);
375 if Match < 0
376 { add a new pending change if there is no existing change that matches EditOf }
377 then uPendingChanges.Add(Piece(AnOrder.EditOf, ';', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName)
378 { leave 1st piece (original ID) intact, while changing text & current ID }
379 else uPendingChanges[Match] := Piece(uPendingChanges[Match], '=', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName;
380 end;
381 ORDER_ACT: { sent by DC, Hold, & Renew actions }
382 if AMedList <> nil then
383 begin
384 if Piece(AnOrder.ActionOn, '=', 2) = 'CA' then
385 begin
386 // cancel action, remove from PendingChanges
387 for idx := uPendingChanges.Count-1 downto 0 do
388 begin
389 Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1));
390 if Match > -1 then uPendingChanges.Delete(Match);
391 end;
392 end
393 else if Piece(AnOrder.ActionOn, '=', 2) = 'DL' then
394 begin
395 // delete action, show as deleted (set OrderID's to 0 so not confused with next order)
396 Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1));
397 if Match > -1 then uPendingChanges[Match] := '0=DL';
398 if AMedList = uMedListIn
399 then AStringList := uPharmacyOrdersIn
400 else if AMedList = uMedListOut
401 then AStringList := uPharmacyOrdersOut
402 else AStringList := uNonVAOrdersOut;
403 with AStringList do for i := 0 to Count - 1 do
404 if (U + Piece(AnOrder.ActionOn, '=', 1)) = Strings[i] then Strings[i] := '^0';
405 Match := -1;
406 with AMedList do for i := 0 to Count - 1 do
407 if TMedListRec(Items[i]).OrderID = Piece(AnOrder.ActionOn, '=', 1) then Match := i;
408 if Match > -1 then TMedListRec(AMedList.Items[Match]).OrderID := '0';
409 end
410 else uPendingChanges.Add(Piece(AnOrder.ActionOn, ';', 1) + '=' +
411 Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID + '^^' + AnOrder.OrderLocName);
412 end; {if AMedList}
413 ORDER_CPLXRN:
414 begin
415 AChildList := TStringList.Create;
416 CplxOrderID := Piece(AnOrder.ActionOn,'=',1);
417 GetChildrenOfComplexOrder(CplxOrderID, Piece(CplxOrderID,';',2), AChildList);
418 if AMedList = uMedListIn then with AMedList do
419 begin
420 for i := Count-1 downto 0 do
421 begin
422 for j := 0 to AChildList.Count - 1 do
423 begin
424 if (TMedListRec(Items[i]).OrderID = AChildList[j]) then
425 begin
426 { Delete(i);
427 Break;}
428 if not IsFirstDoseNowOrder(TMedListRec(Items[i]).OrderID) then
429 begin
430 uPendingChanges.Add(Piece(TMedListRec(Items[i]).OrderID, ';', 1) + '=' + Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID);
431 Break;
432 end;
433 end;
434 end;
435 end;
436 end;
437 AChildList.Clear;
438 AChildList.Free;
439 end;
440 ORDER_SIGN: { sent by fReview, fOrderSign when orders signed, AnOrder=nil}
441 begin
442 // ** only if tab has been visited?
443 uPendingChanges.Clear;
444 RefreshMedLists;
445 end;
446 end; {case}
447end;
448
449procedure TfrmMeds.SetFontSize( FontSize: integer);
450begin
451 inherited SetFontSize(FontSize);
452 if Patient.DFN <> '' then
453 RefreshMedLists;
454end;
455
456{ Form events ------------------------------------------------------------------------------ }
457
458procedure TfrmMeds.FormCreate(Sender: TObject);
459var
460 medsSplitFnd : boolean;
461 panelBottom, panelMedIn : integer;
462 retList : TStringList;
463 i: integer;
464 x: string;
465begin
466 inherited;
467 PageID := CT_MEDS;
468 lstMedsIn.Color := ReadOnlyColor;
469 lstMedsOut.Color := ReadOnlyColor;
470 uMedListIn := TList.Create;
471 uMedListOut := TList.Create;
472 uMedListNonVA := TList.Create;
473 uPendingChanges := TStringList.Create;
474 uDGrp[DG_OUT] := DGroupIEN('O RX');
475 uDGrp[DG_IN] := DGroupIEN('I RX');
476 uDGrp[DG_UD] := DGroupIEN('UD RX');
477 uDGrp[DG_IV] := DGroupIEN('IV RX');
478 uDGrp[DG_TPN] := DGroupIEN('TPN');
479 uDGrp[DG_NVA] := DGroupIEN('NV RX');
480 uDGrp[DG_IMO] := DGroupIEN('C RX');
481 uPharmacyOrdersIn := TStringList.Create;
482 uPharmacyOrdersOut := TStringList.Create;
483 uNonVAOrdersOut := TStringList.Create;
484 FActionOnMedsTab := False;
485 FParentComplexOrderID := '';
486 ChildODList := TStringList.Create;
487
488
489 //DETECT 1st TIME USER.
490 //If first time user (medSplitFound=false), then manually set panel heights.
491 //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
492 medsSplitFnd := FALSE;
493 if Assigned(frmMeds) then
494 begin
495 retList := TStringList.Create;
496 tCallV(retList, 'ORWCH LOADALL', [nil]);
497
498 for i := 0 to retList.Count-1 do
499 begin
500 x := retList.strings[i];
501 if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
502 begin
503 medsSplitFnd := TRUE;
504 Break;
505 end;
506 end;
507
508 if not medsSplitFnd then
509 begin
510 pnlBottom.Height := frmMeds.Height div 2;
511 pnlMedIn.Height := pnlBottom.Height div 2;
512 panelBottom := pnlBottom.Height;
513 panelMedIn := pnlMedIn.Height;
514 end;
515 end;
516
517
518
519end;
520
521procedure TfrmMeds.FormDestroy(Sender: TObject);
522begin
523 inherited;
524 ClearMedList(uMedListIn);
525 ClearMedList(uMedListOut);
526 ClearMedList(uMedListNonVA);
527 uMedListIn.Free;
528 uMedListOut.Free;
529 uMedListNonVA.Free;
530 uPendingChanges.Free;
531 uPharmacyOrdersIn.Free;
532 uPharmacyOrdersOut.Free;
533 uNonVAOrdersOut.Free;
534 ChildODList.Free;
535end;
536
537{ View menu events ------------------------------------------------------------------------- }
538
539procedure TfrmMeds.mnuViewDetailClick(Sender: TObject);
540var
541 AnID, ATitle, AnOrder: string;
542 AListBox: TListBox;
543 i,j,idx: Integer;
544 tmpList: TStringList;
545begin
546 inherited;
547 tmpList := TStringList.Create;
548 try
549 idx := 0;
550 AListBox := ListSelected(TX_NOSEL);
551 if AListBox = nil then Exit
552 else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Details'
553 else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Details'
554 else ATitle := 'Inpatient Medication Details';
555 FIterating := True;
556 with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
557 begin
558 AnID := Piece(Strings[i], U, 1);
559 if AnID <> '' then
560 begin
561 tmpList.Assign(DetailMedLM(AnID));
562 end;
563 AnOrder := Piece(Strings[i], U, 2);
564 if AnOrder <> '' then
565 begin
566 tmpList.Add('');
567 tmpList.Add(StringOfChar('=', 74));
568 tmpList.Add('');
569 tmpList.AddStrings(MedAdminHistory(AnOrder));
570 end;
571 if CheckOrderGroup(AnOrder)=1 then // if it's UD group
572 begin
573 for j := 0 to tmpList.Count - 1 do
574 begin
575 if Pos('PICK UP',UpperCase(tmpList[j]))>0 then
576 begin
577 idx := j;
578 Break;
579 end;
580 end;
581 if idx > 0 then
582 tmpList.Delete(idx);
583 end;
584 if tmpList.Count > 0 then ReportBox(tmpList, ATitle, True);
585 if frmFrame.CCOWDrivedChange then
586 Exit;
587 end;
588 FIterating := False;
589 ResetSelectedForList(AListBox);
590 AListBox.SetFocus;
591 finally
592 tmpList.Free;
593 end;
594end;
595
596procedure TfrmMeds.mnuViewHistoryClick(Sender: TObject);
597var
598 ATitle, AnOrder: string;
599 AListBox: TListBox;
600 i: Integer;
601begin
602 inherited;
603 AListBox := ListSelected(TX_NOSEL);
604 if AListBox = nil then Exit
605 else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Administration History'
606 else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Documentation History'
607 else ATitle := 'Inpatient Medication Administration History';
608 FIterating := True;
609 with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
610 begin
611 AnOrder := Piece(Strings[i], U, 2);
612 if AnOrder <> '' then
613 ReportBox(MedAdminHistory(AnOrder), ATitle, True);
614 end;
615 FIterating := False;
616 ResetSelectedForList(AListBox);
617 AListBox.SetFocus;
618end;
619
620{ Listbox events --------------------------------------------------------------------------- }
621
622procedure TfrmMeds.RefreshMedLists;
623var
624 i: Integer;
625 AMed: TMedListRec;
626begin
627 lstMedsIn.Clear;
628 lstMedsOut.Clear;
629 lstMedsNonVA.Clear;
630 StatusText('Retrieving active medications...');
631 LoadActiveMedLists(uMedListIn, uMedListOut, uMedListNonVA);
632 uPharmacyOrdersIn.Clear;
633 uPharmacyOrdersOut.Clear;
634 uNonVAOrdersOut.Clear;
635 with uMedListIn do for i := 0 to Count - 1 do
636 begin
637 AMed := TMedListRec(Items[i]);
638 uPharmacyOrdersIn.Add(AMed.PharmID + U + AMed.OrderID);
639 lstMedsIn.Items.AddObject(GetPlainText(lstMedsIn, i), AMed);
640 end;
641
642 with uMedListNonVA do for i := 0 to Count - 1 do
643 begin
644 AMed := TMedListRec(Items[i]);
645 uNonVAOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
646 lstMedsNonVA.Items.AddObject(GetPlainText(lstMedsNonVA, i), AMed);
647 end;
648
649 with uMedListOut do for i := 0 to Count - 1 do
650 begin
651 AMed := TMedListRec(Items[i]);
652 uPharmacyOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
653 lstMedsOut.Items.AddObject(GetPlainText(lstMedsOut, i), AMed);
654 end;
655
656 StatusText('');
657end;
658
659function TfrmMeds.GetActionText(const AMed: TMedListRec): string;
660var
661 AnAction: string;
662 Abbreviation: string;
663begin
664 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
665 Abbreviation := Piece(AnAction, U, 1);
666 result := '';
667 if Length(Abbreviation) > 0 then
668 begin
669 if CharAt(Abbreviation, 1) = 'X' then result := 'Change'
670 else if Abbreviation = 'NW' then result := 'New'
671 else if Abbreviation = 'RN' then result := 'Renew'
672 else if Abbreviation = 'RF' then result := 'Refill'
673 else if Abbreviation = 'HD' then result := 'Hold'
674 else if Abbreviation = 'DL' then result := 'Deleted'
675 else if Abbreviation = 'DC' then result := 'DC'
676 else result := Abbreviation;
677 end;
678end;
679
680function TfrmMeds.GetInstructText(const AMed: TMedListRec; var Detail: string): string;
681var
682 AnAction: string;
683 Indent: integer;
684begin
685 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
686 result := AMed.Instruct;
687 // replace pharmacy text with order text if this is a change
688 if CharAt(AnAction, 1) = 'X' then result := Piece(AnAction, U, 3);
689 if AMed.IVFluid then Indent := Pos(#10 + 'in ', result) else Indent := Pos(#13, result);
690 if Indent > 0 then
691 begin
692 if AMed.IVFluid then
693 begin
694 Detail := Copy(result, Indent + 1, Length(result));
695 result := Copy(result, 1, Indent - 1);
696 end else
697 begin
698 Detail := Copy(result, Indent + 2, Length(result));
699 result := Copy(result, 1, Indent - 1);
700 end;
701 end;
702end;
703
704function TfrmMeds.GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string;
705begin
706 result := '';
707 Detail := '';
708 case Column of
709 0: result := GetActionText(AMed);
710 1: result := GetInstructText(AMed, Detail);
711 2: result := FormatFMDateTime('mm/dd/yy', AMed.StopDate);
712 3: result := AMed.Status;
713 4:
714 begin
715 if AMed.Inpatient then
716 result := MixedCase(AMed.Location)
717 else result := FormatFMDateTime('mmm dd,yy', AMed.LastFill);
718 end;
719 5: result := AMed.Refills;
720 else
721 end;
722end;
723
724function TFrmMeds.GetPlainText(Control: TWinControl; Index: integer): string;
725var
726 AMed: TMedListRec;
727 AHeader: THeaderControl;
728 i: integer;
729 x, y: string;
730begin
731 Result := '';
732 AMed := TMedListRec(GetMedList(Control)[Index]);
733 AHeader := GetHeader(Control);
734 for i := 0 to AHeader.Sections.Count-1 do
735 begin
736 x := GetListText(AMed, i, y);
737 if (x <> '') or (y <> '') then
738 Result := Result + AHeader.Sections[i].Text + ': ' + x + ' ' + y + CRLF;
739 end;
740 Result := Trim(Result);
741end;
742
743function TFrmMeds.GetHeader(Control: TWinControl): THeaderControl;
744begin
745 case Control.Tag of
746 TAG_OUTPT: result := hdrMedsOut;
747 TAG_NONVA: result := hdrMedsNonVA;
748 TAG_INPT: result := hdrMedsIn;
749
750 else result := nil;
751 end;
752end;
753
754function TFrmMeds.GetMedList(Control: TWinControl): TList;
755begin
756 case Control.Tag of
757 TAG_OUTPT: result := uMedListOut;
758 TAG_NONVA: result := uMedListNonVA;
759 TAG_INPT: result := uMedListIn;
760 else result := nil;
761 end;
762end;
763
764function TFrmMeds.GetPharmacyOrders(Control: TWinControl): TStringList;
765begin
766 case Control.Tag of
767 TAG_OUTPT: result := uPharmacyOrdersOut;
768 TAG_NONVA: result := uNonVAOrdersOut;
769 TAG_INPT: result := uPharmacyOrdersIn;
770 else
771 result := nil;
772 end;
773end;
774
775procedure TfrmMeds.lstMedsMeasureItem(Control: TWinControl; Index: Integer;
776 var AHeight: Integer);
777var
778 NewHeight, RecRight: Integer;
779 AMed: TMedListRec;
780 AHeader: THeaderControl;
781 AMedList: TList;
782 ARect: TRect;
783 x, y, AnAction: string;
784begin
785 inherited;
786 NewHeight := AHeight;
787 AHeader := GetHeader(Control);
788 AMedList := GetMedList(Control);
789 with Control as TListBox do if Index < Items.Count then
790 begin
791 AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
792 if AMed <> nil then
793 begin
794 ARect := ItemRect(Index);
795 ARect.Left := AHeader.Sections[0].Width + 2;
796 ARect.Right := ARect.Left + AHeader.Sections[1].Width - 6;
797 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
798 if Length(AnAction) > 0 then Canvas.Font.Style := [fsBold];
799 x := GetInstructText( AMed, y);
800 RecRight := ARect.Right;
801 NewHeight := WrappedTextHeightByFont( Canvas, Font, x, ARect);
802 if(length(y)>0) then
803 begin
804 ARect.Left := AHeader.Sections[0].Width + FMT_INDENT;
805 ARect.Right := RecRight; // Draw Text alters ARect.
806 inc(NewHeight, WrappedTextHeightByFont( Canvas, Font, y, ARect));
807 end;
808 if NewHeight > 255 then NewHeight := 255; // windows appears to only look at 8 bits *KCM*
809 if NewHeight < 13 then NewHeight := 13; // show at least one line *KCM*
810 end; {if AMed}
811 end; {if Index}
812 AHeight := NewHeight;
813end;
814
815procedure TfrmMeds.lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
816 State: TOwnerDrawState);
817var
818 ReturnHt: Integer;
819 x, y, AnAction: string;
820 AMed: TMedListRec;
821 AMedList: TList;
822 AHeader: THeaderControl;
823 ARect: TRect;
824 i: integer;
825 RectLeft: integer;
826begin
827 inherited;
828 AHeader := GetHeader(Control);
829 AMedList := GetMedList(Control);
830 ListGridDrawLines(TListBox(Control), AHeader, Index, State);
831 with Control as TListBox do if Index < Items.Count then
832 begin
833 AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
834 if AMed <> nil then
835 begin
836 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
837 if Length(AnAction) > 0 then
838 begin
839 Canvas.Font.Style := [fsBold];
840 if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
841 Canvas.Font.Color := clBlue;
842 if (Length(Piece(AnAction,'^',4)) > 0) then
843 AMed.Location := Piece(AnAction,'^',4);
844 end;
845 RectLeft := 0;
846 for i := 0 to AHeader.Sections.Count -1 do
847 begin
848 x := GetListText(AMed, i, y);
849 if Length(y) > 0 then
850 begin
851 ARect := ItemRect(Index);
852 ARect.Left := RectLeft + 2;
853 ARect.Right := ARect.Left + AHeader.Sections[i].Width - 6;
854 ReturnHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX
855 or DT_WORDBREAK);
856 ARect.Left := RectLeft + FMT_INDENT;
857 ARect.Top := ARect.Top + ReturnHt;
858 DrawText(Canvas.Handle, PChar(y), Length(y), ARect, DT_LEFT or DT_NOPREFIX
859 or DT_WORDBREAK);
860 end
861 else
862 ListGridDrawCell(TListBox(Control), AHeader, Index, i, x, i = 1);
863 Inc(RectLeft, AHeader.Sections[i].Width);
864 end;
865 end; {if AMed}
866 end; {if Index}
867end;
868
869procedure TfrmMeds.lstMedsExit(Sender: TObject);
870begin
871 inherited;
872 if not FIterating then ResetSelectedForList(TListBox(Sender));
873end;
874
875procedure TfrmMeds.lstMedsDblClick(Sender: TObject);
876begin
877 inherited;
878 mnuViewDetailClick(Self);
879end;
880
881procedure TfrmMeds.lstMedsInClick(Sender: TObject);
882var
883 i: integer;
884begin
885 inherited;
886 with lstMedsOut do for i := 0 to Items.Count -1 do
887 Selected[i] := false;
888 with lstMedsNonVA do for i := 0 to Items.Count - 1 do
889 Selected[i] := FALSE;
890end;
891
892procedure TfrmMeds.lstMedsOutClick(Sender: TObject);
893var
894 i: integer;
895begin
896 inherited;
897 with lstMedsIn do for i := 0 to Items.Count -1 do
898 Selected[i] := false;
899 with lstMedsNonVA do for i := 0 to Items.Count -1 do
900 Selected[i] := false;
901end;
902
903procedure TfrmMeds.hdrMedsOutSectionResize(HeaderControl: THeaderControl;
904 Section: THeaderSection);
905begin
906 inherited;
907 RedrawSuspend(Self.Handle);
908 with lstMedsOut do
909 begin
910 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
911 IntegralHeight := not IntegralHeight; // listbox window to be recreated
912 end;
913 RedrawActivate(Self.Handle);
914 lstMedsOut.Invalidate;
915 Refresh;
916end;
917
918procedure TfrmMeds.hdrMedsInSectionResize(HeaderControl: THeaderControl;
919 Section: THeaderSection);
920begin
921 inherited;
922 RedrawSuspend(Self.Handle);
923 with lstMedsIn do
924 begin
925 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
926 IntegralHeight := not IntegralHeight; // listbox window to be recreated
927 end;
928 RedrawActivate(Self.Handle);
929 lstMedsIn.Invalidate;
930 Refresh;
931end;
932
933{ Action menu events ---------------------------------------------------------------------- }
934
935procedure TfrmMeds.mnuActClick(Sender: TObject);
936begin
937 inherited;
938 //frmFrame.UpdatePtInfoOnRefresh;
939 if lstMedsOut.SelCount > 0 then
940 begin
941 mnuActTransfer.Caption := 'Transfer to Inpatient...';
942 mnuActTransfer.Enabled := True;
943 end
944 else if lstMedsIn.SelCount > 0 then
945 begin
946 mnuActTransfer.Caption := 'Transfer to Outpatient...';
947 mnuActTransfer.Enabled := True;
948 end
949 else
950 begin
951 mnuActTransfer.Caption := 'Transfer to...';
952 mnuActTransfer.Enabled := False;
953 end;
954end;
955
956procedure TfrmMeds.mnuActDCClick(Sender: TObject);
957{ discontinue/cancel/delete the selected med orders as appropriate for each order }
958{ similar to action on fOrders}
959var
960 ActiveList: TListBox;
961 SelectedList: TList;
962 DelEvt: boolean;
963begin
964 inherited;
965 DelEvt := False;
966 ActiveList := ListSelected(TX_NOSEL);
967 if ActiveList = nil then Exit;
968 SelectedList := TList.Create;
969 try
970 FIterating := True;
971 if AuthorizedUser and EncounterPresent and LockedForOrdering then
972 begin
973 ValidateSelected(ActiveList, OA_DC, TX_NO_DC, TC_NO_DC);
974 MakeSelectedList(ActiveList, SelectedList);
975 if ExecuteDCOrders(SelectedList,DelEvt) then
976 begin
977 ResetSelectedForList(ActiveList);
978 SynchListToOrders(ActiveList, SelectedList);
979 end;
980 if DelEvt then
981 frmFrame.mnuFileRefreshClick(Self);
982 end;
983 finally
984 FIterating := False;
985 SelectedList.Free;
986 UnlockIfAble;
987 end;
988end;
989
990procedure TfrmMeds.mnuActHoldClick(Sender: TObject);
991{ hold the selected med orders as appropriate for each order }
992{ similar to action on fOrders}
993var
994 ActiveList: TListBox;
995 SelectedList: TList;
996begin
997 inherited;
998 ActiveList := ListSelected(TX_NOSEL);
999 if ActiveList = nil then Exit;
1000 SelectedList := TList.Create;
1001 try
1002 FIterating := True;
1003 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1004 begin
1005 ValidateSelected(ActiveList, OA_HOLD, TX_NO_HOLD, TC_NO_HOLD);
1006 MakeSelectedList(ActiveList, SelectedList);
1007 if ExecuteHoldOrders(SelectedList) then
1008 begin
1009 AddSelectedToChanges(SelectedList);
1010 ResetSelectedForList(ActiveList);
1011 SynchListToOrders(ActiveList, SelectedList);
1012 end;
1013 end;
1014 finally
1015 ActiveList.SetFocus;
1016 FIterating := False;
1017 SelectedList.Free;
1018 UnlockIfAble;
1019 end;
1020end;
1021
1022procedure TfrmMeds.mnuActRenewClick(Sender: TObject);
1023{ renew the selected med orders as appropriate for each order }
1024{ similar to action on fOrders}
1025var
1026 ActiveList: TListBox;
1027 SelectedList: TList;
1028 ParntOrder : TOrder;
1029begin
1030 inherited;
1031 ActiveList := ListSelected(TX_NOSEL);
1032 if ActiveList = nil then Exit;
1033 SelectedList := TList.Create;
1034 try
1035 FIterating := True;
1036 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1037 begin
1038 ValidateSelected(ActiveList, OA_RENEW, TX_NO_RENEW, TC_NO_RENEW);
1039 MakeSelectedList(ActiveList, SelectedList);
1040 if Length(FParentComplexOrderID)>0 then
1041 begin
1042 ParntOrder := GetOrderByIFN(FParentComplexOrderID);
1043 if CharAt(ParntOrder.Text,1)='+' then
1044 ParntOrder.Text := Copy(ParntOrder.Text,2,Length(ParntOrder.Text));
1045 if Pos('First Dose NOW',ParntOrder.Text)>1 then
1046 Delete(ParntOrder.text, Pos('First Dose NOW',ParntOrder.Text), Length('First Dose NOW'));
1047 SelectedList.Add(ParntOrder);
1048 FParentComplexOrderID := '';
1049 end;
1050 if ExecuteRenewOrders(SelectedList) then
1051 begin
1052 AddSelectedToChanges(SelectedList);
1053 ResetSelectedForList(ActiveList);
1054 SynchListToOrders(ActiveList, SelectedList);
1055 end;
1056 end;
1057 finally
1058 ActiveList.SetFocus;
1059 FIterating := False;
1060 SelectedList.Free;
1061 UnlockIfAble;
1062 end;
1063end;
1064
1065procedure TfrmMeds.mnuActChangeClick(Sender: TObject);
1066{ loop thru selected med orders, present ordering dialog for each with defaults to selected order }
1067{ similar to action on fOrders}
1068var
1069 i: Integer;
1070 ActiveList: TListBox;
1071 SelectedList: TList;
1072 ChangeIFNList: TStringList;
1073 DelayEvent: TOrderDelayEvent;
1074begin
1075 inherited;
1076 if not EncounterPresentEDO then Exit;
1077 ActiveList := ListSelected(TX_NOSEL);
1078 if ActiveList = nil then Exit;
1079 DelayEvent.EventType := 'C'; // temporary, so can pass to ChangeOrders
1080 DelayEvent.Specialty := 0;
1081 DelayEvent.Effective := 0;
1082 DelayEvent.EventIFN := 0;
1083 SelectedList := TList.Create; // temporary until able to create ChangeIFNList directly
1084 ChangeIFNList := TStringList.Create;
1085 try
1086 MakeSelectedList(Activelist, SelectedList);
1087 with SelectedList do for i := 0 to Count - 1 do ChangeIFNList.Add(TOrder(Items[i]).ID);
1088 if not ShowMsgOn(ChangeIFNList.Count = 0, TX_NOSEL, TC_NOSEL)
1089 then ChangeOrders(ChangeIFNList, DelayEvent);
1090 SynchListToOrders(ActiveList, SelectedList); // rehighlights
1091 Activelist.SetFocus;
1092 finally
1093 SelectedList.Free;
1094 ChangeIFNList.Free;
1095 end;
1096end;
1097
1098procedure TfrmMeds.mnuActCopyClick(Sender: TObject);
1099{ loop thru selected med orders, present ordering dialog for each with defaults to selected order }
1100{ similar to action on fOrders}
1101const
1102 CP_TXT = 'copied';
1103 XF_TXT = 'transfered';
1104var
1105 i: Integer;
1106 LimitEvent: Char;
1107 ActiveList: TListBox;
1108 SelectedList: TList;
1109 CopyIFNList: TStringList;
1110 TempEvent,DelayEvent: TOrderDelayEvent;
1111 ActName, radTxt,thePtEvtID, AuthErr: string;
1112 IsNewEvent,needVerify,NewOrderCreated,DoesDestEvtOccur: boolean;
1113
1114begin
1115 inherited;
1116 AuthErr := '';
1117 ActName := '';
1118 if not EncounterPresentEDO then Exit;
1119 CheckAuthForMeds(AuthErr);
1120 if (Length(AuthErr)>0) then
1121 begin
1122 ShowMessage(AuthErr);
1123 if not EncounterPresent then Exit;
1124 end;
1125 if not FActionOnMedsTab then
1126 FActionOnMedsTab := True;
1127 DelayEvent.EventType := #0;
1128 DelayEvent.EventIFN := 0;
1129 DelayEvent.EventName := '';
1130 DelayEvent.Specialty := 0;
1131 DelayEvent.Effective := 0;
1132 DelayEvent.PtEventIFN := 0;
1133 DelayEvent.TheParent := TParentEvent.Create;
1134 DelayEvent.IsNewEvent := False;
1135 TempEvent := DelayEvent;
1136 DoesDestEvtOccur := False;
1137 ActiveList := ListSelected(TX_NOSEL);
1138 if ActiveList = nil then Exit;
1139 NewOrderCreated := False;
1140 if frmOrders.lstSheets.ItemIndex >= 0 then
1141 begin
1142 frmOrders.lstSheets.ItemIndex := 0;
1143 frmOrders.lstSheetsClick(Application);
1144 end;
1145 LimitEvent := #0;
1146 if TComponent(Sender).Name = 'mnuActTransfer' then
1147 begin
1148 ActName := 'Transfer';
1149 IsTransferAction := True;
1150 radTxt := XF_TXT;
1151 if ActiveList = lstMedsOut then
1152 begin
1153 if Patient.Inpatient then LimitEvent := 'C' else LimitEvent := 'A';
1154 XferOutToInOnMeds := True;
1155 end;
1156 if ActiveList = lstMedsIn then
1157 begin
1158 if Patient.Inpatient then LimitEvent := 'D' else
1159 begin
1160 LimitEvent := 'C';
1161 XfInToOutNow := True;
1162 end;
1163 XferOutToInOnMeds := False;
1164 end;
1165 end else
1166 radTxt := CP_TXT;
1167 SelectedList := TList.Create; // temporary until able to create CopyIFNList directly
1168 CopyIFNList := TStringList.Create;
1169 try
1170 MakeSelectedList(Activelist, SelectedList, ActName);
1171 {if (CopyIFNList.Count = 0) and (ActName = 'Transfer') then
1172 Exit;}
1173 with SelectedList do for i := 0 to Count - 1 do CopyIFNList.Add(TOrder(Items[i]).ID);
1174 if not ShowMsgOn(CopyIFNList.Count = 0, TX_NOSEL, TC_NOSEL) then
1175 begin
1176 IsNewEvent := False;
1177 if SetDelayEventForMed(radTxt, DelayEvent, IsNewEvent, LimitEvent) then
1178 begin
1179 if (ActiveList = lstMedsOut) and (DelayEvent.EventIFN > 0) then
1180 XferOutToInOnMeds := True;
1181 TempEvent.PtEventIFN := DelayEvent.PtEventIFN;
1182 TempEvent.EventName := DelayEvent.EventName;
1183 if (DelayEvent.PtEventIFN>0) and IsCompletedPtEvt(DelayEvent.PtEventIFN) then
1184 begin
1185 DelayEvent.EventType := 'C';
1186 DelayEvent.PtEventIFN := 0;
1187 DelayEvent.EventName := '';
1188 DelayEvent.EventIFN := 0;
1189 DelayEvent.TheParent := TParentEvent.Create;
1190 DoesDestEvtOccur := True;
1191 needVerify := false;
1192 CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify);
1193 if XferOutToInOnMeds then
1194 XferOutToInOnMeds := False;
1195 if frmOrders <> nil then
1196 frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName);
1197 Exit;
1198 end;
1199 if (DelayEvent.EventIFN>0) and (DelayEvent.EventType <> 'D') then
1200 begin
1201 needVerify := False;
1202 uAutoAC := True;
1203 end else
1204 begin
1205 needVerify := True;
1206 uAutoAC := False;
1207 end;
1208 if LimitEvent = #0 then
1209 begin
1210 if CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
1211 NewOrderCreated := True;
1212 if ImmdCopyAct then
1213 ImmdCopyAct := False;
1214 end else
1215 begin
1216 if TransferOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
1217 NewOrderCreated := True;
1218 end;
1219 if XferOutToInOnMeds then
1220 XferOutToInOnMeds := False;
1221 if (DelayEvent.EventIFN > 0) and ( isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) ) then
1222 frmOrders.HighlightFromMedsTab := StrToIntDef(ThePtEvtID,0);
1223 if (not NewOrderCreated) and (DelayEvent.EventIFN>0) then
1224 if isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) then
1225 begin
1226 if PtEvtEmpty(ThePtEvtID) then
1227 begin
1228 DeletePtEvent(ThePtEvtID);
1229 frmOrders.ChangesUpdate(ThePtEvtID);
1230 frmOrders.EventDefaultOrder := '';
1231 frmOrders.InitOrderSheetsForEvtDelay;
1232 if frmOrders.lstSheets.ItemIndex <> 0 then
1233 frmOrders.lstSheets.ItemIndex := 0;
1234 frmOrders.lstSheetsClick(Self);
1235 end;
1236 end;
1237 end;
1238 end;
1239 SynchListToOrders(ActiveList, SelectedList); // rehighlights
1240 if IsTransferAction then
1241 IsTransferAction := False;
1242 if XferOuttoInOnMeds then
1243 XferOuttoInOnMeds := False;
1244 if XfInToOutNow then
1245 XfInToOutNow := False;
1246 frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName,True);
1247 finally
1248 ActiveList.SetFocus;
1249 FActionOnMedsTab := False;
1250 uAutoAC := False;
1251 SelectedList.Free;
1252 CopyIFNList.Free;
1253 end;
1254end;
1255
1256procedure TfrmMeds.mnuActNewClick(Sender: TObject);
1257{ new med orders dependent on order dialog for inpatient or outpatient }
1258{ similar to lstWriteClick on fOrders}
1259var
1260 DialogInfo: string;
1261 DelayEvent: TOrderDelayEvent;
1262begin
1263 inherited;
1264 DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders
1265 DelayEvent.Specialty := 0;
1266 DelayEvent.EventIFN := 0;
1267 DelayEvent.Effective := 0;
1268 frmOrders.DontCheck := True;
1269 frmOrders.lstSheets.ItemIndex := 0;
1270 frmOrders.lstSheetsClick(self);
1271 frmOrders.DontCheck := False;
1272 if not ReadyForNewOrder(DelayEvent) then Exit;
1273 frmOrders.DontCheck := True;
1274 frmOrders.lstSheets.ItemIndex := 0;
1275 frmOrders.lstSheetsClick(self);
1276 frmOrders.DontCheck := False;
1277 { get appropriate form, create the dialog form and show it }
1278 DialogInfo := GetNewDialog; // DialogInfo = DlgIEN;FormID;DGroup
1279 case CharAt(Piece(DialogInfo, ';', 4), 1) of
1280 'A': ActivateAction( Piece(DialogInfo, ';', 1), Self, 0);
1281 'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1282 'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1283 'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1284 else InfoBox('Unsupported dialog type', 'Error', MB_OK);
1285 end; {case}
1286end;
1287
1288procedure TfrmMeds.mnuActRefillClick(Sender: TObject);
1289{ for selected orders, present refill dialog }
1290var
1291 ActiveList: TListBox;
1292 SelectedList: TList;
1293begin
1294 inherited;
1295 ActiveList := ListSelected(TX_NOSEL);
1296 if ActiveList = nil then Exit;
1297 SelectedList := TList.Create;
1298 try
1299 FIterating := True;
1300 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1301 begin
1302 ValidateSelected(ActiveList, OA_REFILL, TX_NO_REFILL, TC_NO_REFILL);
1303 MakeSelectedList(ActiveList, SelectedList);
1304 if ExecuteRefillOrders(SelectedList) then
1305 begin
1306 ResetSelectedForList(ActiveList);
1307 SynchListToOrders(ActiveList, SelectedList);
1308 end;
1309 end;
1310 finally
1311 ActiveList.SetFocus;
1312 FIterating := False;
1313 SelectedList.Free;
1314 UnlockIfAble;
1315 end;
1316end;
1317
1318{ Action utilities --------------------------------------------------------------------------- }
1319
1320function TfrmMeds.ListSelected(const ErrMsg: string): TListBox;
1321{ return selected listbox - inpatient or outpatient }
1322begin
1323 Result := nil;
1324 if lstMedsOut.SelCount > 0 then Result := lstMedsOut
1325 else if lstMedsIn.SelCount > 0 then Result := lstMedsIn
1326 else if lstMedsNonVA.SelCount > 0 then Result := lstMedsNonVA;
1327 if Result = nil then InfoBox(ErrMsg, TC_NOSEL, MB_OK);
1328end;
1329
1330procedure TfrmMeds.ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string);
1331{ loop to validate action on each selected med order, deselect if not valid }
1332var
1333 i: Integer;
1334 OrderText, CurID: string;
1335 ErrMsg, AParentID: string;
1336 CheckedList,SomePharmacyOrders: TStringList;
1337 ChildOrder: TChildOD;
1338begin
1339 CheckedList := TStringList.Create;
1340 SomePharmacyOrders := GetPharmacyOrders(AListBox);
1341 with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then
1342 begin
1343 if (AnAction = 'RN') and (pos('Active',AListBox.Items[i])>0) and (AListBox.name = 'lstMedsIn') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then
1344 begin
1345 Selected[i] := False;
1346 MessageDlg('You can not renew inpatient medication order on a clinic location for selected inpatient.', mtWarning, [mbOK], 0);
1347 end;
1348 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
1349 if Length(CurID) > 0
1350 then CurID := Piece(CurID, U, 2)
1351 else CurID := Piece(SomePharmacyOrders[i], U, 2);
1352 ValidateOrderAction(CurID, AnAction, ErrMsg);
1353 if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(CurID) then
1354 begin
1355 InfoBox(AListBox.Items[i] + #13+ WarningMsg + ErrMsg, WarningTitle, MB_OK);
1356 Selected[i] := False;
1357 Continue;
1358 end;
1359 AParentID := '';
1360 if not IsValidActionOnComplexOrder(CurID, AnAction, AListBox, CheckedList,ErrMsg,AParentID) then
1361 Selected[i] := False;
1362 if Length(AParentID)>0 then
1363 begin
1364 if ChildODList.IndexOf(CurID)< 0 then
1365 begin
1366 ChildOrder := TChildOD.Create;
1367 ChildOrder.ChildID := CurId;
1368 ChildOrder.ParentID := AParentID;
1369 ChildODList.AddObject(CurID, ChildOrder);
1370 end;
1371 end;
1372 if Length(ErrMsg) > 0 then
1373 begin
1374 OrderText := TextForOrder(Piece(SomePharmacyOrders[i], U, 2));
1375 InfoBox(OrderText + WarningMsg + ErrMsg, WarningTitle, MB_OK);
1376 Selected[i] := False;
1377 end;
1378 if Selected[i] and (not OrderIsLocked(CurID, AnAction)) then Selected[i] := False;
1379 end;
1380end;
1381
1382procedure TfrmMeds.MakeSelectedList(AListBox: TListBox; AList: TList; ActName: string);
1383{ make a list of selected med orders }
1384var
1385 i,idx: Integer;
1386 AnOrder: TOrder;
1387 CurID,x: string;
1388 SomePharmacyOrders: TStringList;
1389 TempList: TStringList;
1390begin
1391 SomePharmacyOrders := GetPharmacyOrders(AListBox);
1392 TempList := TStringList.Create;
1393 AList.Clear;
1394 with AListBox do for i := 0 to Items.Count - 1 do
1395 if Selected[i] then
1396 begin
1397 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
1398 if Length(CurID) > 0
1399 then CurID := Piece(CurID, U, 2)
1400 else CurID := Piece(SomePharmacyOrders[i], U, 2);
1401 AnOrder := GetOrderByIFN(CurID);
1402 if ActName = 'Transfer' then //imo
1403 begin
1404 if (AnOrder.DGroup = ClinDisp) then //imo
1405 begin
1406 x := AnOrder.Text + #13#10 + 'Clinic medication orders can not be transfered';
1407 if ShowMsgOn(Length(x) > 0, x, 'Unable to transfer.') then
1408 begin
1409 AListBox.Selected[i] := False;
1410 Continue;
1411 end
1412 end;
1413 end;
1414 idx := -1;
1415 idx := ChildODList.IndexOf(AnOrder.ID);
1416 if idx > - 1 then
1417 AnOrder.ParentID := TChildOD(ChildODList.Objects[idx]).ParentID;
1418 if TempList.IndexOf(AnOrder.ID)= -1 then
1419 begin
1420 AList.Add(AnOrder);
1421 TempList.Add(AnOrder.ID);
1422 end;
1423 end;
1424 TempList.Clear;
1425end;
1426
1427procedure TfrmMeds.SynchListToOrders(AListBox: TListBox; AList: TList);
1428{ shows selected med orders as selected }
1429//var
1430// i, j: Integer;
1431// AMedListRec: TMedListRec;
1432// AnOrder: TOrder;
1433begin
1434// with AListBox do for i := 0 to Items.Count - 1 do
1435// begin
1436// AMedListRec := TMedListRec(AListBox.Items.Objects[i]);
1437// with AList do for j := 0 to Count - 1 do
1438// begin
1439// AnOrder := TOrder(AList.Items[j]);
1440// if Piece(AMedListRec.OrderID, ';', 1) = Piece(AnOrder.ID, ';', 1) then
1441// begin
1442// //AMedListRec.Instruct := AMedListRec.Instruct + ' * EDITED *';
1443// //AMedListRec.Action := MED_NEW; //*KCM*
1444// //AListBox.Selected[i] := True; // resets valid selections to indicate changes //*KCM*
1445// end;
1446// end;
1447// end;
1448 AListBox.Invalidate;
1449end;
1450
1451procedure TfrmMeds.pnlMedOut1Resize(Sender: TObject);
1452begin
1453 inherited;
1454 //if pnlMedOut.Height < 20 then pnlMedOut.Height := 20;
1455end;
1456
1457
1458procedure TfrmMeds.popMedPopup(Sender: TObject);
1459begin
1460 inherited;
1461 //frmFrame.UpdatePtInfoOnRefresh;
1462end;
1463
1464procedure TfrmMeds.mnuViewClick(Sender: TObject);
1465begin
1466 inherited;
1467 //frmFrame.UpdatePtInfoOnRefresh;
1468end;
1469
1470procedure TfrmMeds.lstMedsNonVAClick(Sender: TObject);
1471var
1472 i: integer;
1473begin
1474 inherited;
1475 with lstMedsIn do for i := 0 to Items.Count -1 do
1476 Selected[i] := false;
1477 with lstMedsOut do for i := 0 to Items.Count -1 do
1478 Selected[i] := false;
1479end;
1480
1481procedure TfrmMeds.lstMedsNonVADblClick(Sender: TObject);
1482begin
1483 inherited;
1484 mnuViewDetailClick(Self);
1485end;
1486
1487procedure TfrmMeds.lstMedsNonVAExit(Sender: TObject);
1488begin
1489 inherited;
1490 if not FIterating then ResetSelectedForList(TListBox(Sender));
1491end;
1492
1493procedure TfrmMeds.hdrMedsNonVASectionResize(HeaderControl: THeaderControl;
1494 Section: THeaderSection);
1495begin
1496 inherited;
1497 RedrawSuspend(Self.Handle);
1498 with lstMedsNonVA do
1499 begin
1500 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1501 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1502 end;
1503 RedrawActivate(Self.Handle);
1504 lstMedsNonVA.Invalidate;
1505 Refresh;
1506end;
1507
1508function TfrmMeds.PctOfTotalHeight(thisPanel: TPanel) : integer;
1509var
1510 pctOfTotal: real;
1511begin
1512 pctOfTotal := ((thisPanel.Height / totalHeight) * 100);
1513 Result := Round(pctOfTotal);
1514end;
1515
1516procedure TfrmMeds.FormResize(Sender: TObject);
1517begin
1518 inherited;
1519 if Assigned(frmMeds) then
1520 begin
1521 //Adjust splitter positions to always be in view, regardless of window size
1522 if (pnlBottom.Height > frmMeds.Height-50) then pnlBottom.Height := frmMeds.Height-50;
1523 if (pnlMedIn.Height > pnlBottom.Height-50) then pnlMedIn.Height := pnlBottom.Height-50;
1524 end;
1525end;
1526
1527{ TChildOD }
1528
1529constructor TChildOD.Create;
1530begin
1531 ChildID := '';
1532 ParentID := '';
1533end;
1534
1535procedure TfrmMeds.hdrMedsOutResize(Sender: TObject);
1536begin
1537 inherited;
1538 with hdrMedsOut do
1539 begin
1540 if Height < 16 then Height := 16;
1541 if Height > 16 then Height := 16;
1542 Invalidate;
1543 end;
1544end;
1545
1546procedure TfrmMeds.hdrMedsNonVAResize(Sender: TObject);
1547begin
1548 inherited;
1549 with hdrMedsNonVA do
1550 begin
1551 if Height < 16 then Height := 16;
1552 if Height > 16 then Height := 16;
1553 Invalidate;
1554 end;
1555end;
1556
1557procedure TfrmMeds.hdrMedsInResize(Sender: TObject);
1558begin
1559 inherited;
1560 with hdrMedsIn do
1561 begin
1562 if Height < 16 then Height := 16;
1563 if Height > 16 then Height := 16;
1564 Invalidate;
1565 end;
1566end;
1567
1568procedure TfrmMeds.FormShow(Sender: TObject);
1569begin
1570 inherited;
1571 frmMeds.FormResize(Sender);
1572end;
1573
1574procedure TfrmMeds.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1575begin
1576 inherited;
1577 frmMeds.FormResize(Sender);
1578end;
1579
1580procedure TfrmMeds.splitBottomMoved(Sender: TObject);
1581begin
1582 inherited;
1583 if splitBottom.Height > 5 then splitBottom.Height := 5;
1584end;
1585
1586procedure TfrmMeds.splitTopMoved(Sender: TObject);
1587begin
1588 inherited;
1589 if splitTop.Height > 5 then splitTop.Height := 5;
1590end;
1591
1592procedure TfrmMeds.InitfMedsSize;
1593var
1594 retList : TStringList;
1595 strSizeFlds,x: string;
1596 i: integer;
1597 medsSplitFnd : boolean;
1598 panelBottom, panelMedIn : integer;
1599begin
1600 //CQ3229
1601 //DETECT 1st TIME USER.
1602 //If first time user (medSplitFound=false), then manually set panel heights.
1603 //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
1604 medsSplitFnd := FALSE;
1605 if Assigned(frmMeds) then
1606 begin
1607 retList := TStringList.Create;
1608 tCallV(retList, 'ORWCH LOADALL', [nil]);
1609
1610 for i := 0 to retList.Count-1 do
1611 begin
1612 x := retList.strings[i];
1613 if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
1614 begin
1615 medsSplitFnd := TRUE;
1616 Break;
1617 end;
1618 end;
1619
1620 if not medsSplitFnd then
1621 begin
1622 pnlBottom.Height := frmMeds.Height div 2;
1623 pnlMedIn.Height := pnlBottom.Height div 2;
1624 panelBottom := pnlBottom.Height;
1625 panelMedIn := pnlMedIn.Height;
1626 strSizeFlds := IntToStr(panelBottom) + ',' + IntToStr(panelMedIn) + ',' + '0' + ',' + '0';
1627 CallV('ORWCH SAVESIZ', [MEDS_SPLIT_FORM, strSizeFlds]);
1628 end;
1629 end;
1630
1631end;
1632
1633end.
1634
Note: See TracBrowser for help on using the repository browser.