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

Last change on this file since 1103 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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