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

Last change on this file since 459 was 459, checked in by Kevin Toppenberg, 17 years ago

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