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

Last change on this file since 453 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
2unit fOrders;
3
4{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
5
6interface
7
8uses
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
13type
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
255type
256 arOrigSecWidths = array[0..9] of integer; //CQ6170
257
258var
259 frmOrders: TfrmOrders;
260
261 origWidths: arOrigSecWidths; //CQ6170
262
263implementation
264
265uses 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
274const
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
369var
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
424procedure SetupVars;
425//kt Added entire function to replace constant declarations 8/8/2007
426begin
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');
498end;
499
500var
501 uOrderList: TList;
502 uEvtDCList, uEvtRLList: TList;
503
504{ TPage common methods --------------------------------------------------------------------- }
505
506function TfrmOrders.AllowContextChange(var WhyNot: string): Boolean;
507begin
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;
518end;
519
520procedure TfrmOrders.ClearPtData;
521begin
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;
531end;
532
533procedure TfrmOrders.DisplayPage;
534var
535 i: Integer;
536begin
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;
587end;
588
589procedure TfrmOrders.mnuChartTabClick(Sender: TObject);
590begin
591 inherited;
592 frmFrame.mnuChartTabClick(Sender);
593end;
594
595procedure TfrmOrders.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
596var
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
614begin
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}
715end;
716
717{ Form events ------------------------------------------------------------------------------ }
718
719procedure TfrmOrders.FormCreate(Sender: TObject);
720begin
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 := '';
743end;
744
745procedure TfrmOrders.FormDestroy(Sender: TObject);
746begin
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 := '';
760end;
761
762procedure TfrmOrders.UMDestroy(var Message: TMessage);
763{ sent by ordering dialog when it is closing }
764begin
765 lstWrite.ItemIndex := -1;
766 //UnlockIfAble; // - already in uOrders
767end;
768
769{ View menu events ------------------------------------------------------------------------- }
770
771procedure TfrmOrders.PositionTopOrder(DGroup: Integer);
772const
773 SORT_FWD = 0;
774 SORT_REV = 1;
775 SORT_GRP_FWD = 2;
776 SORT_GRP_REV = 3;
777var
778 i, Seq: Integer;
779 AnOrder: TOrder;
780begin
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}
806end;
807
808procedure TfrmOrders.RedrawOrderList;
809{ redraws the Orders list, compensates for changes in item height by re-adding everything }
810var
811 i, SaveTop: Integer;
812 AnOrder: TOrder;
813begin
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;
830end;
831
832procedure TfrmOrders.RefreshOrderList(FromServer: Boolean; APtEvtID: string);
833var
834 i: Integer;
835begin
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;
891end;
892
893procedure TfrmOrders.UseDefaultSort;
894begin
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;
914end;
915
916function TfrmOrders.CanChangeOrderView: Boolean;
917{ Disallows changing view while doing delayed release orders. }
918begin
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;
926end;
927
928procedure 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
932var
933 tmpDate: TDateTime;
934begin
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);
981end;
982
983procedure TfrmOrders.mnuViewActiveClick(Sender: TObject);
984begin
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
988end;
989
990procedure TfrmOrders.mnuViewCurrentClick(Sender: TObject);
991begin
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
995end;
996
997procedure TfrmOrders.mnuViewExpiringClick(Sender: TObject);
998begin
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
1002end;
1003
1004procedure TfrmOrders.mnuViewExpiredClick(Sender: TObject);
1005begin
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
1009end;
1010
1011procedure TfrmOrders.mnuViewUnsignedClick(Sender: TObject);
1012begin
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
1016end;
1017
1018procedure TfrmOrders.mnuViewCustomClick(Sender: TObject);
1019var
1020 AnOrderView: TOrderView;
1021begin
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;
1070end;
1071
1072procedure TfrmOrders.mnuViewDfltShowClick(Sender: TObject);
1073begin
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;
1089end;
1090
1091procedure TfrmOrders.mnuViewDfltSaveClick(Sender: TObject);
1092var
1093 x: string;
1094begin
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);
1117end;
1118
1119procedure TfrmOrders.mnuViewDetailClick(Sender: TObject);
1120var
1121 i,j,idx: Integer;
1122 tmpList: TStringList;
1123 BigOrderID: string;
1124 AnOrderID: string;
1125begin
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;
1182end;
1183
1184procedure TfrmOrders.mnuViewResultClick(Sender: TObject);
1185var
1186 i: Integer;
1187 BigOrderID: string;
1188begin
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;
1203end;
1204
1205procedure TfrmOrders.mnuViewResultsHistoryClick(Sender: TObject);
1206var
1207 i: Integer;
1208 BigOrderID: string;
1209begin
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;
1224end;
1225
1226{ lstSheets events ------------------------------------------------------------------------- }
1227
1228procedure TfrmOrders.ClearOrderSheets;
1229{ delete all order sheets & associated TOrderView objects, set current view to nil }
1230var
1231 i: Integer;
1232begin
1233 with lstSheets do for i := 0 to Items.Count - 1 do TOrderView(Items.Objects[i]).Free;
1234 lstSheets.Clear;
1235 FCurrentView := nil;
1236end;
1237
1238procedure TfrmOrders.InitOrderSheets;
1239{ sets up list of order sheets based on what orders are on the server in delayed status for pt }
1240var
1241 i: Integer;
1242 AnEventInfo: String;
1243 AnOrderView: TOrderView;
1244begin
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;
1294end;
1295
1296procedure 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
1299var
1300 AnOrderView: TOrderView;
1301 APtEvtId: string;
1302 TX_EVTDEL : string; //kt
1303begin
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;
1399end;
1400
1401{ lstOrders events ------------------------------------------------------------------------- }
1402
1403procedure TfrmOrders.RetrieveVisibleOrders(AnIndex: Integer);
1404var
1405 i: Integer;
1406 tmplst: TList;
1407 AnOrder: TOrder;
1408begin
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;
1418end;
1419
1420function TfrmOrders.GetPlainText(AnOrder: TOrder; index: integer):string;
1421var
1422 i: integer;
1423 FirstColumnDisplayed: Integer;
1424 x: string;
1425begin
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;
1437end;
1438
1439function TfrmOrders.MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer;
1440var
1441 ARect: TRect;
1442 x: string;
1443begin
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);
1450end;
1451
1452procedure TfrmOrders.lstOrdersMeasureItem(Control: TWinControl; Index: Integer;
1453 var AHeight: Integer);
1454var
1455 AnOrder: TOrder;
1456 NewHeight: Integer;
1457begin
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;
1480end;
1481
1482function TfrmOrders.GetStartStopText(StartTime: string; StopTime: string): string;
1483var
1484 y: string;
1485begin
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
1494end;
1495
1496function TfrmOrders.GetOrderText(AnOrder: TOrder; Index: integer; Column: integer): string;
1497begin
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;
1535end;
1536
1537procedure TfrmOrders.lstOrdersDrawItem(Control: TWinControl; Index: Integer; TheRect: TRect;
1538 State: TOwnerDrawState);
1539var
1540 i, RightSide: Integer;
1541 FirstColumnDisplayed: Integer;
1542 x: string;
1543 ARect: TRect;
1544 AnOrder: TOrder;
1545 SaveColor: TColor;
1546begin
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;
1612end;
1613
1614procedure TfrmOrders.hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection);
1615begin
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;
1624end;
1625
1626procedure TfrmOrders.lstOrdersDblClick(Sender: TObject);
1627begin
1628 inherited;
1629 mnuViewDetailClick(Self);
1630end;
1631
1632{ Writing Orders }
1633
1634procedure TfrmOrders.lstWriteClick(Sender: TObject);
1635{ ItemID = DlgIEN;FormID;DGroup;DlgType }
1636var
1637 Activated: Boolean;
1638 NextIndex: Integer;
1639begin
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;
1705end;
1706
1707procedure TfrmOrders.SaveSignOrders;
1708var
1709 SaveOrderID: string;
1710 i: Integer;
1711begin
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;
1726end;
1727
1728{ Action menu events ----------------------------------------------------------------------- }
1729
1730procedure TfrmOrders.ValidateSelected(const AnAction, WarningMsg, WarningTitle: string);
1731{ loop to validate action on each selected order, deselect if not valid }
1732var
1733 i: Integer;
1734 AnOrder: TOrder;
1735 ErrMsg, AParentID: string;
1736 GoodList,BadList, CheckedList: TStringList;
1737begin
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;
1846end;
1847
1848procedure TfrmOrders.MakeSelectedList(AList: TList);
1849{ make a list of selected orders }
1850var
1851 i: Integer;
1852begin
1853 with lstOrders do for i := 0 to Items.Count - 1 do
1854 if Selected[i] then AList.Add(Items.Objects[i]);
1855end;
1856
1857function TfrmOrders.NoneSelected(const ErrMsg: string): Boolean;
1858var
1859 i: Integer;
1860begin
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);
1871end;
1872
1873procedure TfrmOrders.RemoveSelectedFromChanges(AList: TList);
1874{ remove from Changes orders that were signed or released }
1875var
1876 i: Integer;
1877begin
1878 with AList do for i := 0 to Count - 1 do
1879 with TOrder(Items[i]) do Changes.Remove(CH_ORD, ID);
1880end;
1881
1882procedure TfrmOrders.SynchListToOrders;
1883{ make sure lstOrders now reflects the current state of orders }
1884var
1885 i: Integer;
1886begin
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;
1893end;
1894
1895procedure TfrmOrders.mnuActDCClick(Sender: TObject);
1896{ discontinue/cancel/delete the selected orders (as appropriate for each order }
1897var
1898 DelEvt: boolean;
1899 SelectedList: TList;
1900begin
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;
1929end;
1930
1931procedure TfrmOrders.mnuActRelClick(Sender: TObject);
1932var
1933 SelectedList: TList;
1934 ALocation: Integer;
1935 AName: string;
1936begin
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;
1977end;
1978
1979procedure TfrmOrders.mnuActChgEvntClick(Sender: TObject);
1980var
1981 SelectedList :TList;
1982 DoesDestEvtOccur: boolean;
1983 DestPtEvtID: integer;
1984 DestPtEvtName: string;
1985begin
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;
2019end;
2020
2021procedure TfrmOrders.mnuActHoldClick(Sender: TObject);
2022{ place the selected orders on hold, creates new orders }
2023var
2024 SelectedList: TList;
2025begin
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;
2048end;
2049
2050procedure TfrmOrders.mnuActUnholdClick(Sender: TObject);
2051{ release orders from hold, no signature required - no new orders created }
2052var
2053 SelectedList: TList;
2054begin
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;
2075end;
2076
2077procedure TfrmOrders.mnuActRenewClick(Sender: TObject);
2078{ renew the selected orders (as appropriate for each order }
2079var
2080 SelectedList: TList;
2081 ParntOrder: TOrder;
2082begin
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;
2116end;
2117
2118procedure TfrmOrders.mnuActAlertClick(Sender: TObject);
2119{ set selected orders to send alerts when results are available, - no new orders created }
2120var
2121 SelectedList: TList;
2122begin
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;
2135end;
2136
2137procedure TfrmOrders.mnuActFlagClick(Sender: TObject);
2138var
2139 i: Integer;
2140 AnOrder: TOrder;
2141 ErrMsg: string;
2142begin
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;
2159end;
2160
2161procedure TfrmOrders.mnuActUnflagClick(Sender: TObject);
2162var
2163 i: Integer;
2164 AnOrder: TOrder;
2165 ErrMsg: string;
2166begin
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));
2182end;
2183
2184procedure TfrmOrders.mnuActCompleteClick(Sender: TObject);
2185{ complete generic orders, no signature required - no new orders created }
2186var
2187 SelectedList: TList;
2188begin
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;
2201end;
2202
2203procedure TfrmOrders.mnuActVerifyClick(Sender: TObject);
2204{ verify orders, signature required but no new orders created }
2205var
2206 SelectedList: TList;
2207begin
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;
2220end;
2221
2222procedure TfrmOrders.mnuActChartRevClick(Sender: TObject);
2223var
2224 SelectedList: TList;
2225begin
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;
2238end;
2239
2240procedure TfrmOrders.mnuActCommentClick(Sender: TObject);
2241{ loop thru selected orders, allowing ward comments to be edited for each }
2242var
2243 i: Integer;
2244 AnOrder: TOrder;
2245 ErrMsg: string;
2246begin
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;
2262end;
2263
2264procedure TfrmOrders.mnuActChangeClick(Sender: TObject);
2265{ loop thru selected orders, present ordering dialog for each with defaults to selected order }
2266var
2267 i: Integer;
2268 ChangeIFNList: TStringList;
2269 ASourceOrderID : string;
2270begin
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;
2296end;
2297
2298procedure TfrmOrders.mnuActCopyClick(Sender: TObject);
2299{ loop thru selected orders, present ordering dialog for each with defaults to selected order }
2300var
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;
2309begin
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
2389end;
2390
2391procedure TfrmOrders.mnuActReleaseClick(Sender: TObject);
2392{ release orders to services without a signature, do appropriate prints }
2393var
2394 SelectedList: TList;
2395 ALocation: Integer;
2396 AName: string;
2397begin
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;
2435end;
2436
2437procedure TfrmOrders.mnuActOnChartClick(Sender: TObject);
2438{ mark orders orders as signed on chart, release to services, do appropriate prints }
2439var
2440 SelectedList: TList;
2441 ALocation: Integer;
2442 AName: string;
2443begin
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;
2480end;
2481
2482procedure TfrmOrders.mnuActSignClick(Sender: TObject);
2483{ obtain signature for orders, release them to services, do appropriate prints }
2484var
2485 SelectedList: TList;
2486 ALocation: Integer;
2487 AName: string;
2488begin
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;
2554end;
2555
2556procedure TfrmOrders.mnuOptSaveQuickClick(Sender: TObject);
2557begin
2558 inherited;
2559 QuickOrderSave;
2560end;
2561
2562procedure TfrmOrders.mnuOptEditCommonClick(Sender: TObject);
2563begin
2564 inherited;
2565 QuickOrderListEdit;
2566end;
2567
2568procedure TfrmOrders.ProcessNotifications;
2569var
2570 OrderIEN, ErrMsg: string;
2571 BigOrderID: string;
2572begin
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, DKLangConstW('fOrders_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;
2728end;
2729
2730procedure TfrmOrders.ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string;
2731 BySvc, InvDate: boolean; Title: string); {**KCM**}
2732var
2733 i, ADGroup: integer;
2734 DGroups: TStrings;
2735begin
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;
2766end;
2767
2768procedure TfrmOrders.pnlRightResize(Sender: TObject);
2769begin
2770 inherited;
2771 imgHide.Left := pnlRight.Width - 19;
2772end;
2773
2774procedure 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
2780var
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
2789begin
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;
2828end;
2829
2830procedure TfrmOrders.btnDelayedOrderClick(Sender: TObject);
2831//const
2832//TX_DELAYCAP = ' Delay release of new order(s) until'; <-- original line. //kt 8/8/2007
2833var
2834 AnEvent: TOrderDelayEvent;
2835 ADlgLst: TStringList;
2836 IsRealeaseNow: boolean;
2837 TX_DELAYCAP : string; //kt
2838begin
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;
2865end;
2866
2867procedure TfrmOrders.CompressEventSection;
2868begin
2869 hdrOrders.Sections[0].MaxWidth := 0;
2870 hdrOrders.Sections[0].MinWidth := 0;
2871 hdrOrders.Sections[0].Width := 0;
2872 hdrOrders.Sections[0].Text := '';
2873end;
2874
2875procedure TfrmOrders.ExpandEventSection;
2876begin
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
2885end;
2886
2887{procedure TfrmOrders.SetEvtIFN(var AnEvtIFN: integer);
2888var
2889 APtEvntID,AnEvtInfo: string;
2890begin
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;
2906end;}
2907
2908procedure TfrmOrders.InitOrderSheetsForEvtDelay;
2909begin
2910 InitOrderSheets;
2911 DfltViewForEvtDelay;
2912end;
2913
2914procedure TfrmOrders.DfltViewForEvtDelay;
2915begin
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;
2922end;
2923
2924procedure TfrmOrders.EventRealeasedOrder1Click(Sender: TObject);
2925var
2926 AnOrderView: TOrderView;
2927begin
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;
2969end;
2970
2971procedure TfrmOrders.ResetOrderPage(AnEvent: TOrderDelayEvent; ADlgLst: TStringList; IsRealeaseNow: boolean);
2972var
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;
2979begin
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;
3126end;
3127
3128function TfrmOrders.GetEvtIFN(AnIndex: integer): string;
3129begin
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;
3142end;
3143
3144function TfrmOrders.PlaceOrderForDefaultDialog(ADlgInfo: string; IsDefaultDialog: boolean; AEvent: TOrderDelayEvent): boolean;
3145{ ADlgInfo = DlgIEN;FormID;DGroup;DlgType }
3146var
3147 Activated: Boolean;
3148 NextIndex,ix: Integer;
3149 APtEvtIdA: string;
3150 TheEvent: TOrderDelayEvent;
3151begin
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;
3229end;
3230
3231function TfrmOrders.DisplayDefaultDlgList(ADest: TORListBox; ADlgList: TStringList): boolean;
3232var
3233 i,j: integer;
3234 AnDlgStr: string;
3235 AFillEvent: TOrderDelayEvent;
3236 APtEvtID,tmpPtEvtID: string;
3237begin
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;
3312end;
3313
3314procedure TfrmOrders.ClickLstSheet;
3315begin
3316 FAskForCancel := False;
3317 lstSheetsClick(Self);
3318 FAskForCancel := True;
3319end;
3320
3321procedure TfrmOrders.lblWriteMouseMove(Sender: TObject; Shift: TShiftState;
3322 X, Y: Integer);
3323begin
3324 inherited;
3325 lblWrite.Hint := lblWrite.Caption;
3326end;
3327
3328procedure TfrmOrders.InitOrderSheets2(AnItem: string);
3329var
3330 i: Integer;
3331begin
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);
3350end;
3351
3352procedure TfrmOrders.SetFontSize( FontSize: integer);
3353begin
3354 inherited SetFontSize( FontSize );
3355 RedrawOrderList;
3356 mnuOptimizeFieldsClick(self);
3357 lstSheets.Repaint;
3358 lstWrite.Repaint;
3359 btnDelayedOrder.Repaint;
3360end;
3361
3362procedure TfrmOrders.popOrderPopup(Sender: TObject);
3363begin
3364 inherited;
3365 if PatientStatusChanged then exit;
3366 //frmFrame.UpdatePtInfoOnRefresh;
3367end;
3368
3369procedure TfrmOrders.mnuViewClick(Sender: TObject);
3370begin
3371 inherited;
3372 if PatientStatusChanged then exit;
3373 //frmFrame.UpdatePtInfoOnRefresh;
3374end;
3375
3376procedure TfrmOrders.mnuActClick(Sender: TObject);
3377begin
3378 inherited;
3379 if PatientStatusChanged then exit;
3380 //frmFrame.UpdatePtInfoOnRefresh;
3381end;
3382
3383procedure TfrmOrders.mnuOptClick(Sender: TObject);
3384begin
3385 inherited;
3386 if PatientStatusChanged then exit;
3387 //frmFrame.UpdatePtInfoOnRefresh;
3388end;
3389
3390procedure TfrmOrders.AddToListBox(AnOrderList: TList);
3391var
3392 idx: integer;
3393 AnOrder: TOrder;
3394 i: integer;
3395begin
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;
3404end;
3405
3406procedure TfrmOrders.ChangesUpdate(APtEvtID: string);
3407var
3408 jdx: integer;
3409 APrtEvtId, tempEvtId,EvtOrderID: string;
3410begin
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;
3423end;
3424
3425function TfrmOrders.PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean): boolean;
3426begin
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;
3445end;
3446
3447procedure TfrmOrders.RefreshToFirstItem;
3448begin
3449 InitOrderSheetsForEvtDelay;
3450 lstSheets.ItemIndex := 0;
3451 RefreshOrderList(True);
3452end;
3453
3454procedure TfrmOrders.GroupChangesUpdate(GrpName: string);
3455var
3456 ji: integer;
3457 theChangeItem: TChangeItem;
3458begin
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;
3466end;
3467
3468procedure TfrmOrders.UMEventOccur(var Message: TMessage);
3469begin
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);
3479end;
3480
3481procedure TfrmOrders.setSectionWidths;
3482var
3483 i: integer;
3484begin
3485 //CQ6170
3486 for i := 0 to 9 do
3487 origWidths[i] := hdrOrders.Sections[i].Width;
3488 //end CQ6170
3489end;
3490
3491function TfrmOrders.getTotalSectionsWidth : integer;
3492var
3493 i: integer;
3494begin
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
3500end;
3501
3502procedure TfrmOrders.FormShow(Sender: TObject);
3503begin
3504 inherited;
3505 //force horizontal scrollbar
3506 //lstOrders.ScrollWidth := lstOrders.ClientWidth+1000; //CQ6170
3507end;
3508
3509procedure TfrmOrders.hdrOrdersMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3510var
3511 i: integer;
3512 totalSectionsWidth, originalwidth: integer;
3513begin
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
3530end;
3531
3532procedure TfrmOrders.hdrOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3533begin
3534 inherited;
3535 setSectionWidths; //CQ6170
3536end;
3537
3538function 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
3546var
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
3555begin
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;
3577end;
3578
3579function TfrmOrders.CheckOrderStatus: boolean;
3580var
3581i: integer;
3582AnOrder: TOrder;
3583begin
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;
3597end;
3598
3599(*procedure TfrmOrders.ActivateDeactiveRenew;
3600var
3601 i: Integer;
3602 AnOrder: TOrder;
3603 tmpArr: TStringList;
3604begin
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);
3612end; *)
3613
3614procedure TfrmOrders.ViewInfo(Sender: TObject);
3615begin
3616 inherited;
3617 frmFrame.ViewInfo(Sender);
3618end;
3619
3620procedure TfrmOrders.mnuViewInformationClick(Sender: TObject);
3621begin
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;
3632end;
3633
3634procedure TfrmOrders.mnuOptimizeFieldsClick(Sender: TObject);
3635var
3636 totalSectionsWidth, unitvalue: integer;
3637begin
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;
3655end;
3656
3657procedure TfrmOrders.hdrOrdersSectionClick(HeaderControl: THeaderControl;
3658 Section: THeaderSection);
3659begin
3660 inherited;
3661 //if Section = hdrOrders.Sections[1] then
3662 mnuOptimizeFieldsClick(self);
3663end;
3664
3665procedure TfrmOrders.sptHorzMoved(Sender: TObject);
3666begin
3667 inherited;
3668 mnuOptimizeFieldsClick(self);
3669end;
3670
3671end.
3672
Note: See TracBrowser for help on using the repository browser.