Context Navigation

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

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

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

Download in other formats: