Context Navigation

source: cprs/trunk/CPRS-Chart/Orders/fOrders.pas@ 1068

Last change on this file since 1068 was 829, checked in by Kevin Toppenberg, 14 years ago
Upgrade to version 27
File size: 123.9 KB

Rev	Line
[456]	1	unit fOrders;
	2
	3	{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
	4
	5	interface
	6
	7	uses
	8	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fHSplit, StdCtrls,
	9	ExtCtrls, Menus, ORCtrls, ComCtrls, ORFn, rOrders, fODBase, uConst, uCore, uOrders,UBACore,
[829]	10	UBAGlobals, VA508AccessibilityManager, fBase508Form;
[456]	11
	12	type
	13	TfrmOrders = class(TfrmHSplit)
	14	mnuOrders: TMainMenu;
	15	mnuAct: TMenuItem;
	16	mnuActChange: TMenuItem;
	17	mnuActDC: TMenuItem;
	18	mnuActHold: TMenuItem;
	19	mnuActUnhold: TMenuItem;
	20	mnuActRenew: TMenuItem;
	21	Z4: TMenuItem;
	22	mnuActFlag: TMenuItem;
	23	mnuActUnflag: TMenuItem;
	24	Z5: TMenuItem;
	25	mnuActVerify: TMenuItem;
	26	mnuActRelease: TMenuItem;
	27	mnuActSign: TMenuItem;
	28	mnuView: TMenuItem;
	29	mnuViewChart: TMenuItem;
	30	mnuChartReports: TMenuItem;
	31	mnuChartLabs: TMenuItem;
	32	mnuChartDCSumm: TMenuItem;
	33	mnuChartCslts: TMenuItem;
	34	mnuChartNotes: TMenuItem;
	35	mnuChartOrders: TMenuItem;
	36	mnuChartMeds: TMenuItem;
	37	mnuChartProbs: TMenuItem;
	38	mnuChartCover: TMenuItem;
	39	mnuViewActive: TMenuItem;
	40	mnuViewExpiring: TMenuItem;
	41	Z2: TMenuItem;
	42	mnuViewCustom: TMenuItem;
	43	Z3: TMenuItem;
	44	mnuViewDetail: TMenuItem;
	45	Z1: TMenuItem;
	46	OROffsetLabel1: TOROffsetLabel;
	47	hdrOrders: THeaderControl;
	48	lstOrders: TCaptionListBox;
	49	lblOrders: TOROffsetLabel;
	50	lstSheets: TORListBox;
	51	lstWrite: TORListBox;
	52	mnuViewUnsigned: TMenuItem;
	53	popOrder: TPopupMenu;
	54	popOrderChange: TMenuItem;
	55	popOrderDC: TMenuItem;
	56	popOrderRenew: TMenuItem;
	57	popOrderDetail: TMenuItem;
	58	N1: TMenuItem;
	59	mnuActCopy: TMenuItem;
	60	mnuActAlert: TMenuItem;
	61	mnuViewResult: TMenuItem;
	62	mnuActOnChart: TMenuItem;
	63	mnuActComplete: TMenuItem;
	64	sepOrderVerify: TMenuItem;
	65	popOrderVerify: TMenuItem;
	66	popOrderResult: TMenuItem;
	67	imgHide: TImage;
	68	mnuOpt: TMenuItem;
	69	mnuOptSaveQuick: TMenuItem;
	70	mnuOptEditCommon: TMenuItem;
	71	popOrderSign: TMenuItem;
	72	popOrderCopy: TMenuItem;
	73	mnuActChartRev: TMenuItem;
	74	popOrderChartRev: TMenuItem;
	75	Z6: TMenuItem;
	76	mnuViewDfltSave: TMenuItem;
	77	mnuViewDfltShow: TMenuItem;
	78	mnuViewCurrent: TMenuItem;
	79	mnuChartSurgery: TMenuItem;
	80	mnuViewResultsHistory: TMenuItem;
	81	popResultsHistory: TMenuItem;
	82	btnDelayedOrder: TORAlignButton;
	83	mnuActChgEvnt: TMenuItem;
	84	mnuChgEvnt: TMenuItem;
	85	mnuActRel: TMenuItem;
	86	popOrderRel: TMenuItem;
	87	EventRealeasedOrder1: TMenuItem;
	88	lblWrite: TLabel;
	89	sptVert: TSplitter;
	90	mnuViewExpired: TMenuItem;
	91	mnuViewInformation: TMenuItem;
	92	mnuViewDemo: TMenuItem;
	93	mnuViewVisits: TMenuItem;
	94	mnuViewPrimaryCare: TMenuItem;
	95	mnuViewMyHealtheVet: TMenuItem;
	96	mnuInsurance: TMenuItem;
	97	mnuViewFlags: TMenuItem;
	98	mnuViewReminders: TMenuItem;
	99	mnuViewRemoteData: TMenuItem;
	100	mnuViewPostings: TMenuItem;
	101	mnuOptimizeFields: TMenuItem;
	102	procedure mnuChartTabClick(Sender: TObject);
	103	procedure FormCreate(Sender: TObject);
	104	procedure FormDestroy(Sender: TObject);
	105	procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer;
	106	TheRect: TRect; State: TOwnerDrawState);
	107	procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
	108	var AHeight: Integer);
	109	procedure mnuViewActiveClick(Sender: TObject);
	110	procedure hdrOrdersSectionResize(HeaderControl: THeaderControl;
	111	Section: THeaderSection);
	112	procedure mnuViewCustomClick(Sender: TObject);
	113	procedure mnuViewExpiringClick(Sender: TObject);
	114	procedure mnuViewExpiredClick(Sender: TObject);
	115	procedure mnuViewUnsignedClick(Sender: TObject);
	116	procedure mnuViewDetailClick(Sender: TObject);
	117	procedure lstOrdersDblClick(Sender: TObject);
	118	procedure lstWriteClick(Sender: TObject);
	119	procedure mnuActHoldClick(Sender: TObject);
	120	procedure mnuActUnholdClick(Sender: TObject);
	121	procedure mnuActDCClick(Sender: TObject);
	122	procedure mnuActAlertClick(Sender: TObject);
	123	procedure mnuActFlagClick(Sender: TObject);
	124	procedure mnuActUnflagClick(Sender: TObject);
	125	procedure mnuActSignClick(Sender: TObject);
	126	procedure mnuActReleaseClick(Sender: TObject);
	127	procedure mnuActOnChartClick(Sender: TObject);
	128	procedure mnuActCompleteClick(Sender: TObject);
	129	procedure mnuActVerifyClick(Sender: TObject);
	130	procedure mnuViewResultClick(Sender: TObject);
	131	procedure mnuActCommentClick(Sender: TObject);
	132	procedure mnuOptSaveQuickClick(Sender: TObject);
	133	procedure mnuOptEditCommonClick(Sender: TObject);
	134	procedure mnuActCopyClick(Sender: TObject);
	135	procedure mnuActChangeClick(Sender: TObject);
	136	procedure mnuActRenewClick(Sender: TObject);
	137	procedure pnlRightResize(Sender: TObject);
	138	procedure lstSheetsClick(Sender: TObject);
	139	procedure mnuActChartRevClick(Sender: TObject);
	140	procedure mnuViewDfltShowClick(Sender: TObject);
	141	procedure mnuViewDfltSaveClick(Sender: TObject);
	142	procedure mnuViewCurrentClick(Sender: TObject);
	143	procedure mnuViewResultsHistoryClick(Sender: TObject);
	144	procedure btnDelayedOrderClick(Sender: TObject);
	145	procedure mnuActChgEvntClick(Sender: TObject);
	146	procedure mnuActRelClick(Sender: TObject);
	147	procedure EventRealeasedOrder1Click(Sender: TObject);
	148	procedure lblWriteMouseMove(Sender: TObject; Shift: TShiftState; X,
	149	Y: Integer);
	150	procedure popOrderPopup(Sender: TObject);
	151	procedure mnuViewClick(Sender: TObject);
	152	procedure mnuActClick(Sender: TObject);
	153	procedure mnuOptClick(Sender: TObject);
	154	procedure FormShow(Sender: TObject);
	155	procedure hdrOrdersMouseUp(Sender: TObject; Button: TMouseButton;
	156	Shift: TShiftState; X, Y: Integer);
	157	procedure hdrOrdersMouseDown(Sender: TObject; Button: TMouseButton;
	158	Shift: TShiftState; X, Y: Integer);
	159	procedure ViewInfo(Sender: TObject);
	160	procedure mnuViewInformationClick(Sender: TObject);
	161	procedure mnuOptimizeFieldsClick(Sender: TObject);
	162	procedure hdrOrdersSectionClick(HeaderControl: THeaderControl;
	163	Section: THeaderSection);
	164	procedure sptHorzMoved(Sender: TObject);
	165	private
	166	{ Private declarations }
[829]	167	OrderListClickProcessing : Boolean;
[456]	168	FDfltSort: Integer;
	169	FCurrentView: TOrderView;
	170	FCompress: boolean;
	171	FFromDCRelease: boolean;
	172	FSendDelayOrders: boolean;
	173	FNewEvent: boolean;
	174	FAskForCancel: boolean;
	175	FNeedShowModal: boolean;
	176	FOrderViewForActiveOrders: TOrderView;
	177	FEventForCopyActiveOrders: TOrderDelayEvent;
	178	FEventDefaultOrder : string;
	179	FIsDefaultDlg: boolean;
	180	FHighlightFromMedsTab: integer;
	181	FCalledFromWDO: boolean; //called from Write Delay Orders button
	182	FEvtOrderList: TStringlist;
	183	FEvtColWidth: integer;
	184	FRightAfterWriteOrderBox : boolean;
	185	FDontCheck: boolean;
	186	FParentComplexOrderID: string;
[829]	187	FHighContrast2Mode: boolean;
[456]	188	function CanChangeOrderView: Boolean;
	189	function GetEvtIFN(AnIndex: integer): string;
	190	function DisplayDefaultDlgList(ADest: TORListBox; ADlgList: TStringList): boolean;
	191	procedure AddToListBox(AnOrderList: TList);
	192	procedure ExpandEventSection;
	193	procedure CompressEventSection;
	194	procedure ClearOrderSheets;
	195	procedure InitOrderSheets;
	196	procedure DfltViewForEvtDelay;
	197	procedure MakeSelectedList(AList: TList);
	198	function NoneSelected(const ErrMsg: string): Boolean;
	199	procedure ProcessNotifications;
	200	procedure PositionTopOrder(DGroup: Integer);
	201	procedure RedrawOrderList;
	202	procedure RefreshOrderList(FromServer: Boolean; APtEvtID: string = '');
	203	procedure RetrieveVisibleOrders(AnIndex: Integer);
	204	procedure RemoveSelectedFromChanges(AList: TList);
	205	procedure SetOrderView(AFilter, ADGroup: Integer; const AViewName: string; NotifSort: Boolean);
	206	//procedure SetEvtIFN(var AnEvtIFN: integer);
	207	procedure UseDefaultSort;
	208	procedure SynchListToOrders;
[829]	209	procedure ActivateDeactiveRenew;
[456]	210	procedure ValidateSelected(const AnAction, WarningMsg, WarningTitle: string);
	211	procedure ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string;
	212	BySvc, InvDate: boolean; Title: string);
	213	procedure UMDestroy(var Message: TMessage); message UM_DESTROY;
	214	function GetStartStopText(StartTime: string; StopTime: string): string;
	215	function GetOrderText(AnOrder: TOrder; Index: integer; Column: integer): string;
	216	function MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer;
	217	function GetPlainText(AnOrder: TOrder; index: integer):string;
[829]	218	//function PatientStatusChanged: boolean;
[456]	219	procedure UMEventOccur(var Message: TMessage); message UM_EVENTOCCUR;
	220	function CheckOrderStatus: boolean;
[829]	221	procedure RightClickMessageHandler(var Msg: TMessage; var Handled: Boolean);
[456]	222	public
	223	procedure setSectionWidths; //CQ6170
	224	function getTotalSectionsWidth : integer; //CQ6170
	225	function AllowContextChange(var WhyNot: string): Boolean; override;
	226	function PlaceOrderForDefaultDialog(ADlgInfo: string; IsDefaultDialog: boolean; AEvent: TOrderDelayEvent): boolean;
	227	function PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean = False): boolean;
	228	procedure RefreshToFirstItem;
	229	procedure ChangesUpdate(APtEvtID: string);
	230	procedure GroupChangesUpdate(GrpName: string);
	231	procedure ClearPtData; override;
	232	procedure DisplayPage; override;
	233	procedure InitOrderSheetsForEvtDelay;
	234	procedure ResetOrderPage(AnEvent: TOrderDelayEvent; ADlgLst: TStringList; IsRealeaseNow: boolean);
	235	procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override;
	236	procedure SaveSignOrders;
	237	procedure ClickLstSheet;
	238	procedure RequestPrint; override;
	239	procedure InitOrderSheets2(AnItem: string = '');
	240	procedure SetFontSize( FontSize: integer); override;
	241	property IsDefaultDlg: boolean read FIsDefaultDlg write FIsDefaultDlg;
	242	property SendDelayOrders: Boolean read FSendDelayOrders write FSendDelayOrders;
	243	property NewEvent: Boolean read FNewEvent write FNewEvent;
	244	property NeedShowModal: Boolean read FNeedShowModal write FNeedShowModal;
	245	property AskForCancel: Boolean read FAskForCancel write FAskForCancel;
	246	property EventDefaultOrder: string read FEventDefaultOrder write FEventDefaultOrder;
	247	property TheCurrentView: TOrderView read FCurrentView;
	248	property HighlightFromMedsTab: integer read FHighlightFromMedsTab write FHighlightFromMedsTab;
	249	property CalledFromWDO: boolean read FCalledFromWDO;
	250	property EvtOrderList: TStringlist read FEvtOrderList write FEvtOrderList;
	251	property FromDCRelease: boolean read FFromDCRelease write FFromDCRelease;
	252	property EvtColWidth: integer read FEvtColWidth write FEvtColWidth;
	253	property DontCheck: boolean read FDontCheck write FDontCheck;
	254	property ParentComplexOrderID: string read FParentComplexOrderID write FParentComplexOrderID;
	255	end;
	256
	257	type
	258	arOrigSecWidths = array[0..9] of integer; //CQ6170
	259
	260	var
	261	frmOrders: TfrmOrders;
	262
	263	origWidths: arOrigSecWidths; //CQ6170
	264
	265	implementation
	266
	267	uses fFrame, fEncnt, fOrderVw, fRptBox, fLkUpLocation, fOrdersDC, fOrdersCV, fOrdersHold, fOrdersUnhold,
	268	fOrdersAlert, fOrderFlag, fOrderUnflag, fOrdersSign, fOrdersRelease, fOrdersOnChart, fOrdersEvntRelease,
	269	fOrdersComplete, fOrdersVerify, fOrderComment, fOrderSaveQuick, fOrdersRenew,fODReleaseEvent,
	270	fOMNavA, rCore, fOCSession, fOrdersPrint, fOrdersTS, fEffectDate, fODActive, fODChild,
	271	fOrdersCopy, fOMVerify, fODAuto, rODBase, uODBase, rMeds,fODValidateAction, fMeds, uInit, fBALocalDiagnoses,
[829]	272	fODConsult, fClinicWardMeds, fActivateDeactivate, VA2006Utils, rodMeds,
	273	VA508AccessibilityRouter, VAUtils;
[456]	274
	275	{$R *.DFM}
	276
	277	const
	278	FROM_SELF = False;
	279	FROM_SERVER = True;
	280	OVS_CATINV = 0;
	281	OVS_CATFWD = 1;
	282	OVS_INVERSE = 2;
	283	OVS_FORWARD = 3;
	284	STS_ACTIVE = 2;
	285	STS_DISCONTINUED = 3;
	286	STS_COMPLETE = 4;
	287	STS_EXPIRING = 5;
	288	STS_RECENT = 6;
	289	STS_UNVERIFIED = 8;
	290	STS_UNVER_NURSE = 9;
	291	STS_UNSIGNED = 11;
	292	STS_FLAGGED = 12;
	293	STS_HELD = 18;
	294	STS_NEW = 19;
	295	STS_CURRENT = 23;
	296	STS_EXPIRED = 27;
	297	FM_DATE_ONLY = 7;
	298	CT_ORDERS = 4; // chart tab - doctor's orders
	299
	300	TX_NO_HOLD = CRLF + CRLF + '- cannot be placed on hold.' + CRLF + CRLF + 'Reason: ';
	301	TC_NO_HOLD = 'Unable to Hold';
	302	TX_NO_UNHOLD = CRLF + CRLF + '- cannot be released from hold.' + CRLF + CRLF + 'Reason: ';
	303	TC_NO_UNHOLD = 'Unable to Release from Hold';
	304	TX_NO_DC = CRLF + CRLF + '- cannot be discontinued.' + CRLF + CRLF + 'Reason: ';
	305	TC_NO_DC = 'Unable to Discontinue';
	306	TX_NO_CV = CRLF + 'The release event cannot be changed.' + CRLF + CRLF + 'Reason: ';
	307	TC_NO_CV = 'Unable to Change Release Event';
	308	TX_NO_ALERT = CRLF + CRLF + '- cannot be set to send an alert.' + CRLF + CRLF + 'Reason: ';
	309	TC_NO_ALERT = 'Unable to Set Alert';
	310	TX_NO_FLAG = CRLF + CRLF + '- cannot be flagged.' + CRLF + CRLF + 'Reason: ';
	311	TC_NO_FLAG = 'Unable to Flag Order';
	312	TX_NO_UNFLAG = CRLF + CRLF + '- cannot be unflagged.' + CRLF + CRLF + 'Reason: ';
	313	TC_NO_UNFLAG = 'Unable to Unflag Order';
	314	TX_NO_SIGN = CRLF + CRLF + '- cannot be signed.' + CRLF + CRLF + 'Reason: ';
	315	TC_NO_SIGN = 'Unable to Sign Order';
	316	TX_NO_REL = CRLF + 'Cannot be released to the service(s).' + CRLF + CRLF + 'Reason: ';
	317	TC_NO_REL = 'Unable to be Released to Service';
	318	TX_NO_CHART = CRLF + CRLF + '- cannot be marked "Signed on Chart".' + CRLF + CRLF + 'Reason: ';
	319	TC_NO_CHART = 'Unable to Release Orders';
	320	TX_NO_CPLT = CRLF + CRLF + '- cannot be completed.' + CRLF + CRLF + 'Reason: ';
	321	TC_NO_CPLT = 'Unable to Complete';
	322	TX_NO_VERIFY = CRLF + CRLF + '- cannot be verified.' + CRLF + CRLF + 'Reason: ';
	323	TC_NO_VERIFY = 'Unable to Verify';
	324	TX_NO_CMNT = CRLF + CRLF + '- cannot have comments edited.' + CRLF + CRLF + 'Reason: ';
	325	TC_NO_CMNT = 'Unable to Edit Comments';
	326	TX_NO_RENEW = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ';
	327	TC_NO_RENEW = 'Unable to Renew Order';
	328	TX_LOC_PRINT = 'The selected location will be used to determine where orders are printed.';
	329	TX_PRINT_LOC = 'A location must be selected to print orders.';
	330	TX_REL_LOC = 'A location must be selected to release orders.';
	331	TX_CHART_LOC = 'A location must be selected to mark orders "signed on chart".';
	332	TX_SIGN_LOC = 'A location must be selected to sign orders.';
	333	TC_REQ_LOC = 'Location Required';
	334	TX_NOSEL = 'No orders are highlighted. Highlight the orders' + CRLF +
	335	'you wish to take action on.';
	336	TX_NOSEL_SIGN = 'No orders are highlighted. Highlight orders you want to sign or' + CRLF +
	337	'use Review/Sign Changes (File menu) to sign all orders written' + CRLF +
	338	'in this session.';
	339	TC_NOSEL = 'No Orders Selected';
	340	TX_NOCHG_VIEW = 'The view of orders may not be changed while an ordering dialog is' + CRLF +
	341	'active for an event-delayed order.';
	342	TC_NOCHG_VIEW = 'Order View Restriction';
	343	TX_DELAY1 = 'Now writing orders for ';
	344	TC_DELAY = 'Ordering Information';
	345	TX_BAD_TYPE = 'This item is a type that is not supported in the graphical interface.';
	346	TC_BAD_TYPE = 'Unsupported Ordering Item';
	347	TC_VWSAVE = 'Save Default Order View';
	348	TX_VWSAVE1 = 'The current order view is: ' + CRLF + CRLF;
	349	TX_VWSAVE2 = CRLF + CRLF + 'Do you wish to save this as your default view?';
	350	TX_NO_COPY = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ';
	351	TC_NO_COPY = 'Unable to Copy Order';
	352	TX_NO_CHANGE = CRLF + CRLF + '- cannot be changed' + CRLF + CRLF + 'Reason: ';
	353	TC_NO_CHANGE = 'Unable to Change Order';
	354	TX_COMPLEX = 'You can not take this action on a complex medication.' + #13 + 'You must enter a new order.';
	355	TX_CMPTEVT = ' occurred since you started writing delayed orders. '
	356	+ 'The orders that were entered and signed have now been released. '
	357	+ 'Any unsigned orders will be released immediately upon signature. '
	358	+ #13#13
	359	+ 'To write new delayed orders for this event you need to click the write delayed orders button again and select the appropriate event. '
	360	+ 'Orders delayed to this same event will remain delayed until the event occurs again.'
	361	+ #13#13
	362	+ 'The Orders tab will now be refreshed and switched to the Active Orders view. '
	363	+ 'If you wish to continue to write active orders for this patient, '
	364	+ 'close this message window and continue as usual.';
	365	TX_CMPTEVT_MEDSTAB = ' occurred since you started writing delayed orders. '
	366	+ 'The orders that were entered and signed have now been released. '
	367	+ 'Any unsigned orders will be released immediately upon signature. '
	368	+ #13#13
	369	+ 'To write new delayed orders for this event you need to click the write delayed orders button on the orders tab and select the appropriate event. '
	370	+ 'Orders delayed to this same event will remain delayed until the event occurs again.';
	371
	372	var
	373	uOrderList: TList;
	374	uEvtDCList, uEvtRLList: TList;
	375
	376	{ TPage common methods --------------------------------------------------------------------- }
	377
	378	function TfrmOrders.AllowContextChange(var WhyNot: string): Boolean;
	379	begin
	380	Result := inherited AllowContextChange(WhyNot); // sets result = true
	381	case BOOLCHAR[frmFrame.CCOWContextChanging] of
	382	'1': if ActiveOrdering then
	383	begin
	384	WhyNot := 'Orders in progress will be discarded.';
	385	Result := False;
	386	end;
	387	'0': Result := CloseOrdering; // call in uOrders, should move to fFrame
	388	end;
	389	end;
	390
	391	procedure TfrmOrders.ClearPtData;
	392	begin
	393	inherited ClearPtData;
	394	lstOrders.Clear;
	395	ClearOrderSheets;
	396	ClearOrders(uOrderList);
	397	if uEvtDCList <> nil then
	398	uEvtDCList.Clear;
	399	if uEvtRLList <> nil then
	400	uEvtRLList.Clear;
	401	ClearFillerAppList;
	402	end;
	403
	404	procedure TfrmOrders.DisplayPage;
	405	var
	406	i: Integer;
	407	begin
	408	inherited DisplayPage;
	409	frmFrame.ShowHideChartTabMenus(mnuViewChart);
	410	frmFrame.mnuFilePrint.Tag := CT_ORDERS;
	411	frmFrame.mnuFilePrint.Enabled := True;
	412	frmFrame.mnuFilePrintSetup.Enabled := True;
	413	if InitPage then
	414	begin
	415	// set visibility according to order role
	416	mnuActComplete.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK) or
	417	(User.OrderRole = OR_PHYSICIAN);
	418	mnuActVerify.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK);
	419	popOrderVerify.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK);
	420	sepOrderVerify.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK);
	421	mnuActChartRev.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK);
	422	popOrderChartRev.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK);
	423	mnuActRelease.Visible := User.OrderRole = OR_NURSE;
	424	mnuActOnChart.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK);
	425	mnuActSign.Visible := User.OrderRole = OR_PHYSICIAN;
	426	popOrderSign.Visible := User.OrderRole = OR_PHYSICIAN;
	427	mnuActRel.Visible := False;
	428	popOrderRel.Visible := False;
	429	// now set enabled/disabled according to parameters
	430	// popup items that apply to ordering have tag>0
	431	with mnuAct do
	432	for i := 0 to Pred(Count) do
	433	Items[i].Enabled := not User.NoOrdering;
	434	with popOrder.Items do
	435	for i := 0 to Pred(Count) do
	436	if Items[i].Tag > 0 then Items[i].Enabled := not User.NoOrdering;
	437	// set nurse verification actions (may be enabled when ordering disabled)
	438	mnuActVerify.Enabled := User.EnableVerify;
	439	mnuActChartRev.Enabled := User.EnableVerify;
	440	popOrderVerify.Enabled := User.EnableVerify;
	441	popOrderChartRev.Enabled := User.EnableVerify;
	442	if User.DisableHold then
	443	begin
	444	mnuActHold.Visible := False;
	445	mnuActUnhold.Visible := False;
	446	end;
	447	end;
	448	AskForCancel := true;
	449	if InitPatient then // for both CC_INIT_PATIENT and CC_NOTIFICATION
	450	begin
	451	if not User.NoOrdering then LoadWriteOrders(lstWrite.Items) else lstWrite.Clear;
	452	InitOrderSheets;
	453	end;
	454	case CallingContext of
	455	CC_INIT_PATIENT: mnuViewDfltShowClick(Self); // when new patient but not doing notifications
	456	CC_NOTIFICATION: ProcessNotifications; // when new patient and doing notifications
	457	end;
	458	end;
	459
	460	procedure TfrmOrders.mnuChartTabClick(Sender: TObject);
	461	begin
	462	inherited;
	463	frmFrame.mnuChartTabClick(Sender);
	464	end;
	465
	466	procedure TfrmOrders.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
	467	var
	468	OrderForList: TOrder;
	469	IndexOfOrder, ReturnedType, CanSign, i: Integer;
	470	j: integer;
	471	AChildList: TStringlist;
	472	CplxOrderID: string;
[829]	473	DCNewOrder: boolean;
	474	DCChangeItem: TChangeItem;
[456]	475
	476	procedure RemoveFromOrderList(ChildOrderID: string);
	477	var
	478	ij: integer;
	479	begin
	480	for ij := uOrderList.Count - 1 downto 0 do
	481	begin
	482	if TOrder(uOrderList[ij]).ID = ChildOrderID then
	483	uOrderList.Remove(TOrder(uOrderList[ij]));
	484	end;
	485	end;
	486
	487	begin
	488	// if FCurrentView = nil then {REV}
	489	// begin {REV}
	490	// FCurrentView := TOrderView.Create; {REV}
	491	// with FCurrentView do {REV}
	492	// begin {REV}
	493	// InvChrono := True; {REV}
	494	// ByService := True; {REV}
	495	// end; {REV}
	496	// end; {REV}
	497	if FCurrentView = nil then Exit;
	498	case OrderAction of
	499	ORDER_NEW: if AnOrder.ID <> '' then
	500	begin
	501	OrderForList := TOrder.Create;
	502	OrderForList.Assign(AnOrder);
	503	uOrderList.Add(OrderForList);
	504	FCompress := True;
	505	RefreshOrderList(FROM_SELF);
	506	//PositionTopOrder(AnOrder.DGroup);
	507	PositionTopOrder(0); // puts new orders on top
	508	lstOrders.Invalidate;
	509	end;
	510	ORDER_DC: begin
	511	IndexOfOrder := -1;
	512	with lstOrders do for i := 0 to Items.Count - 1 do
	513	if TOrder(Items.Objects[i]).ID = AnOrder.ID then IndexOfOrder := i;
	514	if IndexOfOrder > -1
	515	then OrderForList := TOrder(lstOrders.Items.Objects[IndexOfOrder])
	516	else OrderForList := AnOrder;
	517	if (Encounter.Provider = User.DUZ) and User.CanSignOrders
	518	then CanSign := CH_SIGN_YES
	519	else CanSign := CH_SIGN_NA;
[829]	520	DCNEwOrder := false;
	521	if Changes.Orders.Count > 0 then
	522	begin
	523	for j := 0 to Changes.Orders.Count - 1 do
	524	begin
	525	DCChangeItem := TChangeItem(Changes.Orders.Items[j]);
	526	if DCChangeItem.ID = OrderForList.ID then
	527	begin
	528	if (Pos('DC', OrderForList.ActionOn) = 0) then
	529	DCNewOrder := True;
	530	//else DCNewOrder := False;
	531	end;
	532	end;
	533	end;
	534	DCOrder(OrderForList, GetReqReason, DCNewOrder, ReturnedType);
[456]	535	Changes.Add(CH_ORD, OrderForList.ID, OrderForList.Text, '', CanSign);
	536	FCompress := True;
	537	SynchListToOrders;
	538	end;
	539	ORDER_EDIT: with lstOrders do
	540	begin
	541	IndexOfOrder := -1;
	542	for i := 0 to Items.Count - 1 do
	543	if TOrder(Items.Objects[i]).ID = AnOrder.EditOf then IndexOfOrder := i;
	544	if IndexOfOrder > -1 then
	545	begin
	546	TOrder(Items.Objects[IndexOfOrder]).Assign(AnOrder);
	547	end; {if IndexOfOrder}
	548	//RedrawOrderList; {redraw here appears to clear selected}
	549	end; {with lstOrders}
	550	ORDER_ACT: begin
	551	if IsComplexOrder(AnOrder.ID) then
	552	begin
	553	RefreshOrderList(FROM_SERVER);
	554	exit;
	555	end;
	556	with lstOrders do
	557	begin
	558	IndexOfOrder := -1;
	559	for i := 0 to Items.Count - 1 do
	560	if TOrder(Items.Objects[i]).ID = Piece(AnOrder.ActionOn, '=', 1) then IndexOfOrder := i;
	561	if (IndexOfOrder > -1) and (AnOrder <> Items.Objects[IndexOfOrder]) then
	562	begin
	563	TOrder(Items.Objects[IndexOfOrder]).Assign(AnOrder);
	564	end; {if IndexOfOrder}
	565	FCompress := True;
	566	RedrawOrderList;
	567	end; {with lstOrders}
	568	end; //PSI-COMPLEX
	569	ORDER_CPLXRN: begin
	570	AChildList := TStringList.Create;
	571	CplxOrderID := Piece(AnOrder.ActionOn,'=',1);
	572	GetChildrenOfComplexOrder(CplxOrderID, Piece(CplxOrderID,';',2), AChildList);
	573	with lstOrders do
	574	begin
	575	for i := Items.Count-1 downto 0 do
	576	begin
	577	for j := 0 to AChildList.Count - 1 do
	578	begin
	579	if TOrder(Items.Objects[i]).ID = AChildList[j] then
	580	begin
	581	RemoveFromOrderList(AChildList[j]);
	582	Items.Objects[i].Free;
	583	Items.Delete(i);
	584	Break;
	585	end;
	586	end;
	587	end;
	588	Items.InsertObject(0,AnOrder.Text,AnOrder);
	589	Items[0] := GetPlainText(AnOrder,0);
	590	uOrderList.Insert(0,AnOrder);
	591	end;
	592	FCompress := True;
	593	RedrawOrderList;
	594	AChildList.Clear;
	595	AChildList.Free;
	596	end;
	597	ORDER_SIGN: begin
	598	FCompress := True;
	599	SaveSignOrders; // sent when orders signed, AnOrder=nil
	600	end;
	601	end; {case}
	602	end;
	603
	604	{ Form events ------------------------------------------------------------------------------ }
	605
	606	procedure TfrmOrders.FormCreate(Sender: TObject);
	607	begin
	608	inherited;
[829]	609	OrderListClickProcessing := false;
	610	FixHeaderControlDelphi2006Bug(hdrOrders);
[456]	611	PageID := CT_ORDERS;
	612	uOrderList := TList.Create;
	613	uEvtDCList := TList.Create;
	614	uEvtRLList := TList.Create;
	615	FDfltSort := OVS_CATINV;
	616	FCompress := False;
	617	FFromDCRelease := False;
	618	FSendDelayOrders := False;
	619	FNewEvent := False;
	620	FNeedShowModal := False;
	621	FAskForCancel := True;
	622	FRightAfterWriteOrderBox := False;
	623	FEventForCopyActiveOrders.EventType := #0;
	624	FEventForCopyActiveOrders.EventIFN := 0;
	625	FHighlightFromMedsTab := 0;
	626	FCalledFromWDO := False;
	627	FEvtOrderList := TStringList.Create;
	628	FEvtColWidth := 0;
	629	FDontCheck := False;
	630	FParentComplexOrderID := '';
[829]	631	// 508 black color scheme that causes problems
	632	FHighContrast2Mode := BlackColorScheme and (ColorToRGB(clInfoBk) <> ColorToRGB(clBlack));
	633	AddMessageHandler(lstOrders, RightClickMessageHandler);
[456]	634	end;
	635
	636	procedure TfrmOrders.FormDestroy(Sender: TObject);
	637	begin
	638	inherited;
[829]	639	RemoveMessageHandler(lstOrders, RightClickMessageHandler);
[456]	640	ClearOrders(uOrderList);
	641	uEvtDCList.Clear;
	642	uEvtRLList.Clear;
	643	ClearOrderSheets;
	644	FEvtOrderList.Free;
	645	uEvtDCList.Free;
	646	uEvtRLList.Free;
	647	uOrderList.Free;
	648	if FOrderViewForActiveOrders <> nil then FOrderViewForActiveOrders := nil;
	649	FEventForCopyActiveOrders.EventType := #0;
	650	FEventForCopyActiveOrders.EventIFN := 0;
	651	FEventForCopyActiveOrders.EventName := '';
	652	end;
	653
	654	procedure TfrmOrders.UMDestroy(var Message: TMessage);
	655	{ sent by ordering dialog when it is closing }
	656	begin
	657	lstWrite.ItemIndex := -1;
	658	//UnlockIfAble; // - already in uOrders
	659	end;
	660
	661	{ View menu events ------------------------------------------------------------------------- }
	662
	663	procedure TfrmOrders.PositionTopOrder(DGroup: Integer);
	664	const
	665	SORT_FWD = 0;
	666	SORT_REV = 1;
	667	SORT_GRP_FWD = 2;
	668	SORT_GRP_REV = 3;
	669	var
	670	i, Seq: Integer;
	671	AnOrder: TOrder;
	672	begin
	673	with lstOrders do
	674	begin
	675	case (Ord(FCurrentView.ByService) * 2) + Ord(FCurrentView.InvChrono) of
	676	SORT_FWD: TopIndex := Items.Count - 1;
	677	SORT_REV: TopIndex := 0;
	678	SORT_GRP_FWD: begin
	679	Seq := SeqOfDGroup(DGroup);
	680	for i := Items.Count - 1 downto 0 do
	681	begin
	682	AnOrder := TOrder(Items.Objects[i]);
	683	if AnOrder.DGroupSeq <= Seq then break;
	684	end;
	685	TopIndex := i;
	686	end;
	687	SORT_GRP_REV: begin
	688	Seq := SeqOfDGroup(DGroup);
	689	for i := 0 to Items.Count - 1 do
	690	begin
	691	AnOrder := TOrder(Items.Objects[i]);
	692	if AnOrder.DGroupSeq >= Seq then break;
	693	end;
	694	TopIndex := i;
	695	end;
	696	end; {case}
	697	end; {with}
	698	end;
	699
	700	procedure TfrmOrders.RedrawOrderList;
	701	{ redraws the Orders list, compensates for changes in item height by re-adding everything }
	702	var
	703	i, SaveTop: Integer;
	704	AnOrder: TOrder;
	705	begin
	706	with lstOrders do
	707	begin
	708	RedrawSuspend(Handle);
	709	SaveTop := TopIndex;
	710	Clear;
[829]	711	repaint;
[456]	712	for i := 0 to uOrderList.Count - 1 do
	713	begin
	714	AnOrder := TOrder(uOrderList.Items[i]);
	715	if (AnOrder.OrderTime <= 0) then
	716	Continue;
	717	Items.AddObject(AnOrder.ID, AnOrder);
	718	Items[i] := GetPlainText(AnOrder,i);
	719	end;
	720	TopIndex := SaveTop;
	721	RedrawActivate(Handle);
	722	end;
	723	end;
	724
	725	procedure TfrmOrders.RefreshOrderList(FromServer: Boolean; APtEvtID: string);
	726	var
	727	i: Integer;
	728	begin
	729	with FCurrentView do
	730	begin
	731	if EventDelay.EventIFN > 0 then
	732	FCompress := False;
	733	RedrawSuspend(lstOrders.Handle);
	734	lstOrders.Clear;
	735	if FromServer then
	736	begin
	737	StatusText('Retrieving orders list...');
	738	if not FFromDCRelease then
	739	LoadOrdersAbbr(uOrderList, FCurrentView, APtEvtID)
	740	else
	741	begin
	742	ClearOrders(uOrderList);
	743	uEvtDCList.Clear;
	744	uEvtRLList.Clear;
	745	LoadOrdersAbbr(uEvtDCList,uEvtRLList,FCurrentView,APtEvtID);
	746	end;
	747	end;
	748	if ((Length(APtEvtID)>0) or (FCurrentView.Filter in [15,16,17,24]) or (FCurrentView.EventDelay.PtEventIFN>0))
	749	and ((not FCompress) or (lstSheets.ItemIndex<0)) and (not FFromDCRelease) then ExpandEventSection
	750	else CompressEventSection;
	751	if not FFromDCRelease then
	752	begin
	753	if FRightAfterWriteOrderBox and (EventDelay.EventIFN>0) then
	754	begin
	755	SortOrders(uOrderList,False,True);
	756	FRightAfterWriteOrderBox := False;
	757	end else
	758	SortOrders(uOrderList, ByService, InvChrono);
	759	AddToListBox(uOrderList);
	760	end;
	761	if FFromDCRelease then
	762	begin
	763	if uEvtRLList.Count > 0 then
	764	begin
	765	SortOrders(uEvtRLList,True,True);
	766	for i := 0 to uEvtRLList.Count - 1 do
	767	uOrderList.Add(TOrder(uEvtRLList[i]));
	768	end;
	769	if uEvtDCList.Count > 0 then
	770	begin
	771	SortOrders(uEvtDCList,True,True);
	772	for i := 0 to uEvtDCList.Count - 1 do
	773	uOrderList.Add(TOrder(uEvtDCList[i]));
	774	end;
	775	AddToListBox(uOrderList);
	776	end;
	777	RedrawActivate(lstOrders.Handle);
	778	lblOrders.Caption := ViewName;
	779	lstOrders.Caption := ViewName;
	780	imgHide.Visible := not ((Filter in [1, 2]) and (DGroup = DGroupAll));
	781	StatusText('');
	782	end;
	783	end;
	784
	785	procedure TfrmOrders.UseDefaultSort;
	786	begin
	787	with FCurrentView do
	788	case FDfltSort of
	789	OVS_CATINV: begin
	790	InvChrono := True;
	791	ByService := True;
	792	end;
	793	OVS_CATFWD: begin
	794	InvChrono := False;
	795	ByService := True;
	796	end;
	797	OVS_INVERSE: begin
	798	InvChrono := True;
	799	ByService := False;
	800	end;
	801	OVS_FORWARD: begin
	802	InvChrono := False;
	803	ByService := False;
	804	end;
	805	end;
	806	end;
	807
	808	function TfrmOrders.CanChangeOrderView: Boolean;
	809	{ Disallows changing view while doing delayed release orders. }
	810	begin
	811	Result := True;
	812	if (lstSheets.ItemIndex > 0) and ActiveOrdering then
	813	begin
	814	InfoBox(TX_NOCHG_VIEW, TC_NOCHG_VIEW, MB_OK);
	815	Result := False;
	816	end;
	817	end;
	818
	819	procedure TfrmOrders.SetOrderView(AFilter, ADGroup: Integer; const AViewName: string;
	820	NotifSort: Boolean);
	821	{ sets up a 'canned' order view, assumes the date range is never restricted }
	822	var
	823	tmpDate: TDateTime;
	824	begin
	825	if not CanChangeOrderView then Exit;
	826	lstSheets.ItemIndex := 0;
	827	FCurrentView := TOrderView(lstSheets.Items.Objects[0]);
	828	if FCurrentView = nil then
	829	FCurrentView := TOrderView.Create;
	830	with FCurrentView do
	831	begin
	832	TimeFrom := 0;
	833	TimeThru := 0;
	834	if NotifSort then
	835	begin
	836	ByService := False;
	837	InvChrono := True;
	838	if AFilter = STS_RECENT then
	839	begin
	840	tmpDate := Trunc(FMDateTimeToDateTime(StrToFMDateTime(Piece(Piece(Notifications.RecordID, U, 2), ';', 3))));
	841	TimeFrom := DateTimeToFMDateTime(tmpDate - 5);
	842	TimeThru := FMNow;
	843	end;
	844	if AFilter = STS_UNVERIFIED then
	845	begin
	846	if Patient.AdmitTime > 0 then
	847	tmpDate := Trunc(FMDateTimeToDateTime(Patient.AdmitTime))
	848	else
	849	tmpdate := Trunc(FMDateTimeToDateTime(FMNow)) - 30;
	850	TimeFrom := DateTimeToFMDateTime(tmpDate);
	851	TimeThru := FMNow;
	852	end;
	853	end
	854	else UseDefaultSort;
	855	if AFilter = STS_EXPIRED then
	856	begin
	857	TimeFrom := ExpiredOrdersStartDT;
	858	TimeThru := FMNow;
	859	end;
	860	Filter := AFilter;
	861	DGroup := ADGroup;
	862	CtxtTime := 0;
	863	TextView := 0;
	864	ViewName := AViewName;
	865	lstSheets.Items[0] := 'C;0^' + ViewName;
	866	EventDelay.EventType := 'C';
	867	EventDelay.Specialty := 0;
	868	EventDelay.Effective := 0;
	869	end;
	870	RefreshOrderList(FROM_SERVER);
	871	end;
	872
	873	procedure TfrmOrders.mnuViewActiveClick(Sender: TObject);
	874	begin
	875	inherited;
	876	SetOrderView(STS_ACTIVE, DGroupAll, 'Active Orders (includes Pending & Recent Activity) - ALL SERVICES', False);
	877	end;
	878
	879	procedure TfrmOrders.mnuViewCurrentClick(Sender: TObject);
	880	begin
	881	inherited;
	882	SetOrderView(STS_CURRENT, DGroupAll, 'Current Orders (Active & Pending Status Only) - ALL SERVICES', False);
	883	end;
	884
	885	procedure TfrmOrders.mnuViewExpiringClick(Sender: TObject);
	886	begin
	887	inherited;
	888	SetOrderView(STS_EXPIRING, DGroupAll, 'Expiring Orders - ALL SERVICES', False);
	889	end;
	890
	891	procedure TfrmOrders.mnuViewExpiredClick(Sender: TObject);
	892	begin
	893	inherited;
	894	SetOrderView(STS_EXPIRED, DGroupAll, 'Recently Expired Orders - ALL SERVICES', False);
	895	end;
	896
	897	procedure TfrmOrders.mnuViewUnsignedClick(Sender: TObject);
	898	begin
	899	inherited;
	900	SetOrderView(STS_UNSIGNED, DGroupAll, 'Unsigned Orders - ALL SERVICES', False);
	901	end;
	902
	903	procedure TfrmOrders.mnuViewCustomClick(Sender: TObject);
	904	var
	905	AnOrderView: TOrderView;
	906	begin
	907	inherited;
	908	if not CanChangeOrderView then Exit;
[829]	909	AnOrderView := TOrderView.Create; // - this starts fresh instead, since CPRS v22
	910	try
	911	AnOrderView.Assign(FCurrentView); // RV - v27.1 - preload form with current view params
	912	(* AnOrderView.Filter := STS_ACTIVE; - CQ #11261
	913	AnOrderView.DGroup := DGroupAll;
	914	AnOrderView.ViewName := 'All Services, Active';
	915	AnOrderView.InvChrono := True;
	916	AnOrderView.ByService := True;
	917	AnOrderView.CtxtTime := 0;
	918	AnOrderView.TextView := 0;
	919	AnOrderView.EventDelay.EventType := 'C';
	920	AnOrderView.EventDelay.Specialty := 0;
	921	AnOrderView.EventDelay.Effective := 0;
	922	AnOrderView.EventDelay.EventIFN := 0;
	923	AnOrderView.EventDelay.EventName := 'All Services, Active';*)
	924	SelectOrderView(AnOrderView);
	925	with AnOrderView do if Changed then
[456]	926	begin
[829]	927	FCurrentView.Assign(AnOrderView);
	928	if FCurrentView.Filter in [15,16,17,24] then
	929	begin
	930	FCompress := False;
	931	mnuActRel.Visible := True;
	932	popOrderRel.Visible := True;
	933	end else
	934	begin
	935	mnuActRel.Visible := False;
	936	popOrderRel.Visible := False;
	937	end;
[456]	938
[829]	939	//lstSheets.ItemIndex := -1;
	940	lstSheets.Items[0] := 'C;0^' + FCurrentView.ViewName; // v27.5 - RV
[456]	941
[829]	942	lblWrite.Caption := 'Write Orders';
	943	lstWrite.Clear;
	944	lstWrite.Caption := lblWrite.Caption;
	945	LoadWriteOrders(lstWrite.Items);
	946	RefreshOrderList(FROM_SERVER);
	947
	948	if ByService then
	949	begin
	950	if InvChrono then FDfltSort := OVS_CATINV else FDfltSort := OVS_CATFWD;
	951	end else
	952	begin
	953	if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD;
	954	end;
[456]	955	end;
[829]	956	finally
	957	AnOrderView.free;
[456]	958	end;
	959	end;
	960
	961	procedure TfrmOrders.mnuViewDfltShowClick(Sender: TObject);
	962	begin
	963	inherited;
	964	if not CanChangeOrderView then Exit;
	965	if HighlightFromMedsTab > 0 then
	966	lstSheets.ItemIndex := lstSheets.SelectByIEN(HighlightFromMedsTab);
	967	if lstSheets.ItemIndex < 0 then
	968	lstSheets.ItemIndex := 0;
	969	FCurrentView := TOrderView(lstSheets.Items.Objects[lstSheets.ItemIndex]);
	970	LoadOrderViewDefault(TOrderView(lstSheets.Items.Objects[0]));
	971	lstSheets.Items[0] := 'C;0^' + TOrderView(lstSheets.Items.Objects[0]).ViewName;
	972	if lstSheets.ItemIndex > 0 then
	973	lstSheetsClick(Application)
	974	else
	975	RefreshOrderList(FROM_SERVER);
	976	if HighlightFromMedsTab > 0 then
	977	HighlightFromMedsTab := 0;
	978	end;
	979
	980	procedure TfrmOrders.mnuViewDfltSaveClick(Sender: TObject);
	981	var
	982	x: string;
	983	begin
	984	inherited;
	985	with FCurrentView do
	986	begin
	987	x := Piece(Viewname, '(', 1) + CRLF;
	988	if TimeFrom > 0 then x := x + 'From: ' + MakeRelativeDateTime(TimeFrom);
	989	if TimeThru > 0 then x := x + ' Thru: ' + MakeRelativeDateTime(TimeThru);
	990	if InvChrono
	991	then x := x + CRLF + 'Sort order dates in reverse chronological order'
	992	else x := x + CRLF + 'Sort order dates in chronological order';
	993	if ByService
	994	then x := x + CRLF + 'Group orders by service'
	995	else x := x + CRLF + 'Don''t group orders by service';
	996	end;
	997	if InfoBox(TX_VWSAVE1 + x + TX_VWSAVE2, TC_VWSAVE, MB_YESNO) = IDYES
	998	then SaveOrderViewDefault(FCurrentView);
	999	end;
	1000
	1001	procedure TfrmOrders.mnuViewDetailClick(Sender: TObject);
	1002	var
	1003	i,j,idx: Integer;
	1004	tmpList: TStringList;
	1005	BigOrderID: string;
	1006	AnOrderID: string;
	1007	begin
	1008	inherited;
	1009	if NoneSelected(TX_NOSEL) then Exit;
	1010	tmpList := TStringList.Create;
	1011	idx := 0;
	1012	try
	1013	with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
	1014	begin
	1015	StatusText('Retrieving order details...');
	1016	BigOrderID := TOrder(Items.Objects[i]).ID;
	1017	AnOrderID := Piece(BigOrderID, ';', 1);
	1018	if StrToIntDef(AnOrderID,0) = 0 then
[829]	1019	ShowMsg('Detail view is not available for selected order.')
[456]	1020	else
	1021	begin
[829]	1022	FastAssign(DetailOrder(BigOrderID), tmpList);
[456]	1023	if ((TOrder(Items.Objects[i]).DGroupName = 'Inpt. Meds') or
	1024	(TOrder(Items.Objects[i]).DGroupName = 'Out. Meds') or
[829]	1025	(TOrder(Items.Objects[i]).DGroupName = 'Clinic Orders') or
[456]	1026	(TOrder(Items.Objects[i]).DGroupName = 'Infusion')) then
	1027	begin
	1028	tmpList.Add('');
	1029	tmpList.Add(StringOfChar('=', 74));
	1030	tmpList.Add('');
[829]	1031	FastAddStrings(MedAdminHistory(AnOrderID), tmpList);
[456]	1032	end;
	1033
	1034	if CheckOrderGroup(AnOrderID)=1 then // if it's UD group
	1035	begin
	1036	for j := 0 to tmpList.Count - 1 do
	1037	begin
	1038	if Pos('PICK UP',UpperCase(tmpList[j]))>0 then
	1039	begin
	1040	idx := j;
	1041	Break;
	1042	end;
	1043	end;
	1044	if idx > 0 then
	1045	tmpList.Delete(idx);
	1046	end;
	1047	ReportBox(tmpList, 'Order Details - ' + BigOrderID, True);
	1048	end;
	1049	StatusText('');
	1050	if (frmFrame.TimedOut) or (frmFrame.CCOWDrivedChange) then Exit; //code added to correct access violation on timeout
	1051	Selected[i] := False;
	1052	end;
	1053	finally
	1054	tmpList.Free;
	1055	end;
	1056	end;
	1057
	1058	procedure TfrmOrders.mnuViewResultClick(Sender: TObject);
	1059	var
	1060	i: Integer;
	1061	BigOrderID: string;
	1062	begin
	1063	inherited;
	1064	if NoneSelected(TX_NOSEL) then Exit;
	1065	with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
	1066	begin
	1067	StatusText('Retrieving order results...');
	1068	BigOrderID := TOrder(Items.Objects[i]).ID;
	1069	if Length(Piece(BigOrderID,';',1)) > 0 then
	1070	ReportBox(ResultOrder(BigOrderID), 'Order Results - ' + BigOrderID, True);
	1071	Selected[i] := False;
	1072	StatusText('');
	1073	end;
	1074	end;
	1075
	1076	procedure TfrmOrders.mnuViewResultsHistoryClick(Sender: TObject);
	1077	var
	1078	i: Integer;
	1079	BigOrderID: string;
	1080	begin
	1081	inherited;
	1082	if NoneSelected(TX_NOSEL) then Exit;
	1083	with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
	1084	begin
	1085	StatusText('Retrieving order results...');
	1086	BigOrderID := TOrder(Items.Objects[i]).ID;
	1087	if Length(Piece(BigOrderID,';',1)) > 0 then
	1088	ReportBox(ResultOrderHistory(BigOrderID), 'Order Results History- ' + BigOrderID, True);
	1089	Selected[i] := False;
	1090	StatusText('');
	1091	end;
	1092	end;
	1093
	1094	{ lstSheets events ------------------------------------------------------------------------- }
	1095
	1096	procedure TfrmOrders.ClearOrderSheets;
	1097	{ delete all order sheets & associated TOrderView objects, set current view to nil }
	1098	var
	1099	i: Integer;
	1100	begin
	1101	with lstSheets do for i := 0 to Items.Count - 1 do TOrderView(Items.Objects[i]).Free;
	1102	lstSheets.Clear;
	1103	FCurrentView := nil;
	1104	end;
	1105
	1106	procedure TfrmOrders.InitOrderSheets;
	1107	{ sets up list of order sheets based on what orders are on the server in delayed status for pt }
	1108	var
	1109	i: Integer;
	1110	AnEventInfo: String;
	1111	AnOrderView: TOrderView;
	1112	begin
	1113	ClearOrderSheets;
	1114	LoadOrderSheetsED(lstSheets.Items);
	1115	// the 1st item in lstSheets should always be the 'Current' view
	1116	if CharAt(lstSheets.Items[0], 1) <> 'C' then Exit;
	1117	AnOrderView := TOrderView.Create;
	1118	AnOrderView.Filter := STS_ACTIVE;
	1119	AnOrderView.DGroup := DGroupAll;
	1120	AnOrderView.ViewName := 'All Services, Active';
	1121	AnOrderView.InvChrono := True;
	1122	AnOrderView.ByService := True;
	1123	AnOrderView.CtxtTime := 0;
	1124	AnOrderView.TextView := 0;
	1125	AnOrderView.EventDelay.EventType := 'C';
	1126	AnOrderView.EventDelay.Specialty := 0;
	1127	AnOrderView.EventDelay.Effective := 0;
	1128	AnOrderView.EventDelay.EventIFN := 0;
	1129	AnOrderView.EventDelay.EventName := 'All Services, Active';
	1130	lstSheets.Items.Objects[0] := AnOrderView;
	1131	FCurrentView := AnOrderView;
	1132	FOrderViewForActiveOrders := AnOrderView;
	1133	// now setup the event-delayed views in lstSheets, each with its own TOrderView object
	1134	with lstSheets do for i := 1 to Items.Count - 1 do
	1135	begin
	1136	AnOrderView := TOrderView.Create;
	1137	AnOrderView.DGroup := DGroupAll;
	1138	AnEventInfo := EventInfo(Piece(Items[i],'^',1));
	1139	AnOrderView.EventDelay.EventType := CharAt(AnEventInfo, 1);
	1140	AnOrderView.EventDelay.EventIFN := StrToInt(Piece(AnEventInfo,'^',2));
	1141	AnOrderView.EventDelay.EventName := Piece(AnEventInfo,'^',3);
	1142	AnOrderView.EventDelay.Specialty := 0;
	1143	AnOrderView.EventDelay.Effective := 0;
	1144	case AnOrderView.EventDelay.EventType of
	1145	'A': AnOrderView.Filter := 15;
	1146	'D': AnOrderView.Filter := 16;
	1147	'T': AnOrderView.Filter := 17;
	1148	end;
	1149	AnOrderView.ViewName := DisplayText[i] + ' Orders';
	1150	AnOrderView.InvChrono := FCurrentView.InvChrono;
	1151	AnOrderView.ByService := FCurrentView.ByService;
	1152	AnOrderView.CtxtTime := 0;
	1153	AnOrderView.TextView := 0;
	1154	Items.Objects[i] := AnOrderView;
	1155	end; {for}
	1156	lblWrite.Caption := 'Write Orders';
	1157	lstWrite.Caption := lblWrite.Caption;
	1158	end;
	1159
	1160	procedure TfrmOrders.lstSheetsClick(Sender: TObject);
	1161	const
	1162	TX_EVTDEL = 'There are no orders tied to this event, would you like to cancel it?';
	1163	var
	1164	AnOrderView: TOrderView;
	1165	APtEvtId: string;
	1166	begin
	1167	inherited;
	1168	if not CloseOrdering then Exit;
	1169	FCompress := True;
	1170	if lstSheets.ItemIndex < 0 then Exit;
	1171	with lstSheets do
	1172	begin
	1173	AnOrderView := TOrderView(Items.Objects[ItemIndex]);
	1174	AnOrderView.EventDelay.PtEventIFN := StrToIntDef(Piece(Items[lstSheets.ItemIndex],'^',1),0);
	1175	if AnOrderView.EventDelay.PtEventIFN > 0 then
	1176	FCompress := False;
	1177	end;
	1178
	1179	if (FCurrentView <> nil) and (AnOrderView.EventDelay.EventIFN <> FCurrentView.EventDelay.EventIFN) and (FCurrentView.EventDelay.EventIFN > 0 ) then
	1180	begin
	1181	APtEvtID := IntToStr(FCurrentView.EventDelay.PtEventIFN);
	1182	if frmMeds.ActionOnMedsTab then
	1183	Exit;
	1184	if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	1185	Exit;
	1186	if (not FDontCheck) and DeleteEmptyEvt(APtEvtID, FCurrentView.EventDelay.EventName) then
	1187	begin
	1188	ChangesUpdate(APtEvtID);
	1189	FCompress := True;
	1190	InitOrderSheetsForEvtDelay;
	1191	lstSheets.ItemIndex := 0;
	1192	lstSheetsClick(self);
	1193	Exit;
	1194	end;
	1195	end;
	1196
	1197	if (FCurrentView = nil) or (AnOrderView <> FCurrentView) or ((AnOrderView=FcurrentView) and (FCurrentView.EventDelay.EventIFN>0)) then
	1198	begin
	1199	FCurrentView := AnOrderView;
	1200	if FCurrentView.EventDelay.EventIFN > 0 then
	1201	begin
	1202	FCompress := False;
	1203	lstWrite.Items.Clear;
	1204	lblWrite.Caption := 'Write ' + FCurrentView.ViewName;
	1205	lstWrite.Caption := lblWrite.Caption;
	1206	lstWrite.Items.Clear;
	1207	LoadWriteOrdersED(lstWrite.Items, IntToStr(AnOrderView.EventDelay.EventIFN));
	1208	if lstWrite.Items.Count < 1 then
	1209	LoadWriteOrders(lstWrite.Items);
	1210	RefreshOrderList(FROM_SERVER,Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1));
	1211	mnuActRel.Visible := True;
	1212	popOrderRel.Visible := True;
	1213	if (lstOrders.Items.Count = 0) and (not NewEvent) then
	1214	begin
	1215	if frmMeds.ActionOnMedsTab then
	1216	Exit;
	1217	if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	1218	Exit;
	1219	if PtEvtEmpty(Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1)) then
	1220	begin
	1221	if (FAskForCancel) and ( InfoBox(TX_EVTDEL, 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES ) then
	1222	begin
	1223	DeletePtEvent(Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1));
	1224	FCompress := True;
	1225	lstSheets.Items.Objects[lstSheets.ItemIndex].Free;
	1226	lstSheets.Items.Delete(lstSheets.ItemIndex);
	1227	FCurrentView := TOrderView.Create;
	1228	lstSheets.ItemIndex := 0;
	1229	lstSheetsClick(self);
	1230	Exit;
	1231	end;
	1232	end;
	1233	end;
	1234	if NewEvent then
	1235	NewEvent := False;
	1236	end
	1237	else
	1238	begin
	1239	NewEvent := False;
	1240	mnuActRel.Visible := False;
	1241	popOrderRel.Visible := False;
	1242	lblWrite.Caption := 'Write Orders';
	1243	lstWrite.Caption := lblWrite.Caption;
	1244	LoadWriteOrders(lstWrite.Items);
	1245	RefreshOrderList(FROM_SERVER);
	1246	end;
	1247	end else
	1248	begin
	1249	mnuActRel.Visible := False;
	1250	popOrderRel.Visible := False;
	1251	lblWrite.Caption := 'Write Orders';
	1252	lstWrite.Caption := lblWrite.Caption;
	1253	LoadWriteOrders(lstWrite.Items);
	1254	RefreshOrderList(FROM_SERVER);
	1255	end;
	1256	FCompress := True;
	1257	end;
	1258
	1259	{ lstOrders events ------------------------------------------------------------------------- }
	1260
	1261	procedure TfrmOrders.RetrieveVisibleOrders(AnIndex: Integer);
	1262	var
	1263	i: Integer;
	1264	tmplst: TList;
	1265	AnOrder: TOrder;
	1266	begin
	1267	tmplst := TList.Create;
	1268	for i := AnIndex to AnIndex + 100 do
	1269	begin
	1270	if i >= uOrderList.Count then break;
	1271	AnOrder := TOrder(uOrderList.Items[i]);
	1272	if not AnOrder.Retrieved then tmplst.Add(AnOrder);
	1273	end;
	1274	RetrieveOrderFields(tmplst, FCurrentView.TextView, FCurrentView.CtxtTime);
	1275	tmplst.Free;
	1276	end;
	1277
[829]	1278	procedure TfrmOrders.RightClickMessageHandler(var Msg: TMessage;
	1279	var Handled: Boolean);
	1280	begin
	1281	if Msg.Msg = WM_RBUTTONUP then
	1282	lstOrders.RightClickSelect := (lstOrders.SelCount < 1);
	1283	end;
	1284
[456]	1285	function TfrmOrders.GetPlainText(AnOrder: TOrder; index: integer):string;
	1286	var
	1287	i: integer;
	1288	FirstColumnDisplayed: Integer;
	1289	x: string;
	1290	begin
	1291	result := '';
	1292	if hdrOrders.Sections[0].Text = 'Event' then
	1293	FirstColumnDisplayed := 0
	1294	else
	1295	FirstColumnDisplayed := 1;
[829]	1296	for i:= FirstColumnDisplayed to 9 do begin
[456]	1297	x := GetOrderText(AnOrder, index, i);
	1298	if x <> '' then
	1299	result := result + hdrOrders.Sections[i].Text + ': ' + x + CRLF;
	1300	end;
	1301	end;
	1302
	1303	function TfrmOrders.MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer;
	1304	var
	1305	ARect: TRect;
	1306	x: string;
	1307	begin
	1308	x := GetOrderText(AnOrder, Index, Column);
	1309	ARect.Left := 0;
	1310	ARect.Top := 0;
	1311	ARect.Bottom := 0;
	1312	ARect.Right := hdrOrders.Sections[Column].Width -6;
	1313	Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,x,ARect);
	1314	end;
	1315
	1316	procedure TfrmOrders.lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
	1317	var AHeight: Integer);
	1318	var
	1319	AnOrder: TOrder;
	1320	NewHeight: Integer;
	1321	begin
	1322	NewHeight := AHeight;
	1323	with lstOrders do if Index < Items.Count then
	1324	begin
	1325	AnOrder := TOrder(uOrderList.Items[Index]);
	1326	if AnOrder <> nil then with AnOrder do
	1327	begin
	1328	if not AnOrder.Retrieved then RetrieveVisibleOrders(Index);
	1329	Canvas.Font.Style := [];
	1330	if Changes.Exist(CH_ORD, ID) then Canvas.Font.Style := [fsBold];
	1331	end;
	1332	{measure height of event delayed name}
	1333	if hdrOrders.Sections[0].Text = 'Event' then
	1334	NewHeight := HigherOf(AHeight, MeasureColumnHeight(AnOrder, Index, 0));
	1335	{measure height of order text}
	1336	NewHeight := HigherOf(NewHeight, MeasureColumnHeight(AnOrder, Index, 2));
	1337	{measure height of start/stop times}
	1338	NewHeight := HigherOf(NewHeight, MeasureColumnHeight(AnOrder, Index, 3));
[829]	1339	if NewHeight > 255 then NewHeight := 255; // This is maximum allowed by a Windows
[456]	1340	if NewHeight < 13 then NewHeight := 13;
	1341	end;
	1342	AHeight := NewHeight;
	1343	end;
	1344
	1345	function TfrmOrders.GetStartStopText(StartTime: string; StopTime: string): string;
	1346	var
	1347	y: string;
	1348	begin
	1349	result := FormatFMDateTimeStr('mm/dd/yy hh:nn', StartTime);
	1350	if IsFMDateTime(StartTime) and (Length(StartTime) = FM_DATE_ONLY) then result := Piece(result, ' ', 1);
	1351	if Length(result) > 0 then result := 'Start: ' + result;
	1352	y := FormatFMDateTimeStr('mm/dd/yy hh:nn', StopTime);
	1353	if IsFMDateTime(StopTime) and (Length(StopTime) = FM_DATE_ONLY) then y := Piece(y, ' ', 1);
	1354	if Length(y) > 0 then result := result + CRLF + 'Stop: ' + y;
	1355	end;
	1356
	1357	function TfrmOrders.GetOrderText(AnOrder: TOrder; Index: integer; Column: integer): string;
[829]	1358	var
	1359	AReason: TStringlist;
	1360	i: integer;
[456]	1361	begin
	1362	if AnOrder <> nil then with AnOrder do
	1363	begin
	1364	case Column of
	1365	0:
	1366	begin
	1367	result := EventName;
	1368	if (Index > 0) and (result = TOrder(lstOrders.Items.Objects[Index - 1]).EventName) then result := '';
	1369	end;
	1370	1:
	1371	begin
	1372	result := DGroupName;
	1373	if (Index > 0) and (result = TOrder(lstOrders.Items.Objects[Index - 1]).DGroupName) then result := '';
	1374	end;
	1375	2:
	1376	begin
	1377	result := Text;
	1378	if Flagged then
[829]	1379	begin
	1380	if Notifications.Active then
	1381	begin
	1382	AReason := TStringList.Create;
	1383	try
	1384	result := result + crlf;
	1385	LoadFlagReason(AReason, ID);
	1386	for i := 0 to AReason.Count - 1 do
	1387	result := result + AReason[i] + CRLF;
	1388	finally
	1389	AReason.Free;
	1390	end;
	1391	end
	1392	else
	1393	result := result + ' Flagged';
	1394	end;
[456]	1395	end;
	1396	3: result := GetStartStopText( StartTime, StopTime);
	1397	4:
	1398	begin
	1399	result := MixedCase(ProviderName);
	1400	result := Piece(result, ',', 1) + ',' + Copy(Piece(result, ',', 2), 1, 1);
	1401	end;
	1402	5: result := VerNurse;
	1403	6: result := VerClerk;
	1404	7: result := ChartRev;
	1405	8: result := NameOfStatus(Status);
	1406	9: result := MixedCase(Anorder.OrderLocName);
	1407	//begin AGP change 26.52 display all location for orders.
	1408	//result := MixedCase(Anorder.OrderLocName);
	1409	//if (Index > 0) and (result = TOrder(lstOrders.Items.Objects[Index - 1]).OrderLocName) then result := '';
	1410	//end;
	1411	end;
	1412	end;
	1413	end;
	1414
	1415	procedure TfrmOrders.lstOrdersDrawItem(Control: TWinControl; Index: Integer; TheRect: TRect;
	1416	State: TOwnerDrawState);
	1417	var
	1418	i, RightSide: Integer;
	1419	FirstColumnDisplayed: Integer;
	1420	x: string;
	1421	ARect: TRect;
	1422	AnOrder: TOrder;
	1423	SaveColor: TColor;
	1424	begin
	1425	inherited;
	1426	with lstOrders do
	1427	begin
	1428	ARect := TheRect;
	1429	if odSelected in State then
	1430	begin
	1431	Canvas.Brush.Color := clHighlight;
	1432	Canvas.Font.Color := clHighlightText
	1433	end;
	1434	Canvas.FillRect(ARect);
[829]	1435	Canvas.Pen.Color := Get508CompliantColor(clSilver);
[456]	1436	Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
	1437	Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
	1438	RightSide := -2;
	1439
	1440	for i := 0 to 9 do
	1441	begin
	1442	RightSide := RightSide + hdrOrders.Sections[i].Width;
	1443	Canvas.MoveTo(RightSide, ARect.Bottom - 1);
	1444	Canvas.LineTo(RightSide, ARect.Top);
	1445	end;
	1446
	1447	if Index < Items.Count then
	1448	begin
	1449	AnOrder := TOrder(Items.Objects[Index]);
	1450	if hdrOrders.Sections[0].Text = 'Event' then
	1451	FirstColumnDisplayed := 0
	1452	else
	1453	FirstColumnDisplayed := 1;
	1454	if AnOrder <> nil then with AnOrder do for i := FirstColumnDisplayed to 9 do
	1455	begin
	1456	if i > FirstColumnDisplayed then
	1457	ARect.Left := ARect.Right + 2
	1458	else
	1459	ARect.Left := 2;
	1460	ARect.Right := ARect.Left + hdrOrders.Sections[i].Width - 6;
	1461	x := GetOrderText(AnOrder, Index, i);
	1462	SaveColor := Canvas.Brush.Color;
	1463	if i = FirstColumnDisplayed then
	1464	begin
[829]	1465	if Flagged then
[456]	1466	begin
[829]	1467	Canvas.Brush.Color := Get508CompliantColor(clRed);
[456]	1468	Canvas.FillRect(ARect);
	1469	end;
	1470	end;
	1471	if i = 2 then
	1472	begin
	1473	Canvas.Font.Style := [];
	1474	if Changes.Exist(CH_ORD, AnOrder.ID) then Canvas.Font.Style := [fsBold];
	1475	if not (odSelected in State) and (AnOrder.Signature = OSS_UNSIGNED) then
	1476	begin
[829]	1477	if FHighContrast2Mode then
	1478	Canvas.Font.Color := clBlue
	1479	else
	1480	Canvas.Font.Color := Get508CompliantColor(clBlue);
[456]	1481	end;
	1482	end;
	1483	if (i = 2) or (i = 3) or (i = 0) then
	1484	DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK)
	1485	else DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX );
	1486	Canvas.Brush.Color := SaveColor;
	1487	ARect.Right := ARect.Right + 4;
	1488	end;
	1489	end;
	1490	end;
	1491	end;
	1492
	1493	procedure TfrmOrders.hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
	1494	begin
	1495	inherited;
	1496	FEvtColWidth := hdrOrders.Sections[0].Width;
	1497	RedrawOrderList;
	1498	lstOrders.Invalidate;
	1499	pnlRight.Refresh;
	1500	pnlLeft.Refresh;
	1501	end;
	1502
	1503	procedure TfrmOrders.lstOrdersDblClick(Sender: TObject);
	1504	begin
	1505	inherited;
	1506	mnuViewDetailClick(Self);
	1507	end;
	1508
	1509	{ Writing Orders }
	1510
	1511	procedure TfrmOrders.lstWriteClick(Sender: TObject);
	1512	{ ItemID = DlgIEN;FormID;DGroup;DlgType }
	1513	var
	1514	Activated: Boolean;
	1515	NextIndex: Integer;
	1516	begin
[829]	1517	if OrderListClickProcessing then Exit;
	1518	OrderListClickProcessing := true; //Make sure this gets set to false prior to exiting.
	1519	//if PatientStatusChanged then exit;
[456]	1520	if BILLING_AWARE then //CQ5114
	1521	fODConsult.displayDXCode := ''; //CQ5114
	1522
	1523	inherited;
	1524	//frmFrame.UpdatePtInfoOnRefresh;
	1525	if not ActiveOrdering then SetConfirmEventDelay;
	1526	NextIndex := lstWrite.ItemIndex;
	1527	if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
[829]	1528	begin
	1529	OrderListClickProcessing := false;
[456]	1530	Exit;
[829]	1531	end;
[456]	1532	if not ReadyForNewOrder(FCurrentView.EventDelay) then
	1533	begin
	1534	lstWrite.ItemIndex := RefNumFor(Self);
[829]	1535	OrderListClickProcessing := false;
[456]	1536	Exit;
	1537	end;
[829]	1538
[456]	1539	// don't write delayed orders for non-VA meds:
	1540	if (FCurrentView.EventDelay.EventIFN>0) and (Piece(lstWrite.ItemID,';',2) = '145') then
	1541	begin
	1542	InfoBox('Delayed orders cannot be written for Non-VA Medications.', 'Meds, Non-VA', MB_OK);
[829]	1543	OrderListClickProcessing := false;
[456]	1544	Exit;
	1545	end;
	1546
	1547	if (FCurrentView <> nil) and (FCurrentView.EventDelay.EventIFN>0) then
	1548	FRightAfterWriteOrderBox := True;
	1549	lstWrite.ItemIndex := NextIndex; // (ReadyForNewOrder may reset ItemIndex to -1)
	1550	if FCurrentView <> nil then with FCurrentView.EventDelay do
	1551	if (EventType = 'D') and (Effective = 0) then
	1552	if not ObtainEffectiveDate(Effective) then
	1553	begin
	1554	lstWrite.ItemIndex := -1;
[829]	1555	OrderListClickProcessing := false;
[456]	1556	Exit;
	1557	end;
[829]	1558	if frmFrame.CCOWDrivedChange then begin
	1559	OrderListClickProcessing := false;
[456]	1560	Exit;
[829]	1561	end;
[456]	1562	PositionTopOrder(StrToIntDef(Piece(lstWrite.ItemID, ';', 3), 0)); // position Display Group
	1563	case CharAt(Piece(lstWrite.ItemID, ';', 4), 1) of
	1564	'A': Activated := ActivateAction( Piece(lstWrite.ItemID, ';', 1), Self,
	1565	lstWrite.ItemIndex);
	1566	'D', 'Q': Activated := ActivateOrderDialog(Piece(lstWrite.ItemID, ';', 1),
	1567	FCurrentView.EventDelay, Self, lstWrite.ItemIndex);
	1568	'H': Activated := ActivateOrderHTML( Piece(lstWrite.ItemID, ';', 1),
	1569	FCurrentView.EventDelay, Self, lstWrite.ItemIndex);
	1570	'M': Activated := ActivateOrderMenu( Piece(lstWrite.ItemID, ';', 1),
	1571	FCurrentView.EventDelay, Self, lstWrite.ItemIndex);
	1572	'O': Activated := ActivateOrderSet( Piece(lstWrite.ItemID, ';', 1),
	1573	FCurrentView.EventDelay, Self, lstWrite.ItemIndex);
	1574	else Activated := not (InfoBox(TX_BAD_TYPE, TC_BAD_TYPE, MB_OK) = IDOK);
	1575	end; {case}
	1576	if not Activated then
	1577	begin
	1578	lstWrite.ItemIndex := -1;
	1579	FRightAfterWriteOrderBox := False;
	1580	end;
	1581	if (lstSheets.ItemIndex > -1) and (Pos('EVT',Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1))>0) then
	1582	begin
	1583	InitOrderSheetsForEvtDelay;
	1584	lstSheets.ItemIndex := 0;
	1585	lstSheetsClick(Self);
	1586	end;
[829]	1587	OrderListClickProcessing := false;
[456]	1588	if (FCurrentView <> nil) and (FCurrentView.EventDelay.PtEventIFN>0) and
	1589	(PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	1590	Exit;
	1591	end;
	1592
	1593	procedure TfrmOrders.SaveSignOrders;
	1594	var
	1595	SaveOrderID: string;
	1596	i: Integer;
	1597	begin
	1598	// unlock if able??
	1599	if not PatientViewed then Exit;
	1600	if not frmFrame.ContextChanging then with lstOrders do
	1601	begin
	1602	if (TopIndex < Items.Count) and (TopIndex > -1)
	1603	then SaveOrderID := TOrder(Items.Objects[TopIndex]).ID
	1604	else SaveOrderID := '';
	1605	if lstSheets.ItemIndex > 0 then
	1606	RefreshOrderList(FROM_SERVER,Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1))
	1607	else
	1608	RefreshOrderList(FROM_SERVER);
	1609	if Length(SaveOrderID) > 0 then for i := 0 to Items.Count - 1 do
	1610	if TOrder(Items.Objects[i]).ID = SaveOrderID then TopIndex := i;
	1611	end;
	1612	end;
	1613
	1614	{ Action menu events ----------------------------------------------------------------------- }
	1615
	1616	procedure TfrmOrders.ValidateSelected(const AnAction, WarningMsg, WarningTitle: string);
	1617	{ loop to validate action on each selected order, deselect if not valid }
	1618	var
	1619	i: Integer;
	1620	AnOrder: TOrder;
	1621	ErrMsg, AParentID: string;
	1622	GoodList,BadList, CheckedList: TStringList;
	1623	begin
	1624	GoodList := TStringList.Create;
	1625	BadList := TStringList.Create;
	1626	CheckedList := TStringList.Create;
	1627	try
	1628	with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
	1629	begin
	1630	AnOrder := TOrder(Items.Objects[i]);
[829]	1631	if (AnAction = 'RN') and (PassDrugTest(StrtoINT(Piece(AnOrder.ID, ';',1)), 'E', True, True)=True) then
	1632	begin
	1633	ShowMsg('Cannot renew Clozapine orders.');
	1634	Selected[i] := false;
	1635	end;
[456]	1636	if (AnAction = 'RN') and (AnOrder.Status=6) and (AnOrder.DGroupName = 'Inpt. Meds') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then
	1637	begin
	1638	Selected[i] := False;
	1639	MessageDlg('You cannot renew inpatient medication order on a clinic location for selected inpatient.', mtWarning, [mbOK], 0);
	1640	end;
	1641	if ((AnAction = 'RN') or (AnAction = 'EV')) and (AnOrder.EnteredInError = 0) then //AGP Changes PSI-04053
	1642	begin
	1643	if not IsValidSchedule(AnOrder.ID) then
	1644	begin
	1645	if (AnAction = 'RN') then
[829]	1646	ShowMsg('The order contains invalid schedule and can not be renewed.')
[456]	1647	else if (AnAction = 'EV') then
[829]	1648	ShowMsg('The order contains invalid schedule and can not be changed to event delayed order.');
[456]	1649
	1650	Selected[i] := False;
	1651	Continue;
	1652	end;
	1653	end;
	1654	//AGP CHANGE ORDER ENTERED IN ERROR TO ALLOW SIGNATURE AND VERIFY ACTIONS 26.23
	1655	if ((AnOrder.EnteredInError = 1) and ((AnOrder.Status = 1) or (AnOrder.Status = 13))) and ((AnAction <> 'ES') and (AnAction <> 'VR')) then
	1656	begin
	1657	InfoBox(AnOrder.Text + WarningMsg + 'This order has been mark as Entered in error.', WarningTitle, MB_OK);
	1658	Selected[i] := False;
	1659	Continue;
	1660	end;
	1661	if ((AnAction <> OA_RELEASE) and (AnOrder.EnteredInError = 0)) or (((AnOrder.EnteredInError = 1) and ((AnOrder.Status = 1) or (AnOrder.Status = 13))) and
	1662	(AnAction = 'ES')) then
	1663	ValidateOrderAction(AnOrder.ID, AnAction, ErrMsg)
	1664	//AGP END Changes
	1665	else ErrMsg := '';
	1666	if (Length(ErrMsg)>0) and (Pos('COMPLEX-PSI',ErrMsg)<1) then
	1667	begin
	1668	InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
	1669	Selected[i] := False;
	1670	Continue;
	1671	end;
	1672	if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(AnOrder.ID) and (AnAction <> 'RL') then
	1673	begin
	1674	InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
	1675	Selected[i] := False;
	1676	Continue;
	1677	end;
	1678	if (Length(ErrMsg)>0) and ( (AnAction = OA_CHGEVT) or (AnAction = OA_EDREL) ) then
	1679	begin
	1680	InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
	1681	Selected[i] := False;
	1682	Continue;
	1683	end;
	1684	AParentID := '';
	1685	IsValidActionOnComplexOrder(AnOrder.ID, AnAction,TListBox(lstOrders),CheckedList,ErrMsg, AParentID);
	1686	TOrder(Items.Objects[i]).ParentID := AParentID;
	1687	if (Length(ErrMsg)=0) and (AnAction=OA_EDREL) then
	1688	begin
	1689	if (AnOrder.Signature = 2) and (not VerbTelPolicyOrder(AnOrder.ID)) then
	1690	begin
	1691	ErrMsg := 'Need to be signed first.';
	1692	Selected[i] := False;
	1693	end;
	1694	end;
	1695
	1696	if (AnAction = OA_CHGEVT) or (AnAction = OA_EDREL) then
	1697	begin
	1698	if Length(ErrMsg)>0 then
	1699	begin
	1700	Selected[i] := False;
	1701	Badlist.Add(AnOrder.Text + '^' + ErrMsg);
	1702	end
	1703	else
	1704	GoodList.Add(AnOrder.Text);
	1705	end;
	1706
	1707	if (Length(ErrMsg) > 0) and (AnAction <> OA_CHGEVT) and (AnAction <> OA_EDREL) then
	1708	begin
	1709	if Pos('COMPLEX-PSI',ErrMsg)>0 then ErrMsg := TX_COMPLEX;
	1710	InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK);
	1711	Selected[i] := False;
	1712	end;
	1713
	1714	if Selected[i] and (not OrderIsLocked(AnOrder.ID, AnAction)) then Selected[i] := False;
	1715
	1716	end; //with
	1717
	1718	if ((AnAction = OA_CHGEVT) or (AnAction = OA_EDREL)) then
	1719	begin
	1720	if (BadList.Count = 1) and (GoodList.Count < 1 ) then
	1721	InfoBox(Piece(BadList[0],'^',1) + WarningMsg + Piece(BadList[0],'^',2), WarningTitle, MB_OK);
	1722	if ((BadList.Count >= 1) and (GoodList.Count >= 1)) or ( BadList.Count > 1 )then
	1723	DisplayOrdersForAction(BadList,GoodList,AnAction);
	1724	end;
	1725	finally
	1726	GoodList.Free;
	1727	BadList.Free;
	1728	CheckedList.Free;
	1729	end;
	1730	end;
	1731
	1732	procedure TfrmOrders.MakeSelectedList(AList: TList);
	1733	{ make a list of selected orders }
	1734	var
	1735	i: Integer;
	1736	begin
	1737	with lstOrders do for i := 0 to Items.Count - 1 do
	1738	if Selected[i] then AList.Add(Items.Objects[i]);
	1739	end;
	1740
	1741	function TfrmOrders.NoneSelected(const ErrMsg: string): Boolean;
	1742	var
	1743	i: Integer;
	1744	begin
	1745	// use if selcount
	1746	Result := True;
	1747	with lstOrders do for i := 0 to Items.Count - 1 do
	1748	if Selected[i] then
	1749	begin
	1750	Result := False;
	1751	Break;
	1752	end;
	1753	if Result then InfoBox(ErrMsg, TC_NOSEL, MB_OK);
	1754	end;
	1755
	1756	procedure TfrmOrders.RemoveSelectedFromChanges(AList: TList);
	1757	{ remove from Changes orders that were signed or released }
	1758	var
	1759	i: Integer;
	1760	begin
	1761	with AList do for i := 0 to Count - 1 do
	1762	with TOrder(Items[i]) do Changes.Remove(CH_ORD, ID);
	1763	end;
	1764
	1765	procedure TfrmOrders.SynchListToOrders;
	1766	{ make sure lstOrders now reflects the current state of orders }
	1767	var
	1768	i: Integer;
	1769	begin
	1770	with lstOrders do for i := 0 to Items.Count - 1 do
	1771	begin
	1772	Items[i] := GetPlainText(TOrder(Items.Objects[i]),i);
	1773	if Selected[i] then Selected[i] := False;
	1774	end;
	1775	lstOrders.Invalidate;
	1776	end;
	1777
	1778	procedure TfrmOrders.mnuActDCClick(Sender: TObject);
	1779	{ discontinue/cancel/delete the selected orders (as appropriate for each order }
	1780	var
	1781	DelEvt: boolean;
	1782	SelectedList: TList;
	1783	begin
	1784	inherited;
	1785	if NoneSelected(TX_NOSEL) then Exit;
	1786	if not AuthorizedUser then Exit;
	1787	if not (FCurrentView.EventDelay.EventIFN>0) then
	1788	if not EncounterPresent then Exit; // make sure have provider & location
	1789	if not LockedForOrdering then Exit;
	1790	if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	1791	Exit;
	1792	SelectedList := TList.Create;
	1793	try
	1794	//if CheckOrderStatus = True then Exit;
	1795	ValidateSelected(OA_DC, TX_NO_DC, TC_NO_DC); // validate DC action on each order
[829]	1796	ActivateDeactiveRenew; //AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE
[456]	1797	MakeSelectedList(SelectedList); // build list of orders that remain
	1798	// updating the Changes object happens in ExecuteDCOrders, based on individual order
	1799	if ExecuteDCOrders(SelectedList,DelEvt) then SynchListToOrders;
	1800	UpdateUnsignedOrderAlerts(Patient.DFN);
	1801	with Notifications do
	1802	if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then
	1803	UnsignedOrderAlertFollowup(Piece(RecordID, U, 2));
	1804	UpdateExpiringMedAlerts(Patient.DFN);
	1805	UpdateUnverifiedMedAlerts(Patient.DFN);
	1806	UpdateUnverifiedOrderAlerts(Patient.DFN);
	1807	finally
	1808	SelectedList.Free;
	1809	UnlockIfAble;
	1810	end;
	1811	end;
	1812
	1813	procedure TfrmOrders.mnuActRelClick(Sender: TObject);
	1814	var
	1815	SelectedList: TList;
	1816	ALocation: Integer;
	1817	AName: string;
	1818	begin
	1819	inherited;
	1820	if NoneSelected(TX_NOSEL_SIGN) then Exit;
	1821	if not AuthorizedUser then Exit;
	1822	if not CanManualRelease then
	1823	begin
[829]	1824	ShowMsg('You are not authorized to manual release delayed orders.');
[456]	1825	Exit;
	1826	end;
	1827	if Encounter.Location = 0 then // location required for ORCSEND
	1828	begin
	1829	LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
	1830	if ALocation > 0 then Encounter.Location := ALocation;
	1831	frmFrame.DisplayEncounterText;
	1832	end;
	1833	if Encounter.Location = 0 then
	1834	begin
	1835	InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
	1836	Exit;
	1837	end;
	1838	if not LockedForOrdering then Exit;
	1839	SelectedList := TList.Create;
	1840	try
	1841	ValidateSelected(OA_EDREL, TX_NO_REL, TC_NO_REL); // validate realease action on each order
	1842	MakeSelectedList(SelectedList);
	1843	if SelectedList.Count=0 then
	1844	Exit;
	1845	//ExecuteReleaseOrderChecks(SelectedList);
	1846	if not ExecuteReleaseEventOrders(SelectedList) then
	1847	Exit;
	1848	UpdateExpiringMedAlerts(Patient.DFN);
	1849	UpdateUnverifiedMedAlerts(Patient.DFN);
	1850	UpdateUnverifiedOrderAlerts(Patient.DFN);
	1851	FCompress := True;
	1852	SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0);
	1853	finally
	1854	SelectedList.Free;
	1855	UnlockIfAble;
	1856	end;
	1857	end;
	1858
	1859	procedure TfrmOrders.mnuActChgEvntClick(Sender: TObject);
	1860	var
	1861	SelectedList :TList;
	1862	DoesDestEvtOccur: boolean;
	1863	DestPtEvtID: integer;
	1864	DestPtEvtName: string;
	1865	begin
	1866	inherited;
	1867	if not EncounterPresentEDO then Exit;
	1868	if NoneSelected(TX_NOSEL) then Exit;
	1869	if not AuthorizedUser then Exit;
	1870	if not LockedForOrdering then Exit;
	1871	//if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	1872	// Exit;
	1873	DoesDestEvtOccur := False;
	1874	DestPtEvtID := 0;
	1875	DestPtEvtName := '';
	1876	SelectedList := TList.Create;
	1877	try
	1878	if CheckOrderStatus = True then Exit;
	1879	ValidateSelected(OA_CHGEVT, TX_NO_CV, TC_NO_CV); // validate Change Event action on each order
	1880	MakeSelectedList(SelectedList); // build list of orders that remain
	1881	if ExecuteChangeEvt(SelectedList,DoesDestEvtOccur,DestPtEvtId,DestPtEvtName) then
	1882	SynchListToOrders
	1883	else
	1884	Exit;
	1885	UpdateUnsignedOrderAlerts(Patient.DFN);
	1886	with Notifications do
	1887	if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then
	1888	UnsignedOrderAlertFollowup(Piece(RecordID, U, 2));
	1889	UpdateExpiringMedAlerts(Patient.DFN);
	1890	UpdateUnverifiedMedAlerts(Patient.DFN);
	1891	UpdateUnverifiedOrderAlerts(Patient.DFN);
	1892	finally
	1893	SelectedList.Free;
	1894	UnlockIfAble;
	1895	if DoesDestEvtOccur then
	1896	PtEvtCompleted(DestPtEvtID,DestPtEvtName);
	1897	end;
	1898	end;
	1899
	1900	procedure TfrmOrders.mnuActHoldClick(Sender: TObject);
	1901	{ place the selected orders on hold, creates new orders }
	1902	var
	1903	SelectedList: TList;
	1904	begin
	1905	inherited;
	1906	if NoneSelected(TX_NOSEL) then Exit;
	1907	if not AuthorizedUser then Exit;
	1908	if not EncounterPresent then Exit; // make sure have provider & location
	1909	if not LockedForOrdering then Exit;
	1910	if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	1911	Exit;
	1912	SelectedList := TList.Create;
	1913	try
	1914	if CheckOrderStatus = True then Exit;
	1915	ValidateSelected(OA_HOLD, TX_NO_HOLD, TC_NO_HOLD); // validate hold action on each order
	1916	MakeSelectedList(SelectedList); // build list of orders that remain
	1917	if ExecuteHoldOrders(SelectedList) then // confirm & perform hold
	1918	begin
	1919	AddSelectedToChanges(SelectedList); // send held orders to changes
	1920	SynchListToOrders; // ensure ID's in lstOrders are correct
	1921	end;
	1922	finally
	1923	SelectedList.Free;
	1924	UnlockIfAble;
	1925	end;
	1926	end;
	1927
	1928	procedure TfrmOrders.mnuActUnholdClick(Sender: TObject);
	1929	{ release orders from hold, no signature required - no new orders created }
	1930	var
	1931	SelectedList: TList;
	1932	begin
	1933	inherited;
	1934	if NoneSelected(TX_NOSEL) then Exit;
	1935	if not AuthorizedUser then Exit;
	1936	if not EncounterPresent then Exit;
	1937	if not LockedForOrdering then Exit;
	1938	SelectedList := TList.Create;
	1939	try
	1940	if CheckOrderStatus = True then Exit;
	1941	ValidateSelected(OA_UNHOLD, TX_NO_UNHOLD, TC_NO_UNHOLD); // validate release hold action
	1942	MakeSelectedList(SelectedList); // build list of selected orders
	1943	if ExecuteUnholdOrders(SelectedList) then
	1944	begin
	1945	AddSelectedToChanges(SelectedList);
	1946	SynchListToOrders;
	1947	end;
	1948	finally
	1949	SelectedList.Free;
	1950	UnlockIfAble;
	1951	end;
	1952	end;
	1953
	1954	procedure TfrmOrders.mnuActRenewClick(Sender: TObject);
	1955	{ renew the selected orders (as appropriate for each order }
	1956	var
	1957	SelectedList: TList;
	1958	ParntOrder: TOrder;
	1959	begin
	1960	inherited;
	1961	if NoneSelected(TX_NOSEL) then Exit;
	1962	if not AuthorizedUser then Exit;
	1963	if not EncounterPresent then Exit; // make sure have provider & location
	1964	if not LockedForOrdering then Exit;
	1965	SelectedList := TList.Create;
	1966	try
	1967	if CheckOrderStatus = True then Exit;
	1968	ValidateSelected(OA_RENEW, TX_NO_RENEW, TC_NO_RENEW); // validate renew action for each
	1969	MakeSelectedList(SelectedList); // build list of orders that remain
	1970	if Length(FParentComplexOrderID)>0 then
	1971	begin
	1972	ParntOrder := GetOrderByIFN(FParentComplexOrderID);
	1973	if CharAt(ParntOrder.Text,1)='+' then
	1974	ParntOrder.Text := Copy(ParntOrder.Text,2,Length(ParntOrder.Text));
	1975	if Pos('First Dose NOW',ParntOrder.Text)>1 then
	1976	Delete(ParntOrder.text, Pos('First Dose NOW',ParntOrder.Text), Length('First Dose NOW'));
	1977	SelectedList.Add(ParntOrder);
	1978	FParentComplexOrderID := '';
	1979	end;
	1980	if ExecuteRenewOrders(SelectedList) then
	1981	begin
	1982	AddSelectedToChanges(SelectedList); // should this happen in ExecuteRenewOrders?
	1983	SynchListToOrders;
	1984	end;
	1985	UpdateExpiringMedAlerts(Patient.DFN);
	1986	finally
	1987	SelectedList.Free;
	1988	UnlockIfAble;
	1989	end;
	1990	end;
	1991
	1992	procedure TfrmOrders.mnuActAlertClick(Sender: TObject);
	1993	{ set selected orders to send alerts when results are available, - no new orders created }
	1994	var
	1995	SelectedList: TList;
	1996	begin
	1997	inherited;
	1998	if NoneSelected(TX_NOSEL) then Exit;
	1999	if not AuthorizedUser then Exit;
	2000	SelectedList := TList.Create;
	2001	try
	2002	ValidateSelected(OA_ALERT, TX_NO_ALERT, TC_NO_ALERT); // validate release hold action
	2003	MakeSelectedList(SelectedList); // build list of selected orders
	2004	ExecuteAlertOrders(SelectedList);
	2005	finally
	2006	SelectedList.Free;
	2007	end;
	2008	end;
	2009
	2010	procedure TfrmOrders.mnuActFlagClick(Sender: TObject);
	2011	var
	2012	i: Integer;
	2013	AnOrder: TOrder;
	2014	ErrMsg: string;
	2015	begin
	2016	inherited;
	2017	if NoneSelected(TX_NOSEL) then Exit;
	2018	if not AuthorizedUser then Exit;
	2019	if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	2020	Exit;
	2021	with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
	2022	begin
	2023	AnOrder := TOrder(Items.Objects[i]);
	2024	ValidateOrderAction(AnOrder.ID, OA_FLAG, ErrMsg);
	2025	if Length(ErrMsg) > 0
	2026	then InfoBox(AnOrder.Text + TX_NO_FLAG + ErrMsg, TC_NO_FLAG, MB_OK)
	2027	else ExecuteFlagOrder(AnOrder);
	2028	Selected[i] := False;
	2029	end;
	2030	lstOrders.Invalidate;
	2031	end;
	2032
	2033	procedure TfrmOrders.mnuActUnflagClick(Sender: TObject);
	2034	var
	2035	i: Integer;
	2036	AnOrder: TOrder;
	2037	ErrMsg: string;
	2038	begin
	2039	inherited;
	2040	if NoneSelected(TX_NOSEL) then Exit;
	2041	if not AuthorizedUser then Exit;
	2042	with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
	2043	begin
	2044	AnOrder := TOrder(Items.Objects[i]);
	2045	ValidateOrderAction(AnOrder.ID, OA_UNFLAG, ErrMsg);
	2046	if Length(ErrMsg) > 0
	2047	then InfoBox(AnOrder.Text + TX_NO_UNFLAG + ErrMsg, TC_NO_UNFLAG, MB_OK)
	2048	else ExecuteUnflagOrder(AnOrder);
	2049	Selected[i] := False;
	2050	end;
	2051	lstOrders.Invalidate;
	2052	if Notifications.Active then AutoUnflagAlertedOrders(Patient.DFN, Piece(Notifications.RecordID, U, 2));
	2053	end;
	2054
	2055	procedure TfrmOrders.mnuActCompleteClick(Sender: TObject);
	2056	{ complete generic orders, no signature required - no new orders created }
	2057	var
	2058	SelectedList: TList;
	2059	begin
	2060	inherited;
	2061	if NoneSelected(TX_NOSEL) then Exit;
	2062	if not AuthorizedUser then Exit;
	2063	SelectedList := TList.Create;
	2064	try
	2065	ValidateSelected(OA_COMPLETE, TX_NO_CPLT, TC_NO_CPLT); // validate completing of order
	2066	MakeSelectedList(SelectedList); // build list of selected orders
	2067	if ExecuteCompleteOrders(SelectedList) then SynchListToOrders;
	2068	finally
	2069	SelectedList.Free;
	2070	end;
	2071	end;
	2072
	2073	procedure TfrmOrders.mnuActVerifyClick(Sender: TObject);
	2074	{ verify orders, signature required but no new orders created }
	2075	var
	2076	SelectedList: TList;
	2077	begin
	2078	inherited;
	2079	if NoneSelected(TX_NOSEL) then Exit;
	2080	if not AuthorizedToVerify then Exit;
	2081	SelectedList := TList.Create;
	2082	try
	2083	ValidateSelected(OA_VERIFY, TX_NO_VERIFY, TC_NO_VERIFY); // make sure order can be verified
	2084	MakeSelectedList(SelectedList); // build list of selected orders
	2085	if ExecuteVerifyOrders(SelectedList, False) then SynchListToOrders;
	2086	finally
	2087	SelectedList.Free;
	2088	end;
	2089	end;
	2090
	2091	procedure TfrmOrders.mnuActChartRevClick(Sender: TObject);
	2092	var
	2093	SelectedList: TList;
	2094	begin
	2095	inherited;
	2096	if NoneSelected(TX_NOSEL) then Exit;
	2097	if not AuthorizedToVerify then Exit;
	2098	SelectedList := TList.Create;
	2099	try
	2100	ValidateSelected(OA_CHART, TX_NO_VERIFY, TC_NO_VERIFY); // make sure order can be verified
	2101	MakeSelectedList(SelectedList); // build list of selected orders
	2102	if ExecuteVerifyOrders(SelectedList, True) then SynchListToOrders;
	2103	finally
	2104	SelectedList.Free;
	2105	end;
	2106	end;
	2107
	2108	procedure TfrmOrders.mnuActCommentClick(Sender: TObject);
	2109	{ loop thru selected orders, allowing ward comments to be edited for each }
	2110	var
	2111	i: Integer;
	2112	AnOrder: TOrder;
	2113	ErrMsg: string;
	2114	begin
	2115	inherited;
	2116	if NoneSelected(TX_NOSEL) then Exit;
	2117	if not AuthorizedUser then Exit;
	2118	if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	2119	Exit;
	2120	with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
	2121	begin
	2122	AnOrder := TOrder(Items.Objects[i]);
	2123	ValidateOrderAction(AnOrder.ID, OA_COMMENT, ErrMsg);
	2124	if Length(ErrMsg) > 0
	2125	then InfoBox(AnOrder.Text + TX_NO_CMNT + ErrMsg, TC_NO_CMNT, MB_OK)
	2126	else ExecuteWardComments(AnOrder);
	2127	Selected[i] := False;
	2128	end;
	2129	end;
	2130
	2131	procedure TfrmOrders.mnuActChangeClick(Sender: TObject);
	2132	{ loop thru selected orders, present ordering dialog for each with defaults to selected order }
	2133	var
	2134	i: Integer;
	2135	ChangeIFNList: TStringList;
	2136	ASourceOrderID : string;
	2137	begin
	2138
	2139	inherited;
	2140	if not EncounterPresentEDO then exit;
	2141	ChangeIFNList := TStringList.Create;
	2142	try
	2143	if NoneSelected(TX_NOSEL) then Exit;
	2144	if CheckOrderStatus = True then Exit;
	2145	ValidateSelected(OA_CHANGE, TX_NO_CHANGE, TC_NO_CHANGE);
	2146	if (FCurrentView.EventDelay.PtEventIFN>0) and
	2147	PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName) then
	2148	Exit;
	2149	with lstOrders do for i := 0 to Items.Count - 1 do
	2150	if Selected[i] then
	2151	begin
	2152	ChangeIFNList.Add(TOrder(Items.Objects[i]).ID);
	2153	ASourceOrderID := TOrder(lstOrders.Items.Objects[i]).ID;
	2154	end;
	2155	if ChangeIFNList.Count > 0 then
	2156	ChangeOrders(ChangeIFNList, FCurrentView.EventDelay);
	2157	// do we need to deselect the orders?
	2158	finally
	2159	ChangeIFNList.Free;
	2160	end;
[829]	2161	if frmFrame.TimedOut then Exit;
[456]	2162	RedrawOrderList;
	2163	end;
	2164
	2165	procedure TfrmOrders.mnuActCopyClick(Sender: TObject);
	2166	{ loop thru selected orders, present ordering dialog for each with defaults to selected order }
	2167	var
	2168	ThePtEvtID: string;
	2169	i: Integer;
	2170	IsNewEvent, needVerify, NewOrderCreated: boolean;
	2171	CopyIFNList: TStringList;
	2172	DestPtEvtID: integer;
	2173	DestPtEvtName: string;
	2174	DoesDestEvtOccur: boolean;
	2175	TempEvent: TOrderDelayEvent;
	2176	begin
	2177	inherited;
	2178	if not EncounterPresentEDO then Exit;
	2179	DestPtEvtID := 0;
	2180	DestPtEvtName := '';
	2181	DoesDestEvtOccur := False;
	2182	needVerify := True;
	2183	CopyIFNList := TStringList.Create;
	2184	try
	2185	if NoneSelected(TX_NOSEL) then Exit;
	2186	NewOrderCreated := False;
	2187	if CheckOrderStatus = True then Exit;
	2188	ValidateSelected(OA_COPY, TX_NO_COPY, TC_NO_COPY);
	2189	if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	2190	Exit;
	2191	with lstOrders do for i := 0 to Items.Count - 1 do
	2192	if Selected[i] then
	2193	CopyIFNList.Add(TOrder(Items.Objects[i]).ID);
	2194
	2195	IsNewEvent := False;
	2196	//if not ShowMsgOn(CopyIFNList.Count = 0, TX_NOSEL, TC_NOSEL) then
	2197	if CopyIFNList.Count > 0 then
	2198	if SetViewForCopy(IsNewEvent,DoesDestEvtOccur,DestPtEvtId,DestPtEvtName) then
	2199	begin
	2200	if DoesDestEvtOccur then
	2201	begin
	2202	TempEvent.TheParent := TParentEvent.Create;
	2203	TempEvent.EventIFN := 0;
	2204	TempEvent.PtEventIFN := 0;
	2205	TempEvent.EventType := #0;
	2206	CopyOrders(CopyIFNList, TempEvent, DoesDestEvtOccur, needVerify);
	2207	if ImmdCopyAct then
	2208	ImmdCopyAct := False;
	2209	PtEvtCompleted(DestPtEvtID,DestPtEvtName);
	2210	Exit;
	2211	end;
	2212	FCurrentView.EventDelay.EventName := DestPtEvtName;
	2213	if (FCurrentView.EventDelay.EventIFN > 0) and (FCurrentView.EventDelay.EventType <> 'D') then
	2214	begin
	2215	needVerify := False;
	2216	uAutoAC := True;
	2217	end;
	2218	TempEvent.EventName := DestPtEvtName; //FCurrentView.EventDelay.EventName;
	2219	TempEvent.PtEventIFN := DestPtEvtId; //FCurrentView.EventDelay.PtEventIFN;
	2220	if (FCurrentView.EventDelay.EventType = 'D') or ((not Patient.InPatient) and (FCurrentView.EventDelay.EventType = 'T')) then
	2221	begin
	2222	if TransferOrders(CopyIFNList, FCurrentView.EventDelay, DoesDestEvtOccur, needVerify) then NewOrderCreated := True;
	2223	end
	2224	else if (not Patient.Inpatient) and (FCurrentView.EventDelay.EventType = 'A') then
	2225	begin
	2226	if TransferOrders(CopyIFNList, FCurrentView.EventDelay, DoesDestEvtOccur, needVerify) then NewOrderCreated := True;
	2227	end
	2228	else
	2229	begin
	2230	if CopyOrders(CopyIFNList, FCurrentView.EventDelay, DoesDestEvtOccur, needVerify) then
	2231	NewOrderCreated := True;
	2232	end;
	2233	if (not NewOrderCreated) and Assigned(FCurrentView) and (FCurrentView.EventDelay.EventIFN>0) then
	2234	if isExistedEvent(Patient.DFN,IntToStr(FCurrentView.EventDelay.EventIFN),ThePtEvtID) then
	2235	begin
	2236	if PtEvtEmpty(ThePtEvtID) then
	2237	begin
	2238	DeletePtEvent(ThePtEvtID);
	2239	ChangesUpdate(ThePtEvtID);
	2240	InitOrderSheetsForEvtDelay;
	2241	lstSheets.ItemIndex := 0;
	2242	lstSheetsClick(self);
	2243	end;
	2244	end;
	2245	if ImmdCopyAct then
	2246	ImmdCopyAct := False;
	2247	if DoesDestEvtOccur then
	2248	PtEvtCompleted(DestPtEvtId, DestPtEvtName);
	2249	end;
	2250	finally
	2251	uAutoAC := False;
	2252	CopyIFNList.Free;
	2253	end;
	2254
	2255	end;
	2256
	2257	procedure TfrmOrders.mnuActReleaseClick(Sender: TObject);
	2258	{ release orders to services without a signature, do appropriate prints }
	2259	var
	2260	SelectedList: TList;
	2261	ALocation: Integer;
	2262	AName: string;
	2263	begin
	2264	inherited;
	2265	if NoneSelected(TX_NOSEL) then Exit;
	2266	if not AuthorizedUser then Exit;
	2267	if Encounter.Location = 0 then // location required for ORCSEND
	2268	begin
	2269	LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
	2270	if ALocation > 0 then Encounter.Location := ALocation;
	2271	frmFrame.DisplayEncounterText;
	2272	end;
	2273	if Encounter.Location = 0 then
	2274	begin
	2275	InfoBox(TX_REL_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
	2276	Exit;
	2277	end;
	2278	if not LockedForOrdering then Exit;
	2279	SelectedList := TList.Create;
	2280	try
	2281	ValidateSelected(OA_RELEASE, TX_NO_REL, TC_NO_REL); // validate release action on each order
	2282	MakeSelectedList(SelectedList); // build list of orders that remain
	2283	ExecuteReleaseOrderChecks(SelectedList); // call order checking
	2284	if not uInit.TimedOut then
	2285	if ExecuteReleaseOrders(SelectedList) then // confirm, then perform release
	2286	RemoveSelectedFromChanges(SelectedList); // remove released orders from Changes
	2287	//SaveSignOrders;
	2288	UpdateUnsignedOrderAlerts(Patient.DFN);
	2289	with Notifications do
	2290	if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then
	2291	UnsignedOrderAlertFollowup(Piece(RecordID, U, 2));
	2292	UpdateExpiringMedAlerts(Patient.DFN);
	2293	UpdateUnverifiedMedAlerts(Patient.DFN);
	2294	UpdateUnverifiedOrderAlerts(Patient.DFN);
	2295	if not uInit.TimedOut then SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0);
	2296	finally
	2297	SelectedList.Free;
	2298	UnlockIfAble;
	2299	end;
	2300	end;
	2301
	2302	procedure TfrmOrders.mnuActOnChartClick(Sender: TObject);
	2303	{ mark orders orders as signed on chart, release to services, do appropriate prints }
	2304	var
	2305	SelectedList: TList;
	2306	ALocation: Integer;
	2307	AName: string;
	2308	begin
	2309	inherited;
	2310	if NoneSelected(TX_NOSEL) then Exit;
	2311	if not AuthorizedUser then Exit;
	2312	if Encounter.Location = 0 then // location required for ORCSEND
	2313	begin
	2314	LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
	2315	if ALocation > 0 then Encounter.Location := ALocation;
	2316	frmFrame.DisplayEncounterText;
	2317	end;
	2318	if Encounter.Location = 0 then
	2319	begin
	2320	InfoBox(TX_CHART_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
	2321	Exit;
	2322	end;
	2323	if not LockedForOrdering then Exit;
	2324	SelectedList := TList.Create;
	2325	try
	2326	ValidateSelected(OA_ONCHART, TX_NO_CHART, TC_NO_CHART); // validate sign on chart for each
	2327	MakeSelectedList(SelectedList); // build list of orders that remain
	2328	ExecuteReleaseOrderChecks(SelectedList); // call order checking
	2329	if not uInit.TimedOut then
	2330	if ExecuteOnChartOrders(SelectedList) then // confirm, then perform release
	2331	RemoveSelectedFromChanges(SelectedList); // remove released orders from Changes
	2332	UpdateUnsignedOrderAlerts(Patient.DFN);
	2333	with Notifications do
	2334	if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then
	2335	UnsignedOrderAlertFollowup(Piece(RecordID, U, 2));
	2336	UpdateExpiringMedAlerts(Patient.DFN);
	2337	UpdateUnverifiedMedAlerts(Patient.DFN);
	2338	UpdateUnverifiedOrderAlerts(Patient.DFN);
	2339	if not uInit.TimedOut then SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0);
	2340	finally
	2341	SelectedList.Free;
	2342	UnlockIfAble;
	2343	end;
	2344	end;
	2345
	2346	procedure TfrmOrders.mnuActSignClick(Sender: TObject);
	2347	{ obtain signature for orders, release them to services, do appropriate prints }
	2348	var
	2349	SelectedList: TList;
	2350	ALocation: Integer;
	2351	AName: string;
	2352	begin
	2353	inherited;
	2354	if NoneSelected(TX_NOSEL_SIGN) then Exit;
	2355	if not AuthorizedUser then Exit;
	2356	if (User.OrderRole <> 2) and (User.OrderRole <> 3) then
	2357	begin
[829]	2358	ShowMsg('Sorry, You don''t have the permission to release selected orders manually');
[456]	2359	Exit;
	2360	end;
	2361	if not (FCurrentView.EventDelay.EventIFN>0) then
	2362	begin
	2363	if Encounter.Location = 0 then // location required for ORCSEND
	2364	begin
	2365	LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
	2366	if ALocation > 0 then Encounter.Location := ALocation;
	2367	frmFrame.DisplayEncounterText;
	2368	end;
	2369	if Encounter.Location = 0 then
	2370	begin
	2371	InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
	2372	Exit;
	2373	end;
	2374	end;
	2375	if not LockedForOrdering then Exit;
	2376
	2377	if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	2378	Exit;
	2379
	2380	SelectedList := TList.Create;
	2381	try
	2382	ValidateSelected(OA_SIGN, TX_NO_SIGN, TC_NO_SIGN); // validate sign action on each order
	2383	MakeSelectedList(SelectedList);
	2384	{billing Aware}
	2385	if BILLING_AWARE then
	2386	begin
	2387	UBACore.rpcBuildSCIEList(SelectedList); // build list of orders and Billable Status
	2388	UBACore.CompleteUnsignedBillingInfo(rpcGetUnsignedOrdersBillingData(OrderListSCEI) );
	2389	end;
	2390
	2391	{billing Aware}
	2392	ExecuteReleaseOrderChecks(SelectedList); // call order checking
	2393	if not uInit.TimedOut then
	2394	if ExecuteSignOrders(SelectedList) // confirm, sign & release
	2395	then RemoveSelectedFromChanges(SelectedList); // remove signed orders from Changes
	2396	UpdateUnsignedOrderAlerts(Patient.DFN);
	2397	with Notifications do
	2398	if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then
	2399	UnsignedOrderAlertFollowup(Piece(RecordID, U, 2));
	2400	if Active then
	2401	begin
	2402	UpdateExpiringMedAlerts(Patient.DFN);
	2403	UpdateUnverifiedMedAlerts(Patient.DFN);
	2404	UpdateUnverifiedOrderAlerts(Patient.DFN);
	2405	end;
	2406	if not uInit.TimedOut then
	2407	begin
	2408	SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0);
	2409	if lstSheets.ItemIndex < 0 then
	2410	lstSheets.ItemIndex := 0;
	2411	end;
	2412	finally
	2413	SelectedList.Free;
	2414	UnlockIfAble;
	2415	end;
	2416	end;
	2417
	2418	procedure TfrmOrders.mnuOptSaveQuickClick(Sender: TObject);
	2419	begin
	2420	inherited;
	2421	QuickOrderSave;
	2422	end;
	2423
	2424	procedure TfrmOrders.mnuOptEditCommonClick(Sender: TObject);
	2425	begin
	2426	inherited;
	2427	QuickOrderListEdit;
	2428	end;
	2429
	2430	procedure TfrmOrders.ProcessNotifications;
	2431	var
	2432	OrderIEN, ErrMsg: string;
	2433	BigOrderID: string;
	2434	begin
	2435	//if not User.NoOrdering then LoadWriteOrders(lstWrite.Items) else lstWrite.Clear; {KCM}
	2436	OrderIEN := IntToStr(ExtractInteger(Notifications.AlertData));
	2437	case Notifications.FollowUp of
	2438	NF_FLAGGED_ORDERS :
	2439	begin
	2440	ViewAlertedOrders('', STS_FLAGGED, '', False, True, 'All Services, Flagged');
	2441	AutoUnflagAlertedOrders(Patient.DFN, Piece(Notifications.RecordID, U, 2));
	2442	end;
	2443	NF_ORDER_REQUIRES_ELEC_SIGNATURE :
	2444	begin
	2445	ViewAlertedOrders('', STS_UNSIGNED, '', False, True, 'All Services, Unsigned');
	2446	UnsignedOrderAlertFollowup(Piece(Notifications.RecordID, U, 2));
	2447	end;
	2448	NF_IMAGING_REQUEST_CANCEL_HELD :
	2449	if Pos('HELD', UpperCase(Notifications.Text)) > 0 then
	2450	begin
	2451	ViewAlertedOrders(OrderIEN, STS_HELD, 'IMAGING', False, True, 'Imaging, On Hold');
	2452	Notifications.Delete;
	2453	end
	2454	else
	2455	begin
	2456	ViewAlertedOrders(OrderIEN, STS_DISCONTINUED, 'IMAGING', False, True, 'Imaging, Cancelled');
	2457	Notifications.Delete;
	2458	end;
	2459	NF_SITE_FLAGGED_RESULTS :
	2460	begin
	2461	ViewAlertedOrders(OrderIEN, STS_COMPLETE, '', False, True, 'All Services, Site-Flagged');
	2462	with lstOrders do if Selected[ItemIndex] then
	2463	begin
	2464	BigOrderID := TOrder(Items.Objects[ItemIndex]).ID;
	2465	if Length(Piece(BigOrderID,';',1)) > 0 then
	2466	begin
	2467	ReportBox(ResultOrder(BigOrderID), 'Order Results - ' + BigOrderID, True);
	2468	Notifications.Delete;
	2469	end;
	2470	end;
	2471	end;
	2472	NF_ORDERER_FLAGGED_RESULTS :
	2473	begin
	2474	ViewAlertedOrders(OrderIEN, STS_COMPLETE, '', False, True, 'All Services, Orderer-Flagged');
	2475	with lstOrders do if Selected[ItemIndex] then
	2476	begin
	2477	BigOrderID := TOrder(Items.Objects[ItemIndex]).ID;
	2478	if Length(Piece(BigOrderID,';',1)) > 0 then
	2479	begin
	2480	ReportBox(ResultOrder(BigOrderID), 'Order Results - ' + BigOrderID, True);
	2481	Notifications.Delete;
	2482	end;
	2483	end;
	2484	end;
	2485	NF_ORDER_REQUIRES_COSIGNATURE :
	2486	ViewAlertedOrders('', STS_UNSIGNED, '', False, True, 'All Services, Unsigned');
	2487	NF_LAB_ORDER_CANCELED :
	2488	begin
	2489	ViewAlertedOrders(OrderIEN, STS_DISCONTINUED, 'LABORATORY', False, True, 'Lab, Cancelled');
	2490	Notifications.Delete;
	2491	end;
	2492	NF_DNR_EXPIRING :
	2493	ViewAlertedOrders('', STS_EXPIRING, '', False, True, 'All Services, Expiring');
	2494	NF_MEDICATIONS_EXPIRING_INPT :
	2495	begin
	2496	ViewAlertedOrders('', STS_EXPIRING, 'PHARMACY', False, True, 'Medications, Expiring');
	2497	end;
	2498	NF_MEDICATIONS_EXPIRING_OUTPT :
	2499	begin
	2500	ViewAlertedOrders('', STS_EXPIRING, 'PHARMACY', False, True, 'Medications, Expiring');
	2501	end;
	2502	NF_UNVERIFIED_MEDICATION_ORDER :
	2503	begin
	2504	ViewAlertedOrders(OrderIEN, STS_UNVERIFIED, 'PHARMACY', False, True, 'Medications, Unverified');
	2505	if StrToIntDef(OrderIEN, 0) > 0 then {REV}
	2506	begin // Delete alert if user can't verify
	2507	ValidateOrderAction(OrderIEN, OA_VERIFY, ErrMsg);
	2508	if Pos('COMPLEX-PSI',ErrMsg)>0 then
	2509	ErrMsg := TX_COMPLEX;
	2510	if Length(ErrMsg) > 0 then Notifications.Delete;
	2511	end;
	2512	UpdateUnverifiedMedAlerts(Patient.DFN);
	2513	end;
	2514	NF_NEW_ORDER :
	2515	begin
	2516	ViewAlertedOrders(OrderIEN, STS_RECENT, '', False, True, 'All Services, Recent Activity');
	2517	Notifications.Delete;
	2518	end;
	2519	NF_UNVERIFIED_ORDER :
	2520	begin
	2521	ViewAlertedOrders(OrderIEN, STS_UNVERIFIED, '', False, True, 'All Services, Unverified');
	2522	if StrToIntDef(OrderIEN, 0) > 0 then {REV}
	2523	begin // Delete alert if user can't verify
	2524	ValidateOrderAction(OrderIEN, OA_SIGN, ErrMsg);
	2525	if Pos('COMPLEX-PSI',ErrMsg)>0 then
	2526	ErrMsg := TX_COMPLEX;
	2527	if Length(ErrMsg) > 0 then Notifications.Delete;
	2528	end;
	2529	UpdateUnverifiedOrderAlerts(Patient.DFN);
	2530	end;
	2531	NF_FLAGGED_OI_RESULTS :
	2532	begin
	2533	ViewAlertedOrders(OrderIEN, STS_COMPLETE, '', False, True, 'All Services, Orderable Item Flagged');
	2534	with lstOrders do if Selected[ItemIndex] then
	2535	begin
	2536	BigOrderID := TOrder(Items.Objects[ItemIndex]).ID;
	2537	if Length(Piece(BigOrderID,';',1)) > 0 then
	2538	begin
	2539	ReportBox(ResultOrder(BigOrderID), 'Order Results - ' + BigOrderID, True);
	2540	Notifications.Delete;
	2541	end;
	2542	end;
	2543	end;
	2544	NF_DC_ORDER :
	2545	begin
	2546	ViewAlertedOrders(OrderIEN, STS_RECENT, '', False, True, 'All Services, Recent Activity');
	2547	Notifications.Delete;
	2548	end;
	2549	NF_FLAGGED_OI_EXP_INPT :
	2550	begin
	2551	ViewAlertedOrders('', STS_EXPIRING, '', False, True, 'All Services, Expiring');
	2552	UpdateExpiringFlaggedOIAlerts(Patient.DFN, NF_FLAGGED_OI_EXP_INPT);
	2553	end;
	2554	NF_FLAGGED_OI_EXP_OUTPT :
	2555	begin
	2556	ViewAlertedOrders('', STS_EXPIRING, '', False, True, 'All Services, Expiring');
	2557	UpdateExpiringFlaggedOIAlerts(Patient.DFN, NF_FLAGGED_OI_EXP_OUTPT);
	2558	end;
	2559	NF_CONSULT_REQUEST_CANCEL_HOLD :
	2560	begin
	2561	OrderIEN := GetConsultOrderNumber(Notifications.AlertData);
	2562	ViewAlertedOrders(OrderIEN, STS_DISCONTINUED, 'CONSULTS', False, True, 'Consults, Cancelled');
	2563	with lstOrders do Selected[ItemIndex] := True;
	2564	end;
	2565	else mnuViewUnsignedClick(Self);
	2566	end;
	2567	end;
	2568
	2569	procedure TfrmOrders.ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string;
	2570	BySvc, InvDate: boolean; Title: string); {KCM}
	2571	var
	2572	i, ADGroup: integer;
	2573	DGroups: TStrings;
	2574	begin
	2575	DGroups := TStringList.Create;
	2576	try
	2577	ADGroup := DGroupAll;
	2578	if Length(DispGrp) > 0 then
	2579	begin
	2580	ListDGroupAll(DGroups);
	2581	for i := 0 to DGroups.Count-1 do
	2582	if Piece(DGroups.Strings[i], U, 2) = DispGrp then
	2583	ADGroup := StrToIntDef(Piece(DGroups.Strings[i], U, 1),0);
	2584	end;
	2585	finally
	2586	DGroups.Free;
	2587	end;
	2588	SetOrderView(Status, ADGroup, Title, True);
	2589	with lstOrders do
	2590	begin
	2591	if Length(OrderIEN) > 0 then
	2592	begin
	2593	for i := 0 to Items.Count-1 do
	2594	if Piece(TOrder(Items.Objects[i]).ID, ';', 1) = OrderIEN then
	2595	begin
	2596	ItemIndex := i;
	2597	Selected[i] := True;
	2598	break;
	2599	end;
	2600	end
	2601	else for i := 0 to Items.Count-1 do
	2602	if Piece(TOrder(Items.Objects[i]).ID, ';', 1) <> '0' then Selected[i] := True;
	2603	if SelCount = 0 then Notifications.Delete;
	2604	end;
	2605	end;
	2606
	2607	procedure TfrmOrders.pnlRightResize(Sender: TObject);
	2608	begin
	2609	inherited;
	2610	imgHide.Left := pnlRight.Width - 19;
	2611	end;
	2612
	2613	procedure TfrmOrders.RequestPrint;
	2614	{ obtain print devices for selected orders, do appropriate prints }
	2615	const
	2616	TX_NEW_LOC1 = 'The patient''s location has changed to ';
	2617	TX_NEW_LOC2 = '.' + CRLF + 'Should the orders be printed using the new location?';
	2618	TC_NEW_LOC = 'New Patient Location';
	2619	var
	2620	SelectedList: TStringList;
	2621	ALocation, i: Integer;
	2622	AName, ASvc, DeviceInfo: string;
	2623	Nature: char;
	2624	PrintIt: Boolean;
	2625	begin
	2626	inherited;
	2627	if NoneSelected(TX_NOSEL) then Exit;
	2628	//if not AuthorizedUser then Exit; removed in v17.1 (RV) SUX-0901-41044
	2629	SelectedList := TStringList.Create;
	2630	Nature := #0;
	2631	try
	2632	with lstOrders do for i := 0 to Items.Count - 1 do
	2633	if Selected[i] then SelectedList.Add(Piece(TOrder(Items.Objects[i]).ID, U, 1));
	2634	CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc);
	2635	if (ALocation > 0) and (ALocation <> Encounter.Location) then
	2636	begin
	2637	//gary
	2638	Encounter.Location := frmClinicWardMeds.ClinicOrWardLocation(Alocation);
	2639	// if InfoBox(TX_NEW_LOC1 + AName + TX_NEW_LOC2, TC_NEW_LOC, MB_YESNO) = IDYES
	2640	// then Encounter.Location := ALocation;
	2641	end;
	2642	if Encounter.Location = 0
	2643	then Encounter.Location := CommonLocationForOrders(SelectedList);
	2644	if Encounter.Location = 0 then // location required for DEVINFO
	2645	begin
	2646	LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT);
	2647	if ALocation > 0 then Encounter.Location := ALocation;
	2648	end;
	2649	frmFrame.DisplayEncounterText;
	2650	if Encounter.Location <> 0 then
	2651	begin
	2652	SetupOrdersPrint(SelectedList, DeviceInfo, Nature, False, PrintIt);
	2653	if PrintIt then ExecutePrintOrders(SelectedList, DeviceInfo);
	2654	SynchListToOrders;
	2655	end
	2656	else InfoBox(TX_PRINT_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING);
	2657	finally
	2658	SelectedList.Free;
	2659	end;
	2660	end;
	2661
	2662	procedure TfrmOrders.btnDelayedOrderClick(Sender: TObject);
	2663	const
	2664	TX_DELAYCAP = ' Delay release of new order(s) until';
	2665	var
	2666	AnEvent: TOrderDelayEvent;
	2667	ADlgLst: TStringList;
	2668	IsRealeaseNow: boolean;
	2669	begin
	2670	inherited;
	2671	if not EncounterPresentEDO then Exit;
	2672	AnEvent.EventType := #0;
	2673	AnEvent.TheParent := TParentEvent.Create;
	2674	AnEvent.EventIFN := 0;
	2675	AnEvent.PtEventIFN := 0;
	2676	AnEvent.EventName := '';
	2677	if not CloseOrdering then Exit;
	2678	FCalledFromWDO := True;
	2679	//frmFrame.UpdatePtInfoOnRefresh;
	2680	IsRealeaseNow := False;
	2681	FCompress := True; //treat as lstSheet click
	2682	ADlgLst := TStringList.Create;
	2683	//SetEvtIFN(AnEvent.EventIFN);
	2684	if ShowDelayedEventsTreatingSepecialty(TX_DELAYCAP,AnEvent,ADlgLst,IsRealeaseNow) then
	2685	begin
	2686	FEventForCopyActiveOrders := AnEvent;
	2687	FAskForCancel := False;
	2688	ResetOrderPage(AnEvent,ADlgLst, IsRealeaseNow);
	2689	end;
	2690	FCompress := False;
	2691	FCalledFromWDO := False;
	2692	if (FCurrentView <> nil) and (FCurrentView.EventDelay.PtEventIFN>0) and
	2693	(PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then
	2694	Exit;
	2695	end;
	2696
	2697	procedure TfrmOrders.CompressEventSection;
	2698	begin
	2699	hdrOrders.Sections[0].MaxWidth := 0;
	2700	hdrOrders.Sections[0].MinWidth := 0;
	2701	hdrOrders.Sections[0].Width := 0;
	2702	hdrOrders.Sections[0].Text := '';
	2703	end;
	2704
	2705	procedure TfrmOrders.ExpandEventSection;
	2706	begin
	2707	hdrOrders.Sections[0].MaxWidth := 10000;
	2708	hdrOrders.Sections[0].MinWidth := 50;
	2709	if FEvtColWidth > 0 then
	2710	hdrOrders.Sections[0].Width := EvtColWidth
	2711	else
	2712	hdrOrders.Sections[0].Width := 65;
	2713	hdrOrders.Sections[0].Text := 'Event';
	2714	end;
	2715
	2716	{procedure TfrmOrders.SetEvtIFN(var AnEvtIFN: integer);
	2717	var
	2718	APtEvntID,AnEvtInfo: string;
	2719	begin
	2720	if lstSheets.ItemIndex < 0 then
	2721	APtEvntID := Piece(lstSheets.Items[0],'^',1)
	2722	else
	2723	APtEvntID := Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1);
	2724	if CharAt(APtEvntID,1) <> 'C' then
	2725	begin
	2726	if Pos('EVT',APtEvntID)>0 then
	2727	AnEvtIFN := StrToIntDef(Piece(APtEvntID,';',1),0)
	2728	else
	2729	begin
	2730	AnEvtInfo := EventInfo(APtEvntID);
	2731	AnEvtIFN := StrToIntDef(Piece(AnEvtInfo,'^',2),0);
	2732	end;
	2733	end else
	2734	AnEvtIFN := 0;
	2735	end;}
	2736
	2737	procedure TfrmOrders.InitOrderSheetsForEvtDelay;
	2738	begin
	2739	InitOrderSheets;
	2740	DfltViewForEvtDelay;
	2741	end;
	2742
	2743	procedure TfrmOrders.DfltViewForEvtDelay;
	2744	begin
	2745	inherited;
	2746	if not CanChangeOrderView then Exit;
	2747	lstSheets.ItemIndex := 0;
	2748	FCurrentView := TOrderView(lstSheets.Items.Objects[0]);
	2749	LoadOrderViewDefault(FCurrentView);
	2750	lstSheets.Items[0] := 'C;0^' + FCurrentView.ViewName;
	2751	end;
	2752
	2753	procedure TfrmOrders.EventRealeasedOrder1Click(Sender: TObject);
	2754	var
	2755	AnOrderView: TOrderView;
	2756	begin
	2757	inherited;
	2758	if not CanChangeOrderView then Exit;
	2759	AnOrderView := TOrderView.Create;
	2760	AnOrderView.Filter := STS_ACTIVE;
	2761	AnOrderView.DGroup := DGroupAll;
	2762	AnOrderView.ViewName := 'All Services, Active';
	2763	AnOrderView.InvChrono := True;
	2764	AnOrderView.ByService := True;
	2765	AnOrderView.CtxtTime := 0;
	2766	AnOrderView.TextView := 0;
	2767	AnOrderView.EventDelay.EventType := 'C';
	2768	AnOrderView.EventDelay.Specialty := 0;
	2769	AnOrderView.EventDelay.Effective := 0;
	2770	AnOrderView.EventDelay.EventIFN := 0;
	2771	AnOrderView.EventDelay.EventName := 'All Services, Active';
	2772	SelectEvtReleasedOrders(AnOrderView);
	2773	with AnOrderView do if Changed then
	2774	begin
	2775	mnuActRel.Visible := False;
	2776	popOrderRel.Visible := False;
	2777	FCompress := True;
	2778	lstSheets.ItemIndex := -1;
	2779	lblWrite.Caption := 'Write Orders';
	2780	lstWrite.Clear;
	2781	LoadWriteOrders(lstWrite.Items);
	2782	if AnOrderView.EventDelay.PtEventIFN > 0 then
	2783	RefreshOrderList(FROM_SERVER,IntToStr(AnOrderView.EventDelay.PtEventIFN));
	2784	lblOrders.Caption := AnOrderView.ViewName;
	2785	if ByService then
	2786	begin
	2787	if InvChrono then FDfltSort := OVS_CATINV else FDfltSort := OVS_CATFWD;
	2788	end else
	2789	begin
	2790	if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD;
	2791	end;
	2792	end;
	2793	if FFromDCRelease then
	2794	FFromDCRelease := False;
	2795	end;
	2796
	2797	procedure TfrmOrders.ResetOrderPage(AnEvent: TOrderDelayEvent; ADlgLst: TStringList; IsRealeaseNow: boolean);
	2798	var
	2799	i,AnIndex,EFilter: integer;
	2800	APtEvtID: string; // ptr to #100.2
	2801	theEvtID: string; // ptr to #100.5
	2802	tmptPtEvtID: string;
	2803	AnOrderView: TOrderView;
	2804	AnDlgStr: string;
	2805	begin
	2806	EFilter := 0;
	2807	theEvtID := '';
	2808	AnDlgStr := '';
	2809	IsDefaultDlg := False;
	2810	AnOrderView := TOrderView.Create;
	2811	if FCurrentView = nil then
	2812	begin
	2813	FCurrentView := TOrderView.Create;
	2814	with FCurrentView do
	2815	begin
	2816	InvChrono := True;
	2817	ByService := True;
	2818	end;
	2819	end;
	2820	if IsRealeaseNow then
	2821	lstSheets.ItemIndex := 0;
	2822	if AnEvent.EventIFN > 0 then with lstSheets do
	2823	begin
	2824	AnIndex := -1;
	2825	for i := 0 to Items.Count - 1 do
	2826	begin
	2827	theEvtID := GetEvtIFN(i);
	2828	if theEvtID = IntToStr(AnEvent.EventIFN) then
	2829	begin
	2830	AnIndex := i;
	2831	theEvtID := '';
	2832	Break;
	2833	end;
	2834	theEvtID := '';
	2835	end;
	2836	if AnIndex > -1 then
	2837	begin
	2838	NewEvent := False;
	2839	ItemIndex := AnIndex;
	2840	lstSheetsClick(Self);
	2841	end else
	2842	begin
	2843	NewEvent := True;
	2844	if TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 2 then
	2845	begin
	2846	SaveEvtForOrder(Patient.DFN, AnEvent.EventIFN, '');
	2847	AnEvent.IsNewEvent := False;
	2848	if (ADlgLst.Count > 0) and (Piece(ADlgLst[0],'^',2) <> 'SET') then
	2849	ADlgLst.Delete(0);
	2850	end;
	2851	if (TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0) and (AnEvent.TheParent.ParentIFN > 0) then
	2852	begin
	2853	if ((ADlgLst.Count > 0) and (Piece(ADlgLst[0],'^',2) = 'SET')) or (ADlgLst.Count = 0 )then
	2854	begin
	2855	SaveEvtForOrder(Patient.DFN, AnEvent.TheParent.ParentIFN, '');
	2856	SaveEvtForOrder(Patient.DFN, AnEvent.EventIFN, '');
	2857	AnEvent.IsNewEvent := False;
	2858	end;
	2859	end;
	2860	if (TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0) and (AnEvent.TheParent.ParentIFN = 0) then
	2861	begin
	2862	if ((ADlgLst.Count > 0) and (Piece(ADlgLst[0],'^',2) = 'SET')) or (ADlgLst.Count = 0 )then
	2863	begin
	2864	SaveEvtForOrder(Patient.DFN, AnEvent.EventIFN, '');
	2865	AnEvent.IsNewEvent := False;
	2866	end;
	2867	end;
	2868	if isExistedEvent(Patient.DFN,IntToStr(AnEvent.EventIFN), APtEvtID) then
	2869	begin
	2870	case AnEvent.EventType of
	2871	'A': EFilter := 15;
	2872	'D': EFilter := 16;
	2873	'T': EFilter := 17;
	2874	end;
	2875	AnOrderView.DGroup := DGroupAll;
	2876	AnOrderView.Filter := EFilter;
	2877	AnOrderView.EventDelay := AnEvent;
	2878	AnOrderView.CtxtTime := -1;
	2879	AnOrderView.TextView := 0;
	2880	AnOrderView.ViewName := 'Delayed ' + AnEvent.EventName + ' Orders';
	2881	AnOrderView.InvChrono := FCurrentView.InvChrono;
	2882	AnOrderView.ByService := FCurrentView.ByService;
	2883	if ItemIndex >= 0 then
	2884	Items.InsertObject(ItemIndex+1, APtEvtID + U + AnOrderView.ViewName, AnOrderView)
	2885	else
	2886	Items.InsertObject(lstSheets.Items.Count, APtEvtID + U + AnOrderView.ViewName, AnOrderView);
	2887	ItemIndex := lstSheets.Items.IndexOfObject(AnOrderView);
	2888	FCurrentView := AnOrderView;
	2889	lblWrite.Caption := 'Write ' + FCurrentView.ViewName;
	2890	lstWrite.Caption := lblWrite.Caption;
	2891	ClickLstSheet;
	2892	NewEvent := True;
	2893	if ADlgLst.Count > 0 then
	2894	DisplayDefaultDlgList(lstWrite,ADlgLst)
	2895	else
	2896	begin
	2897	if DispOrdersForEvent(IntToStr(FEventForCopyActiveOrders.EventIFN)) then
	2898	begin
	2899	if IsExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN),tmptPtEvtID) then
	2900	begin
	2901	FEventForCopyActiveOrders.PtEventIFN := StrToIntDef(tmptPtEvtID,0);
	2902	FEventForCopyActiveOrders.IsNewEvent := False
	2903	end;
	2904	CopyActiveOrdersToEvent(FOrderViewForActiveOrders, FEventForCopyActiveOrders);
	2905	end;
	2906	FEventForCopyActiveOrders.EventIFN := 0;
	2907	end;
	2908	end
	2909	else
	2910	begin
	2911	case AnEvent.EventType of
	2912	'A': EFilter := 15;
	2913	'D': EFilter := 16;
	2914	'T': EFilter := 17;
	2915	end;
	2916	if ItemIndex < 0 then
	2917	ItemIndex := 0;
	2918	IsDefaultDlg := True;
	2919	AnOrderView.DGroup := DGroupAll;
	2920	AnOrderView.Filter := EFilter;
	2921	AnOrderView.EventDelay := AnEvent;
	2922	AnOrderView.CtxtTime := -1;
	2923	AnOrderView.TextView := 0;
	2924	AnOrderView.ViewName := 'Delayed ' + AnEvent.EventName + ' Orders';
	2925	if FCurrentView <> nil then
	2926	begin
	2927	AnOrderView.InvChrono := FCurrentView.InvChrono;
	2928	AnOrderView.ByService := FCurrentView.ByService;
	2929	end;
	2930	Items.InsertObject(ItemIndex+1, IntToStr(AnEvent.EventIFN)+ ';EVT' + U + AnOrderView.ViewName, AnOrderView);
	2931	lstSheets.ItemIndex := lstSheets.Items.IndexOfObject(AnOrderView);
	2932	FCurrentView := AnOrderView;
	2933	lblWrite.Caption := 'Write ' + FCurrentView.ViewName;
	2934	lstWrite.Caption := lblWrite.Caption;
	2935	ClickLstSheet;
	2936	NewEvent := True;
	2937	if (NewEvent) and (ADlgLst.Count>0) then
	2938	DisplayDefaultDlgList(lstWrite,ADlgLst);
	2939	end;
	2940	end;
	2941	end else
	2942	begin
	2943	lblWrite.Caption := 'Write Orders';
	2944	lstWrite.Caption := lblWrite.Caption;
	2945	RefreshOrderList(FROM_SERVER);
	2946	end;
	2947	end;
	2948
	2949	function TfrmOrders.GetEvtIFN(AnIndex: integer): string;
	2950	begin
	2951	if AnIndex >= lstSheets.Items.Count then
	2952	begin
	2953	Result := '';
	2954	exit;
	2955	end;
	2956	with lstSheets do
	2957	begin
	2958	if Piece(Piece(Items[AnIndex],';',2),'^',1)='EVT' then
	2959	Result := Piece(Items[AnIndex],';',1)
	2960	else
	2961	Result := GetEventIFN(Piece(Items[AnIndex], U, 1));
	2962	end;
	2963	end;
	2964
	2965	function TfrmOrders.PlaceOrderForDefaultDialog(ADlgInfo: string; IsDefaultDialog: boolean; AEvent: TOrderDelayEvent): boolean;
	2966	{ ADlgInfo = DlgIEN;FormID;DGroup;DlgType }
	2967	var
	2968	Activated: Boolean;
	2969	NextIndex,ix: Integer;
	2970	APtEvtIdA: string;
	2971	TheEvent: TOrderDelayEvent;
	2972	begin
	2973	inherited;
	2974	Result := False;
	2975
	2976	if FCurrentView = nil then
	2977	begin
	2978	FCurrentView := TOrderView.Create;
	2979	with FCurrentView do
	2980	begin
	2981	InvChrono := True;
	2982	ByService := True;
	2983	end;
	2984	end;
	2985
	2986	if AEvent.EventType = #0 then
	2987	TheEvent := FCurrentView.EventDelay
	2988	else
	2989	TheEvent := AEvent;
	2990	if not ActiveOrdering then SetConfirmEventDelay;
	2991	NextIndex := lstWrite.ItemIndex;
	2992	if not ReadyForNewOrder1(TheEvent) then
	2993	begin
	2994	lstWrite.ItemIndex := RefNumFor(Self);
	2995	Exit;
	2996	end;
	2997	if AEvent.EventType <> #0 then
	2998	lstWrite.ItemIndex := -1
	2999	else
	3000	lstWrite.ItemIndex := NextIndex; // (ReadyForNewOrder may reset ItemIndex to -1)
	3001
	3002	with TheEvent do
	3003	if (EventType = 'D') and (Effective = 0) then
	3004	if not ObtainEffectiveDate(Effective) then
	3005	begin
	3006	lstWrite.ItemIndex := -1;
	3007	Exit;
	3008	end;
	3009	PositionTopOrder(StrToIntDef(Piece(ADlgInfo, ';', 3), 0));
	3010	case CharAt(Piece(ADlgInfo, ';', 4), 1) of
	3011	'A': Activated := ActivateAction( Piece(ADlgInfo, ';', 1), Self,
	3012	lstWrite.ItemIndex);
	3013	'D', 'Q': Activated := ActivateOrderDialog(Piece(ADlgInfo, ';', 1),
	3014	TheEvent, Self, lstWrite.ItemIndex);
	3015	'H': Activated := ActivateOrderHTML( Piece(ADlgInfo, ';', 1),
	3016	TheEvent, Self, lstWrite.ItemIndex);
	3017	'M': Activated := ActivateOrderMenu( Piece(ADlgInfo, ';', 1),
	3018	TheEvent, Self, lstWrite.ItemIndex);
	3019	'O': Activated := ActivateOrderSet( Piece(ADlgInfo, ';', 1),
	3020	TheEvent, Self, lstWrite.ItemIndex);
	3021	else Activated := not (InfoBox(TX_BAD_TYPE, TC_BAD_TYPE, MB_OK) = IDOK);
	3022	end;
	3023	if (not Activated) and (IsDefaultDialog) then
	3024	begin
	3025	lstWrite.ItemIndex := -1;
	3026	ix := lstSheets.ItemIndex;
	3027	if lstSheets.ItemIndex < 0 then
	3028	Exit;
	3029	APtEvtIdA := Piece(lstSheets.Items[ix],'^',1);
	3030	if CharAt(APtEvtIdA,1) <> 'C' then
	3031	begin
	3032	if Pos('EVT',APtEvtIdA)>0 then
	3033	begin
	3034	lstSheets.Items.Objects[ix].Free;
	3035	lstSheets.Items.Delete(ix);
	3036	lstSheets.ItemIndex := 0;
	3037	lstSheetsClick(Self);
	3038	lblWrite.Caption := 'Write Orders';
	3039	lstWrite.Caption := lblWrite.Caption;
	3040	lblOrders.Caption := Piece(lstSheets.Items[0],U,2);
	3041	lstOrders.Caption := Piece(lstSheets.Items[0],U,2);
	3042	lstWrite.Clear;
	3043	LoadWriteOrders(lstWrite.Items);
	3044	end;
	3045	end;
	3046	end;
	3047	Result := Activated;
	3048	end;
	3049
	3050	function TfrmOrders.DisplayDefaultDlgList(ADest: TORListBox; ADlgList: TStringList): boolean;
	3051	var
	3052	i,j: integer;
	3053	AnDlgStr: string;
	3054	AFillEvent: TOrderDelayEvent;
	3055	APtEvtID,tmpPtEvtID: string;
	3056	begin
	3057	AFillEvent.EventType := #0;
	3058	AFillEvent.EventIFN := 0;
	3059	AFillEvent.PtEventIFN := 0;
	3060	AFillEvent.TheParent := TParentEvent.Create;
	3061
	3062	Result := False;
	3063	for i := 0 to ADlgList.Count - 1 do
	3064	begin
	3065	if i = 0 then
	3066	begin
	3067	if AnsiCompareText('Set', Piece(ADlgList[i],'^',2)) = 0 then
	3068	IsDefaultDlg := False;
	3069	end;
	3070	if i > 0 then
	3071	IsDefaultDlg := False;
[829]	3072
[456]	3073	ADest.ItemIndex := -1;
	3074	for j := 0 to ADest.Items.Count - 1 do
	3075	begin
	3076	if Piece(ADest.Items[j],';',1)=Piece(ADlgList[i],'^',1) then
	3077	begin
	3078	ADest.ItemIndex := j;
	3079	break;
	3080	end;
	3081	end;
	3082
	3083	if ADest.ItemIndex < 0 then
	3084	AnDlgStr := GetDlgData(Piece(ADlgList[i],'^',1))
	3085	else
	3086	AnDlgStr := ADest.Items[ADest.ItemIndex];
	3087
	3088	if IsDefaultDlg then NeedShowModal := True else FNeedShowModal := False;
	3089	if not IsDefaultDlg then
	3090	begin
	3091	if FEventForCopyActiveOrders.EventIFN > 0 then
	3092	begin
	3093	if IsExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN),tmpPtEvtID) then
	3094	begin
	3095	FEventForCopyActiveOrders.PtEventIFN := StrToIntDef(tmpPtEvtID,0);
	3096	FEventForCopyActiveOrders.IsNewEvent := False
	3097	end;
	3098	if DispOrdersForEvent(IntToStr(FEventForCopyActiveOrders.EventIFN)) then
	3099	CopyActiveOrdersToEvent(FOrderViewForActiveOrders, FEventForCopyActiveOrders);
	3100	end;
	3101	FEventForCopyActiveOrders.EventIFN := 0;
	3102	end;
	3103
	3104	if PlaceOrderForDefaultDialog(AnDlgStr,IsDefaultDlg, AFillEvent) then
	3105	begin
	3106	if isExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN), APtEvtID) then
	3107	begin
	3108	FCurrentView.EventDelay.PtEventIFN := StrToIntDef(APtEvtID,0);
	3109	FCurrentView.EventDelay.IsNewEvent := False;
	3110	end;
	3111	if FEventForCopyActiveOrders.EventIFN > 0 then
	3112	begin
	3113	if IsExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN),tmpPtEvtID) then
	3114	begin
	3115	FEventForCopyActiveOrders.PtEventIFN := StrToIntDef(tmpPtEvtID,0);
	3116	FEventForCopyActiveOrders.IsNewEvent := False
	3117	end;
	3118	if DispOrdersForEvent(IntToStr(FEventForCopyActiveOrders.EventIFN)) then
	3119	CopyActiveOrdersToEvent(FOrderViewForActiveOrders, FEventForCopyActiveOrders);
	3120	end;
	3121	{if isExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN), APtEvtID) then
	3122	begin
	3123	FCurrentView.EventDelay.PtEventIFN := StrToIntDef(APtEvtID,0);
	3124	FCurrentView.EventDelay.IsNewEvent := False;
	3125	end;}
	3126	EventDefaultOrder := '';
	3127	FEventForCopyActiveOrders.EventIFN := 0;
	3128	Result := IsDefaultDlg
	3129	end
	3130	else break;
	3131	end;
	3132	end;
	3133
	3134	procedure TfrmOrders.ClickLstSheet;
	3135	begin
	3136	FAskForCancel := False;
	3137	lstSheetsClick(Self);
	3138	FAskForCancel := True;
	3139	end;
	3140
	3141	procedure TfrmOrders.lblWriteMouseMove(Sender: TObject; Shift: TShiftState;
	3142	X, Y: Integer);
	3143	begin
	3144	inherited;
	3145	lblWrite.Hint := lblWrite.Caption;
	3146	end;
	3147
	3148	procedure TfrmOrders.InitOrderSheets2(AnItem: string);
	3149	var
	3150	i: Integer;
	3151	begin
	3152	InitOrderSheets;
	3153	LoadOrderViewDefault(TOrderView(lstSheets.Items.Objects[0]));
	3154	lstSheets.Items[0] := 'C;0^' + TOrderView(lstSheets.Items.Objects[0]).ViewName;
	3155	if Length(AnItem)>0 then
	3156	begin
	3157	with lstSheets do for i := 0 to Items.Count - 1 do
	3158	begin
	3159	if AnsiCompareText(TOrderView(Items.Objects[i]).ViewName, AnItem)=0 then
	3160	begin
	3161	ItemIndex := i;
	3162	FCurrentView := TOrderView(lstSheets.Items.Objects[i]);
	3163	break;
	3164	end;
	3165	end;
	3166	end;
	3167	if lstSheets.ItemIndex < -1 then
	3168	lstSheets.ItemIndex := 0;
	3169	lstSheetsClick(Self);
	3170	end;
	3171
	3172	procedure TfrmOrders.SetFontSize( FontSize: integer);
	3173	begin
	3174	inherited SetFontSize( FontSize );
	3175	RedrawOrderList;
	3176	mnuOptimizeFieldsClick(self);
	3177	lstSheets.Repaint;
	3178	lstWrite.Repaint;
	3179	btnDelayedOrder.Repaint;
	3180	end;
	3181
	3182	procedure TfrmOrders.popOrderPopup(Sender: TObject);
	3183	begin
	3184	inherited;
[829]	3185	//if PatientStatusChanged then exit;
[456]	3186	//frmFrame.UpdatePtInfoOnRefresh;
	3187	end;
	3188
	3189	procedure TfrmOrders.mnuViewClick(Sender: TObject);
	3190	begin
	3191	inherited;
[829]	3192	//if PatientStatusChanged then exit;
[456]	3193	//frmFrame.UpdatePtInfoOnRefresh;
	3194	end;
	3195
	3196	procedure TfrmOrders.mnuActClick(Sender: TObject);
	3197	begin
	3198	inherited;
[829]	3199	//if PatientStatusChanged then exit;
[456]	3200	//frmFrame.UpdatePtInfoOnRefresh;
	3201	end;
	3202
	3203	procedure TfrmOrders.mnuOptClick(Sender: TObject);
	3204	begin
	3205	inherited;
[829]	3206	//if PatientStatusChanged then exit;
[456]	3207	//frmFrame.UpdatePtInfoOnRefresh;
	3208	end;
	3209
	3210	procedure TfrmOrders.AddToListBox(AnOrderList: TList);
	3211	var
	3212	idx: integer;
	3213	AnOrder: TOrder;
	3214	i: integer;
	3215	begin
	3216	with AnOrderList do for idx := 0 to Count - 1 do
	3217	begin
	3218	AnOrder := TOrder(Items[idx]);
	3219	if (AnOrder.OrderTime <= 0) then
	3220	Continue;
	3221	i := lstOrders.Items.AddObject(AnOrder.ID, AnOrder);
	3222	lstOrders.Items[i] := GetPlainText(AnOrder,i);
	3223	end;
	3224	end;
	3225
	3226	procedure TfrmOrders.ChangesUpdate(APtEvtID: string);
	3227	var
	3228	jdx: integer;
	3229	APrtEvtId, tempEvtId,EvtOrderID: string;
	3230	begin
	3231	APrtEvtId := TheParentPtEvt(APtEvtID);
	3232	if Length(APrtEvtId)>0 then
	3233	tempEvtId := APrtEvtId
	3234	else
	3235	tempEvtId := APtEvtID;
	3236	for jdx := EvtOrderList.Count - 1 downto 0 do
	3237	if AnsiCompareStr(Piece(EvtOrderList[jdx],'^',1),tempEvtID) = 0 then
	3238	begin
	3239	EvtOrderID := Piece(EvtOrderList[jdx],'^',2);
	3240	Changes.Remove(CH_ORD,EvtOrderID);
	3241	EvtOrderList.Delete(jdx);
	3242	end;
	3243	end;
	3244
	3245	function TfrmOrders.PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean): boolean;
	3246	begin
	3247	Result := False;
	3248	if IsCompletedPtEvt(APtEvtID) then
	3249	begin
	3250	if FromMeds then
	3251	InfoBox('The event "Delayed ' + APtEvtName + '" ' + TX_CMPTEVT_MEDSTAB, 'Warning', MB_OK or MB_ICONWARNING)
	3252	else
	3253	InfoBox('The event "Delayed ' + APtEvtName + '" ' + TX_CMPTEVT, 'Warning', MB_OK or MB_ICONWARNING);
	3254	GroupChangesUpdate('Delayed ' + APtEvtName);
	3255	InitOrderSheetsForEvtDelay;
	3256	lstSheets.ItemIndex := 0;
	3257	lstSheetsClick(self);
	3258	RefreshOrderList(True);
	3259	Result := True;
	3260	end;
	3261	end;
	3262
	3263	procedure TfrmOrders.RefreshToFirstItem;
	3264	begin
	3265	InitOrderSheetsForEvtDelay;
	3266	lstSheets.ItemIndex := 0;
	3267	RefreshOrderList(True);
	3268	end;
	3269
	3270	procedure TfrmOrders.GroupChangesUpdate(GrpName: string);
	3271	var
	3272	ji: integer;
	3273	theChangeItem: TChangeItem;
	3274	begin
	3275	Changes.ChangeOrderGrp(GrpName,'');
	3276	for ji := 0 to Changes.Orders.Count - 1 do
	3277	begin
	3278	theChangeItem := TChangeItem(Changes.Orders.Items[ji]);
	3279	if AnsiCompareText(theChangeItem.GroupName,GrpName)=0 then
	3280	Changes.ReplaceODGrpName(theChangeItem.ID,'');
	3281	end;
	3282	end;
	3283
	3284	procedure TfrmOrders.UMEventOccur(var Message: TMessage);
	3285	begin
	3286	InfoBox('The event "Delayed ' + FCurrentView.EventDelay.EventName + '" ' + TX_CMPTEVT, 'Warning', MB_OK or MB_ICONWARNING);
	3287	GroupChangesUpdate('Delayed '+ frmOrders.TheCurrentView.EventDelay.EventName);
	3288	InitOrderSheetsForEvtDelay;
	3289	lstSheets.ItemIndex := 0;
	3290	lstSheetsClick(self);
	3291	RefreshOrderList(True);
	3292	end;
	3293
	3294	procedure TfrmOrders.setSectionWidths;
	3295	var
	3296	i: integer;
	3297	begin
	3298	//CQ6170
	3299	for i := 0 to 9 do
	3300	origWidths[i] := hdrOrders.Sections[i].Width;
	3301	//end CQ6170
	3302	end;
	3303
	3304	function TfrmOrders.getTotalSectionsWidth : integer;
	3305	var
	3306	i: integer;
	3307	begin
	3308	//CQ6170
	3309	Result := 0;
	3310	for i := 0 to hdrOrders.Sections.Count - 1 do
	3311	Result := Result + hdrOrders.Sections[i].Width;
	3312	//end CQ6170
	3313	end;
	3314
	3315	procedure TfrmOrders.FormShow(Sender: TObject);
	3316	begin
	3317	inherited;
	3318	//force horizontal scrollbar
	3319	//lstOrders.ScrollWidth := lstOrders.ClientWidth+1000; //CQ6170
	3320	end;
	3321
	3322	procedure TfrmOrders.hdrOrdersMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
	3323	var
	3324	i: integer;
	3325	totalSectionsWidth, originalwidth: integer;
	3326	begin
	3327	inherited;
	3328	//CQ6170
	3329	totalSectionsWidth := getTotalSectionsWidth;
	3330	if totalSectionsWidth > lstOrders.Width - 5 then
	3331	begin
	3332	originalwidth := 0;
	3333	for i := 0 to hdrOrders.Sections.Count - 1 do
	3334	originalwidth := originalwidth + origWidths[i];
	3335	if originalwidth < totalSectionsWidth then
	3336	begin
	3337	for i := 0 to hdrOrders.Sections.Count - 1 do
	3338	hdrOrders.Sections[i].Width := origWidths[i];
	3339	lstOrders.Invalidate;
	3340	end;
	3341	end;
	3342	//end CQ6170
	3343	end;
	3344
	3345	procedure TfrmOrders.hdrOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
	3346	begin
	3347	inherited;
	3348	setSectionWidths; //CQ6170
	3349	end;
	3350
[829]	3351	{function TfrmOrders.PatientStatusChanged: boolean;
[456]	3352	const
	3353
	3354	msgTxt1 = 'Patient status was changed from ';
	3355	msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.';
	3356	//GE CQ9537 - Change message text
	3357	msgTxt3 = 'Patient has been admitted. ';
	3358	msgTxt4 = CRLF + 'You will be prompted to sign your orders. Any new orders subsequently' +
	3359	CRLF +'entered and signed will be directed to the inpatient staff.';
	3360	var
	3361	PtSelect: TPtSelect;
	3362	IsInpatientNow: boolean;
	3363	ptSts: string;
	3364	begin
	3365	result := False;
	3366	SelectPatient(Patient.DFN, PtSelect);
	3367	IsInpatientNow := Length(PtSelect.Location) > 0;
	3368	if Patient.Inpatient <> IsInpatientNow then
	3369	begin
	3370	if (not Patient.Inpatient) then //GE CQ9537 - Change message text
	3371	MessageDlg(msgTxt3 + msgTxt4, mtWarning, [mbOK], 0)
	3372	else
	3373	begin
	3374	if Patient.Inpatient then ptSts := 'Inpatient to Outpatient.';
	3375	MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0);
	3376	end;
	3377	frmFrame.mnuFileRefreshClick(Application);
	3378	Result := True;
	3379	end;
[829]	3380	end;}
[456]	3381
	3382	function TfrmOrders.CheckOrderStatus: boolean;
	3383	var
	3384	i: integer;
	3385	AnOrder: TOrder;
[829]	3386	OrderArray: TStringList;
[456]	3387	begin
	3388	Result := False;
[829]	3389	OrderArray := TStringList.Create;
[456]	3390	with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
	3391	begin
	3392	AnOrder := TOrder(Items.Objects[i]);
[829]	3393	OrderArray.Add(AnOrder.ID + U + InttoStr(AnOrder.Status));
[456]	3394	end;
[829]	3395	if (OrderArray <> nil) and (not DoesOrderStatusMatch(OrderArray)) then
	3396	begin
	3397	MessageDlg('The Order status has changed.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct order status', mtWarning, [mbOK], 0);
	3398	frmFrame.mnuFileRefreshClick(Application);
	3399	Result := True;
	3400	end;
	3401	ORderArray.Free;
[456]	3402	end;
	3403
[829]	3404	procedure TfrmOrders.ActivateDeactiveRenew;
[456]	3405	var
	3406	i: Integer;
	3407	AnOrder: TOrder;
	3408	tmpArr: TStringList;
	3409	begin
	3410	tmpArr := TStringList.Create;
	3411	with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then
	3412	begin
	3413	AnOrder := TOrder(Items.Objects[i]);
	3414	if AnOrder.Status = 5 then tmpArr.Add(AnOrder.ID);
	3415	end;
	3416	if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr);
[829]	3417	end;
[456]	3418
	3419	procedure TfrmOrders.ViewInfo(Sender: TObject);
	3420	begin
	3421	inherited;
	3422	frmFrame.ViewInfo(Sender);
	3423	end;
	3424
	3425	procedure TfrmOrders.mnuViewInformationClick(Sender: TObject);
	3426	begin
	3427	inherited;
	3428	mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
	3429	mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
	3430	mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
	3431	mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
	3432	mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
	3433	mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
	3434	mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
	3435	mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
	3436	mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
	3437	end;
	3438
	3439	procedure TfrmOrders.mnuOptimizeFieldsClick(Sender: TObject);
	3440	var
	3441	totalSectionsWidth, unitvalue: integer;
	3442	begin
	3443	totalSectionsWidth := pnlRight.Width - 3;
	3444	if totalSectionsWidth < 16 then exit;
	3445	unitvalue := round(totalSectionsWidth / 16);
	3446	with hdrOrders do
	3447	begin
	3448	Sections[1].Width := unitvalue;
	3449	Sections[2].Width := pnlRight.Width - (unitvalue * 10) - 5;
	3450	Sections[3].Width := unitvalue * 2;
	3451	Sections[4].Width := unitvalue * 2;
	3452	Sections[5].Width := unitvalue;
	3453	Sections[6].Width := unitvalue;
	3454	Sections[7].Width := unitvalue;
	3455	Sections[8].Width := unitvalue;
	3456	Sections[9].Width := unitvalue;
	3457	end;
	3458	hdrOrdersSectionResize(hdrOrders, hdrOrders.Sections[0]);
	3459	hdrOrders.Repaint;
	3460	end;
	3461
	3462	procedure TfrmOrders.hdrOrdersSectionClick(HeaderControl: THeaderControl;
	3463	Section: THeaderSection);
	3464	begin
	3465	inherited;
	3466	//if Section = hdrOrders.Sections[1] then
	3467	mnuOptimizeFieldsClick(self);
	3468	end;
	3469
	3470	procedure TfrmOrders.sptHorzMoved(Sender: TObject);
	3471	begin
	3472	inherited;
	3473	mnuOptimizeFieldsClick(self);
	3474	end;
	3475
[829]	3476	initialization
	3477	SpecifyFormIsNotADialog(TfrmOrders);
	3478
[456]	3479	end.
	3480

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

Download in other formats: