Context Navigation

fOrders.pas@ 1721

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

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

Context Navigation

source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fOrders.pas@ 1721

Download in other formats: