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

Last change on this file since 792 was 456, checked in by Kevin Toppenberg, 16 years ago

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