source: cprs/branches/tmg-cprs/CPRS-Chart/fMeds.pas.bak@ 1806

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

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