Module

fMeds

Path

C:\CPRS\CPRS30\fMeds.pas

Last Modified

7/15/2014 3:26:38 PM

Comments

REMOVE AFTER UNIT IS DEBUGGED

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmMeds);

end.

Units Used in Interface

Name Comments
fBase508Form -
fPage -
rMeds -
rOrders -
uConst -

Units Used in Implementation

Name Comments
fActivateDeactivate -
fFrame -
fMedCopy -
fODBase -
fODChild -
fOMNavA -
fOrders -
fOrdersDC -
fOrdersHold -
fOrdersRefill -
fOrdersRenew -
fOrdersUnhold -
fRptBox -
rCore -
rODBase -
uCore -
uOrders -

Classes

Name Comments
TChildOD -
TfrmMeds -

Procedures

Name Owner Declaration Scope Comments
ActivateDeactiveRenew TfrmMeds procedure ActivateDeactiveRenew(AListBox: TListBox); Public/Published -
ClearChildODList TfrmMeds procedure ClearChildODList; Private Function PatientStatusChanged: boolean;
ClearPtData TfrmMeds procedure ClearPtData; override; Public TPage common methods ---------------------------------------------------------------------
DisplayPage TfrmMeds procedure DisplayPage; override; Public -
FormCreate TfrmMeds procedure FormCreate(Sender: TObject); Public/Published Form events ------------------------------------------------------------------------------
FormDestroy TfrmMeds procedure FormDestroy(Sender: TObject); Public/Published -
FormMouseUp TfrmMeds procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
FormResize TfrmMeds procedure FormResize(Sender: TObject); Public/Published -
FormShow TfrmMeds procedure FormShow(Sender: TObject); Public/Published -
hdrMedsInMouseDown TfrmMeds procedure hdrMedsInMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
hdrMedsInMouseUp TfrmMeds procedure hdrMedsInMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published CQ7586
hdrMedsInResize TfrmMeds procedure hdrMedsInResize(Sender: TObject); Public/Published -
hdrMedsInSectionClick TfrmMeds procedure hdrMedsInSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
hdrMedsInSectionResize TfrmMeds procedure hdrMedsInSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
hdrMedsNonVAMouseDown TfrmMeds procedure hdrMedsNonVAMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
hdrMedsNonVAMouseUp TfrmMeds procedure hdrMedsNonVAMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published CQ7586
hdrMedsNonVAResize TfrmMeds procedure hdrMedsNonVAResize(Sender: TObject); Public/Published -
hdrMedsNonVASectionClick TfrmMeds procedure hdrMedsNonVASectionClick(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
hdrMedsNonVASectionResize TfrmMeds procedure hdrMedsNonVASectionResize(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
hdrMedsOutMouseDown TfrmMeds procedure hdrMedsOutMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
hdrMedsOutMouseUp TfrmMeds procedure hdrMedsOutMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published CQ7586
hdrMedsOutResize TfrmMeds procedure hdrMedsOutResize(Sender: TObject); Public/Published -
hdrMedsOutSectionClick TfrmMeds procedure hdrMedsOutSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
hdrMedsOutSectionResize TfrmMeds procedure hdrMedsOutSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
InitfMedsSize TfrmMeds procedure InitfMedsSize; Public -
lstMedsDblClick TfrmMeds procedure lstMedsDblClick(Sender: TObject); Public/Published -
lstMedsDrawItem TfrmMeds procedure lstMedsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
lstMedsExit TfrmMeds procedure lstMedsExit(Sender: TObject); Public/Published -
lstMedsInClick TfrmMeds procedure lstMedsInClick(Sender: TObject); Public/Published -
lstMedsInRightClickHandler TfrmMeds procedure lstMedsInRightClickHandler(var Msg: TMessage; var Handled: Boolean); Private -
lstMedsMeasureItem TfrmMeds procedure lstMedsMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); Public/Published -
lstMedsNonVAClick TfrmMeds procedure lstMedsNonVAClick(Sender: TObject); Public/Published -
lstMedsNonVADblClick TfrmMeds procedure lstMedsNonVADblClick(Sender: TObject); Public/Published -
lstMedsNonVAExit TfrmMeds procedure lstMedsNonVAExit(Sender: TObject); Public/Published -
lstMedsNonVARightClickHandler TfrmMeds procedure lstMedsNonVARightClickHandler(var Msg: TMessage; var Handled: Boolean); Private -
lstMedsOutClick TfrmMeds procedure lstMedsOutClick(Sender: TObject); Public/Published -
lstMedsOutRightClickHandler TfrmMeds procedure lstMedsOutRightClickHandler(var Msg: TMessage; var Handled: Boolean); Private -
MakeSelectedList TfrmMeds procedure MakeSelectedList(AListBox: TListBox; AList: TList; ActName: String = ''); Private Make a list of selected med orders
mnuActChangeClick TfrmMeds procedure mnuActChangeClick(Sender: TObject); Public/Published
Loop thru selected med orders, present ordering dialog for each with defaults to selected order 
 similar to action on fOrders
mnuActClick TfrmMeds procedure mnuActClick(Sender: TObject); Public/Published Action menu events ----------------------------------------------------------------------
mnuActCopyClick TfrmMeds procedure mnuActCopyClick(Sender: TObject); Public/Published
Loop thru selected med orders, present ordering dialog for each with defaults to selected order 
 similar to action on fOrders
mnuActDCClick TfrmMeds procedure mnuActDCClick(Sender: TObject); Public/Published
Discontinue/cancel/delete the selected med orders as appropriate for each order 
 similar to action on fOrders
mnuActHoldClick TfrmMeds procedure mnuActHoldClick(Sender: TObject); Public/Published
Hold the selected med orders as appropriate for each order 
 similar to action on fOrders
mnuActNewClick TfrmMeds procedure mnuActNewClick(Sender: TObject); Public/Published
New med orders dependent on order dialog for inpatient or outpatient 
 similar to lstWriteClick on fOrders
mnuActRefillClick TfrmMeds procedure mnuActRefillClick(Sender: TObject); Public/Published For selected orders, present refill dialog
mnuActRenewClick TfrmMeds procedure mnuActRenewClick(Sender: TObject); Public/Published
Renew the selected med orders as appropriate for each order 
 similar to action on fOrders
mnuActUnholdClick TfrmMeds procedure mnuActUnholdClick(Sender: TObject); Public/Published -
mnuChartTabClick TfrmMeds procedure mnuChartTabClick(Sender: TObject); Public/Published -
mnuOptimizeFieldsClick TfrmMeds procedure mnuOptimizeFieldsClick(Sender: TObject); Public/Published -
mnuViewClick TfrmMeds procedure mnuViewClick(Sender: TObject); Public/Published -
mnuViewDetailClick TfrmMeds procedure mnuViewDetailClick(Sender: TObject); Public/Published View menu events -------------------------------------------------------------------------
mnuViewHistoryClick TfrmMeds procedure mnuViewHistoryClick(Sender: TObject); Public/Published -
mnuViewInformationClick TfrmMeds procedure mnuViewInformationClick(Sender: TObject); Public/Published -
NotifyOrder TfrmMeds procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override; Public -
popMedPopup TfrmMeds procedure popMedPopup(Sender: TObject); Public/Published -
RefreshMedLists TfrmMeds procedure RefreshMedLists; Public Listbox events ---------------------------------------------------------------------------
SetCurrentOrderID - procedure SetCurrentOrderID; Local -
SetFontSize TfrmMeds procedure SetFontSize( FontSize: integer); override; Public -
SetSectionWidths TfrmMeds procedure SetSectionWidths(Sender: TObject); Public
CQ7586
Copy values of column widths into array variables.
SetViewCaption TfrmMeds procedure SetViewCaption(Caption : String); Private -
SortbyClinicOrderthenStatusthenStopDate1Click TfrmMeds procedure SortbyClinicOrderthenStatusthenStopDate1Click( Sender: TObject); Public/Published -
SortbyDrugalphabeticallystatusactivestatusrecentexpired1Click TfrmMeds procedure SortbyDrugalphabeticallystatusactivestatusrecentexpired1Click( Sender: TObject); Public/Published -
SortbyStatusthenLocation1Click TfrmMeds procedure SortbyStatusthenLocation1Click(Sender: TObject); Public/Published -
splitBottomMoved TfrmMeds procedure splitBottomMoved(Sender: TObject); Public/Published -
splitTopMoved TfrmMeds procedure splitTopMoved(Sender: TObject); Public/Published -
SynchListToOrders TfrmMeds procedure SynchListToOrders(AListBox: TListBox; AList: TList); Private -
ValidateSelected TfrmMeds procedure ValidateSelected(AListBox: TListBox; const AnAction, WarningMsg, WarningTitle: string); Private Loop to validate action on each selected med order, deselect if not valid
ViewInfo TfrmMeds procedure ViewInfo(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
CheckMedStatus TfrmMeds function CheckMedStatus(ActiveList: TListBox): boolean; Public -
FontChanged - function FontChanged : boolean; Global -
GetActionText TfrmMeds function GetActionText(const AMed: TMedListRec): string; Private -
GetHeader TfrmMeds function GetHeader(Control: TWinControl): THeaderControl; Private -
GetInstructText TfrmMeds function GetInstructText(const AMed: TMedListRec; var Detail: string): string; Private -
GetListText TfrmMeds function GetListText(const AMed: TMedListRec; Column: integer; var Detail: string): string; Private -
GetMedList TfrmMeds function GetMedList(Control: TWinControl): TList; Private -
GetPharmacyOrders TfrmMeds function GetPharmacyOrders(Control: TWinControl): TStringList; Private -
GetPlainText TfrmMeds function GetPlainText(Control: TWinControl; Index: integer): string; Private -
GetTotalSectionsWidth TfrmMeds function GetTotalSectionsWidth(Sender: TObject) : integer; Public
Function TfrmMeds.PatientStatusChanged: boolean;
const

  msgTxt1 = 'Patient status was changed from ';
  msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.';
   //GE CQ9537  - Change message text
  msgTxt3 = 'Patient has been admitted.';
  msgTxt4 = CRLF +'You will be prompted to sign your orders.  Any new orders subsequently' +
            CRLF + 'entered and signed will be directed to the inpatient staff.';

var
  PtSelect: TPtSelect;
  IsInpatientNow: boolean;
  ptSts: string;
begin
  result := False;
  SelectPatient(Patient.DFN, PtSelect);
  IsInpatientNow := Length(PtSelect.Location) > 0;
   //GE CQ9537  - Change message text
  if Patient.Inpatient <> IsInpatientNow then
  begin
    if (not Patient.Inpatient) then MessageDlg(msgTxt3 + msgTxt4, mtWarning, [mbOK], 0);
    if Patient.Inpatient then ptSts := 'Inpatient to Outpatient.';
    MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0);
    frmFrame.mnuFileRefreshClick(Application);
    Result := True;
  end;
end;

CQ7586
Return stored values of column widths
IndexForCurrentID - function IndexForCurrentID(const AnID: string): Integer; Local -
ListSelected TfrmMeds function ListSelected(const ErrMsg: string): TListBox; Private
Action utilities --------------------------------------------------------------------------- 

 return selected listbox - inpatient or outpatient

Global Variables

Name Type Declaration Comments
frmMeds TfrmMeds frmMeds: TfrmMeds; -
LargePanelSize Integer LargePanelSize: integer; -
MedNonVAPanelSize Integer MedNonVAPanelSize: integer; -
MedOutSize Double MedOutSize: double; -
oldFont Integer oldFont: integer; CQ9182
OrigInPtSecWidths OrigInPtSecWidths : arOrigInPtSecWidths; CQ7586
OrigNonVASecWidths OrigNonVASecWidths: arOrigNonVASecWidths; CQ7586
OrigOutPtSecWidths OrigOutPtSecWidths: arOrigOutPtSecWidths;
LargePanelPortion: Integer;
  SmallPanelPortion: integer;

CQ7586
resizedMedInPanelHeight Extended resizedMedInPanelHeight: Extended; -
resizedMedOutPanelHeight Extended resizedMedOutPanelHeight: Extended; -
resizedNonVAPanelHeight Extended resizedNonVAPanelHeight: Extended; -
resizedTotalHeight Integer resizedTotalHeight: integer; -
s UnicodeString s: string; -
SmallPanelSize Integer SmallPanelSize : integer; -
splitterBottom TSplitter splitterBottom: TSplitter; -
splitterTop TSplitter splitterTop: TSplitter; -
totalHeight Integer totalHeight: integer; -

Constants

Name Declaration Scope Comments
COL_MEDNAME 1 Global -
DG_IMO 6 Global -
DG_IN 1 Global -
DG_IV 3 Global -
DG_NVA 5 Global -
DG_OUT 0 Global -
DG_TPN 4 Global -
DG_UD 2 Global -
FMT_INDENT 12 Global -
LARGE_PANEL 60 Global -
MEDS_SPLIT_FORM 'frmMedsSplit' Global -
SMALL_PANEL 20 Global -
TAG_INPT 2 Global -
TAG_NONVA 3 Global -
TAG_OUTPT 1 Global -
TC_NO_CHANGE 'Unable to Change Order' Global -
TC_NO_COPY 'Unable to Copy Order' Global -
TC_NO_DC 'Unable to Discontinue' Global -
TC_NO_HOLD 'Unable to Hold' Global -
TC_NO_REFILL 'Unable to Refill Order' Global -
TC_NO_RENEW 'Unable to Renew Order' Global -
TC_NO_UNHOLD 'Unable to Release from Hold' Global -
TC_NOSEL 'No Orders Selected' Global -
TX_NO_CHANGE CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_COPY CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_DC CRLF + CRLF + '- cannot be discontinued.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_HOLD CRLF + CRLF + '- cannot be placed on hold.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_REFILL CRLF + CRLF + '- cannot be refilled.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_RENEW CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_UNHOLD CRLF + CRLF + '- cannot be released from hold.' + CRLF + CRLF + 'Reason: ' Global -
TX_NOSEL 'No orders are highlighted. Highlight the orders' + CRLF + Global -


Module Source

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

Module Calls (2 levels)


fMeds
 ├fPage
 │ ├uConst
 │ ├rOrders
 │ ├fBase508Form
 │ ├fFrame
 │ └uInit
 ├rOrders...
 ├uConst
 ├rMeds
 │ ├uCore
 │ └uConst
 ├uCore...
 ├fFrame...
 ├fRptBox
 │ ├fFrame...
 │ ├fBase508Form...
 │ ├uReports
 │ └rReports
 ├uOrders
 │ ├uConst
 │ ├rConsults
 │ ├rOrders...
 │ ├fODBase
 │ ├XuDsigS
 │ ├fODDiet
 │ ├fODMisc
 │ ├fODGen
 │ ├fODMedIn
 │ ├fODMedOut
 │ ├fODText
 │ ├fODConsult
 │ ├fODProc
 │ ├fODRad
 │ ├fODLab
 │ ├fODBBank
 │ ├fODMeds
 │ ├fODMedIV
 │ ├fODVitals
 │ ├fODAuto
 │ ├fOMNavA
 │ ├rCore
 │ ├uCore...
 │ ├fFrame...
 │ ├fEncnt
 │ ├fOMVerify
 │ ├fOrderSaveQuick
 │ ├fOMSet
 │ ├rMisc
 │ ├uODBase
 │ ├rODMeds
 │ ├fLkUpLocation
 │ ├fOrdersPrint
 │ ├fOMAction
 │ ├fARTAllgy
 │ ├fOMHTML
 │ ├fOrders
 │ ├rODBase
 │ ├fODChild
 │ ├fMeds...
 │ ├rMeds...
 │ ├rPCE
 │ ├fRptBox...
 │ ├fODMedNVA
 │ ├fODChangeUnreleasedRenew
 │ ├rODAllergy
 │ ├UBAGlobals
 │ └uTemplateFields
 ├fODBase...
 ├fOrdersDC
 │ ├fBase508Form...
 │ ├rMisc...
 │ ├rOrders...
 │ ├uCore...
 │ ├uConst
 │ └fOrders...
 ├fOrdersHold
 │ ├fAutoSz
 │ ├rOrders...
 │ └uConst
 ├fOrdersUnhold
 │ ├fAutoSz...
 │ ├rOrders...
 │ └uConst
 ├fOrdersRenew
 │ ├fAutoSz...
 │ ├uConst
 │ ├rODMeds...
 │ ├uOrders...
 │ ├fOCAccept
 │ ├uODBase...
 │ ├rOrders...
 │ ├fDateRange
 │ ├fRenewOutMed
 │ ├uCore...
 │ ├rCore...
 │ ├rMisc...
 │ ├UBAGlobals...
 │ └fFrame...
 ├fOrdersRefill
 │ ├fAutoSz...
 │ ├rOrders...
 │ ├rMeds...
 │ ├uConst
 │ └rMisc...
 ├fMedCopy
 │ ├rOrders...
 │ ├uCore...
 │ ├rCore...
 │ ├mEvntDelay
 │ ├uConst
 │ ├fBase508Form...
 │ ├fODBase...
 │ └fOrders...
 ├fOrders...
 ├rODBase...
 └fActivateDeactivate
   ├fAutoSz...
   ├fOrders...
   ├rOrders...
   └rMeds...

Module Called-By (2 levels)


                       fMeds
                   uOrders┤ 
                   uCore┤ │ 
                 fODBase┤ │ 
                 rODBase┤ │ 
                  fFrame┤ │ 
                 fOrders┤ │ 
             fOrdersSign┤ │ 
                fMeds...┤ │ 
               fARTAllgy┤ │ 
                  fNotes┤ │ 
               fConsults┤ │ 
         fReminderDialog┤ │ 
                 fReview┤ │ 
            fOrdersRenew┤ │ 
               fOrdersCV┤ │ 
                 fODMeds┤ │ 
                 fOMNavA┤ │ 
         fOrderSaveQuick┤ │ 
                  fOMSet┤ │ 
          fOrdersRelease┤ │ 
                 fOMHTML┤ │ 
               fODMedNVA┤ │ 
fODChangeUnreleasedRenew┤ │ 
          fOrdersOnChart┤ │ 
         fODReleaseEvent┤ │ 
               fODActive┘ │ 
                 fFrame...┤ 
                fOrders...┤ 
             fOptionsOther┘ 
                fOptions┘