Context Navigation

fOrders.pas@ 1806

Last change on this file since 1806 was 460, checked in by Kevin Toppenberg, 16 years ago
Uploading from OR_30_258
File size: 120.7 KB

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

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

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrders.pas@ 1806

Download in other formats: