Context Navigation

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

Last change on this file since 840 was 830, checked in by Kevin Toppenberg, 14 years ago
Upgrading to version 27
File size: 71.4 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: