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

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

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