Context Navigation

fOrders.pas@ 1787

Last change on this file since 1787 was 1679, checked in by healthsevak, 10 years ago
Updating the working copy to CPRS version 28
File size: 125.3 KB

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

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

Context Navigation

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

Download in other formats: