Context Navigation

fOrders.pas@ 1381

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

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

Context Navigation

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

Download in other formats: