Context Navigation

fOrders.pas

Last change on this file was 453, checked in by Kevin Toppenberg, 16 years ago
Initial upload of TMG-CPRS 1.0.26.69
File size: 149.8 KB

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

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

Context Navigation

source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOrders.pas

Download in other formats: