source: cprs/trunk/CPRS-Chart/fMeds.pas@ 1800

Last change on this file since 1800 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28
File size: 71.6 KB
RevLine 
[1679]1 unit fMeds;
[456]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,
[830]10 rMeds, ORNet, fBase508Form, VA508AccessibilityManager;
[456]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 mnuViewInformation: TMenuItem;
75 mnuViewDemo: TMenuItem;
76 mnuViewVisits: TMenuItem;
77 mnuViewPrimaryCare: TMenuItem;
78 mnuViewMyHealtheVet: TMenuItem;
79 mnuInsurance: TMenuItem;
80 mnuViewFlags: TMenuItem;
81 mnuViewReminders: TMenuItem;
82 mnuViewRemoteData: TMenuItem;
83 mnuViewPostings: TMenuItem;
84 mnuOptimizeFields: TMenuItem;
[830]85 SortbyStatusthenLocation1: TMenuItem;
86 SortbyClinicOrderthenStatusthenStopDate1: TMenuItem;
87 SortbyDrugalphabeticallystatusactivestatusrecentexpired1: TMenuItem;
88 N3: TMenuItem;
89 pnlView: TPanel;
90 txtView: TVA508StaticText;
[1679]91 mnuActUnhold: TMenuItem;
[456]92 procedure mnuChartTabClick(Sender: TObject);
93 procedure FormCreate(Sender: TObject);
94 procedure FormDestroy(Sender: TObject);
95 procedure lstMedsMeasureItem(Control: TWinControl; Index: Integer;
96 var AHeight: Integer);
97 procedure lstMedsDrawItem(Control: TWinControl; Index: Integer;
98 Rect: TRect; State: TOwnerDrawState);
99 procedure mnuViewDetailClick(Sender: TObject);
100 procedure lstMedsExit(Sender: TObject);
101 procedure lstMedsDblClick(Sender: TObject);
102 procedure lstMedsInClick(Sender: TObject);
103 procedure lstMedsOutClick(Sender: TObject);
104 procedure hdrMedsOutSectionResize(HeaderControl: THeaderControl;
105 Section: THeaderSection);
106 procedure hdrMedsInSectionResize(HeaderControl: THeaderControl;
107 Section: THeaderSection);
108 procedure mnuActDCClick(Sender: TObject);
109 procedure mnuActHoldClick(Sender: TObject);
110 procedure mnuActRenewClick(Sender: TObject);
111 procedure mnuActChangeClick(Sender: TObject);
112 procedure mnuActCopyClick(Sender: TObject);
113 procedure mnuActNewClick(Sender: TObject);
114 procedure mnuActRefillClick(Sender: TObject);
115 procedure mnuActClick(Sender: TObject);
116 procedure mnuViewHistoryClick(Sender: TObject);
117 procedure popMedPopup(Sender: TObject);
118 procedure mnuViewClick(Sender: TObject);
119 procedure lstMedsNonVAClick(Sender: TObject);
120 procedure lstMedsNonVADblClick(Sender: TObject);
121 procedure lstMedsNonVAExit(Sender: TObject);
122 procedure hdrMedsNonVASectionResize(HeaderControl: THeaderControl;
123 Section: THeaderSection);
124 procedure FormResize(Sender: TObject);
125 procedure hdrMedsOutResize(Sender: TObject);
126 procedure hdrMedsNonVAResize(Sender: TObject);
127 procedure hdrMedsInResize(Sender: TObject);
128 procedure FormShow(Sender: TObject);
129 procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
130 Shift: TShiftState; X, Y: Integer);
131 procedure splitBottomMoved(Sender: TObject);
132 procedure splitTopMoved(Sender: TObject);
133 procedure hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton;
134 Shift: TShiftState; X, Y: Integer);
135 procedure hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton;
136 Shift: TShiftState; X, Y: Integer);
137 procedure hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton;
138 Shift: TShiftState; X, Y: Integer);
139 procedure hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton;
140 Shift: TShiftState; X, Y: Integer);
141 procedure hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton;
142 Shift: TShiftState; X, Y: Integer);
143 procedure hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton;
144 Shift: TShiftState; X, Y: Integer);
[830]145 procedure ActivateDeactiveRenew(AListBox: TListBox);
[456]146 procedure ViewInfo(Sender: TObject);
147 procedure mnuViewInformationClick(Sender: TObject);
148 procedure mnuOptimizeFieldsClick(Sender: TObject);
149 procedure hdrMedsOutSectionClick(HeaderControl: THeaderControl;
150 Section: THeaderSection);
151 procedure hdrMedsNonVASectionClick(HeaderControl: THeaderControl;
152 Section: THeaderSection);
153 procedure hdrMedsInSectionClick(HeaderControl: THeaderControl;
154 Section: THeaderSection);
[830]155 procedure SortbyStatusthenLocation1Click(Sender: TObject);
156 procedure SortbyClinicOrderthenStatusthenStopDate1Click(
157 Sender: TObject);
158 procedure SortbyDrugalphabeticallystatusactivestatusrecentexpired1Click(
159 Sender: TObject);
[1679]160 procedure mnuActUnholdClick(Sender: TObject);
[456]161 private
162 FIterating: Boolean;
163 FActionOnMedsTab: Boolean;
164 FParentComplexOrderID: string;
165 uMedListIn: TList;
166 uMedListOut: TList;
167 uMedListNonVA: TList;
168 uPendingChanges: TStringList;
169 uDGrp: array[0..6] of Integer;
170 uPharmacyOrdersIn: TStringList;
171 uPharmacyOrdersOut: TStringList;
172 uNonVAOrdersOut: TStringList;
173 ChildODList: TStringList;
[830]174 FSortView: integer;
[456]175 function ListSelected(const ErrMsg: string): TListBox;
176 procedure ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string);
177 procedure MakeSelectedList(AListBox: TListBox; AList: TList; ActName: String = '');
178 procedure SynchListToOrders(AListBox: TListBox; AList: TList);
179 function GetActionText(const AMed: TMedListRec): string;
180 function GetInstructText(const AMed: TMedListRec; var Detail: string): string;
181 function GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string;
182 function GetPlainText(Control: TWinControl; Index: integer): string;
183 function GetHeader(Control: TWinControl): THeaderControl;
184 function GetMedList(Control: TWinControl): TList;
185 function GetPharmacyOrders(Control: TWinControl): TStringList;
[830]186 //function PatientStatusChanged: boolean;
[456]187 procedure ClearChildODList;
[830]188 procedure SetViewCaption(Caption : String);
189 procedure lstMedsInRightClickHandler(var Msg: TMessage; var Handled: Boolean);
190 procedure lstMedsNonVARightClickHandler(var Msg: TMessage; var Handled: Boolean);
191 procedure lstMedsOutRightClickHandler(var Msg: TMessage; var Handled: Boolean);
[456]192 public
193 procedure RefreshMedLists;
194 procedure ClearPtData; override;
195 procedure DisplayPage; override;
196 procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override;
197 procedure SetFontSize( FontSize: integer); override;
198 property ActionOnMedsTab: boolean read FActionOnMedsTab;
199 property ParentComplexOrderID: string read FParentComplexOrderID write FParentComplexOrderID;
200 procedure InitfMedsSize;
201 procedure SetSectionWidths(Sender: TObject);
202 function GetTotalSectionsWidth(Sender: TObject) : integer;
203 function CheckMedStatus(ActiveList: TListBox): boolean;
[830]204 property SortView: integer read FSortView write FSortView;
[456]205 end;
206
207type
208 arOrigOutPtSecWidths = array[0..6] of integer; //CQ7586
209 arOrigInPtSecWidths = array[0..4] of integer; //CQ7586
210 arOrigNonVASecWidths = array[0..3] of integer; //CQ7586
211
212var
213 frmMeds: TfrmMeds;
214// LargePanelPortion: Integer;
215// SmallPanelPortion: integer;
216
217 OrigOutPtSecWidths: arOrigOutPtSecWidths; //CQ7586
218 OrigInPtSecWidths : arOrigInPtSecWidths; //CQ7586
219 OrigNonVASecWidths: arOrigNonVASecWidths; //CQ7586
220
221 MedOutSize: double;
222 s: string;
223 LargePanelSize: integer;
224 SmallPanelSize : integer;
225 MedNonVAPanelSize: integer;
226
227 totalHeight: integer;
228
229 resizedTotalHeight: integer;
230 resizedMedOutPanelHeight: Extended;
231 resizedNonVAPanelHeight: Extended;
232 resizedMedInPanelHeight: Extended;
233
234 splitterTop: TSplitter;
235 splitterBottom: TSplitter;
236
237 oldFont: integer; //CQ9182
238
239
240implementation
241
[1679]242uses uCore, rCore, fFrame, fRptBox, uOrders, fODBase, fOrdersDC, fOrdersHold, fOrdersUnhold,
[456]243 fOrdersRenew, fOMNavA, fOrdersRefill, fMedCopy, fOrders, fODChild, rODBase,
[830]244 StrUtils, fActivateDeactivate, VA2006Utils, VA508AccessibilityRouter,
245 VAUtils;
[456]246
247{$R *.DFM}
248
249const
250 SMALL_PANEL = 20;
251 LARGE_PANEL = 60;
252 COL_MEDNAME = 1;
253 DG_OUT = 0;
254 DG_IN = 1;
255 DG_UD = 2;
256 DG_IV = 3;
257 DG_TPN = 4;
258 DG_NVA = 5;
259 DG_IMO = 6;
260 FMT_INDENT = 12;
261 TAG_OUTPT = 1;
262 TAG_INPT = 2;
263 TAG_NONVA = 3;
264 TX_NOSEL = 'No orders are highlighted. Highlight the orders' + CRLF +
265 'you wish to take action on.';
266 TC_NOSEL = 'No Orders Selected';
267 TX_NO_DC = CRLF + CRLF + '- cannot be discontinued.' + CRLF + CRLF + 'Reason: ';
268 TC_NO_DC = 'Unable to Discontinue';
269 TX_NO_RENEW = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
270 TC_NO_RENEW = 'Unable to Renew Order';
271 TX_NO_HOLD = CRLF + CRLF + '- cannot be placed on hold.' + CRLF + CRLF + 'Reason: ';
[1679]272 TC_NO_HOLD = 'Unable to Hold';
273 TX_NO_UNHOLD = CRLF + CRLF + '- cannot be released from hold.' + CRLF + CRLF + 'Reason: ';
274 TC_NO_UNHOLD = 'Unable to Release from Hold';
[456]275 TX_NO_COPY = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ';
276 TC_NO_COPY = 'Unable to Copy Order';
277 TX_NO_CHANGE = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
278 TC_NO_CHANGE = 'Unable to Change Order';
279 TX_NO_REFILL = CRLF + CRLF + '- cannot be refilled.' + CRLF + CRLF + 'Reason: ';
280 TC_NO_REFILL = 'Unable to Refill Order';
281 MEDS_SPLIT_FORM = 'frmMedsSplit';
282
283{ TPage common methods --------------------------------------------------------------------- }
284
285procedure TfrmMeds.ClearPtData;
286begin
287 inherited ClearPtData;
288 ClearChildODList;
289 lstMedsIn.Clear;
290 lstMedsOut.Clear;
291 lstMedsNonVA.Clear;
292 ClearMedList(uMedListIn);
293 ClearMedList(uMedListOut);
294 ClearMedList(uMedListNonVA);
295 uPendingChanges.Clear;
296 uPharmacyOrdersIn.Clear;
297 uPharmacyOrdersOut.Clear;
298 uMedListNonVA.Clear;
299 totalHeight := 0;
300
301end;
302
303procedure TfrmMeds.DisplayPage;
304const
305 RATIO_SMALL = 0.13; //0.1866;
306
307
308begin
309 inherited DisplayPage;
310
311 frmFrame.ShowHideChartTabMenus(mnuViewChart);
312
313 if InitPage and User.NoOrdering then
314 begin
315 mnuAct.Enabled := False;
316 popMedChange.Enabled := False;
317 popMedDC.Enabled := False;
318 popMedRenew.Enabled := False;
319 popMedNew.Enabled := False;
320
321 end;
322
323 //Swap Inpatient/Outpatient list display positions depending in inpatient/outpatient status
324 if InitPage and User.DisableHold then
325 mnuActHold.Visible := False;
326
327 if Patient.Inpatient then
328 begin
329 splitBottom.Align := alNone;
330 hdrMedsIn.Align := alNone;
331 lstMedsIn.Align := alNone;
332
333 lstMedsIn.Parent := pnlTop;
334 lstMedsIn.Align := alClient;
335 lstMedsOut.Parent := pnlMedIn;
336
337 hdrMedsIn.Parent := pnlTop;
338 hdrMedsIn.Align := alTop;
339
340 hdrMedsOut.Parent := pnlMedIn;
341 splitBottom.Align := alBottom;
342
343 lstMedsIn.Height := lstMedsIn.Height - 1; // added to cause repaint if user makes area small
344 lstMedsIn.Height := lstMedsIn.Height + 1; // added to cause repaint if user makes area small.
345 lstMedsOut.Height := lstMedsOut.Height + 1; // added to cause repaint if user makes area small
346 lstMedsOut.Height := lstMedsOut.Height - 1; // added to cause repaint if user makes area small
347
348 end
349 else
350 begin
351 splitBottom.Align := alNone;
352 hdrMedsIn.Align := alNone;
353
354 lstMedsIn.Parent := pnlMedIn;
355 lstMedsOut.Parent := pnlTop;
356 lstMedsOut.Align := alClient;
357
358 hdrMedsIn.Parent := pnlMedIn;
359 hdrMedsIn.Align := alTop;
360
361 hdrMedsOut.Parent := pnlTop;
362 splitBottom.Align := alBottom;
363
364 lstMedsIn.Height := lstMedsIn.Height - 1; // added to cause repaint if user makes area small
365 lstMedsIn.Height := lstMedsIn.Height + 1; // added to cause repaint if user makes area small.
366 lstMedsOut.Height := lstMedsOut.Height + 1; // added to cause repaint if user makes area small
367 lstMedsOut.Height := lstMedsOut.Height - 1; // added to cause repaint if user makes area small
368 end;
369 RefreshMedLists;
370
371end;
372
373procedure TfrmMeds.mnuChartTabClick(Sender: TObject);
374begin
375 inherited;
376 frmFrame.mnuChartTabClick(Sender);
377end;
378
379procedure TfrmMeds.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
380var
381 AMedList: TList;
382 AStringList: TStringList;
383 NewMedRec: TMedListRec;
384 i, idx, Match: Integer;
385 j: integer;
386 AChildList: TStringlist;
387 CplxOrderID: string;
388
389 procedure SetCurrentOrderID;
390 var
391 i: Integer;
392 AMedRec: TMedListRec;
393 begin
394 with AMedList do for i := 0 to Count - 1 do
395 begin
396 AMedRec := TMedListRec(AMedList[i]);
397 if Piece(AMedRec.OrderID, ';', 1) = Piece(AnOrder.ActionOn, ';', 1) then
398 begin
399 end;
400 end;
401 end;
402
403 function IndexForCurrentID(const AnID: string): Integer;
404 var
405 i: Integer;
406 begin
407 Result := -1;
408 for i := 0 to uPendingChanges.Count - 1 do
409 if Piece(uPendingChanges[i], U, 2) = AnID then Result := i;
410 if Result < 0 then
411 for i := 0 to uPendingChanges.Count - 1 do
412 if Piece(uPendingChanges[i], '=', 1) = Piece(AnID, ';', 1) then Result := i;
413 end;
414
415begin
416 AMedList := nil;
417 if AnOrder <> nil then
418 begin
419 //AGP Change 26.24 CQ 7150 fixes the problem with non-va meds initially showing up in the inpatient section
420 if uDGrp[DG_OUT] = AnOrder.DGroup then AMedList := uMedListOut;
421 If uDGrp[DG_NVA] = AnOrder.DGroup then AMedList := uMedListNonVA;
422 if (AMedList <> uMedListOut) and (AMedList <> uMedListNonVA) then
423 for i := 1 to 6 do if uDGrp[i] = AnOrder.DGroup then AMedList := uMedListIn;
424 end;
425 case OrderAction of
426 ORDER_NEW: { sent by accept order on new order }
427 if AMedList <> nil then
428 begin
429 // check this out carefully!!
430 NewMedRec := TMedListRec.Create;
431 NewMedRec.OrderID := AnOrder.ID;
432 NewMedRec.Instruct := AnOrder.Text;
433 NewMedRec.Inpatient := AMedList = uMedListIn;
434 AMedList.Insert(0, NewMedRec);
435 if AMedList = uMedListIn then
436 begin
437 lstMedsIn.Items.Insert(0, GetPlainText(lstMedsIn,0));
438 uPharmacyOrdersIn.Insert(0, U + AnOrder.ID);
439 end
440 else
441 begin
442 if AMedList = uMedListOut then
443 begin
444 lstMedsOut.Items.Insert(0, GetPlainText(lstMedsOut,0));
445 uPharmacyOrdersOut.Insert(0, U + AnOrder.ID);
446 end
447 else
448 begin
449 if AMedList = uMedListNonVA then
450 begin
451 lstMedsNonVA.Items.Insert(0, GetPlainText(lstMedsNonVA,0));
452 uNonVAOrdersOut.Insert(0, U + AnOrder.ID);
453 end;
454 end;
455 end;
456 uPendingChanges.Add(Piece(AnOrder.ID, ';', 1) + '=NW^' + AnOrder.ID);
457 end;
458 ORDER_DC: { sent by a diet to cancel a tubefeeding - do nothing };
459 ORDER_EDIT: { sent by accept on edit order }
460 if AMedList <> nil then
461 begin
462 Match := IndexForCurrentID(AnOrder.EditOf);
463 if Match < 0
464 { add a new pending change if there is no existing change that matches EditOf }
465 then uPendingChanges.Add(Piece(AnOrder.EditOf, ';', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName)
466 { leave 1st piece (original ID) intact, while changing text & current ID }
467 else uPendingChanges[Match] := Piece(uPendingChanges[Match], '=', 1) + '=XX' + U + AnOrder.ID + U + AnOrder.Text + U + AnOrder.OrderLocName;
468 end;
469 ORDER_ACT: { sent by DC, Hold, & Renew actions }
470 if AMedList <> nil then
471 begin
472 if Piece(AnOrder.ActionOn, '=', 2) = 'CA' then
473 begin
474 // cancel action, remove from PendingChanges
475 for idx := uPendingChanges.Count-1 downto 0 do
476 begin
477 Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1));
478 if Match > -1 then uPendingChanges.Delete(Match);
479 end;
480 end
481 else if Piece(AnOrder.ActionOn, '=', 2) = 'DL' then
482 begin
483 // delete action, show as deleted (set OrderID's to 0 so not confused with next order)
484 Match := IndexForCurrentID(Piece(AnOrder.ActionOn, '=', 1));
485 if Match > -1 then uPendingChanges[Match] := '0=DL';
486 if AMedList = uMedListIn
487 then AStringList := uPharmacyOrdersIn
488 else if AMedList = uMedListOut
489 then AStringList := uPharmacyOrdersOut
490 else AStringList := uNonVAOrdersOut;
491 with AStringList do for i := 0 to Count - 1 do
492 if (U + Piece(AnOrder.ActionOn, '=', 1)) = Strings[i] then Strings[i] := '^0';
493 Match := -1;
494 with AMedList do for i := 0 to Count - 1 do
495 if TMedListRec(Items[i]).OrderID = Piece(AnOrder.ActionOn, '=', 1) then Match := i;
496 if Match > -1 then TMedListRec(AMedList.Items[Match]).OrderID := '0';
497 end
498 else uPendingChanges.Add(Piece(AnOrder.ActionOn, ';', 1) + '=' +
499 Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID + '^^' + AnOrder.OrderLocName);
500
501 end; {if AMedList}
502 ORDER_CPLXRN:
503 begin
504 AChildList := TStringList.Create;
505 CplxOrderID := Piece(AnOrder.ActionOn,'=',1);
506 GetChildrenOfComplexOrder(CplxOrderID, Piece(CplxOrderID,';',2), AChildList);
507 if AMedList = uMedListIn then with AMedList do
508 begin
509 for i := Count-1 downto 0 do
510 begin
511 for j := 0 to AChildList.Count - 1 do
512 begin
513 if (TMedListRec(Items[i]).OrderID = AChildList[j]) then
514 begin
515 { Delete(i);
516 Break;}
517 if not IsFirstDoseNowOrder(TMedListRec(Items[i]).OrderID) then
518 begin
519 uPendingChanges.Add(Piece(TMedListRec(Items[i]).OrderID, ';', 1) + '=' + Piece(AnOrder.ActionOn, '=', 2) + U + AnOrder.ID);
520 Break;
521 end;
522 end;
523 end;
524 end;
525 end;
526 AChildList.Clear;
527 AChildList.Free;
528 end;
529 ORDER_SIGN: { sent by fReview, fOrderSign when orders signed, AnOrder=nil}
530 begin
531 // ** only if tab has been visited?
532 uPendingChanges.Clear;
533 RefreshMedLists;
534 end;
535 end; {case}
536end;
537
538procedure TfrmMeds.SetFontSize( FontSize: integer);
539begin
540 inherited SetFontSize(FontSize);
541 mnuOptimizeFieldsClick(self);
542 if Patient.DFN <> '' then
543 RefreshMedLists;
544end;
545
546{ Form events ------------------------------------------------------------------------------ }
547
548procedure TfrmMeds.FormCreate(Sender: TObject);
549var
550 medsSplitFnd : boolean;
551 retList : TStringList;
552 i: integer;
553 x: string;
554begin
555 inherited;
[830]556 FixHeaderControlDelphi2006Bug(hdrMedsIn);
557 FixHeaderControlDelphi2006Bug(hdrMedsOut);
558 FixHeaderControlDelphi2006Bug(hdrMedsNonVA);
[456]559 PageID := CT_MEDS;
560 uMedListIn := TList.Create;
561 uMedListOut := TList.Create;
562 uMedListNonVA := TList.Create;
563 uPendingChanges := TStringList.Create;
564 uDGrp[DG_OUT] := DGroupIEN('O RX');
565 uDGrp[DG_IN] := DGroupIEN('I RX');
566 uDGrp[DG_UD] := DGroupIEN('UD RX');
567 uDGrp[DG_IV] := DGroupIEN('IV RX');
568 uDGrp[DG_TPN] := DGroupIEN('TPN');
569 uDGrp[DG_NVA] := DGroupIEN('NV RX');
570 uDGrp[DG_IMO] := DGroupIEN('C RX');
571 uPharmacyOrdersIn := TStringList.Create;
572 uPharmacyOrdersOut := TStringList.Create;
573 uNonVAOrdersOut := TStringList.Create;
574 FActionOnMedsTab := False;
575 FParentComplexOrderID := '';
576 ChildODList := TStringList.Create;
577
578
579
580 //DETECT 1st TIME USER.
581 //If first time user (medSplitFound=false), then manually set panel heights.
582 //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
583 medsSplitFnd := FALSE;
584 if Assigned(frmMeds) then
585 begin
586 retList := TStringList.Create;
587 tCallV(retList, 'ORWCH LOADALL', [nil]);
588
589 for i := 0 to retList.Count-1 do
590 begin
591 x := retList.strings[i];
592 if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
593 begin
594 medsSplitFnd := False;//TRUE;
595 Break;
596 end;
597 end;
598
599 if not medsSplitFnd then
600 begin
601 pnlBottom.Height := frmMeds.Height div 2;
602 pnlMedIn.Height := pnlBottom.Height div 2;
603 end;
604 end;
605
606 //CQ9622
607 if hdrMedsIn.Sections[1].Width < 100 then
608 begin
609 hdrMedsIn.Sections[1].Width := 100;
610 hdrMedsIn.Refresh;
611 end;
612 if hdrMedsNonVA.Sections[1].Width < 100 then
613 begin
614 hdrMedsNonVA.Sections[1].Width := 100;
615 lstMedsNonVA.Refresh;
616 end;
617 if hdrMedsOut.Sections[1].Width < 100 then
618 begin
619 hdrMedsOut.Sections[1].Width := 100;
620 hdrMedsOut.Refresh;
621 end;
622 //end CQ9622
[830]623 AddMessageHandler(lstMedsIn, lstMedsInRightClickHandler);
624 AddMessageHandler(lstMedsNonVA, lstMedsNonVARightClickHandler);
625 AddMessageHandler(lstMedsOut, lstMedsOutRightClickHandler);
[456]626end;
627
628procedure TfrmMeds.FormDestroy(Sender: TObject);
629begin
630 inherited;
[830]631 RemoveMessageHandler(lstMedsOut, lstMedsOutRightClickHandler);
632 RemoveMessageHandler(lstMedsNonVA, lstMedsNonVARightClickHandler);
633 RemoveMessageHandler(lstMedsIn, lstMedsInRightClickHandler);
[456]634 ClearChildODList;
635 ClearMedList(uMedListIn);
636 ClearMedList(uMedListOut);
637 ClearMedList(uMedListNonVA);
638 uMedListIn.Free;
639 uMedListOut.Free;
640 uMedListNonVA.Free;
641 uPendingChanges.Free;
642 uPharmacyOrdersIn.Free;
643 uPharmacyOrdersOut.Free;
644 uNonVAOrdersOut.Free;
645 ChildODList.Free;
646end;
647
648{ View menu events ------------------------------------------------------------------------- }
649
650procedure TfrmMeds.mnuViewDetailClick(Sender: TObject);
651var
652 AnID, ATitle, AnOrder: string;
653 AListBox: TListBox;
654 i,j,idx: Integer;
655 tmpList: TStringList;
656begin
657 inherited;
658 tmpList := TStringList.Create;
659 try
660 idx := 0;
661 AListBox := ListSelected(TX_NOSEL);
662 if AListBox = nil then Exit
663 else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Details'
664 else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Details'
665 else ATitle := 'Inpatient Medication Details';
666 FIterating := True;
667 with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
668 begin
669 AnID := Piece(Strings[i], U, 1);
670 if AnID <> '' then
671 begin
[830]672 FastAssign(DetailMedLM(AnID), tmpList);
[456]673 end;
674 AnOrder := Piece(Strings[i], U, 2);
675 if AnOrder <> '' then
676 begin
677 tmpList.Add('');
678 tmpList.Add(StringOfChar('=', 74));
679 tmpList.Add('');
[830]680 FastAddStrings(MedAdminHistory(AnOrder), tmpList);
[456]681 end;
682 if CheckOrderGroup(AnOrder)=1 then // if it's UD group
683 begin
684 for j := 0 to tmpList.Count - 1 do
685 begin
686 if Pos('PICK UP',UpperCase(tmpList[j]))>0 then
687 begin
688 idx := j;
689 Break;
690 end;
691 end;
692 if idx > 0 then
693 tmpList.Delete(idx);
694 end;
695 if tmpList.Count > 0 then ReportBox(tmpList, ATitle, True);
[830]696 if (frmFrame.TimedOut) or (frmFrame.CCOWDrivedChange) then Exit; //code added to correct access violation on timeout
[456]697 Exit;
698 end;
699 FIterating := False;
700 ResetSelectedForList(AListBox);
701 AListBox.SetFocus;
702 finally
703 tmpList.Free;
704 end;
705end;
706
707procedure TfrmMeds.mnuViewHistoryClick(Sender: TObject);
708var
709 ATitle, AnOrder: string;
710 AListBox: TListBox;
711 i: Integer;
712begin
713 inherited;
714 AListBox := ListSelected(TX_NOSEL);
715 if AListBox = nil then Exit
716 else if AListBox = lstMedsOut then ATitle := 'Outpatient Medication Administration History'
717 else if AListBox = lstMedsNonVA then ATitle := 'Non VA Medication Documentation History'
718 else ATitle := 'Inpatient Medication Administration History';
719 FIterating := True;
720 with GetPharmacyOrders(AListBox) do for i := 0 to Count - 1 do if AListBox.Selected[i] then
721 begin
722 AnOrder := Piece(Strings[i], U, 2);
723 if AnOrder <> '' then
724 ReportBox(MedAdminHistory(AnOrder), ATitle, True);
725 end;
726 FIterating := False;
727 ResetSelectedForList(AListBox);
728 AListBox.SetFocus;
729end;
730
731{ Listbox events --------------------------------------------------------------------------- }
732
733procedure TfrmMeds.RefreshMedLists;
734var
[1679]735 i, view: Integer;
[456]736 AMed: TMedListRec;
[1679]737 DateRange: string;
[456]738begin
[1679]739 if frmFrame.TimedOut then Exit;
[456]740 lstMedsIn.Clear;
741 lstMedsOut.Clear;
742 lstMedsNonVA.Clear;
[1679]743 DateRange := '';
[456]744 StatusText('Retrieving active medications...');
[830]745 view := self.FSortView;
746 //AGP Fix for CQ 10410 added view arguement to control Meds Tab sort criteria
[1679]747 LoadActiveMedLists(uMedListIn, uMedListOut, uMedListNonVA, view, DateRange);
[830]748 self.FSortView := view;
749 if view = 1 then
750 begin
751 self.SortbyStatusthenLocation1.Checked := True;
[1679]752 SetViewCaption(SortbyStatusthenLocation1.Caption + ' ' + DateRange);
[830]753 self.SortbyClinicOrderthenStatusthenStopDate1.Checked := False;
754 self.SortbyDrugalphabeticallystatusactivestatusrecentexpired1.checked := false;
755 end
756 else if view = 2 then
757 begin
758 self.SortbyStatusthenLocation1.Checked := False;
759 self.SortbyClinicOrderthenStatusthenStopDate1.Checked := True;
[1679]760 SetViewCaption(SortbyClinicOrderthenStatusthenStopDate1.Caption + ' ' + DateRange);
[830]761 self.SortbyDrugalphabeticallystatusactivestatusrecentexpired1.Checked := false;
762 end
763 else if view = 3 then
764 begin
765 self.SortbyStatusthenLocation1.Checked := False;
766 self.SortbyClinicOrderthenStatusthenStopDate1.Checked := false;
767 self.SortbyDrugalphabeticallystatusactivestatusrecentexpired1.Checked := true;
[1679]768 SetViewCaption(SortbyDrugalphabeticallystatusactivestatusrecentexpired1.Caption + ' ' + DateRange);
769 end;
[456]770 uPharmacyOrdersIn.Clear;
771 uPharmacyOrdersOut.Clear;
772 uNonVAOrdersOut.Clear;
773 with uMedListIn do for i := 0 to Count - 1 do
774 begin
775 AMed := TMedListRec(Items[i]);
776 uPharmacyOrdersIn.Add(AMed.PharmID + U + AMed.OrderID);
777 lstMedsIn.Items.AddObject(GetPlainText(lstMedsIn, i), AMed);
778 end;
779
780 with uMedListNonVA do for i := 0 to Count - 1 do
781 begin
782 AMed := TMedListRec(Items[i]);
783 uNonVAOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
784 lstMedsNonVA.Items.AddObject(GetPlainText(lstMedsNonVA, i), AMed);
785 end;
786
787 with uMedListOut do for i := 0 to Count - 1 do
788 begin
789 AMed := TMedListRec(Items[i]);
790 uPharmacyOrdersOut.Add(AMed.PharmID + U + AMed.OrderID);
791 lstMedsOut.Items.AddObject(GetPlainText(lstMedsOut, i), AMed);
792 end;
[830]793
[456]794 StatusText('');
795end;
796
797function TfrmMeds.GetActionText(const AMed: TMedListRec): string;
798var
799 AnAction: string;
800 Abbreviation: string;
801begin
802 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
803 Abbreviation := Piece(AnAction, U, 1);
804 result := '';
805 if Length(Abbreviation) > 0 then
806 begin
807 if CharAt(Abbreviation, 1) = 'X' then result := 'Change'
808 else if Abbreviation = 'NW' then result := 'New'
809 else if Abbreviation = 'RN' then result := 'Renew'
810 else if Abbreviation = 'RF' then result := 'Refill'
811 else if Abbreviation = 'HD' then result := 'Hold'
812 else if Abbreviation = 'DL' then result := 'Deleted'
813 else if Abbreviation = 'DC' then result := 'DC'
[1679]814 else if Abbreviation = 'UH' then result := 'Unhold'
815
[456]816 else result := Abbreviation;
817 end;
818end;
819
820function TfrmMeds.GetInstructText(const AMed: TMedListRec; var Detail: string): string;
821var
822 AnAction: string;
823 Indent: integer;
824begin
825 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
826 result := AMed.Instruct;
827 // replace pharmacy text with order text if this is a change
828 if CharAt(AnAction, 1) = 'X' then result := Piece(AnAction, U, 3);
[830]829 if AMed.IVFluid then Indent := Pos(CRLF + 'in ', result) else Indent := Pos(#13, result);
[456]830 if Indent > 0 then
831 begin
832 if AMed.IVFluid then
833 begin
[830]834 Detail := Copy(result, Indent + Length(CRLF), Length(result));
[456]835 result := Copy(result, 1, Indent - 1);
836 end else
837 begin
838 Detail := Copy(result, Indent + 2, Length(result));
839 result := Copy(result, 1, Indent - 1);
840 end;
841 end;
842end;
843
844function TfrmMeds.GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string;
845begin
846 result := '';
847 Detail := '';
848 if AMed.Status = 'Suspended' then AMed.Status := 'Active/Susp'; //HDS00007547 PSI-03-033 Interim Solution.
849 case Column of
850 0: result := GetActionText(AMed);
851 1: result := GetInstructText(AMed, Detail);
852 2: result := FormatFMDateTime('mm/dd/yy', AMed.StopDate);
853 3: result := AMed.Status;
854 4:
855 begin
856 if AMed.Inpatient then
857 result := MixedCase(AMed.Location)
858 else result := FormatFMDateTime('mmm dd,yy', AMed.LastFill);
859 end;
860 5: result := AMed.Refills;
861 else
862 end;
863end;
864
865function TFrmMeds.GetPlainText(Control: TWinControl; Index: integer): string;
866var
867 AMed: TMedListRec;
868 AHeader: THeaderControl;
869 i: integer;
870 x, y: string;
871begin
872 Result := '';
873 AMed := TMedListRec(GetMedList(Control)[Index]);
874 AHeader := GetHeader(Control);
875 for i := 0 to AHeader.Sections.Count-1 do
876 begin
877 x := GetListText(AMed, i, y);
878 if (x <> '') or (y <> '') then
879 Result := Result + AHeader.Sections[i].Text + ': ' + x + ' ' + y + CRLF;
880 end;
881 Result := Trim(Result);
882end;
883
884function TFrmMeds.GetHeader(Control: TWinControl): THeaderControl;
885begin
886 case Control.Tag of
887 TAG_OUTPT: result := hdrMedsOut;
888 TAG_NONVA: result := hdrMedsNonVA;
889 TAG_INPT: result := hdrMedsIn;
890
891 else
892 result := nil;
893 end;
894end;
895
896function TFrmMeds.GetMedList(Control: TWinControl): TList;
897begin
898 case Control.Tag of
899 TAG_OUTPT: result := uMedListOut;
900 TAG_NONVA: result := uMedListNonVA;
901 TAG_INPT: result := uMedListIn;
902 else
903 result := nil;
904 end;
905end;
906
907function TFrmMeds.GetPharmacyOrders(Control: TWinControl): TStringList;
908begin
909 case Control.Tag of
910 TAG_OUTPT: result := uPharmacyOrdersOut;
911 TAG_NONVA: result := uNonVAOrdersOut;
912 TAG_INPT: result := uPharmacyOrdersIn;
913 else
914 result := nil;
915 end;
916end;
917
918procedure TfrmMeds.lstMedsMeasureItem(Control: TWinControl; Index: Integer;
919 var AHeight: Integer);
920var
921 NewHeight, RecRight: Integer;
922 AMed: TMedListRec;
923 AHeader: THeaderControl;
924 AMedList: TList;
925 ARect: TRect;
926 x, y, AnAction: string;
927begin
928 inherited;
929 NewHeight := AHeight;
930 AHeader := GetHeader(Control);
931 AMedList := GetMedList(Control);
932 with Control as TListBox do if Index < Items.Count then
933 begin
934 AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
935 if AMed <> nil then
936 begin
937 ARect := ItemRect(Index);
938 ARect.Left := AHeader.Sections[0].Width + 2;
939 ARect.Right := ARect.Left + AHeader.Sections[1].Width - 6;
940 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
941 if Length(AnAction) > 0 then Canvas.Font.Style := [fsBold];
942 x := GetInstructText( AMed, y);
943 RecRight := ARect.Right;
944 NewHeight := WrappedTextHeightByFont( Canvas, Font, x, ARect);
945 if(length(y)>0) then
946 begin
947 ARect.Left := AHeader.Sections[0].Width + FMT_INDENT;
948 ARect.Right := RecRight; // Draw Text alters ARect.
949 inc(NewHeight, WrappedTextHeightByFont( Canvas, Font, y, ARect));
950 end;
951 if NewHeight > 255 then NewHeight := 255; // windows appears to only look at 8 bits *KCM*
952 if NewHeight < 13 then NewHeight := 13; // show at least one line *KCM*
953 end; {if AMed}
954 end; {if Index}
955 AHeight := NewHeight;
956end;
957
958procedure TfrmMeds.lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
959var
960 ReturnHt: Integer;
961 x, y, AnAction: string;
962 AMed: TMedListRec;
963 AMedList: TList;
964 AHeader: THeaderControl;
965 ARect: TRect;
966 i: integer;
967 RectLeft: integer;
968begin
969 inherited;
970 AHeader := GetHeader(Control);
971 AMedList := GetMedList(Control);
972 ListGridDrawLines(TListBox(Control), AHeader, Index, State);
973 with Control as TListBox do if Index < Items.Count then
974 begin
975 AMed := TMedListRec(AMedList[Index]); // can't use Items.Objects here - its not there yet
976 if AMed <> nil then
977 begin
978 AnAction := uPendingChanges.Values[Piece(AMed.OrderID, ';', 1)];
979 if Length(AnAction) > 0 then
980 begin
981 Canvas.Font.Style := [fsBold];
982 //AGP Change 26.29 CQ #8188 Fix for highlighted new meds displaying blue font with a blue background.
983 if odSelected in State then
984 begin
985 Canvas.Brush.Color := clHighlight;
986 Canvas.Font.Color := clHighlightText;
987 //Canvas.FillRect(ARect);
[830]988 Canvas.Font.Color := Get508CompliantColor(clWhite);
[456]989 end;
[830]990 if (Canvas.Font.Color <> Get508CompliantColor(clWhite)) then
991 Canvas.Font.Color := Get508CompliantColor(clBlue);
[456]992 if (Length(Piece(AnAction,'^',4)) > 0) then
993 AMed.Location := Piece(AnAction,'^',4);
994 end;
995 RectLeft := 0;
996 for i := 0 to AHeader.Sections.Count -1 do
997 begin
998 x := GetListText(AMed, i, y);
999 if Length(y) > 0 then
1000 begin
1001 ARect := ItemRect(Index);
1002 ARect.Left := RectLeft + 2;
1003 ARect.Right := (ARect.Left + AHeader.Sections[i].Width - 6);
1004
1005 //if ((ARect.Right - ARect.Left) < 100) then
1006 //ARect.Right := ARect.Right + (100 - (ARect.Left + AHeader.Sections[i].Width - 6));
1007
1008 ReturnHt := DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX
1009 or DT_WORDBREAK);
1010 ARect.Left := RectLeft + FMT_INDENT;
1011 ARect.Top := ARect.Top + ReturnHt;
1012 DrawText(Canvas.Handle, PChar(y), Length(y), ARect, DT_LEFT or DT_NOPREFIX
1013 or DT_WORDBREAK);
1014 end
1015 else
1016 ListGridDrawCell(TListBox(Control), AHeader, Index, i, x, i = 1);
1017 Inc(RectLeft, AHeader.Sections[i].Width);
1018 end;
1019 end; {if AMed}
1020 end; {if Index}
1021end;
1022
1023procedure TfrmMeds.lstMedsExit(Sender: TObject);
1024begin
1025 inherited;
1026 if not FIterating then ResetSelectedForList(TListBox(Sender));
1027end;
1028
1029procedure TfrmMeds.lstMedsDblClick(Sender: TObject);
1030begin
1031 inherited;
1032 mnuViewDetailClick(Self);
1033end;
1034
1035procedure TfrmMeds.lstMedsInClick(Sender: TObject);
1036var
1037 i: integer;
1038begin
1039 inherited;
1040
[830]1041 //if PatientStatusChanged then exit;
[456]1042 with lstMedsOut do for i := 0 to Items.Count -1 do
1043 Selected[i] := false;
1044 with lstMedsNonVA do for i := 0 to Items.Count - 1 do
1045 Selected[i] := FALSE;
1046end;
1047
[830]1048procedure TfrmMeds.lstMedsInRightClickHandler(var Msg: TMessage;
1049 var Handled: Boolean);
1050begin
1051 if Msg.Msg = WM_RBUTTONUP then
1052 begin
1053 lstMedsIn.RightClickSelect := (lstMedsIn.SelCount < 1);
1054 lstMedsInClick(lstMedsIn);
1055 end;
1056end;
1057
[456]1058procedure TfrmMeds.lstMedsOutClick(Sender: TObject);
1059var
1060 i: integer;
1061begin
1062 inherited;
1063
[830]1064 //if PatientStatusChanged then exit;
[456]1065 with lstMedsIn do for i := 0 to Items.Count -1 do
1066 Selected[i] := false;
1067 with lstMedsNonVA do for i := 0 to Items.Count -1 do
1068 Selected[i] := false;
1069end;
1070
[830]1071procedure TfrmMeds.lstMedsOutRightClickHandler(var Msg: TMessage;
1072 var Handled: Boolean);
1073begin
1074 if Msg.Msg = WM_RBUTTONUP then
1075 begin
1076 lstMedsOut.RightClickSelect := (lstMedsOut.SelCount < 1);
1077 lstMedsOutClick(lstMedsOut);
1078 end;
1079end;
1080
[456]1081procedure TfrmMeds.hdrMedsOutSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1082begin
1083 inherited;
1084 RedrawSuspend(Self.Handle);
1085 with lstMedsOut do
1086 begin
1087 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1088 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1089 end;
1090 RedrawActivate(Self.Handle);
1091 lstMedsOut.Invalidate;
1092 Refresh;
1093end;
1094
1095procedure TfrmMeds.hdrMedsInSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1096begin
1097 inherited;
1098 RedrawSuspend(Self.Handle);
1099 with lstMedsIn do
1100 begin
1101 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1102 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1103 end;
1104
1105 RedrawActivate(Self.Handle);
1106 lstMedsIn.Invalidate;
1107 Refresh;
1108end;
1109
1110{ Action menu events ---------------------------------------------------------------------- }
1111
1112procedure TfrmMeds.mnuActClick(Sender: TObject);
1113begin
1114 inherited;
[830]1115 //if PatientStatusChanged then exit;
[456]1116 if lstMedsOut.SelCount > 0 then
1117 begin
1118 mnuActTransfer.Caption := 'Transfer to Inpatient...';
1119 mnuActTransfer.Enabled := True;
1120 end
1121 else if lstMedsIn.SelCount > 0 then
1122 begin
1123 mnuActTransfer.Caption := 'Transfer to Outpatient...';
1124 mnuActTransfer.Enabled := True;
1125 end
1126 else
1127 begin
1128 mnuActTransfer.Caption := 'Transfer to...';
1129 mnuActTransfer.Enabled := False;
1130 end;
1131end;
1132
1133procedure TfrmMeds.mnuActDCClick(Sender: TObject);
1134{ discontinue/cancel/delete the selected med orders as appropriate for each order }
1135{ similar to action on fOrders}
1136var
1137 ActiveList: TListBox;
1138 SelectedList: TList;
1139 DelEvt: boolean;
1140begin
1141 inherited;
1142 DelEvt := False;
1143 ActiveList := ListSelected(TX_NOSEL);
1144 if ActiveList = nil then Exit;
1145 SelectedList := TList.Create;
1146 try
1147 FIterating := True;
1148 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1149 begin
1150 ValidateSelected(ActiveList, OA_DC, TX_NO_DC, TC_NO_DC);
[830]1151 ActivateDeactiveRenew(ActiveList); //AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
[456]1152 MakeSelectedList(ActiveList, SelectedList);
1153 if ExecuteDCOrders(SelectedList,DelEvt) then
1154 begin
1155 ResetSelectedForList(ActiveList);
1156 SynchListToOrders(ActiveList, SelectedList);
1157 end;
1158 if DelEvt then
1159 frmFrame.mnuFileRefreshClick(Self);
1160 end;
1161 finally
1162 FIterating := False;
1163 SelectedList.Free;
1164 UnlockIfAble;
1165 end;
1166end;
1167
1168procedure TfrmMeds.mnuActHoldClick(Sender: TObject);
1169{ hold the selected med orders as appropriate for each order }
1170{ similar to action on fOrders}
1171var
1172 ActiveList: TListBox;
1173 SelectedList: TList;
1174begin
1175 inherited;
1176 ActiveList := ListSelected(TX_NOSEL);
1177 if ActiveList = nil then Exit;
1178 SelectedList := TList.Create;
1179 if CheckMedStatus(ActiveList) = True then Exit;
1180 try
1181 FIterating := True;
1182 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1183 begin
1184 ValidateSelected(ActiveList, OA_HOLD, TX_NO_HOLD, TC_NO_HOLD);
1185 MakeSelectedList(ActiveList, SelectedList);
1186 if ExecuteHoldOrders(SelectedList) then
1187 begin
1188 AddSelectedToChanges(SelectedList);
1189 ResetSelectedForList(ActiveList);
1190 SynchListToOrders(ActiveList, SelectedList);
1191 end;
1192 end;
1193 finally
[1679]1194 ActiveList.SetFocus;
[456]1195 FIterating := False;
1196 SelectedList.Free;
1197 UnlockIfAble;
1198 end;
1199end;
1200
1201procedure TfrmMeds.mnuActRenewClick(Sender: TObject);
1202{ renew the selected med orders as appropriate for each order }
1203{ similar to action on fOrders}
1204var
1205 ActiveList: TListBox;
1206 SelectedList: TList;
1207 ParntOrder : TOrder;
1208begin
1209 inherited;
1210 ActiveList := ListSelected(TX_NOSEL);
1211 if ActiveList = nil then Exit;
1212 SelectedList := TList.Create;
1213 try
1214 FIterating := True;
1215 if CheckMedStatus(ActiveList) = True then Exit;
1216 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1217 begin
1218 ValidateSelected(ActiveList, OA_RENEW, TX_NO_RENEW, TC_NO_RENEW);
1219 MakeSelectedList(ActiveList, SelectedList);
1220 if Length(FParentComplexOrderID)>0 then
1221 begin
1222 ParntOrder := GetOrderByIFN(FParentComplexOrderID);
1223 if CharAt(ParntOrder.Text,1)='+' then
1224 ParntOrder.Text := Copy(ParntOrder.Text,2,Length(ParntOrder.Text));
1225 if Pos('First Dose NOW',ParntOrder.Text)>1 then
1226 Delete(ParntOrder.text, Pos('First Dose NOW',ParntOrder.Text), Length('First Dose NOW'));
1227 SelectedList.Add(ParntOrder);
1228 FParentComplexOrderID := '';
1229 end;
1230 if ExecuteRenewOrders(SelectedList) then
1231 begin
1232 AddSelectedToChanges(SelectedList);
1233 ResetSelectedForList(ActiveList);
1234 SynchListToOrders(ActiveList, SelectedList);
1235 end;
1236 end;
1237 finally
[1679]1238 ActiveList.SetFocus;
[456]1239 FIterating := False;
1240 SelectedList.Free;
1241 UnlockIfAble;
1242 end;
1243end;
1244
[1679]1245procedure TfrmMeds.mnuActUnholdClick(Sender: TObject);
1246var
1247 ActiveList: TListBox;
1248 SelectedList: TList;
1249begin
1250 inherited;
1251 ActiveList := ListSelected(TX_NOSEL);
1252 if ActiveList = nil then Exit;
1253 if not AuthorizedUser then Exit;
1254 if not EncounterPresent then Exit;
1255 if not LockedForOrdering then Exit;
1256 SelectedList := TList.Create;
1257 try
1258 if CheckMedStatus(ActiveList) = True then Exit;
1259 ValidateSelected(ActiveList, OA_UNHOLD, TX_NO_UNHOLD, TC_NO_UNHOLD); // validate release hold action
1260 MakeSelectedList(ActiveList, SelectedList); // build list of selected orders
1261 if ExecuteUnholdOrders(SelectedList) then
1262 begin
1263 AddSelectedToChanges(SelectedList);
1264 ResetSelectedForList(ActiveList);
1265 SynchListToOrders(ActiveList, SelectedList);
1266 end;
1267 finally
1268 ActiveList.SetFocus;
1269 FIterating := False;
1270 SelectedList.Free;
1271 UnlockIfAble;
1272 end;
1273end;
1274
[456]1275procedure TfrmMeds.mnuActChangeClick(Sender: TObject);
1276{ loop thru selected med orders, present ordering dialog for each with defaults to selected order }
1277{ similar to action on fOrders}
1278var
1279 i: Integer;
1280 ActiveList: TListBox;
1281 SelectedList: TList;
1282 ChangeIFNList: TStringList;
1283 DelayEvent: TOrderDelayEvent;
1284begin
1285 inherited;
1286 if not EncounterPresentEDO then Exit;
1287 ActiveList := ListSelected(TX_NOSEL);
1288 if ActiveList = nil then Exit;
1289 DelayEvent.EventType := 'C'; // temporary, so can pass to ChangeOrders
1290 DelayEvent.Specialty := 0;
1291 DelayEvent.Effective := 0;
1292 DelayEvent.EventIFN := 0;
1293 SelectedList := TList.Create; // temporary until able to create ChangeIFNList directly
1294 ChangeIFNList := TStringList.Create;
1295 try
1296 FIterating := true;
1297 if CheckMedStatus(ActiveList) = True then Exit;
1298 ValidateSelected(ActiveList, OA_CHANGE, TX_NO_CHANGE, TC_NO_CHANGE);
1299 MakeSelectedList(Activelist, SelectedList);
1300 with SelectedList do for i := 0 to Count - 1 do ChangeIFNList.Add(TOrder(Items[i]).ID);
1301 if not ShowMsgOn(ChangeIFNList.Count = 0, TX_NOSEL, TC_NOSEL)
1302 then ChangeOrders(ChangeIFNList, DelayEvent);
1303 SynchListToOrders(ActiveList, SelectedList); // rehighlights
1304 Activelist.SetFocus;
1305 finally
1306 SelectedList.Free;
1307 ChangeIFNList.Free;
1308 end;
1309end;
1310
1311procedure TfrmMeds.mnuActCopyClick(Sender: TObject);
1312{ loop thru selected med orders, present ordering dialog for each with defaults to selected order }
1313{ similar to action on fOrders}
1314const
1315 CP_TXT = 'copied';
[1679]1316 XF_TXT = 'transferred';
[456]1317var
1318 i: Integer;
1319 LimitEvent: Char;
1320 ActiveList: TListBox;
1321 SelectedList: TList;
1322 CopyIFNList: TStringList;
1323 TempEvent,DelayEvent: TOrderDelayEvent;
1324 ActName, radTxt,thePtEvtID, AuthErr: string;
1325 IsNewEvent,needVerify,NewOrderCreated,DoesDestEvtOccur: boolean;
1326
1327begin
1328 inherited;
1329 AuthErr := '';
1330 ActName := '';
1331 if not EncounterPresentEDO then Exit;
1332 CheckAuthForMeds(AuthErr);
1333 if (Length(AuthErr)>0) then
1334 begin
[830]1335 ShowMsg(AuthErr);
[456]1336 if not EncounterPresent then Exit;
1337 end;
1338 if not FActionOnMedsTab then
1339 FActionOnMedsTab := True;
1340 DelayEvent.EventType := #0;
1341 DelayEvent.EventIFN := 0;
1342 DelayEvent.EventName := '';
1343 DelayEvent.Specialty := 0;
1344 DelayEvent.Effective := 0;
1345 DelayEvent.PtEventIFN := 0;
1346 DelayEvent.TheParent := TParentEvent.Create;
1347 DelayEvent.IsNewEvent := False;
1348 TempEvent := DelayEvent;
1349 DoesDestEvtOccur := False;
1350 ActiveList := ListSelected(TX_NOSEL);
[830]1351 if not assigned(ActiveList) then exit;
[456]1352 if CheckMedStatus(ActiveList) = True then Exit;
1353 if ActiveList = nil then Exit;
1354 NewOrderCreated := False;
1355 if frmOrders.lstSheets.ItemIndex >= 0 then
1356 begin
1357 frmOrders.lstSheets.ItemIndex := 0;
1358 frmOrders.lstSheetsClick(Application);
1359 end;
1360 LimitEvent := #0;
1361 if TComponent(Sender).Name = 'mnuActTransfer' then
1362 begin
1363 ActName := 'Transfer';
1364 IsTransferAction := True;
1365 radTxt := XF_TXT;
1366 if ActiveList = lstMedsOut then
1367 begin
1368 if Patient.Inpatient then LimitEvent := 'C' else LimitEvent := 'A';
1369 XferOutToInOnMeds := True;
1370 end;
1371 if ActiveList = lstMedsIn then
1372 begin
1373 if Patient.Inpatient then LimitEvent := 'D' else
1374 begin
1375 LimitEvent := 'C';
1376 XfInToOutNow := True;
1377 end;
1378 XferOutToInOnMeds := False;
1379 end;
1380 end else
1381 radTxt := CP_TXT;
1382 SelectedList := TList.Create; // temporary until able to create CopyIFNList directly
1383 CopyIFNList := TStringList.Create;
1384 try
1385 MakeSelectedList(Activelist, SelectedList, ActName);
1386 {if (CopyIFNList.Count = 0) and (ActName = 'Transfer') then
1387 Exit;}
1388 with SelectedList do for i := 0 to Count - 1 do CopyIFNList.Add(TOrder(Items[i]).ID);
1389 if not ShowMsgOn(CopyIFNList.Count = 0, TX_NOSEL, TC_NOSEL) then
1390 begin
1391 IsNewEvent := False;
1392 if SetDelayEventForMed(radTxt, DelayEvent, IsNewEvent, LimitEvent) then
1393 begin
1394 if (ActiveList = lstMedsOut) and (DelayEvent.EventIFN > 0) then
1395 XferOutToInOnMeds := True;
1396 TempEvent.PtEventIFN := DelayEvent.PtEventIFN;
1397 TempEvent.EventName := DelayEvent.EventName;
1398 if (DelayEvent.PtEventIFN>0) and IsCompletedPtEvt(DelayEvent.PtEventIFN) then
1399 begin
1400 DelayEvent.EventType := 'C';
1401 DelayEvent.PtEventIFN := 0;
1402 DelayEvent.EventName := '';
1403 DelayEvent.EventIFN := 0;
1404 DelayEvent.TheParent := TParentEvent.Create;
1405 DoesDestEvtOccur := True;
1406 needVerify := false;
1407 CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify);
1408 if XferOutToInOnMeds then
1409 XferOutToInOnMeds := False;
1410 if frmOrders <> nil then
1411 frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName);
1412 Exit;
1413 end;
1414 if (DelayEvent.EventIFN>0) and (DelayEvent.EventType <> 'D') then
1415 begin
1416 needVerify := False;
1417 uAutoAC := True;
1418 end else
1419 begin
1420 needVerify := True;
1421 uAutoAC := False;
1422 end;
1423 if LimitEvent = #0 then
1424 begin
1425 if CopyOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
1426 NewOrderCreated := True;
1427 if ImmdCopyAct then
1428 ImmdCopyAct := False;
1429 end else
1430 begin
1431 if TransferOrders(CopyIFNList, DelayEvent, DoesDestEvtOccur, needVerify) then
1432 NewOrderCreated := True;
1433 end;
1434 if XferOutToInOnMeds then
1435 XferOutToInOnMeds := False;
1436 if (DelayEvent.EventIFN > 0) and ( isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) ) then
1437 frmOrders.HighlightFromMedsTab := StrToIntDef(ThePtEvtID,0);
1438 if (not NewOrderCreated) and (DelayEvent.EventIFN>0) then
1439 if isExistedEvent(Patient.DFN,IntToStr(DelayEvent.EventIFN),ThePtEvtID) then
1440 begin
1441 if PtEvtEmpty(ThePtEvtID) then
1442 begin
1443 DeletePtEvent(ThePtEvtID);
1444 frmOrders.ChangesUpdate(ThePtEvtID);
1445 frmOrders.EventDefaultOrder := '';
1446 frmOrders.InitOrderSheetsForEvtDelay;
1447 if frmOrders.lstSheets.ItemIndex <> 0 then
1448 frmOrders.lstSheets.ItemIndex := 0;
1449 frmOrders.lstSheetsClick(Self);
1450 end;
1451 end;
1452 end;
1453 end;
1454 SynchListToOrders(ActiveList, SelectedList); // rehighlights
1455 if IsTransferAction then
1456 IsTransferAction := False;
1457 if XferOuttoInOnMeds then
1458 XferOuttoInOnMeds := False;
1459 if XfInToOutNow then
1460 XfInToOutNow := False;
1461 frmOrders.PtEvtCompleted(TempEvent.PtEventIFN,TempEvent.EventName,True);
1462 finally
[1679]1463 ActiveList.SetFocus;
[456]1464 FActionOnMedsTab := False;
1465 uAutoAC := False;
1466 SelectedList.Free;
1467 CopyIFNList.Free;
1468 end;
1469end;
1470
1471procedure TfrmMeds.mnuActNewClick(Sender: TObject);
1472{ new med orders dependent on order dialog for inpatient or outpatient }
1473{ similar to lstWriteClick on fOrders}
1474var
1475 DialogInfo: string;
1476 DelayEvent: TOrderDelayEvent;
1477begin
1478 inherited;
1479 DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders
1480 DelayEvent.Specialty := 0;
1481 DelayEvent.EventIFN := 0;
1482 DelayEvent.Effective := 0;
1483 frmOrders.DontCheck := True;
1484 frmOrders.lstSheets.ItemIndex := 0;
1485 frmOrders.lstSheetsClick(self);
1486 frmOrders.DontCheck := False;
1487 if not ReadyForNewOrder(DelayEvent) then Exit;
1488 frmOrders.DontCheck := True;
1489 frmOrders.lstSheets.ItemIndex := 0;
1490 frmOrders.lstSheetsClick(self);
1491 frmOrders.DontCheck := False;
1492 { get appropriate form, create the dialog form and show it }
1493 DialogInfo := GetNewDialog; // DialogInfo = DlgIEN;FormID;DGroup
1494 case CharAt(Piece(DialogInfo, ';', 4), 1) of
1495 'A': ActivateAction( Piece(DialogInfo, ';', 1), Self, 0);
1496 'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1497 'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1498 'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1499 else InfoBox('Unsupported dialog type', 'Error', MB_OK);
1500 end; {case}
1501end;
1502
1503procedure TfrmMeds.mnuActRefillClick(Sender: TObject);
1504{ for selected orders, present refill dialog }
1505var
1506 ActiveList: TListBox;
1507 SelectedList: TList;
1508begin
1509 inherited;
1510 ActiveList := ListSelected(TX_NOSEL);
1511 if ActiveList = nil then Exit;
1512 SelectedList := TList.Create;
1513 if CheckMedStatus(ActiveList) = True then Exit;
1514 try
1515 FIterating := True;
1516 if AuthorizedUser and EncounterPresent and LockedForOrdering then
1517 begin
1518 ValidateSelected(ActiveList, OA_REFILL, TX_NO_REFILL, TC_NO_REFILL);
1519 MakeSelectedList(ActiveList, SelectedList);
1520 if ExecuteRefillOrders(SelectedList) then
1521 begin
1522 ResetSelectedForList(ActiveList);
1523 SynchListToOrders(ActiveList, SelectedList);
1524 end;
1525 end;
1526 finally
[1679]1527 ActiveList.SetFocus;
[456]1528 FIterating := False;
1529 SelectedList.Free;
1530 UnlockIfAble;
1531 end;
1532end;
1533
1534{ Action utilities --------------------------------------------------------------------------- }
1535
1536function TfrmMeds.ListSelected(const ErrMsg: string): TListBox;
1537{ return selected listbox - inpatient or outpatient }
1538begin
1539 Result := nil;
1540 if lstMedsOut.SelCount > 0 then Result := lstMedsOut
1541 else if lstMedsIn.SelCount > 0 then Result := lstMedsIn
1542 else if lstMedsNonVA.SelCount > 0 then Result := lstMedsNonVA;
1543 if Result = nil then InfoBox(ErrMsg, TC_NOSEL, MB_OK);
1544end;
1545
1546procedure TfrmMeds.ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string);
1547{ loop to validate action on each selected med order, deselect if not valid }
1548var
1549 i: Integer;
1550 OrderText, CurID: string;
1551 ErrMsg, AParentID: string;
1552 CheckedList,SomePharmacyOrders: TStringList;
1553 ChildOrder: TChildOD;
1554begin
1555 CheckedList := TStringList.Create;
1556 SomePharmacyOrders := GetPharmacyOrders(AListBox);
1557 with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then
1558 begin
1559 if (AnAction = 'RN') and (pos('Active',AListBox.Items[i])>0) and (AListBox.name = 'lstMedsIn') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then
1560 begin
1561 Selected[i] := False;
1562 MessageDlg('You cannot renew inpatient medication orders from a clinic location for selected patient.', mtWarning, [mbOK], 0);
1563 end;
1564 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
1565 if Length(CurID) > 0
1566 then CurID := Piece(CurID, U, 2)
1567 else CurID := Piece(SomePharmacyOrders[i], U, 2);
1568 ValidateOrderAction(CurID, AnAction, ErrMsg);
1569 if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(CurID) then
1570 begin
1571 InfoBox(AListBox.Items[i] + #13+ WarningMsg + ErrMsg, WarningTitle, MB_OK);
1572 Selected[i] := False;
1573 Continue;
1574 end;
1575 AParentID := '';
1576 if not IsValidActionOnComplexOrder(CurID, AnAction, AListBox, CheckedList,ErrMsg,AParentID) then
1577 Selected[i] := False;
1578 if Length(AParentID)>0 then
1579 begin
1580 if ChildODList.IndexOf(CurID)< 0 then
1581 begin
1582 ChildOrder := TChildOD.Create;
1583 ChildOrder.ChildID := CurId;
1584 ChildOrder.ParentID := AParentID;
1585 ChildODList.AddObject(CurID, ChildOrder);
1586 end;
1587 end;
1588 if Length(ErrMsg) > 0 then
1589 begin
1590 OrderText := TextForOrder(Piece(SomePharmacyOrders[i], U, 2));
1591 InfoBox(OrderText + WarningMsg + ErrMsg, WarningTitle, MB_OK);
1592 Selected[i] := False;
1593 end;
1594 if Selected[i] and (not OrderIsLocked(CurID, AnAction)) then Selected[i] := False;
1595 end;
1596end;
1597
1598procedure TfrmMeds.MakeSelectedList(AListBox: TListBox; AList: TList; ActName: string);
1599{ make a list of selected med orders }
1600var
1601 i,idx: Integer;
1602 AnOrder: TOrder;
1603 CurID,x: string;
1604 SomePharmacyOrders: TStringList;
1605 TempList: TStringList;
1606begin
1607 SomePharmacyOrders := GetPharmacyOrders(AListBox);
1608 TempList := TStringList.Create;
1609 AList.Clear;
1610 with AListBox do for i := 0 to Items.Count - 1 do
1611 if Selected[i] then
1612 begin
1613 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
1614 if Length(CurID) > 0
1615 then CurID := Piece(CurID, U, 2)
1616 else CurID := Piece(SomePharmacyOrders[i], U, 2);
1617 AnOrder := GetOrderByIFN(CurID);
1618 if ActName = 'Transfer' then //imo
1619 begin
1620 if (AnOrder.DGroup = ClinDisp) then //imo
1621 begin
[1679]1622 x := AnOrder.Text + #13#10 + 'Clinic medication orders can not be transferred';
[456]1623 if ShowMsgOn(Length(x) > 0, x, 'Unable to transfer.') then
1624 begin
1625 AListBox.Selected[i] := False;
1626 Continue;
1627 end
1628 end;
1629 end;
1630 idx := ChildODList.IndexOf(AnOrder.ID);
1631 if idx > - 1 then
1632 AnOrder.ParentID := TChildOD(ChildODList.Objects[idx]).ParentID;
1633 if TempList.IndexOf(AnOrder.ID)= -1 then
1634 begin
1635 AList.Add(AnOrder);
1636 TempList.Add(AnOrder.ID);
1637 end;
1638 end;
1639 TempList.Clear;
1640end;
1641
1642procedure TfrmMeds.SynchListToOrders(AListBox: TListBox; AList: TList);
1643begin
1644 AListBox.Invalidate;
1645end;
1646
1647procedure TfrmMeds.popMedPopup(Sender: TObject);
1648begin
1649 inherited;
[830]1650 //if PatientStatusChanged then exit;
[456]1651end;
1652
1653procedure TfrmMeds.mnuViewClick(Sender: TObject);
1654begin
1655 inherited;
[830]1656 //if PatientStatusChanged then exit;
[456]1657end;
1658
1659procedure TfrmMeds.lstMedsNonVAClick(Sender: TObject);
1660var
1661 i: integer;
1662begin
1663 inherited;
[830]1664 //if PatientStatusChanged then exit;
[456]1665 with lstMedsIn do for i := 0 to Items.Count -1 do
1666 Selected[i] := false;
1667 with lstMedsOut do for i := 0 to Items.Count -1 do
1668 Selected[i] := false;
1669end;
1670
1671procedure TfrmMeds.lstMedsNonVADblClick(Sender: TObject);
1672begin
1673 inherited;
1674 mnuViewDetailClick(Self);
1675end;
1676
1677procedure TfrmMeds.lstMedsNonVAExit(Sender: TObject);
1678begin
1679 inherited;
1680 if not FIterating then ResetSelectedForList(TListBox(Sender));
1681end;
1682
[830]1683procedure TfrmMeds.lstMedsNonVARightClickHandler(var Msg: TMessage;
1684 var Handled: Boolean);
1685begin
1686 if Msg.Msg = WM_RBUTTONUP then
1687 begin
1688 lstMedsNonVA.RightClickSelect := (lstMedsNonVA.SelCount < 1);
1689 lstMedsNonVAClick(lstMedsNonVA);
1690 end;
1691end;
1692
[456]1693procedure TfrmMeds.hdrMedsNonVASectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1694begin
1695 inherited;
1696 RedrawSuspend(Self.Handle);
1697 with lstMedsNonVA do
1698 begin
1699 IntegralHeight := not IntegralHeight; // both lines are necessary, this forces the
1700 IntegralHeight := not IntegralHeight; // listbox window to be recreated
1701 end;
1702 RedrawActivate(Self.Handle);
1703 lstMedsNonVA.Invalidate;
1704 Refresh;
1705end;
1706
1707function FontChanged : boolean;
1708//CQ9182: SEE ALSO procedure TfrmFrame.mnuFontSizeClick()
1709begin
1710 Result := false;
1711 if Assigned(frmMeds) then
1712 begin
1713 if fMeds.oldFont = 0 then Result := False
1714 else
1715 if (fMeds.oldFont <> MainFontSize) then
1716 Result := true;
1717 end;
1718end;
1719
1720procedure TfrmMeds.FormResize(Sender: TObject);
1721var
1722 maxPanelHeight: integer;
1723
1724begin
1725 inherited;
1726 if Assigned(frmMeds) then
1727 begin
1728 //CQ9522 v26.51 Make sure all three panels are visible regardless of font size
1729 if Assigned(self.Parent) then
1730 begin
1731 if self.Height > parent.ClientHeight then
1732 self.Height := parent.ClientHeight;
1733 maxPanelHeight := round((parent.ClientHeight-20)/3);
1734 if pnlTop.Height + pnlBottom.Height > parent.ClientHeight then
1735 begin
1736 pnlBottom.Height := maxPanelHeight*2;
1737 pnlTop.Height := maxPanelHeight;
1738 end;
1739 end; //assigned(self.parent)
1740 end;
1741end;
1742
1743{ TChildOD }
1744
1745constructor TChildOD.Create;
1746begin
1747 ChildID := '';
1748 ParentID := '';
1749end;
1750
1751procedure TfrmMeds.hdrMedsOutResize(Sender: TObject);
1752begin
1753 inherited;
1754 with hdrMedsOut do
1755 begin
1756 Height := TextHeightByFont(Font.Handle, Sections[0].Text);
1757 Invalidate;
1758 end;
1759end;
1760
1761procedure TfrmMeds.hdrMedsNonVAResize(Sender: TObject);
1762begin
1763 inherited;
1764 with hdrMedsNonVA do
1765 begin
1766 Height := TextHeightByFont(Font.Handle, Sections[0].Text);
1767 Invalidate;
1768 end;
1769end;
1770
1771procedure TfrmMeds.hdrMedsInResize(Sender: TObject);
1772begin
1773 inherited;
1774 with hdrMedsIn do
1775 begin
1776 Height := TextHeightByFont(Font.Handle, Sections[0].Text);
1777 Invalidate;
1778 end;
1779end;
1780
1781procedure TfrmMeds.FormShow(Sender: TObject);
1782begin
1783 inherited;
1784 frmMeds.FormResize(Sender);
1785end;
1786
1787procedure TfrmMeds.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1788begin
1789 inherited;
1790 frmMeds.FormResize(Sender);
1791end;
1792
1793procedure TfrmMeds.splitBottomMoved(Sender: TObject);
1794begin
1795 inherited;
1796 splitBottom.Height := 5;
1797end;
1798
1799procedure TfrmMeds.splitTopMoved(Sender: TObject);
1800begin
1801 inherited;
1802 splitTop.Height := 5;
1803end;
1804
1805procedure TfrmMeds.InitfMedsSize;
1806var
1807 retList : TStringList;
1808 strSizeFlds,x: string;
1809 i: integer;
1810 medsSplitFnd : boolean;
1811 panelBottom, panelMedIn : integer;
1812begin
1813 //CQ3229
1814 //DETECT 1st TIME USER.
1815 //If first time user (medSplitFound=false), then manually set panel heights.
1816 //if NOT first time user (medSplitFound=true), then set Meds tab windows to saved settings.
1817 medsSplitFnd := FALSE;
1818 if Assigned(frmMeds) then
1819 begin
1820 retList := TStringList.Create;
1821 tCallV(retList, 'ORWCH LOADALL', [nil]);
1822
1823 for i := 0 to retList.Count-1 do
1824 begin
1825 x := retList.strings[i];
1826 if strPos(PChar(x),PChar(MEDS_SPLIT_FORM)) <> nil then
1827 begin
1828 medsSplitFnd := TRUE;
1829 Break;
1830 end;
1831 end;
1832
1833 if not medsSplitFnd then
1834 begin
1835 pnlBottom.Height := frmMeds.Height div 2;
1836 pnlMedIn.Height := pnlBottom.Height div 2;
1837 panelBottom := pnlBottom.Height;
1838 panelMedIn := pnlMedIn.Height;
1839 strSizeFlds := IntToStr(panelBottom) + ',' + IntToStr(panelMedIn) + ',' + '0' + ',' + '0';
1840 CallV('ORWCH SAVESIZ', [MEDS_SPLIT_FORM, strSizeFlds]);
1841 end;
1842 end;
1843
1844end;
1845
[830]1846{function TfrmMeds.PatientStatusChanged: boolean;
[456]1847const
1848
1849 msgTxt1 = 'Patient status was changed from ';
1850 msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.';
1851 //GE CQ9537 - Change message text
1852 msgTxt3 = 'Patient has been admitted.';
1853 msgTxt4 = CRLF +'You will be prompted to sign your orders. Any new orders subsequently' +
1854 CRLF + 'entered and signed will be directed to the inpatient staff.';
1855
1856var
1857 PtSelect: TPtSelect;
1858 IsInpatientNow: boolean;
1859 ptSts: string;
1860begin
1861 result := False;
1862 SelectPatient(Patient.DFN, PtSelect);
1863 IsInpatientNow := Length(PtSelect.Location) > 0;
1864 //GE CQ9537 - Change message text
1865 if Patient.Inpatient <> IsInpatientNow then
1866 begin
1867 if (not Patient.Inpatient) then MessageDlg(msgTxt3 + msgTxt4, mtWarning, [mbOK], 0);
1868 if Patient.Inpatient then ptSts := 'Inpatient to Outpatient.';
1869 MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0);
1870 frmFrame.mnuFileRefreshClick(Application);
1871 Result := True;
1872 end;
[830]1873end;}
[456]1874
1875function TfrmMeds.GetTotalSectionsWidth(Sender: TObject) : integer;
1876//CQ7586
1877//Return stored values of column widths
1878var
1879 i: integer;
1880begin
1881 Result := 0;
1882
1883 if (Sender as THeaderControl).Name = 'hdrMedsOut' then
1884 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1885 Result := Result + hdrMedsOut.Sections[i].Width;
1886
1887 if (Sender as THeaderControl).Name = 'hdrMedsIn' then
1888 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1889 Result := Result + hdrMedsIn.Sections[i].Width;
1890
1891 if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then
1892 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1893 Result := Result + hdrMedsNonVA.Sections[i].Width;
1894end;
1895
1896procedure TfrmMeds.SetSectionWidths(Sender: TObject);
1897//CQ7586
1898//Copy values of column widths into array variables.
1899var
1900 i: integer;
1901begin
1902 if (Sender as THeaderControl).Name = 'hdrMedsOut' then
1903 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1904 OrigOutPtSecWidths[i] := hdrMedsOut.Sections[i].Width;
1905
1906 if (Sender as THeaderControl).Name = 'hdrMedsIn' then
1907 for i := 0 to hdrMedsIn.Sections.Count - 1 do
1908 OrigInPtSecWidths[i] := hdrMedsIn.Sections[i].Width;
1909
1910 if (Sender as THeaderControl).Name = 'hdrMedsNonVA' then
1911 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1912 OrigNonVASecWidths[i] := hdrMedsNonVA.Sections[i].Width;
1913end;
1914
[830]1915procedure TfrmMeds.SetViewCaption(Caption: String);
1916begin
1917 txtView.Caption := StringReplace(Caption,'&','',[rfReplaceAll]);
1918end;
1919
[456]1920procedure TfrmMeds.hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1921begin
1922 inherited;
1923 Self.SetSectionWidths(Sender); //CQ7586
1924end;
1925
1926procedure TfrmMeds.hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1927begin
1928 inherited;
1929 Self.SetSectionWidths(Sender); //CQ7586
1930end;
1931
1932procedure TfrmMeds.hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1933begin
1934 inherited;
1935 Self.SetSectionWidths(Sender); //CQ7586
1936end;
1937
1938procedure TfrmMeds.hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1939//CQ7586
1940var
1941 i: integer;
1942 totalSectionsWidth, originalwidth: integer;
1943begin
1944 inherited;
1945 totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
1946 if totalSectionsWidth > lstMedsOut.Width - 5 then //could used any of the three list boxes here, since all are same width
1947 begin
1948 originalwidth := 0;
1949 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1950 originalwidth := originalwidth + OrigOutPtSecWidths[i];
1951 if originalwidth < totalSectionsWidth then
1952 begin
1953 for i := 0 to hdrMedsOut.Sections.Count - 1 do
1954 hdrMedsOut.Sections[i].Width := OrigOutPtSecWidths[i];
1955 lstMedsOut.Invalidate;
1956 end;
1957 end;
1958 //CQ9622
1959 if hdrMedsOut.Sections[1].Width < 100 then
1960 begin
1961 hdrMedsOut.Sections[1].Width := 100;
1962 lstMedsOut.Refresh;
1963 end;
1964 //end CQ9622
1965 pnlBottom.Height := pnlBottom.Height - 1; // forces autopanel resize
1966 pnlBottom.Height := pnlBottom.Height + 1; // forces autopanel resize
1967end;
1968
1969procedure TfrmMeds.hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1970//CQ7586
1971var
1972 i: integer;
1973 totalSectionsWidth, originalwidth: integer;
1974begin
1975 inherited;
1976 totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
1977 if totalSectionsWidth > lstMedsNonVA.Width - 5 then //could used any of the three list boxes here, since all are same width
1978 begin
1979 originalwidth := 0;
1980 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1981 originalwidth := originalwidth + OrigNonVASecWidths[i];
1982 if originalwidth < totalSectionsWidth then
1983 begin
1984 for i := 0 to hdrMedsNonVA.Sections.Count - 1 do
1985 hdrMedsNonVA.Sections[i].Width := OrigNonVASecWidths[i];
1986 lstMedsNonVA.Invalidate;
1987 end;
1988 end;
1989 //CQ9622
1990 if hdrMedsNonVA.Sections[1].Width < 100 then
1991 begin
1992 hdrMedsNonVA.Sections[1].Width := 100;
1993 lstMedsNonVA.Refresh;
1994 end;
1995 //end CQ9622
1996 pnlNonVA.Height := pnlNonVA.Height - 1; // forces autopanel resize
1997 pnlNonVA.Height := pnlNonVA.Height + 1; // forces autopanel resize
1998end;
1999
2000procedure TfrmMeds.hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2001//CQ7586
2002var
2003 i: integer;
2004 totalSectionsWidth, originalwidth: integer;
2005begin
2006 inherited;
2007 totalSectionsWidth := Self.GetTotalSectionsWidth(Sender);
2008 if totalSectionsWidth > lstMedsIn.Width - 5 then //could used any of the three list boxes here, since all are same width
2009 begin
2010 originalwidth := 0;
2011 for i := 0 to hdrMedsIn.Sections.Count - 1 do
2012 originalwidth := originalwidth + OrigInPtSecWidths[i];
2013 if originalwidth < totalSectionsWidth then
2014 begin
2015 for i := 0 to hdrMedsIn.Sections.Count - 1 do
2016 hdrMedsIn.Sections[i].Width := OrigInPtSecWidths[i];
2017 lstMedsIn.Invalidate;
2018 end;
2019 end;
2020 //CQ9622
2021 if hdrMedsIn.Sections[1].Width < 100 then
2022 begin
2023 hdrMedsIn.Sections[1].Width := 100;
2024 lstMedsIn.Refresh;
2025 end;
2026 //end CQ9622
2027 pnlBottom.Height := pnlBottom.Height - 1; // forces autopanel resize
2028 pnlBottom.Height := pnlBottom.Height + 1; // forces autopanel resize
2029end;
2030
2031procedure TfrmMeds.ClearChildODList;
2032var
2033 i: integer;
2034begin
2035 for i := 0 to ChildODList.count-1 do
2036 if(assigned(ChildODList.Objects[i])) then
2037 ChildODList.Objects[i].Free;
2038 ChildODList.Clear;
2039end;
2040
2041function TfrmMeds.CheckMedStatus(ActiveList: TListBox): boolean;
2042var
2043i: integer;
2044tmpList: TStringList;
2045Str: string;
2046AMed: TMedListRec;
2047AMedList: TList;
2048
2049begin
2050 result := False;
2051 tmpList:= TStringList.Create;
2052 if TMedListRec = nil then exit;
2053 AMedList := GetMedList(ActiveList);
2054 for i := 0 to ActiveList.Count - 1 do if ActiveList.Selected[i] then
2055 begin
2056 AMed := TMedListRec(AMedList[i]);
2057 str := Amed.PharmID + U + AMed.Status;
2058 tmpList.Add(Str);
2059 end;
2060 if tmpList <> nil then
2061 begin
2062 Result := GetMedStatus(tmpList);
2063 tmpList.Free;
2064 end;
2065 if Result = True then
2066 begin
2067 MessageDlg('The Medication status has change.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct medication status', mtWarning, [mbOK], 0);
2068 frmFrame.mnuFileRefreshClick(Application);
2069 end;
2070end;
2071
[830]2072procedure TfrmMeds.ActivateDeactiveRenew(AListBox: TListBox);
[456]2073var
2074 i: Integer;
2075 CurID: string;
2076 SomePharmacyOrders: TStringList;
2077 tmpArr: TStringList;
2078begin
2079 tmpArr := TStringList.Create;
2080 SomePharmacyOrders := GetPharmacyOrders(AListBox);
2081 with AListBox do for i := 0 to Items.Count - 1 do if Selected[i] then
2082 begin
2083 CurID := uPendingChanges.Values[Piece(Piece(SomePharmacyOrders[i], U, 2), ';', 1)];
2084 if Length(CurID) > 0 then CurID := Piece(CurID, U, 2)
2085 else CurID := Piece(SomePharmacyOrders[i], U, 2);
2086 tmpArr.Add(curID);
2087 end;
2088 if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr, AListBox);
[830]2089end;
[456]2090
2091procedure TfrmMeds.ViewInfo(Sender: TObject);
2092begin
2093 inherited;
2094 frmFrame.ViewInfo(Sender);
2095end;
2096
2097procedure TfrmMeds.mnuViewInformationClick(Sender: TObject);
2098begin
2099 inherited;
2100 mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
2101 mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
2102 mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
2103 mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
2104 mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
2105 mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
2106 mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
2107 mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
2108 mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
2109end;
2110
2111procedure TfrmMeds.mnuOptimizeFieldsClick(Sender: TObject);
2112var
2113 totalSectionsWidth, unit1, unit2, unit8: integer;
2114begin
2115 totalSectionsWidth := pnlTop.Width - 5;
2116 if totalSectionsWidth < 16 then exit;
2117 unit1 := (totalSectionsWidth div 16) - 1;
2118 unit2 := unit1 * 2;
2119 unit8 := unit1 * 8;
2120
2121 with hdrMedsNonVA do
2122 begin
2123 Sections[0].Width := unit1;
2124 Sections[1].Width := unit8;
2125 Sections[2].Width := unit2;
2126 Sections[3].Width := unit2;
2127 end;
2128 hdrMedsNonVASectionResize(hdrMedsNonVA, hdrMedsNonVA.Sections[0]);
2129 hdrMedsNonVA.Repaint;
2130
2131 with hdrMedsIn do
2132 begin
2133 Sections[0].Width := unit1;
2134 Sections[1].Width := unit8;
2135 Sections[2].Width := unit2;
2136 Sections[3].Width := unit2;
2137 Sections[4].Width := unit2;
2138 end;
2139 hdrMedsInSectionResize(hdrMedsIn, hdrMedsIn.Sections[0]);
2140 hdrMedsIn.Repaint;
2141 with hdrMedsOut do
2142 begin
2143 Sections[0].Width := unit1;
2144 Sections[1].Width := unit8;
2145 Sections[2].Width := unit2;
2146 Sections[3].Width := unit2;
2147 Sections[4].Width := unit2;
2148 Sections[5].Width := unit1;
2149 end;
2150 hdrMedsOutSectionResize(hdrMedsOut, hdrMedsOut.Sections[0]);
2151 hdrMedsOut.Repaint;
2152end;
2153
2154procedure TfrmMeds.hdrMedsOutSectionClick(HeaderControl: THeaderControl;
2155 Section: THeaderSection);
2156begin
2157 inherited;
2158 //if Section = hdrMedsOut.Sections[1] then
2159 mnuOptimizeFieldsClick(self);
2160end;
2161
2162procedure TfrmMeds.hdrMedsNonVASectionClick(HeaderControl: THeaderControl;
2163 Section: THeaderSection);
2164begin
2165 inherited;
2166 //if Section = hdrMedsNonVA.Sections[1] then
2167 mnuOptimizeFieldsClick(self);
2168end;
2169
2170procedure TfrmMeds.hdrMedsInSectionClick(HeaderControl: THeaderControl;
2171 Section: THeaderSection);
2172begin
2173 inherited;
2174 //if Section = hdrMedsIn.Sections[1] then
2175 mnuOptimizeFieldsClick(self);
2176end;
2177
[830]2178procedure TfrmMeds.SortbyStatusthenLocation1Click(Sender: TObject);
2179begin
2180 inherited;
2181 self.FSortView := 1;
2182 self.RefreshMedLists;
2183end;
2184
2185procedure TfrmMeds.SortbyClinicOrderthenStatusthenStopDate1Click(
2186 Sender: TObject);
2187begin
2188 inherited;
2189 self.FSortView := 2;
2190 self.RefreshMedLists;
2191end;
2192
2193procedure TfrmMeds.SortbyDrugalphabeticallystatusactivestatusrecentexpired1Click(
2194 Sender: TObject);
2195begin
2196 inherited;
2197 self.FSortView := 3;
2198 self.RefreshMedLists;
2199end;
2200
2201initialization
2202 SpecifyFormIsNotADialog(TfrmMeds);
2203
[456]2204end.
2205
Note: See TracBrowser for help on using the repository browser.