//kt -- Modified with SourceScanner on 8/8/2007 unit fOrders; {$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, fHSplit, StdCtrls, ExtCtrls, Menus, ORCtrls, ComCtrls, ORFn, rOrders, fODBase, uConst, uCore, uOrders,UBACore, UBAGlobals, DKLang; type TfrmOrders = class(TfrmHSplit) mnuOrders: TMainMenu; mnuAct: TMenuItem; mnuActChange: TMenuItem; mnuActDC: TMenuItem; mnuActHold: TMenuItem; mnuActUnhold: TMenuItem; mnuActRenew: TMenuItem; Z4: TMenuItem; mnuActFlag: TMenuItem; mnuActUnflag: TMenuItem; Z5: TMenuItem; mnuActVerify: TMenuItem; mnuActRelease: TMenuItem; mnuActSign: TMenuItem; mnuView: TMenuItem; mnuViewChart: TMenuItem; mnuChartReports: TMenuItem; mnuChartLabs: TMenuItem; mnuChartDCSumm: TMenuItem; mnuChartCslts: TMenuItem; mnuChartNotes: TMenuItem; mnuChartOrders: TMenuItem; mnuChartMeds: TMenuItem; mnuChartProbs: TMenuItem; mnuChartCover: TMenuItem; mnuViewActive: TMenuItem; mnuViewExpiring: TMenuItem; Z2: TMenuItem; mnuViewCustom: TMenuItem; Z3: TMenuItem; mnuViewDetail: TMenuItem; Z1: TMenuItem; OROffsetLabel1: TOROffsetLabel; hdrOrders: THeaderControl; lstOrders: TCaptionListBox; lblOrders: TOROffsetLabel; lstSheets: TORListBox; lstWrite: TORListBox; mnuViewUnsigned: TMenuItem; popOrder: TPopupMenu; popOrderChange: TMenuItem; popOrderDC: TMenuItem; popOrderRenew: TMenuItem; popOrderDetail: TMenuItem; N1: TMenuItem; mnuActCopy: TMenuItem; mnuActAlert: TMenuItem; mnuViewResult: TMenuItem; mnuActOnChart: TMenuItem; mnuActComplete: TMenuItem; sepOrderVerify: TMenuItem; popOrderVerify: TMenuItem; popOrderResult: TMenuItem; imgHide: TImage; mnuOpt: TMenuItem; mnuOptSaveQuick: TMenuItem; mnuOptEditCommon: TMenuItem; popOrderSign: TMenuItem; popOrderCopy: TMenuItem; mnuActChartRev: TMenuItem; popOrderChartRev: TMenuItem; Z6: TMenuItem; mnuViewDfltSave: TMenuItem; mnuViewDfltShow: TMenuItem; mnuViewCurrent: TMenuItem; mnuChartSurgery: TMenuItem; mnuViewResultsHistory: TMenuItem; popResultsHistory: TMenuItem; btnDelayedOrder: TORAlignButton; mnuActChgEvnt: TMenuItem; mnuChgEvnt: TMenuItem; mnuActRel: TMenuItem; popOrderRel: TMenuItem; EventRealeasedOrder1: TMenuItem; lblWrite: TLabel; sptVert: TSplitter; mnuViewExpired: TMenuItem; mnuViewInformation: TMenuItem; mnuViewDemo: TMenuItem; mnuViewVisits: TMenuItem; mnuViewPrimaryCare: TMenuItem; mnuViewMyHealtheVet: TMenuItem; mnuInsurance: TMenuItem; mnuViewFlags: TMenuItem; mnuViewReminders: TMenuItem; mnuViewRemoteData: TMenuItem; mnuViewPostings: TMenuItem; mnuOptimizeFields: TMenuItem; procedure mnuChartTabClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer; TheRect: TRect; State: TOwnerDrawState); procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); procedure mnuViewActiveClick(Sender: TObject); procedure hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); procedure mnuViewCustomClick(Sender: TObject); procedure mnuViewExpiringClick(Sender: TObject); procedure mnuViewExpiredClick(Sender: TObject); procedure mnuViewUnsignedClick(Sender: TObject); procedure mnuViewDetailClick(Sender: TObject); procedure lstOrdersDblClick(Sender: TObject); procedure lstWriteClick(Sender: TObject); procedure mnuActHoldClick(Sender: TObject); procedure mnuActUnholdClick(Sender: TObject); procedure mnuActDCClick(Sender: TObject); procedure mnuActAlertClick(Sender: TObject); procedure mnuActFlagClick(Sender: TObject); procedure mnuActUnflagClick(Sender: TObject); procedure mnuActSignClick(Sender: TObject); procedure mnuActReleaseClick(Sender: TObject); procedure mnuActOnChartClick(Sender: TObject); procedure mnuActCompleteClick(Sender: TObject); procedure mnuActVerifyClick(Sender: TObject); procedure mnuViewResultClick(Sender: TObject); procedure mnuActCommentClick(Sender: TObject); procedure mnuOptSaveQuickClick(Sender: TObject); procedure mnuOptEditCommonClick(Sender: TObject); procedure mnuActCopyClick(Sender: TObject); procedure mnuActChangeClick(Sender: TObject); procedure mnuActRenewClick(Sender: TObject); procedure pnlRightResize(Sender: TObject); procedure lstSheetsClick(Sender: TObject); procedure mnuActChartRevClick(Sender: TObject); procedure mnuViewDfltShowClick(Sender: TObject); procedure mnuViewDfltSaveClick(Sender: TObject); procedure mnuViewCurrentClick(Sender: TObject); procedure mnuViewResultsHistoryClick(Sender: TObject); procedure btnDelayedOrderClick(Sender: TObject); procedure mnuActChgEvntClick(Sender: TObject); procedure mnuActRelClick(Sender: TObject); procedure EventRealeasedOrder1Click(Sender: TObject); procedure lblWriteMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure popOrderPopup(Sender: TObject); procedure mnuViewClick(Sender: TObject); procedure mnuActClick(Sender: TObject); procedure mnuOptClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure hdrOrdersMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure hdrOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ViewInfo(Sender: TObject); procedure mnuViewInformationClick(Sender: TObject); procedure mnuOptimizeFieldsClick(Sender: TObject); procedure hdrOrdersSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); procedure sptHorzMoved(Sender: TObject); private { Private declarations } FDfltSort: Integer; FCurrentView: TOrderView; FCompress: boolean; FFromDCRelease: boolean; FSendDelayOrders: boolean; FNewEvent: boolean; FAskForCancel: boolean; FNeedShowModal: boolean; FOrderViewForActiveOrders: TOrderView; FEventForCopyActiveOrders: TOrderDelayEvent; FEventDefaultOrder : string; FIsDefaultDlg: boolean; FHighlightFromMedsTab: integer; FCalledFromWDO: boolean; //called from Write Delay Orders button FEvtOrderList: TStringlist; FEvtColWidth: integer; FRightAfterWriteOrderBox : boolean; FDontCheck: boolean; FParentComplexOrderID: string; function CanChangeOrderView: Boolean; function GetEvtIFN(AnIndex: integer): string; function DisplayDefaultDlgList(ADest: TORListBox; ADlgList: TStringList): boolean; procedure AddToListBox(AnOrderList: TList); procedure ExpandEventSection; procedure CompressEventSection; procedure ClearOrderSheets; procedure InitOrderSheets; procedure DfltViewForEvtDelay; procedure MakeSelectedList(AList: TList); function NoneSelected(const ErrMsg: string): Boolean; procedure ProcessNotifications; procedure PositionTopOrder(DGroup: Integer); procedure RedrawOrderList; procedure RefreshOrderList(FromServer: Boolean; APtEvtID: string = ''); procedure RetrieveVisibleOrders(AnIndex: Integer); procedure RemoveSelectedFromChanges(AList: TList); procedure SetOrderView(AFilter, ADGroup: Integer; const AViewName: string; NotifSort: Boolean); //procedure SetEvtIFN(var AnEvtIFN: integer); procedure UseDefaultSort; procedure SynchListToOrders; // procedure ActivateDeactiveRenew; procedure ValidateSelected(const AnAction, WarningMsg, WarningTitle: string); procedure ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string; BySvc, InvDate: boolean; Title: string); procedure UMDestroy(var Message: TMessage); message UM_DESTROY; function GetStartStopText(StartTime: string; StopTime: string): string; function GetOrderText(AnOrder: TOrder; Index: integer; Column: integer): string; function MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer; function GetPlainText(AnOrder: TOrder; index: integer):string; function PatientStatusChanged: boolean; procedure UMEventOccur(var Message: TMessage); message UM_EVENTOCCUR; function CheckOrderStatus: boolean; public procedure setSectionWidths; //CQ6170 function getTotalSectionsWidth : integer; //CQ6170 function AllowContextChange(var WhyNot: string): Boolean; override; function PlaceOrderForDefaultDialog(ADlgInfo: string; IsDefaultDialog: boolean; AEvent: TOrderDelayEvent): boolean; function PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean = False): boolean; procedure RefreshToFirstItem; procedure ChangesUpdate(APtEvtID: string); procedure GroupChangesUpdate(GrpName: string); procedure ClearPtData; override; procedure DisplayPage; override; procedure InitOrderSheetsForEvtDelay; procedure ResetOrderPage(AnEvent: TOrderDelayEvent; ADlgLst: TStringList; IsRealeaseNow: boolean); procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override; procedure SaveSignOrders; procedure ClickLstSheet; procedure RequestPrint; override; procedure InitOrderSheets2(AnItem: string = ''); procedure SetFontSize( FontSize: integer); override; property IsDefaultDlg: boolean read FIsDefaultDlg write FIsDefaultDlg; property SendDelayOrders: Boolean read FSendDelayOrders write FSendDelayOrders; property NewEvent: Boolean read FNewEvent write FNewEvent; property NeedShowModal: Boolean read FNeedShowModal write FNeedShowModal; property AskForCancel: Boolean read FAskForCancel write FAskForCancel; property EventDefaultOrder: string read FEventDefaultOrder write FEventDefaultOrder; property TheCurrentView: TOrderView read FCurrentView; property HighlightFromMedsTab: integer read FHighlightFromMedsTab write FHighlightFromMedsTab; property CalledFromWDO: boolean read FCalledFromWDO; property EvtOrderList: TStringlist read FEvtOrderList write FEvtOrderList; property FromDCRelease: boolean read FFromDCRelease write FFromDCRelease; property EvtColWidth: integer read FEvtColWidth write FEvtColWidth; property DontCheck: boolean read FDontCheck write FDontCheck; property ParentComplexOrderID: string read FParentComplexOrderID write FParentComplexOrderID; end; type arOrigSecWidths = array[0..9] of integer; //CQ6170 var frmOrders: TfrmOrders; origWidths: arOrigSecWidths; //CQ6170 implementation uses fFrame, fEncnt, fOrderVw, fRptBox, fLkUpLocation, fOrdersDC, fOrdersCV, fOrdersHold, fOrdersUnhold, fOrdersAlert, fOrderFlag, fOrderUnflag, fOrdersSign, fOrdersRelease, fOrdersOnChart, fOrdersEvntRelease, fOrdersComplete, fOrdersVerify, fOrderComment, fOrderSaveQuick, fOrdersRenew,fODReleaseEvent, fOMNavA, rCore, fOCSession, fOrdersPrint, fOrdersTS, fEffectDate, fODActive, fODChild, fOrdersCopy, fOMVerify, fODAuto, rODBase, uODBase, rMeds,fODValidateAction, fMeds, uInit, fBALocalDiagnoses, fODConsult, fClinicWardMeds, fActivateDeactivate; {$R *.DFM} const FROM_SELF = False; FROM_SERVER = True; OVS_CATINV = 0; OVS_CATFWD = 1; OVS_INVERSE = 2; OVS_FORWARD = 3; STS_ACTIVE = 2; STS_DISCONTINUED = 3; STS_COMPLETE = 4; STS_EXPIRING = 5; STS_RECENT = 6; STS_UNVERIFIED = 8; STS_UNVER_NURSE = 9; STS_UNSIGNED = 11; STS_FLAGGED = 12; STS_HELD = 18; STS_NEW = 19; STS_CURRENT = 23; STS_EXPIRED = 27; FM_DATE_ONLY = 7; CT_ORDERS = 4; // chart tab - doctor's orders //TX_NO_HOLD = CRLF + CRLF + '- cannot be placed on hold.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_HOLD = 'Unable to Hold'; <-- original line. //kt 8/8/2007 //TX_NO_UNHOLD = CRLF + CRLF + '- cannot be released from hold.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_UNHOLD = 'Unable to Release from Hold'; <-- original line. //kt 8/8/2007 //TX_NO_DC = CRLF + CRLF + '- cannot be discontinued.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_DC = 'Unable to Discontinue'; <-- original line. //kt 8/8/2007 //TX_NO_CV = CRLF + 'The release event cannot be changed.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_CV = 'Unable to Change Release Event'; <-- original line. //kt 8/8/2007 //TX_NO_ALERT = CRLF + CRLF + '- cannot be set to send an alert.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_ALERT = 'Unable to Set Alert'; <-- original line. //kt 8/8/2007 //TX_NO_FLAG = CRLF + CRLF + '- cannot be flagged.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_FLAG = 'Unable to Flag Order'; <-- original line. //kt 8/8/2007 //TX_NO_UNFLAG = CRLF + CRLF + '- cannot be unflagged.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_UNFLAG = 'Unable to Unflag Order'; <-- original line. //kt 8/8/2007 //TX_NO_SIGN = CRLF + CRLF + '- cannot be signed.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_SIGN = 'Unable to Sign Order'; <-- original line. //kt 8/8/2007 //TX_NO_REL = CRLF + 'Cannot be released to the service(s).' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_REL = 'Unable to be Released to Service'; <-- original line. //kt 8/8/2007 //TX_NO_CHART = CRLF + CRLF + '- cannot be marked "Signed on Chart".' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_CHART = 'Unable to Release Orders'; <-- original line. //kt 8/8/2007 //TX_NO_CPLT = CRLF + CRLF + '- cannot be completed.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_CPLT = 'Unable to Complete'; <-- original line. //kt 8/8/2007 //TX_NO_VERIFY = CRLF + CRLF + '- cannot be verified.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_VERIFY = 'Unable to Verify'; <-- original line. //kt 8/8/2007 //TX_NO_CMNT = CRLF + CRLF + '- cannot have comments edited.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_CMNT = 'Unable to Edit Comments'; <-- original line. //kt 8/8/2007 //TX_NO_RENEW = CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_RENEW = 'Unable to Renew Order'; <-- original line. //kt 8/8/2007 //TX_LOC_PRINT = 'The selected location will be used to determine where orders are printed.'; <-- original line. //kt 8/8/2007 //TX_PRINT_LOC = 'A location must be selected to print orders.'; <-- original line. //kt 8/8/2007 //TX_REL_LOC = 'A location must be selected to release orders.'; <-- original line. //kt 8/8/2007 //TX_CHART_LOC = 'A location must be selected to mark orders "signed on chart".'; <-- original line. //kt 8/8/2007 //TX_SIGN_LOC = 'A location must be selected to sign orders.'; <-- original line. //kt 8/8/2007 //TC_REQ_LOC = 'Location Required'; <-- original line. //kt 8/8/2007 //TX_NOSEL = 'No orders are highlighted. Highlight the orders' + CRLF + <-- original line. //kt 8/8/2007 // 'you wish to take action on.'; <-- original line. //kt 8/8/2007 //TX_NOSEL_SIGN = 'No orders are highlighted. Highlight orders you want to sign or' + CRLF + <-- original line. //kt 8/8/2007 // 'use Review/Sign Changes (File menu) to sign all orders written' + CRLF + <-- original line. //kt 8/8/2007 // 'in this session.'; <-- original line. //kt 8/8/2007 //TC_NOSEL = 'No Orders Selected'; <-- original line. //kt 8/8/2007 //TX_NOCHG_VIEW = 'The view of orders may not be changed while an ordering dialog is' + CRLF + <-- original line. //kt 8/8/2007 // 'active for an event-delayed order.'; <-- original line. //kt 8/8/2007 //TC_NOCHG_VIEW = 'Order View Restriction'; <-- original line. //kt 8/8/2007 //TX_DELAY1 = 'Now writing orders for '; <-- original line. //kt 8/8/2007 //TC_DELAY = 'Ordering Information'; <-- original line. //kt 8/8/2007 //TX_BAD_TYPE = 'This item is a type that is not supported in the graphical interface.'; <-- original line. //kt 8/8/2007 //TC_BAD_TYPE = 'Unsupported Ordering Item'; <-- original line. //kt 8/8/2007 //TC_VWSAVE = 'Save Default Order View'; <-- original line. //kt 8/8/2007 //TX_VWSAVE1 = 'The current order view is: ' + CRLF + CRLF; <-- original line. //kt 8/8/2007 //TX_VWSAVE2 = CRLF + CRLF + 'Do you wish to save this as your default view?'; <-- original line. //kt 8/8/2007 //TX_NO_COPY = CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_COPY = 'Unable to Copy Order'; <-- original line. //kt 8/8/2007 //TX_NO_CHANGE = CRLF + CRLF + '- cannot be changed' + CRLF + CRLF + 'Reason: '; <-- original line. //kt 8/8/2007 //TC_NO_CHANGE = 'Unable to Change Order'; <-- original line. //kt 8/8/2007 //TX_COMPLEX = 'You can not take this action on a complex medication.' + #13 + 'You must enter a new order.'; <-- original line. //kt 8/8/2007 //TX_CMPTEVT = ' occurred since you started writing delayed orders. ' <-- original line. //kt 8/8/2007 // + 'The orders that were entered and signed have now been released. ' <-- original line. //kt 8/8/2007 // + 'Any unsigned orders will be released immediately upon signature. ' <-- original line. //kt 8/8/2007 // + #13#13 // + 'To write new delayed orders for this event you need to click the write delayed orders button again and select the appropriate event. ' <-- original line. //kt 8/8/2007 // + 'Orders delayed to this same event will remain delayed until the event occurs again.' <-- original line. //kt 8/8/2007 // + #13#13 // + 'The Orders tab will now be refreshed and switched to the Active Orders view. ' <-- original line. //kt 8/8/2007 // + 'If you wish to continue to write active orders for this patient, ' <-- original line. //kt 8/8/2007 // + 'close this message window and continue as usual.'; <-- original line. //kt 8/8/2007 //TX_CMPTEVT_MEDSTAB = ' occurred since you started writing delayed orders. ' <-- original line. //kt 8/8/2007 // + 'The orders that were entered and signed have now been released. ' <-- original line. //kt 8/8/2007 // + 'Any unsigned orders will be released immediately upon signature. ' <-- original line. //kt 8/8/2007 // + #13#13 // + 'To write new delayed orders for this event you need to click the write delayed orders button on the orders tab and select the appropriate event. ' <-- original line. //kt 8/8/2007 // + 'Orders delayed to this same event will remain delayed until the event occurs again.'; <-- original line. //kt 8/8/2007 var TX_NO_HOLD : string; //kt TC_NO_HOLD : string; //kt TX_NO_UNHOLD : string; //kt TC_NO_UNHOLD : string; //kt TX_NO_DC : string; //kt TC_NO_DC : string; //kt TX_NO_CV : string; //kt TC_NO_CV : string; //kt TX_NO_ALERT : string; //kt TC_NO_ALERT : string; //kt TX_NO_FLAG : string; //kt TC_NO_FLAG : string; //kt TX_NO_UNFLAG : string; //kt TC_NO_UNFLAG : string; //kt TX_NO_SIGN : string; //kt TC_NO_SIGN : string; //kt TX_NO_REL : string; //kt TC_NO_REL : string; //kt TX_NO_CHART : string; //kt TC_NO_CHART : string; //kt TX_NO_CPLT : string; //kt TC_NO_CPLT : string; //kt TX_NO_VERIFY : string; //kt TC_NO_VERIFY : string; //kt TX_NO_CMNT : string; //kt TC_NO_CMNT : string; //kt TX_NO_RENEW : string; //kt TC_NO_RENEW : string; //kt TX_LOC_PRINT : string; //kt TX_PRINT_LOC : string; //kt TX_REL_LOC : string; //kt TX_CHART_LOC : string; //kt TX_SIGN_LOC : string; //kt TC_REQ_LOC : string; //kt TX_NOSEL : string; //kt TX_NOSEL_SIGN : string; //kt TC_NOSEL : string; //kt TX_NOCHG_VIEW : string; //kt TC_NOCHG_VIEW : string; //kt TX_DELAY1 : string; //kt TC_DELAY : string; //kt TX_BAD_TYPE : string; //kt TC_BAD_TYPE : string; //kt TC_VWSAVE : string; //kt TX_VWSAVE1 : string; //kt TX_VWSAVE2 : string; //kt TX_NO_COPY : string; //kt TC_NO_COPY : string; //kt TX_NO_CHANGE : string; //kt TC_NO_CHANGE : string; //kt TX_COMPLEX : string; //kt TX_CMPTEVT : string; //kt TX_CMPTEVT_MEDSTAB : string; //kt procedure SetupVars; //kt Added entire function to replace constant declarations 8/8/2007 begin TX_NO_HOLD := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_placed_on_holdx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_HOLD := DKLangConstW('fOrders_Unable_to_Hold'); TX_NO_UNHOLD := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_released_from_holdx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_UNHOLD := DKLangConstW('fOrders_Unable_to_Release_from_Hold'); TX_NO_DC := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_discontinuedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_DC := DKLangConstW('fOrders_Unable_to_Discontinue'); TX_NO_CV := CRLF + DKLangConstW('fOrders_The_release_event_cannot_be_changedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_CV := DKLangConstW('fOrders_Unable_to_Change_Release_Event'); TX_NO_ALERT := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_set_to_send_an_alertx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_ALERT := DKLangConstW('fOrders_Unable_to_Set_Alert'); TX_NO_FLAG := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_flaggedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_FLAG := DKLangConstW('fOrders_Unable_to_Flag_Order'); TX_NO_UNFLAG := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_unflaggedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_UNFLAG := DKLangConstW('fOrders_Unable_to_Unflag_Order'); TX_NO_SIGN := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_signedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_SIGN := DKLangConstW('fOrders_Unable_to_Sign_Order'); TX_NO_REL := CRLF + DKLangConstW('fOrders_Cannot_be_released_to_the_servicexsxx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_REL := DKLangConstW('fOrders_Unable_to_be_Released_to_Service'); TX_NO_CHART := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_marked_xSigned_on_Chartxx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_CHART := DKLangConstW('fOrders_Unable_to_Release_Orders'); TX_NO_CPLT := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_completedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_CPLT := DKLangConstW('fOrders_Unable_to_Complete'); TX_NO_VERIFY := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_verifiedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_VERIFY := DKLangConstW('fOrders_Unable_to_Verify'); TX_NO_CMNT := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_have_comments_editedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_CMNT := DKLangConstW('fOrders_Unable_to_Edit_Comments'); TX_NO_RENEW := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_changedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_RENEW := DKLangConstW('fOrders_Unable_to_Renew_Order'); TX_LOC_PRINT := DKLangConstW('fOrders_The_selected_location_will_be_used_to_determine_where_orders_are_printedx'); TX_PRINT_LOC := DKLangConstW('fOrders_A_location_must_be_selected_to_print_ordersx'); TX_REL_LOC := DKLangConstW('fOrders_A_location_must_be_selected_to_release_ordersx'); TX_CHART_LOC := DKLangConstW('fOrders_A_location_must_be_selected_to_mark_orders_xsigned_on_chartxx'); TX_SIGN_LOC := DKLangConstW('fOrders_A_location_must_be_selected_to_sign_ordersx'); TC_REQ_LOC := DKLangConstW('fOrders_Location_Required'); TX_NOSEL := DKLangConstW('fOrders_No_orders_are_highlightedx__Highlight_the_orders') + CRLF + DKLangConstW('fOrders_you_wish_to_take_action_onx'); TX_NOSEL_SIGN := DKLangConstW('fOrders_No_orders_are_highlightedx_Highlight_orders_you_want_to_sign_or') + CRLF + DKLangConstW('fOrders_use_ReviewxSign_Changes_xFile_menux_to_sign_all_orders_written') + CRLF + DKLangConstW('fOrders_in_this_sessionx'); TC_NOSEL := DKLangConstW('fOrders_No_Orders_Selected'); TX_NOCHG_VIEW := DKLangConstW('fOrders_The_view_of_orders_may_not_be_changed_while_an_ordering_dialog_is') + CRLF + DKLangConstW('fOrders_active_for_an_eventxdelayed_orderx'); TC_NOCHG_VIEW := DKLangConstW('fOrders_Order_View_Restriction'); TX_DELAY1 := DKLangConstW('fOrders_Now_writing_orders_for'); TC_DELAY := DKLangConstW('fOrders_Ordering_Information'); TX_BAD_TYPE := DKLangConstW('fOrders_This_item_is_a_type_that_is_not_supported_in_the_graphical_interfacex'); TC_BAD_TYPE := DKLangConstW('fOrders_Unsupported_Ordering_Item'); TC_VWSAVE := DKLangConstW('fOrders_Save_Default_Order_View'); TX_VWSAVE1 := DKLangConstW('fOrders_The_current_order_view_isx') + CRLF + CRLF; TX_VWSAVE2 := CRLF + CRLF + DKLangConstW('fOrders_Do_you_wish_to_save_this_as_your_default_viewx'); TX_NO_COPY := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_copiedx') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_COPY := DKLangConstW('fOrders_Unable_to_Copy_Order'); TX_NO_CHANGE := CRLF + CRLF + DKLangConstW('fOrders_x_cannot_be_changed') + CRLF + CRLF + DKLangConstW('fOrders_Reasonx'); TC_NO_CHANGE := DKLangConstW('fOrders_Unable_to_Change_Order'); TX_COMPLEX := DKLangConstW('fOrders_You_can_not_take_this_action_on_a_complex_medicationx') + #13 + DKLangConstW('fOrders_You_must_enter_a_new_orderx'); TX_CMPTEVT := DKLangConstW('fOrders_occurred_since_you_started_writing_delayed_ordersx') + DKLangConstW('fOrders_The_orders_that_were_entered_and_signed_have_now_been_releasedx') + DKLangConstW('fOrders_Any_unsigned_orders_will_be_released_immediately_upon_signaturex') + #13#13 + DKLangConstW('fOrders_To_write_new_delayed_orders_for_this_event_you_need_to_click_the_write_delayed_orders_button_again_and_select_the_appropriate_eventx') + DKLangConstW('fOrders_Orders_delayed_to_this_same_event_will_remain_delayed_until_the_event_occurs_againx') + #13#13 + DKLangConstW('fOrders_The_Orders_tab_will_now_be_refreshed_and_switched_to_the_Active_Orders_viewx') + DKLangConstW('fOrders_If_you_wish_to_continue_to_write_active_orders_for_this_patientx') + DKLangConstW('fOrders_close_this_message_window_and_continue_as_usualx'); TX_CMPTEVT_MEDSTAB := DKLangConstW('fOrders_occurred_since_you_started_writing_delayed_ordersx') + DKLangConstW('fOrders_The_orders_that_were_entered_and_signed_have_now_been_releasedx') + DKLangConstW('fOrders_Any_unsigned_orders_will_be_released_immediately_upon_signaturex') + #13#13 + DKLangConstW('fOrders_To_write_new_delayed_orders_for_this_event_you_need_to_click_the_write_delayed_orders_button_on_the_orders_tab_and_select_the_appropriate_eventx') + DKLangConstW('fOrders_Orders_delayed_to_this_same_event_will_remain_delayed_until_the_event_occurs_againx'); end; var uOrderList: TList; uEvtDCList, uEvtRLList: TList; { TPage common methods --------------------------------------------------------------------- } function TfrmOrders.AllowContextChange(var WhyNot: string): Boolean; begin Result := inherited AllowContextChange(WhyNot); // sets result = true case BOOLCHAR[frmFrame.CCOWContextChanging] of '1': if ActiveOrdering then begin // WhyNot := 'Orders in progress will be discarded.'; <-- original line. //kt 8/8/2007 WhyNot := DKLangConstW('fOrders_Orders_in_progress_will_be_discardedx'); //kt added 8/8/2007 Result := False; end; '0': Result := CloseOrdering; // call in uOrders, should move to fFrame end; end; procedure TfrmOrders.ClearPtData; begin inherited ClearPtData; lstOrders.Clear; ClearOrderSheets; ClearOrders(uOrderList); if uEvtDCList <> nil then uEvtDCList.Clear; if uEvtRLList <> nil then uEvtRLList.Clear; ClearFillerAppList; end; procedure TfrmOrders.DisplayPage; var i: Integer; begin inherited DisplayPage; frmFrame.ShowHideChartTabMenus(mnuViewChart); frmFrame.mnuFilePrint.Tag := CT_ORDERS; frmFrame.mnuFilePrint.Enabled := True; frmFrame.mnuFilePrintSetup.Enabled := True; if InitPage then begin // set visibility according to order role mnuActComplete.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK) or (User.OrderRole = OR_PHYSICIAN); mnuActVerify.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK); popOrderVerify.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK); sepOrderVerify.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK); mnuActChartRev.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK); popOrderChartRev.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK); mnuActRelease.Visible := User.OrderRole = OR_NURSE; mnuActOnChart.Visible := (User.OrderRole = OR_NURSE) or (User.OrderRole = OR_CLERK); mnuActSign.Visible := User.OrderRole = OR_PHYSICIAN; popOrderSign.Visible := User.OrderRole = OR_PHYSICIAN; mnuActRel.Visible := False; popOrderRel.Visible := False; // now set enabled/disabled according to parameters // popup items that apply to ordering have tag>0 with mnuAct do for i := 0 to Pred(Count) do Items[i].Enabled := not User.NoOrdering; with popOrder.Items do for i := 0 to Pred(Count) do if Items[i].Tag > 0 then Items[i].Enabled := not User.NoOrdering; // set nurse verification actions (may be enabled when ordering disabled) mnuActVerify.Enabled := User.EnableVerify; mnuActChartRev.Enabled := User.EnableVerify; popOrderVerify.Enabled := User.EnableVerify; popOrderChartRev.Enabled := User.EnableVerify; if User.DisableHold then begin mnuActHold.Visible := False; mnuActUnhold.Visible := False; end; end; AskForCancel := true; if InitPatient then // for both CC_INIT_PATIENT and CC_NOTIFICATION begin if not User.NoOrdering then LoadWriteOrders(lstWrite.Items) else lstWrite.Clear; InitOrderSheets; end; case CallingContext of CC_INIT_PATIENT: mnuViewDfltShowClick(Self); // when new patient but not doing notifications CC_NOTIFICATION: ProcessNotifications; // when new patient and doing notifications end; end; procedure TfrmOrders.mnuChartTabClick(Sender: TObject); begin inherited; frmFrame.mnuChartTabClick(Sender); end; procedure TfrmOrders.NotifyOrder(OrderAction: Integer; AnOrder: TOrder); var OrderForList: TOrder; IndexOfOrder, ReturnedType, CanSign, i: Integer; j: integer; AChildList: TStringlist; CplxOrderID: string; procedure RemoveFromOrderList(ChildOrderID: string); var ij: integer; begin for ij := uOrderList.Count - 1 downto 0 do begin if TOrder(uOrderList[ij]).ID = ChildOrderID then uOrderList.Remove(TOrder(uOrderList[ij])); end; end; begin // if FCurrentView = nil then {**REV**} // begin {**REV**} // FCurrentView := TOrderView.Create; {**REV**} // with FCurrentView do {**REV**} // begin {**REV**} // InvChrono := True; {**REV**} // ByService := True; {**REV**} // end; {**REV**} // end; {**REV**} if FCurrentView = nil then Exit; case OrderAction of ORDER_NEW: if AnOrder.ID <> '' then begin OrderForList := TOrder.Create; OrderForList.Assign(AnOrder); uOrderList.Add(OrderForList); FCompress := True; RefreshOrderList(FROM_SELF); //PositionTopOrder(AnOrder.DGroup); PositionTopOrder(0); // puts new orders on top lstOrders.Invalidate; end; ORDER_DC: begin IndexOfOrder := -1; with lstOrders do for i := 0 to Items.Count - 1 do if TOrder(Items.Objects[i]).ID = AnOrder.ID then IndexOfOrder := i; if IndexOfOrder > -1 then OrderForList := TOrder(lstOrders.Items.Objects[IndexOfOrder]) else OrderForList := AnOrder; if (Encounter.Provider = User.DUZ) and User.CanSignOrders then CanSign := CH_SIGN_YES else CanSign := CH_SIGN_NA; DCOrder(OrderForList, GetReqReason, ReturnedType); Changes.Add(CH_ORD, OrderForList.ID, OrderForList.Text, '', CanSign); FCompress := True; SynchListToOrders; end; ORDER_EDIT: with lstOrders do begin IndexOfOrder := -1; for i := 0 to Items.Count - 1 do if TOrder(Items.Objects[i]).ID = AnOrder.EditOf then IndexOfOrder := i; if IndexOfOrder > -1 then begin TOrder(Items.Objects[IndexOfOrder]).Assign(AnOrder); end; {if IndexOfOrder} //RedrawOrderList; {redraw here appears to clear selected} end; {with lstOrders} ORDER_ACT: begin if IsComplexOrder(AnOrder.ID) then begin RefreshOrderList(FROM_SERVER); exit; end; with lstOrders do begin IndexOfOrder := -1; for i := 0 to Items.Count - 1 do if TOrder(Items.Objects[i]).ID = Piece(AnOrder.ActionOn, '=', 1) then IndexOfOrder := i; if (IndexOfOrder > -1) and (AnOrder <> Items.Objects[IndexOfOrder]) then begin TOrder(Items.Objects[IndexOfOrder]).Assign(AnOrder); end; {if IndexOfOrder} FCompress := True; RedrawOrderList; end; {with lstOrders} end; //PSI-COMPLEX ORDER_CPLXRN: begin AChildList := TStringList.Create; CplxOrderID := Piece(AnOrder.ActionOn,'=',1); GetChildrenOfComplexOrder(CplxOrderID, Piece(CplxOrderID,';',2), AChildList); with lstOrders do begin for i := Items.Count-1 downto 0 do begin for j := 0 to AChildList.Count - 1 do begin if TOrder(Items.Objects[i]).ID = AChildList[j] then begin RemoveFromOrderList(AChildList[j]); Items.Objects[i].Free; Items.Delete(i); Break; end; end; end; Items.InsertObject(0,AnOrder.Text,AnOrder); Items[0] := GetPlainText(AnOrder,0); uOrderList.Insert(0,AnOrder); end; FCompress := True; RedrawOrderList; AChildList.Clear; AChildList.Free; end; ORDER_SIGN: begin FCompress := True; SaveSignOrders; // sent when orders signed, AnOrder=nil end; end; {case} end; { Form events ------------------------------------------------------------------------------ } procedure TfrmOrders.FormCreate(Sender: TObject); begin inherited; PageID := CT_ORDERS; lstOrders.Color := ReadOnlyColor; uOrderList := TList.Create; uEvtDCList := TList.Create; uEvtRLList := TList.Create; FDfltSort := OVS_CATINV; FCompress := False; FFromDCRelease := False; FSendDelayOrders := False; FNewEvent := False; FNeedShowModal := False; FAskForCancel := True; FRightAfterWriteOrderBox := False; FEventForCopyActiveOrders.EventType := #0; FEventForCopyActiveOrders.EventIFN := 0; FHighlightFromMedsTab := 0; FCalledFromWDO := False; FEvtOrderList := TStringList.Create; FEvtColWidth := 0; FDontCheck := False; FParentComplexOrderID := ''; end; procedure TfrmOrders.FormDestroy(Sender: TObject); begin inherited; ClearOrders(uOrderList); uEvtDCList.Clear; uEvtRLList.Clear; ClearOrderSheets; FEvtOrderList.Free; uEvtDCList.Free; uEvtRLList.Free; uOrderList.Free; if FOrderViewForActiveOrders <> nil then FOrderViewForActiveOrders := nil; FEventForCopyActiveOrders.EventType := #0; FEventForCopyActiveOrders.EventIFN := 0; FEventForCopyActiveOrders.EventName := ''; end; procedure TfrmOrders.UMDestroy(var Message: TMessage); { sent by ordering dialog when it is closing } begin lstWrite.ItemIndex := -1; //UnlockIfAble; // - already in uOrders end; { View menu events ------------------------------------------------------------------------- } procedure TfrmOrders.PositionTopOrder(DGroup: Integer); const SORT_FWD = 0; SORT_REV = 1; SORT_GRP_FWD = 2; SORT_GRP_REV = 3; var i, Seq: Integer; AnOrder: TOrder; begin with lstOrders do begin case (Ord(FCurrentView.ByService) * 2) + Ord(FCurrentView.InvChrono) of SORT_FWD: TopIndex := Items.Count - 1; SORT_REV: TopIndex := 0; SORT_GRP_FWD: begin Seq := SeqOfDGroup(DGroup); for i := Items.Count - 1 downto 0 do begin AnOrder := TOrder(Items.Objects[i]); if AnOrder.DGroupSeq <= Seq then break; end; TopIndex := i; end; SORT_GRP_REV: begin Seq := SeqOfDGroup(DGroup); for i := 0 to Items.Count - 1 do begin AnOrder := TOrder(Items.Objects[i]); if AnOrder.DGroupSeq >= Seq then break; end; TopIndex := i; end; end; {case} end; {with} end; procedure TfrmOrders.RedrawOrderList; { redraws the Orders list, compensates for changes in item height by re-adding everything } var i, SaveTop: Integer; AnOrder: TOrder; begin with lstOrders do begin RedrawSuspend(Handle); SaveTop := TopIndex; Clear; for i := 0 to uOrderList.Count - 1 do begin AnOrder := TOrder(uOrderList.Items[i]); if (AnOrder.OrderTime <= 0) then Continue; Items.AddObject(AnOrder.ID, AnOrder); Items[i] := GetPlainText(AnOrder,i); end; TopIndex := SaveTop; RedrawActivate(Handle); end; end; procedure TfrmOrders.RefreshOrderList(FromServer: Boolean; APtEvtID: string); var i: Integer; begin with FCurrentView do begin if EventDelay.EventIFN > 0 then FCompress := False; RedrawSuspend(lstOrders.Handle); lstOrders.Clear; if FromServer then begin // StatusText('Retrieving orders list...'); <-- original line. //kt 8/8/2007 StatusText(DKLangConstW('fOrders_Retrieving_orders_listxxx')); //kt added 8/8/2007 if not FFromDCRelease then LoadOrdersAbbr(uOrderList, FCurrentView, APtEvtID) else begin ClearOrders(uOrderList); uEvtDCList.Clear; uEvtRLList.Clear; LoadOrdersAbbr(uEvtDCList,uEvtRLList,FCurrentView,APtEvtID); end; end; if ((Length(APtEvtID)>0) or (FCurrentView.Filter in [15,16,17,24]) or (FCurrentView.EventDelay.PtEventIFN>0)) and ((not FCompress) or (lstSheets.ItemIndex<0)) and (not FFromDCRelease) then ExpandEventSection else CompressEventSection; if not FFromDCRelease then begin if FRightAfterWriteOrderBox and (EventDelay.EventIFN>0) then begin SortOrders(uOrderList,False,True); FRightAfterWriteOrderBox := False; end else SortOrders(uOrderList, ByService, InvChrono); AddToListBox(uOrderList); end; if FFromDCRelease then begin if uEvtRLList.Count > 0 then begin SortOrders(uEvtRLList,True,True); for i := 0 to uEvtRLList.Count - 1 do uOrderList.Add(TOrder(uEvtRLList[i])); end; if uEvtDCList.Count > 0 then begin SortOrders(uEvtDCList,True,True); for i := 0 to uEvtDCList.Count - 1 do uOrderList.Add(TOrder(uEvtDCList[i])); end; AddToListBox(uOrderList); end; RedrawActivate(lstOrders.Handle); lblOrders.Caption := ViewName; lstOrders.Caption := ViewName; imgHide.Visible := not ((Filter in [1, 2]) and (DGroup = DGroupAll)); StatusText(''); end; end; procedure TfrmOrders.UseDefaultSort; begin with FCurrentView do case FDfltSort of OVS_CATINV: begin InvChrono := True; ByService := True; end; OVS_CATFWD: begin InvChrono := False; ByService := True; end; OVS_INVERSE: begin InvChrono := True; ByService := False; end; OVS_FORWARD: begin InvChrono := False; ByService := False; end; end; end; function TfrmOrders.CanChangeOrderView: Boolean; { Disallows changing view while doing delayed release orders. } begin SetupVars; //kt added 8/8/2007 to replace constants with vars. Result := True; if (lstSheets.ItemIndex > 0) and ActiveOrdering then begin InfoBox(TX_NOCHG_VIEW, TC_NOCHG_VIEW, MB_OK); Result := False; end; end; procedure TfrmOrders.SetOrderView(AFilter, ADGroup: Integer; const AViewName: string; NotifSort: Boolean); //{ sets up a 'canned' order view, assumes the date range is never restricted } <-- original line. //kt 8/8/2007 { sets up a DKLangConstW('fOrders_canned') order view, assumes the date range is never restricted } //kt added 8/8/2007 var tmpDate: TDateTime; begin if not CanChangeOrderView then Exit; lstSheets.ItemIndex := 0; FCurrentView := TOrderView(lstSheets.Items.Objects[0]); if FCurrentView = nil then FCurrentView := TOrderView.Create; with FCurrentView do begin TimeFrom := 0; TimeThru := 0; if NotifSort then begin ByService := False; InvChrono := True; if AFilter = STS_RECENT then begin tmpDate := Trunc(FMDateTimeToDateTime(StrToFMDateTime(Piece(Piece(Notifications.RecordID, U, 2), ';', 3)))); TimeFrom := DateTimeToFMDateTime(tmpDate - 5); TimeThru := FMNow; end; if AFilter = STS_UNVERIFIED then begin if Patient.AdmitTime > 0 then tmpDate := Trunc(FMDateTimeToDateTime(Patient.AdmitTime)) else tmpdate := Trunc(FMDateTimeToDateTime(FMNow)) - 30; TimeFrom := DateTimeToFMDateTime(tmpDate); TimeThru := FMNow; end; end else UseDefaultSort; if AFilter = STS_EXPIRED then begin TimeFrom := ExpiredOrdersStartDT; TimeThru := FMNow; end; Filter := AFilter; DGroup := ADGroup; CtxtTime := 0; TextView := 0; ViewName := AViewName; lstSheets.Items[0] := 'C;0^' + ViewName; EventDelay.EventType := 'C'; EventDelay.Specialty := 0; EventDelay.Effective := 0; end; RefreshOrderList(FROM_SERVER); end; procedure TfrmOrders.mnuViewActiveClick(Sender: TObject); begin inherited; //SetOrderView(STS_ACTIVE, DGroupAll, 'Active Orders (includes Pending & Recent Activity) - ALL SERVICES', False); <-- original line. //kt 8/8/2007 SetOrderView(STS_ACTIVE, DGroupAll, DKLangConstW('fOrders_Active_Orders_xincludes_Pending_x_Recent_Activityx_x_ALL_SERVICES'), False); //kt added 8/8/2007 end; procedure TfrmOrders.mnuViewCurrentClick(Sender: TObject); begin inherited; //SetOrderView(STS_CURRENT, DGroupAll, 'Current Orders (Active & Pending Status Only) - ALL SERVICES', False); <-- original line. //kt 8/8/2007 SetOrderView(STS_CURRENT, DGroupAll, DKLangConstW('fOrders_Current_Orders_xActive_x_Pending_Status_Onlyx_x_ALL_SERVICES'), False); //kt added 8/8/2007 end; procedure TfrmOrders.mnuViewExpiringClick(Sender: TObject); begin inherited; //SetOrderView(STS_EXPIRING, DGroupAll, 'Expiring Orders - ALL SERVICES', False); <-- original line. //kt 8/8/2007 SetOrderView(STS_EXPIRING, DGroupAll, DKLangConstW('fOrders_Expiring_Orders_x_ALL_SERVICES'), False); //kt added 8/8/2007 end; procedure TfrmOrders.mnuViewExpiredClick(Sender: TObject); begin inherited; //SetOrderView(STS_EXPIRED, DGroupAll, 'Recently Expired Orders - ALL SERVICES', False); <-- original line. //kt 8/8/2007 SetOrderView(STS_EXPIRED, DGroupAll, DKLangConstW('fOrders_Recently_Expired_Orders_x_ALL_SERVICES'), False); //kt added 8/8/2007 end; procedure TfrmOrders.mnuViewUnsignedClick(Sender: TObject); begin inherited; //SetOrderView(STS_UNSIGNED, DGroupAll, 'Unsigned Orders - ALL SERVICES', False); <-- original line. //kt 8/8/2007 SetOrderView(STS_UNSIGNED, DGroupAll, DKLangConstW('fOrders_Unsigned_Orders_x_ALL_SERVICES'), False); //kt added 8/8/2007 end; procedure TfrmOrders.mnuViewCustomClick(Sender: TObject); var AnOrderView: TOrderView; begin inherited; if not CanChangeOrderView then Exit; AnOrderView := TOrderView.Create; AnOrderView.Filter := STS_ACTIVE; AnOrderView.DGroup := DGroupAll; //AnOrderView.ViewName := 'All Services, Active'; <-- original line. //kt 8/8/2007 AnOrderView.ViewName := DKLangConstW('fOrders_All_Servicesx_Active'); //kt added 8/8/2007 AnOrderView.InvChrono := True; AnOrderView.ByService := True; AnOrderView.CtxtTime := 0; AnOrderView.TextView := 0; AnOrderView.EventDelay.EventType := 'C'; AnOrderView.EventDelay.Specialty := 0; AnOrderView.EventDelay.Effective := 0; AnOrderView.EventDelay.EventIFN := 0; //AnOrderView.EventDelay.EventName := 'All Services, Active'; <-- original line. //kt 8/8/2007 AnOrderView.EventDelay.EventName := DKLangConstW('fOrders_All_Servicesx_Active'); //kt added 8/8/2007 SelectOrderView(AnOrderView); with AnOrderView do if Changed then begin FCurrentView := AnOrderView; if FCurrentView.Filter in [15,16,17,24] then begin FCompress := False; mnuActRel.Visible := True; popOrderRel.Visible := True; end else begin mnuActRel.Visible := False; popOrderRel.Visible := False; end; lstSheets.ItemIndex := -1; // lblWrite.Caption := 'Write Orders'; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write_Orders'); //kt added 8/8/2007 lstWrite.Clear; lstWrite.Caption := lblWrite.Caption; LoadWriteOrders(lstWrite.Items); RefreshOrderList(FROM_SERVER); if ByService then begin if InvChrono then FDfltSort := OVS_CATINV else FDfltSort := OVS_CATFWD; end else begin if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD; end; end; end; procedure TfrmOrders.mnuViewDfltShowClick(Sender: TObject); begin inherited; if not CanChangeOrderView then Exit; if HighlightFromMedsTab > 0 then lstSheets.ItemIndex := lstSheets.SelectByIEN(HighlightFromMedsTab); if lstSheets.ItemIndex < 0 then lstSheets.ItemIndex := 0; FCurrentView := TOrderView(lstSheets.Items.Objects[lstSheets.ItemIndex]); LoadOrderViewDefault(TOrderView(lstSheets.Items.Objects[0])); lstSheets.Items[0] := 'C;0^' + TOrderView(lstSheets.Items.Objects[0]).ViewName; if lstSheets.ItemIndex > 0 then lstSheetsClick(Application) else RefreshOrderList(FROM_SERVER); if HighlightFromMedsTab > 0 then HighlightFromMedsTab := 0; end; procedure TfrmOrders.mnuViewDfltSaveClick(Sender: TObject); var x: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; with FCurrentView do begin x := Piece(Viewname, '(', 1) + CRLF; // if TimeFrom > 0 then x := x + 'From: ' + MakeRelativeDateTime(TimeFrom); <-- original line. //kt 8/8/2007 if TimeFrom > 0 then x := x + DKLangConstW('fOrders_Fromx') + MakeRelativeDateTime(TimeFrom); //kt added 8/8/2007 // if TimeThru > 0 then x := x + ' Thru: ' + MakeRelativeDateTime(TimeThru); <-- original line. //kt 8/8/2007 if TimeThru > 0 then x := x + DKLangConstW('fOrders_Thrux') + MakeRelativeDateTime(TimeThru); //kt added 8/8/2007 if InvChrono // then x := x + CRLF + 'Sort order dates in reverse chronological order' <-- original line. //kt 8/8/2007 then x := x + CRLF + DKLangConstW('fOrders_Sort_order_dates_in_reverse_chronological_order') //kt added 8/8/2007 // else x := x + CRLF + 'Sort order dates in chronological order'; <-- original line. //kt 8/8/2007 else x := x + CRLF + DKLangConstW('fOrders_Sort_order_dates_in_chronological_order'); //kt added 8/8/2007 if ByService // then x := x + CRLF + 'Group orders by service' <-- original line. //kt 8/8/2007 then x := x + CRLF + DKLangConstW('fOrders_Group_orders_by_service') //kt added 8/8/2007 // else x := x + CRLF + 'Don''t group orders by service'; <-- original line. //kt 8/8/2007 else x := x + CRLF + DKLangConstW('fOrders_Donxxt_group_orders_by_service'); //kt added 8/8/2007 end; if InfoBox(TX_VWSAVE1 + x + TX_VWSAVE2, TC_VWSAVE, MB_YESNO) = IDYES then SaveOrderViewDefault(FCurrentView); end; procedure TfrmOrders.mnuViewDetailClick(Sender: TObject); var i,j,idx: Integer; tmpList: TStringList; BigOrderID: string; AnOrderID: string; begin inherited; SetupVars; //kt added 8/8/2007 to replace constants with vars. if NoneSelected(TX_NOSEL) then Exit; tmpList := TStringList.Create; idx := 0; try with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin // StatusText('Retrieving order details...'); <-- original line. //kt 8/8/2007 StatusText(DKLangConstW('fOrders_Retrieving_order_detailsxxx')); //kt added 8/8/2007 BigOrderID := TOrder(Items.Objects[i]).ID; AnOrderID := Piece(BigOrderID, ';', 1); if StrToIntDef(AnOrderID,0) = 0 then // ShowMessage('Detail view is not available for selected order.') <-- original line. //kt 8/8/2007 ShowMessage(DKLangConstW('fOrders_Detail_view_is_not_available_for_selected_orderx')) //kt added 8/8/2007 else begin tmpList.Assign(DetailOrder(BigOrderID)); // if ((TOrder(Items.Objects[i]).DGroupName = 'Inpt. Meds') or <-- original line. //kt 8/8/2007 if ((TOrder(Items.Objects[i]).DGroupName = DKLangConstW('fOrders_Inptx_Meds')) or //kt added 8/8/2007 // (TOrder(Items.Objects[i]).DGroupName = 'Out. Meds') or <-- original line. //kt 8/8/2007 (TOrder(Items.Objects[i]).DGroupName = DKLangConstW('fOrders_Outx_Meds')) or //kt added 8/8/2007 // (TOrder(Items.Objects[i]).DGroupName = 'Clin. Orders') or <-- original line. //kt 8/8/2007 (TOrder(Items.Objects[i]).DGroupName = DKLangConstW('fOrders_Clinx_Orders')) or //kt added 8/8/2007 // (TOrder(Items.Objects[i]).DGroupName = 'Infusion')) then <-- original line. //kt 8/8/2007 (TOrder(Items.Objects[i]).DGroupName = DKLangConstW('fOrders_Infusion'))) then //kt added 8/8/2007 begin tmpList.Add(''); tmpList.Add(StringOfChar('=', 74)); tmpList.Add(''); tmpList.AddStrings(MedAdminHistory(AnOrderID)); end; if CheckOrderGroup(AnOrderID)=1 then // if it's UD group begin for j := 0 to tmpList.Count - 1 do begin if Pos('PICK UP',UpperCase(tmpList[j]))>0 then begin idx := j; Break; end; end; if idx > 0 then tmpList.Delete(idx); end; // ReportBox(tmpList, 'Order Details - ' + BigOrderID, True); <-- original line. //kt 8/8/2007 ReportBox(tmpList, DKLangConstW('fOrders_Order_Details_x') + BigOrderID, True); //kt added 8/8/2007 end; StatusText(''); if (frmFrame.TimedOut) or (frmFrame.CCOWDrivedChange) then Exit; //code added to correct access violation on timeout Selected[i] := False; end; finally tmpList.Free; end; end; procedure TfrmOrders.mnuViewResultClick(Sender: TObject); var i: Integer; BigOrderID: string; begin inherited; SetupVars; //kt added 8/8/2007 to replace constants with vars. if NoneSelected(TX_NOSEL) then Exit; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin // StatusText('Retrieving order results...'); <-- original line. //kt 8/8/2007 StatusText(DKLangConstW('fOrders_Retrieving_order_resultsxxx')); //kt added 8/8/2007 BigOrderID := TOrder(Items.Objects[i]).ID; if Length(Piece(BigOrderID,';',1)) > 0 then // ReportBox(ResultOrder(BigOrderID), 'Order Results - ' + BigOrderID, True); <-- original line. //kt 8/8/2007 ReportBox(ResultOrder(BigOrderID), DKLangConstW('fOrders_Order_Results_x') + BigOrderID, True); //kt added 8/8/2007 Selected[i] := False; StatusText(''); end; end; procedure TfrmOrders.mnuViewResultsHistoryClick(Sender: TObject); var i: Integer; BigOrderID: string; begin inherited; SetupVars; //kt added 8/8/2007 to replace constants with vars. if NoneSelected(TX_NOSEL) then Exit; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin // StatusText('Retrieving order results...'); <-- original line. //kt 8/8/2007 StatusText(DKLangConstW('fOrders_Retrieving_order_resultsxxx')); //kt added 8/8/2007 BigOrderID := TOrder(Items.Objects[i]).ID; if Length(Piece(BigOrderID,';',1)) > 0 then // ReportBox(ResultOrderHistory(BigOrderID), 'Order Results History- ' + BigOrderID, True); <-- original line. //kt 8/8/2007 ReportBox(ResultOrderHistory(BigOrderID), DKLangConstW('fOrders_Order_Results_Historyx') + BigOrderID, True); //kt added 8/8/2007 Selected[i] := False; StatusText(''); end; end; { lstSheets events ------------------------------------------------------------------------- } procedure TfrmOrders.ClearOrderSheets; { delete all order sheets & associated TOrderView objects, set current view to nil } var i: Integer; begin with lstSheets do for i := 0 to Items.Count - 1 do TOrderView(Items.Objects[i]).Free; lstSheets.Clear; FCurrentView := nil; end; procedure TfrmOrders.InitOrderSheets; { sets up list of order sheets based on what orders are on the server in delayed status for pt } var i: Integer; AnEventInfo: String; AnOrderView: TOrderView; begin ClearOrderSheets; LoadOrderSheetsED(lstSheets.Items); // the 1st item in lstSheets should always be the 'Current' view if CharAt(lstSheets.Items[0], 1) <> 'C' then Exit; AnOrderView := TOrderView.Create; AnOrderView.Filter := STS_ACTIVE; AnOrderView.DGroup := DGroupAll; //AnOrderView.ViewName := 'All Services, Active'; <-- original line. //kt 8/8/2007 AnOrderView.ViewName := DKLangConstW('fOrders_All_Servicesx_Active'); //kt added 8/8/2007 AnOrderView.InvChrono := True; AnOrderView.ByService := True; AnOrderView.CtxtTime := 0; AnOrderView.TextView := 0; AnOrderView.EventDelay.EventType := 'C'; AnOrderView.EventDelay.Specialty := 0; AnOrderView.EventDelay.Effective := 0; AnOrderView.EventDelay.EventIFN := 0; //AnOrderView.EventDelay.EventName := 'All Services, Active'; <-- original line. //kt 8/8/2007 AnOrderView.EventDelay.EventName := DKLangConstW('fOrders_All_Servicesx_Active'); //kt added 8/8/2007 lstSheets.Items.Objects[0] := AnOrderView; FCurrentView := AnOrderView; FOrderViewForActiveOrders := AnOrderView; // now setup the event-delayed views in lstSheets, each with its own TOrderView object with lstSheets do for i := 1 to Items.Count - 1 do begin AnOrderView := TOrderView.Create; AnOrderView.DGroup := DGroupAll; AnEventInfo := EventInfo(Piece(Items[i],'^',1)); AnOrderView.EventDelay.EventType := CharAt(AnEventInfo, 1); AnOrderView.EventDelay.EventIFN := StrToInt(Piece(AnEventInfo,'^',2)); AnOrderView.EventDelay.EventName := Piece(AnEventInfo,'^',3); AnOrderView.EventDelay.Specialty := 0; AnOrderView.EventDelay.Effective := 0; case AnOrderView.EventDelay.EventType of 'A': AnOrderView.Filter := 15; 'D': AnOrderView.Filter := 16; 'T': AnOrderView.Filter := 17; end; // AnOrderView.ViewName := DisplayText[i] + ' Orders'; <-- original line. //kt 8/8/2007 AnOrderView.ViewName := DisplayText[i] + DKLangConstW('fOrders_Orders'); //kt added 8/8/2007 AnOrderView.InvChrono := FCurrentView.InvChrono; AnOrderView.ByService := FCurrentView.ByService; AnOrderView.CtxtTime := 0; AnOrderView.TextView := 0; Items.Objects[i] := AnOrderView; end; {for} //lblWrite.Caption := 'Write Orders'; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write_Orders'); //kt added 8/8/2007 lstWrite.Caption := lblWrite.Caption; end; procedure TfrmOrders.lstSheetsClick(Sender: TObject); //const //TX_EVTDEL = 'There are no orders tied to this event, would you like to cancel it?'; <-- original line. //kt 8/8/2007 var AnOrderView: TOrderView; APtEvtId: string; TX_EVTDEL : string; //kt begin inherited; TX_EVTDEL := DKLangConstW('fOrders_There_are_no_orders_tied_to_this_eventx_would_you_like_to_cancel_itx'); //kt added 8/8/2007 if not CloseOrdering then Exit; FCompress := True; if lstSheets.ItemIndex < 0 then Exit; with lstSheets do begin AnOrderView := TOrderView(Items.Objects[ItemIndex]); AnOrderView.EventDelay.PtEventIFN := StrToIntDef(Piece(Items[lstSheets.ItemIndex],'^',1),0); if AnOrderView.EventDelay.PtEventIFN > 0 then FCompress := False; end; if (FCurrentView <> nil) and (AnOrderView.EventDelay.EventIFN <> FCurrentView.EventDelay.EventIFN) and (FCurrentView.EventDelay.EventIFN > 0 ) then begin APtEvtID := IntToStr(FCurrentView.EventDelay.PtEventIFN); if frmMeds.ActionOnMedsTab then Exit; if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; if (not FDontCheck) and DeleteEmptyEvt(APtEvtID, FCurrentView.EventDelay.EventName) then begin ChangesUpdate(APtEvtID); FCompress := True; InitOrderSheetsForEvtDelay; lstSheets.ItemIndex := 0; lstSheetsClick(self); Exit; end; end; if (FCurrentView = nil) or (AnOrderView <> FCurrentView) or ((AnOrderView=FcurrentView) and (FCurrentView.EventDelay.EventIFN>0)) then begin FCurrentView := AnOrderView; if FCurrentView.EventDelay.EventIFN > 0 then begin FCompress := False; lstWrite.Items.Clear; // lblWrite.Caption := 'Write ' + FCurrentView.ViewName; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write') + FCurrentView.ViewName; //kt added 8/8/2007 lstWrite.Caption := lblWrite.Caption; lstWrite.Items.Clear; LoadWriteOrdersED(lstWrite.Items, IntToStr(AnOrderView.EventDelay.EventIFN)); if lstWrite.Items.Count < 1 then LoadWriteOrders(lstWrite.Items); RefreshOrderList(FROM_SERVER,Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1)); mnuActRel.Visible := True; popOrderRel.Visible := True; if (lstOrders.Items.Count = 0) and (not NewEvent) then begin if frmMeds.ActionOnMedsTab then Exit; if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; if PtEvtEmpty(Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1)) then begin // if (FAskForCancel) and ( InfoBox(TX_EVTDEL, 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES ) then <-- original line. //kt 8/8/2007 if (FAskForCancel) and ( InfoBox(TX_EVTDEL, DKLangConstW('fOrders_Confirmation'), MB_YESNO or MB_ICONQUESTION) = IDYES ) then //kt added 8/8/2007 begin DeletePtEvent(Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1)); FCompress := True; lstSheets.Items.Objects[lstSheets.ItemIndex].Free; lstSheets.Items.Delete(lstSheets.ItemIndex); FCurrentView := TOrderView.Create; lstSheets.ItemIndex := 0; lstSheetsClick(self); Exit; end; end; end; if NewEvent then NewEvent := False; end else begin NewEvent := False; mnuActRel.Visible := False; popOrderRel.Visible := False; // lblWrite.Caption := 'Write Orders'; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write_Orders'); //kt added 8/8/2007 lstWrite.Caption := lblWrite.Caption; LoadWriteOrders(lstWrite.Items); RefreshOrderList(FROM_SERVER); end; end else begin mnuActRel.Visible := False; popOrderRel.Visible := False; // lblWrite.Caption := 'Write Orders'; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write_Orders'); //kt added 8/8/2007 lstWrite.Caption := lblWrite.Caption; LoadWriteOrders(lstWrite.Items); RefreshOrderList(FROM_SERVER); end; FCompress := True; end; { lstOrders events ------------------------------------------------------------------------- } procedure TfrmOrders.RetrieveVisibleOrders(AnIndex: Integer); var i: Integer; tmplst: TList; AnOrder: TOrder; begin tmplst := TList.Create; for i := AnIndex to AnIndex + 100 do begin if i >= uOrderList.Count then break; AnOrder := TOrder(uOrderList.Items[i]); if not AnOrder.Retrieved then tmplst.Add(AnOrder); end; RetrieveOrderFields(tmplst, FCurrentView.TextView, FCurrentView.CtxtTime); tmplst.Free; end; function TfrmOrders.GetPlainText(AnOrder: TOrder; index: integer):string; var i: integer; FirstColumnDisplayed: Integer; x: string; begin result := ''; //if hdrOrders.Sections[0].Text = 'Event' then <-- original line. //kt 8/8/2007 if hdrOrders.Sections[0].Text = DKLangConstW('fOrders_Event') then //kt added 8/8/2007 FirstColumnDisplayed := 0 else FirstColumnDisplayed := 1; for i:= FirstColumnDisplayed to 8 do begin x := GetOrderText(AnOrder, index, i); if x <> '' then result := result + hdrOrders.Sections[i].Text + ': ' + x + CRLF; end; end; function TfrmOrders.MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer; var ARect: TRect; x: string; begin x := GetOrderText(AnOrder, Index, Column); ARect.Left := 0; ARect.Top := 0; ARect.Bottom := 0; ARect.Right := hdrOrders.Sections[Column].Width -6; Result := WrappedTextHeightByFont(lstOrders.Canvas,lstOrders.Font,x,ARect); end; procedure TfrmOrders.lstOrdersMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); var AnOrder: TOrder; NewHeight: Integer; begin NewHeight := AHeight; with lstOrders do if Index < Items.Count then begin AnOrder := TOrder(uOrderList.Items[Index]); if AnOrder <> nil then with AnOrder do begin if not AnOrder.Retrieved then RetrieveVisibleOrders(Index); Canvas.Font.Style := []; if Changes.Exist(CH_ORD, ID) then Canvas.Font.Style := [fsBold]; end; {measure height of event delayed name} // if hdrOrders.Sections[0].Text = 'Event' then <-- original line. //kt 8/8/2007 if hdrOrders.Sections[0].Text = DKLangConstW('fOrders_Event') then //kt added 8/8/2007 NewHeight := HigherOf(AHeight, MeasureColumnHeight(AnOrder, Index, 0)); {measure height of order text} NewHeight := HigherOf(NewHeight, MeasureColumnHeight(AnOrder, Index, 2)); {measure height of start/stop times} NewHeight := HigherOf(NewHeight, MeasureColumnHeight(AnOrder, Index, 3)); if NewHeight > 255 then NewHeight := 255; if NewHeight < 13 then NewHeight := 13; end; AHeight := NewHeight; end; function TfrmOrders.GetStartStopText(StartTime: string; StopTime: string): string; var y: string; begin result := FormatFMDateTimeStr('mm/dd/yy hh:nn', StartTime); if IsFMDateTime(StartTime) and (Length(StartTime) = FM_DATE_ONLY) then result := Piece(result, ' ', 1); //if Length(result) > 0 then result := 'Start: ' + result; <-- original line. //kt 8/8/2007 if Length(result) > 0 then result := DKLangConstW('fOrders_Startx') + result; //kt added 8/8/2007 y := FormatFMDateTimeStr('mm/dd/yy hh:nn', StopTime); if IsFMDateTime(StopTime) and (Length(StopTime) = FM_DATE_ONLY) then y := Piece(y, ' ', 1); //if Length(y) > 0 then result := result + CRLF + 'Stop: ' + y; <-- original line. //kt 8/8/2007 if Length(y) > 0 then result := result + CRLF + DKLangConstW('fOrders_Stopx') + y; //kt added 8/8/2007 end; function TfrmOrders.GetOrderText(AnOrder: TOrder; Index: integer; Column: integer): string; begin if AnOrder <> nil then with AnOrder do begin case Column of 0: begin result := EventName; if (Index > 0) and (result = TOrder(lstOrders.Items.Objects[Index - 1]).EventName) then result := ''; end; 1: begin result := DGroupName; if (Index > 0) and (result = TOrder(lstOrders.Items.Objects[Index - 1]).DGroupName) then result := ''; end; 2: begin result := Text; if Flagged then // result := result + ' *Flagged*'; <-- original line. //kt 8/8/2007 result := result + DKLangConstW('fOrders_xFlaggedx'); //kt added 8/8/2007 end; 3: result := GetStartStopText( StartTime, StopTime); 4: begin result := MixedCase(ProviderName); result := Piece(result, ',', 1) + ',' + Copy(Piece(result, ',', 2), 1, 1); end; 5: result := VerNurse; 6: result := VerClerk; 7: result := ChartRev; 8: result := NameOfStatus(Status); 9: result := MixedCase(Anorder.OrderLocName); //begin AGP change 26.52 display all location for orders. //result := MixedCase(Anorder.OrderLocName); //if (Index > 0) and (result = TOrder(lstOrders.Items.Objects[Index - 1]).OrderLocName) then result := ''; //end; end; end; end; procedure TfrmOrders.lstOrdersDrawItem(Control: TWinControl; Index: Integer; TheRect: TRect; State: TOwnerDrawState); var i, RightSide: Integer; FirstColumnDisplayed: Integer; x: string; ARect: TRect; AnOrder: TOrder; SaveColor: TColor; begin inherited; with lstOrders do begin ARect := TheRect; if odSelected in State then begin Canvas.Brush.Color := clHighlight; Canvas.Font.Color := clHighlightText end; Canvas.FillRect(ARect); Canvas.Pen.Color := clSilver; Canvas.MoveTo(ARect.Left, ARect.Bottom - 1); Canvas.LineTo(ARect.Right, ARect.Bottom - 1); RightSide := -2; for i := 0 to 9 do begin RightSide := RightSide + hdrOrders.Sections[i].Width; Canvas.MoveTo(RightSide, ARect.Bottom - 1); Canvas.LineTo(RightSide, ARect.Top); end; if Index < Items.Count then begin AnOrder := TOrder(Items.Objects[Index]); // if hdrOrders.Sections[0].Text = 'Event' then <-- original line. //kt 8/8/2007 if hdrOrders.Sections[0].Text = DKLangConstW('fOrders_Event') then //kt added 8/8/2007 FirstColumnDisplayed := 0 else FirstColumnDisplayed := 1; if AnOrder <> nil then with AnOrder do for i := FirstColumnDisplayed to 9 do begin if i > FirstColumnDisplayed then ARect.Left := ARect.Right + 2 else ARect.Left := 2; ARect.Right := ARect.Left + hdrOrders.Sections[i].Width - 6; x := GetOrderText(AnOrder, Index, i); SaveColor := Canvas.Brush.Color; if i = FirstColumnDisplayed then begin if Flagged and (ColorToRGB(clWindowText) = ColorToRGB(clBlack)) then begin Canvas.Brush.Color := clRed; Canvas.FillRect(ARect); end; end; if i = 2 then begin Canvas.Font.Style := []; if Changes.Exist(CH_ORD, AnOrder.ID) then Canvas.Font.Style := [fsBold]; if not (odSelected in State) and (AnOrder.Signature = OSS_UNSIGNED) then begin if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then Canvas.Font.Color := clBlue; end; end; if (i = 2) or (i = 3) or (i = 0) then DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) else DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX ); Canvas.Brush.Color := SaveColor; ARect.Right := ARect.Right + 4; end; end; end; end; procedure TfrmOrders.hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); begin inherited; FEvtColWidth := hdrOrders.Sections[0].Width; RedrawSuspend(Self.Handle); RedrawOrderList; RedrawActivate(Self.Handle); lstOrders.Invalidate; pnlRight.Refresh; pnlLeft.Refresh; end; procedure TfrmOrders.lstOrdersDblClick(Sender: TObject); begin inherited; mnuViewDetailClick(Self); end; { Writing Orders } procedure TfrmOrders.lstWriteClick(Sender: TObject); { ItemID = DlgIEN;FormID;DGroup;DlgType } var Activated: Boolean; NextIndex: Integer; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. if PatientStatusChanged then exit; if BILLING_AWARE then //CQ5114 fODConsult.displayDXCode := ''; //CQ5114 inherited; //frmFrame.UpdatePtInfoOnRefresh; if not ActiveOrdering then SetConfirmEventDelay; NextIndex := lstWrite.ItemIndex; if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; if not ReadyForNewOrder(FCurrentView.EventDelay) then begin lstWrite.ItemIndex := RefNumFor(Self); Exit; end; // don't write delayed orders for non-VA meds: if (FCurrentView.EventDelay.EventIFN>0) and (Piece(lstWrite.ItemID,';',2) = '145') then begin // InfoBox('Delayed orders cannot be written for Non-VA Medications.', 'Meds, Non-VA', MB_OK); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOrders_Delayed_orders_cannot_be_written_for_NonxVA_Medicationsx'), DKLangConstW('fOrders_Medsx_NonxVA'), MB_OK); //kt added 8/8/2007 Exit; end; if (FCurrentView <> nil) and (FCurrentView.EventDelay.EventIFN>0) then FRightAfterWriteOrderBox := True; lstWrite.ItemIndex := NextIndex; // (ReadyForNewOrder may reset ItemIndex to -1) if FCurrentView <> nil then with FCurrentView.EventDelay do if (EventType = 'D') and (Effective = 0) then if not ObtainEffectiveDate(Effective) then begin lstWrite.ItemIndex := -1; Exit; end; if frmFrame.CCOWDrivedChange then Exit; PositionTopOrder(StrToIntDef(Piece(lstWrite.ItemID, ';', 3), 0)); // position Display Group case CharAt(Piece(lstWrite.ItemID, ';', 4), 1) of 'A': Activated := ActivateAction( Piece(lstWrite.ItemID, ';', 1), Self, lstWrite.ItemIndex); 'D', 'Q': Activated := ActivateOrderDialog(Piece(lstWrite.ItemID, ';', 1), FCurrentView.EventDelay, Self, lstWrite.ItemIndex); 'H': Activated := ActivateOrderHTML( Piece(lstWrite.ItemID, ';', 1), FCurrentView.EventDelay, Self, lstWrite.ItemIndex); 'M': Activated := ActivateOrderMenu( Piece(lstWrite.ItemID, ';', 1), FCurrentView.EventDelay, Self, lstWrite.ItemIndex); 'O': Activated := ActivateOrderSet( Piece(lstWrite.ItemID, ';', 1), FCurrentView.EventDelay, Self, lstWrite.ItemIndex); else Activated := not (InfoBox(TX_BAD_TYPE, TC_BAD_TYPE, MB_OK) = IDOK); end; {case} if not Activated then begin lstWrite.ItemIndex := -1; FRightAfterWriteOrderBox := False; end; if (lstSheets.ItemIndex > -1) and (Pos('EVT',Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1))>0) then begin InitOrderSheetsForEvtDelay; lstSheets.ItemIndex := 0; lstSheetsClick(Self); end; if (FCurrentView <> nil) and (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; end; procedure TfrmOrders.SaveSignOrders; var SaveOrderID: string; i: Integer; begin // unlock if able?? if not PatientViewed then Exit; if not frmFrame.ContextChanging then with lstOrders do begin if (TopIndex < Items.Count) and (TopIndex > -1) then SaveOrderID := TOrder(Items.Objects[TopIndex]).ID else SaveOrderID := ''; if lstSheets.ItemIndex > 0 then RefreshOrderList(FROM_SERVER,Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1)) else RefreshOrderList(FROM_SERVER); if Length(SaveOrderID) > 0 then for i := 0 to Items.Count - 1 do if TOrder(Items.Objects[i]).ID = SaveOrderID then TopIndex := i; end; end; { Action menu events ----------------------------------------------------------------------- } procedure TfrmOrders.ValidateSelected(const AnAction, WarningMsg, WarningTitle: string); { loop to validate action on each selected order, deselect if not valid } var i: Integer; AnOrder: TOrder; ErrMsg, AParentID: string; GoodList,BadList, CheckedList: TStringList; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. GoodList := TStringList.Create; BadList := TStringList.Create; CheckedList := TStringList.Create; try with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin AnOrder := TOrder(Items.Objects[i]); // if (AnAction = 'RN') and (AnOrder.Status=6) and (AnOrder.DGroupName = 'Inpt. Meds') and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then <-- original line. //kt 8/8/2007 if (AnAction = 'RN') and (AnOrder.Status=6) and (AnOrder.DGroupName = DKLangConstW('fOrders_Inptx_Meds')) and (Patient.inpatient) and (IsClinicLoc(Encounter.Location)) then //kt added 8/8/2007 begin Selected[i] := False; // MessageDlg('You cannot renew inpatient medication order on a clinic location for selected inpatient.', mtWarning, [mbOK], 0); <-- original line. //kt 8/8/2007 MessageDlg(DKLangConstW('fOrders_You_cannot_renew_inpatient_medication_order_on_a_clinic_location_for_selected_inpatientx'), mtWarning, [mbOK], 0); //kt added 8/8/2007 end; if ((AnAction = 'RN') or (AnAction = 'EV')) and (AnOrder.EnteredInError = 0) then //AGP Changes PSI-04053 begin if not IsValidSchedule(AnOrder.ID) then begin if (AnAction = 'RN') then // ShowMessage('The order contains invalid schedule and can not be renewed.') <-- original line. //kt 8/8/2007 ShowMessage(DKLangConstW('fOrders_The_order_contains_invalid_schedule_and_can_not_be_renewedx')) //kt added 8/8/2007 else if (AnAction = 'EV') then // ShowMessage('The order contains invalid schedule and can not be changed to event delayed order.'); <-- original line. //kt 8/8/2007 ShowMessage(DKLangConstW('fOrders_The_order_contains_invalid_schedule_and_can_not_be_changed_to_event_delayed_orderx')); //kt added 8/8/2007 Selected[i] := False; Continue; end; end; //AGP CHANGE ORDER ENTERED IN ERROR TO ALLOW SIGNATURE AND VERIFY ACTIONS 26.23 if ((AnOrder.EnteredInError = 1) and ((AnOrder.Status = 1) or (AnOrder.Status = 13))) and ((AnAction <> 'ES') and (AnAction <> 'VR')) then begin // InfoBox(AnOrder.Text + WarningMsg + 'This order has been mark as Entered in error.', WarningTitle, MB_OK); <-- original line. //kt 8/8/2007 InfoBox(AnOrder.Text + WarningMsg + DKLangConstW('fOrders_This_order_has_been_mark_as_Entered_in_errorx'), WarningTitle, MB_OK); //kt added 8/8/2007 Selected[i] := False; Continue; end; if ((AnAction <> OA_RELEASE) and (AnOrder.EnteredInError = 0)) or (((AnOrder.EnteredInError = 1) and ((AnOrder.Status = 1) or (AnOrder.Status = 13))) and (AnAction = 'ES')) then ValidateOrderAction(AnOrder.ID, AnAction, ErrMsg) //AGP END Changes else ErrMsg := ''; if (Length(ErrMsg)>0) and (Pos('COMPLEX-PSI',ErrMsg)<1) then begin InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK); Selected[i] := False; Continue; end; if (Length(ErrMsg)>0) and IsFirstDoseNowOrder(AnOrder.ID) and (AnAction <> 'RL') then begin InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK); Selected[i] := False; Continue; end; if (Length(ErrMsg)>0) and ( (AnAction = OA_CHGEVT) or (AnAction = OA_EDREL) ) then begin InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK); Selected[i] := False; Continue; end; AParentID := ''; IsValidActionOnComplexOrder(AnOrder.ID, AnAction,TListBox(lstOrders),CheckedList,ErrMsg, AParentID); TOrder(Items.Objects[i]).ParentID := AParentID; if (Length(ErrMsg)=0) and (AnAction=OA_EDREL) then begin if (AnOrder.Signature = 2) and (not VerbTelPolicyOrder(AnOrder.ID)) then begin // ErrMsg := 'Need to be signed first.'; <-- original line. //kt 8/8/2007 ErrMsg := DKLangConstW('fOrders_Need_to_be_signed_firstx'); //kt added 8/8/2007 Selected[i] := False; end; end; if (AnAction = OA_CHGEVT) or (AnAction = OA_EDREL) then begin if Length(ErrMsg)>0 then begin Selected[i] := False; Badlist.Add(AnOrder.Text + '^' + ErrMsg); end else GoodList.Add(AnOrder.Text); end; if (Length(ErrMsg) > 0) and (AnAction <> OA_CHGEVT) and (AnAction <> OA_EDREL) then begin if Pos('COMPLEX-PSI',ErrMsg)>0 then ErrMsg := TX_COMPLEX; InfoBox(AnOrder.Text + WarningMsg + ErrMsg, WarningTitle, MB_OK); Selected[i] := False; end; if Selected[i] and (not OrderIsLocked(AnOrder.ID, AnAction)) then Selected[i] := False; end; //with if ((AnAction = OA_CHGEVT) or (AnAction = OA_EDREL)) then begin if (BadList.Count = 1) and (GoodList.Count < 1 ) then InfoBox(Piece(BadList[0],'^',1) + WarningMsg + Piece(BadList[0],'^',2), WarningTitle, MB_OK); if ((BadList.Count >= 1) and (GoodList.Count >= 1)) or ( BadList.Count > 1 )then DisplayOrdersForAction(BadList,GoodList,AnAction); end; finally GoodList.Free; BadList.Free; CheckedList.Free; end; end; procedure TfrmOrders.MakeSelectedList(AList: TList); { make a list of selected orders } var i: Integer; begin with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then AList.Add(Items.Objects[i]); end; function TfrmOrders.NoneSelected(const ErrMsg: string): Boolean; var i: Integer; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. // use if selcount Result := True; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin Result := False; Break; end; if Result then InfoBox(ErrMsg, TC_NOSEL, MB_OK); end; procedure TfrmOrders.RemoveSelectedFromChanges(AList: TList); { remove from Changes orders that were signed or released } var i: Integer; begin with AList do for i := 0 to Count - 1 do with TOrder(Items[i]) do Changes.Remove(CH_ORD, ID); end; procedure TfrmOrders.SynchListToOrders; { make sure lstOrders now reflects the current state of orders } var i: Integer; begin with lstOrders do for i := 0 to Items.Count - 1 do begin Items[i] := GetPlainText(TOrder(Items.Objects[i]),i); if Selected[i] then Selected[i] := False; end; lstOrders.Invalidate; end; procedure TfrmOrders.mnuActDCClick(Sender: TObject); { discontinue/cancel/delete the selected orders (as appropriate for each order } var DelEvt: boolean; SelectedList: TList; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; if not (FCurrentView.EventDelay.EventIFN>0) then if not EncounterPresent then Exit; // make sure have provider & location if not LockedForOrdering then Exit; if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; SelectedList := TList.Create; try //if CheckOrderStatus = True then Exit; ValidateSelected(OA_DC, TX_NO_DC, TC_NO_DC); // validate DC action on each order //ActivateDeactiveRenew; AGP 26.53 TURN OFF UNTIL FINAL DECISION CAN BE MADE MakeSelectedList(SelectedList); // build list of orders that remain // updating the Changes object happens in ExecuteDCOrders, based on individual order if ExecuteDCOrders(SelectedList,DelEvt) then SynchListToOrders; UpdateUnsignedOrderAlerts(Patient.DFN); with Notifications do if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then UnsignedOrderAlertFollowup(Piece(RecordID, U, 2)); UpdateExpiringMedAlerts(Patient.DFN); UpdateUnverifiedMedAlerts(Patient.DFN); UpdateUnverifiedOrderAlerts(Patient.DFN); finally SelectedList.Free; UnlockIfAble; end; end; procedure TfrmOrders.mnuActRelClick(Sender: TObject); var SelectedList: TList; ALocation: Integer; AName: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL_SIGN) then Exit; if not AuthorizedUser then Exit; if not CanManualRelease then begin // ShowMessage('You are not authorized to manual release delayed orders.'); <-- original line. //kt 8/8/2007 ShowMessage(DKLangConstW('fOrders_You_are_not_authorized_to_manual_release_delayed_ordersx')); //kt added 8/8/2007 Exit; end; if Encounter.Location = 0 then // location required for ORCSEND begin LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT); if ALocation > 0 then Encounter.Location := ALocation; frmFrame.DisplayEncounterText; end; if Encounter.Location = 0 then begin InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING); Exit; end; if not LockedForOrdering then Exit; SelectedList := TList.Create; try ValidateSelected(OA_EDREL, TX_NO_REL, TC_NO_REL); // validate realease action on each order MakeSelectedList(SelectedList); if SelectedList.Count=0 then Exit; //ExecuteReleaseOrderChecks(SelectedList); if not ExecuteReleaseEventOrders(SelectedList) then Exit; UpdateExpiringMedAlerts(Patient.DFN); UpdateUnverifiedMedAlerts(Patient.DFN); UpdateUnverifiedOrderAlerts(Patient.DFN); FCompress := True; SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0); finally SelectedList.Free; UnlockIfAble; end; end; procedure TfrmOrders.mnuActChgEvntClick(Sender: TObject); var SelectedList :TList; DoesDestEvtOccur: boolean; DestPtEvtID: integer; DestPtEvtName: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if not EncounterPresentEDO then Exit; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; if not LockedForOrdering then Exit; //if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then // Exit; DoesDestEvtOccur := False; DestPtEvtID := 0; DestPtEvtName := ''; SelectedList := TList.Create; try if CheckOrderStatus = True then Exit; ValidateSelected(OA_CHGEVT, TX_NO_CV, TC_NO_CV); // validate Change Event action on each order MakeSelectedList(SelectedList); // build list of orders that remain if ExecuteChangeEvt(SelectedList,DoesDestEvtOccur,DestPtEvtId,DestPtEvtName) then SynchListToOrders else Exit; UpdateUnsignedOrderAlerts(Patient.DFN); with Notifications do if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then UnsignedOrderAlertFollowup(Piece(RecordID, U, 2)); UpdateExpiringMedAlerts(Patient.DFN); UpdateUnverifiedMedAlerts(Patient.DFN); UpdateUnverifiedOrderAlerts(Patient.DFN); finally SelectedList.Free; UnlockIfAble; if DoesDestEvtOccur then PtEvtCompleted(DestPtEvtID,DestPtEvtName); end; end; procedure TfrmOrders.mnuActHoldClick(Sender: TObject); { place the selected orders on hold, creates new orders } var SelectedList: TList; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; if not EncounterPresent then Exit; // make sure have provider & location if not LockedForOrdering then Exit; if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; SelectedList := TList.Create; try if CheckOrderStatus = True then Exit; ValidateSelected(OA_HOLD, TX_NO_HOLD, TC_NO_HOLD); // validate hold action on each order MakeSelectedList(SelectedList); // build list of orders that remain if ExecuteHoldOrders(SelectedList) then // confirm & perform hold begin AddSelectedToChanges(SelectedList); // send held orders to changes SynchListToOrders; // ensure ID's in lstOrders are correct end; finally SelectedList.Free; UnlockIfAble; end; end; procedure TfrmOrders.mnuActUnholdClick(Sender: TObject); { release orders from hold, no signature required - no new orders created } var SelectedList: TList; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; if not EncounterPresent then Exit; if not LockedForOrdering then Exit; SelectedList := TList.Create; try if CheckOrderStatus = True then Exit; ValidateSelected(OA_UNHOLD, TX_NO_UNHOLD, TC_NO_UNHOLD); // validate release hold action MakeSelectedList(SelectedList); // build list of selected orders if ExecuteUnholdOrders(SelectedList) then begin AddSelectedToChanges(SelectedList); SynchListToOrders; end; finally SelectedList.Free; UnlockIfAble; end; end; procedure TfrmOrders.mnuActRenewClick(Sender: TObject); { renew the selected orders (as appropriate for each order } var SelectedList: TList; ParntOrder: TOrder; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; if not EncounterPresent then Exit; // make sure have provider & location if not LockedForOrdering then Exit; SelectedList := TList.Create; try if CheckOrderStatus = True then Exit; ValidateSelected(OA_RENEW, TX_NO_RENEW, TC_NO_RENEW); // validate renew action for each MakeSelectedList(SelectedList); // build list of orders that remain if Length(FParentComplexOrderID)>0 then begin ParntOrder := GetOrderByIFN(FParentComplexOrderID); if CharAt(ParntOrder.Text,1)='+' then ParntOrder.Text := Copy(ParntOrder.Text,2,Length(ParntOrder.Text)); // if Pos('First Dose NOW',ParntOrder.Text)>1 then <-- original line. //kt 8/8/2007 if Pos(DKLangConstW('fOrders_First_Dose_NOW'),ParntOrder.Text)>1 then //kt added 8/8/2007 // Delete(ParntOrder.text, Pos('First Dose NOW',ParntOrder.Text), Length('First Dose NOW')); <-- original line. //kt 8/8/2007 Delete(ParntOrder.text, Pos(DKLangConstW('fOrders_First_Dose_NOW'),ParntOrder.Text), Length(DKLangConstW('fOrders_First_Dose_NOW'))); //kt added 8/8/2007 SelectedList.Add(ParntOrder); FParentComplexOrderID := ''; end; if ExecuteRenewOrders(SelectedList) then begin AddSelectedToChanges(SelectedList); // should this happen in ExecuteRenewOrders? SynchListToOrders; end; UpdateExpiringMedAlerts(Patient.DFN); finally SelectedList.Free; UnlockIfAble; end; end; procedure TfrmOrders.mnuActAlertClick(Sender: TObject); { set selected orders to send alerts when results are available, - no new orders created } var SelectedList: TList; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; SelectedList := TList.Create; try ValidateSelected(OA_ALERT, TX_NO_ALERT, TC_NO_ALERT); // validate release hold action MakeSelectedList(SelectedList); // build list of selected orders ExecuteAlertOrders(SelectedList); finally SelectedList.Free; end; end; procedure TfrmOrders.mnuActFlagClick(Sender: TObject); var i: Integer; AnOrder: TOrder; ErrMsg: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin AnOrder := TOrder(Items.Objects[i]); ValidateOrderAction(AnOrder.ID, OA_FLAG, ErrMsg); if Length(ErrMsg) > 0 then InfoBox(AnOrder.Text + TX_NO_FLAG + ErrMsg, TC_NO_FLAG, MB_OK) else ExecuteFlagOrder(AnOrder); Selected[i] := False; end; lstOrders.Invalidate; end; procedure TfrmOrders.mnuActUnflagClick(Sender: TObject); var i: Integer; AnOrder: TOrder; ErrMsg: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin AnOrder := TOrder(Items.Objects[i]); ValidateOrderAction(AnOrder.ID, OA_UNFLAG, ErrMsg); if Length(ErrMsg) > 0 then InfoBox(AnOrder.Text + TX_NO_UNFLAG + ErrMsg, TC_NO_UNFLAG, MB_OK) else ExecuteUnflagOrder(AnOrder); Selected[i] := False; end; lstOrders.Invalidate; if Notifications.Active then AutoUnflagAlertedOrders(Patient.DFN, Piece(Notifications.RecordID, U, 2)); end; procedure TfrmOrders.mnuActCompleteClick(Sender: TObject); { complete generic orders, no signature required - no new orders created } var SelectedList: TList; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; SelectedList := TList.Create; try ValidateSelected(OA_COMPLETE, TX_NO_CPLT, TC_NO_CPLT); // validate completing of order MakeSelectedList(SelectedList); // build list of selected orders if ExecuteCompleteOrders(SelectedList) then SynchListToOrders; finally SelectedList.Free; end; end; procedure TfrmOrders.mnuActVerifyClick(Sender: TObject); { verify orders, signature required but no new orders created } var SelectedList: TList; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedToVerify then Exit; SelectedList := TList.Create; try ValidateSelected(OA_VERIFY, TX_NO_VERIFY, TC_NO_VERIFY); // make sure order can be verified MakeSelectedList(SelectedList); // build list of selected orders if ExecuteVerifyOrders(SelectedList, False) then SynchListToOrders; finally SelectedList.Free; end; end; procedure TfrmOrders.mnuActChartRevClick(Sender: TObject); var SelectedList: TList; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedToVerify then Exit; SelectedList := TList.Create; try ValidateSelected(OA_CHART, TX_NO_VERIFY, TC_NO_VERIFY); // make sure order can be verified MakeSelectedList(SelectedList); // build list of selected orders if ExecuteVerifyOrders(SelectedList, True) then SynchListToOrders; finally SelectedList.Free; end; end; procedure TfrmOrders.mnuActCommentClick(Sender: TObject); { loop thru selected orders, allowing ward comments to be edited for each } var i: Integer; AnOrder: TOrder; ErrMsg: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin AnOrder := TOrder(Items.Objects[i]); ValidateOrderAction(AnOrder.ID, OA_COMMENT, ErrMsg); if Length(ErrMsg) > 0 then InfoBox(AnOrder.Text + TX_NO_CMNT + ErrMsg, TC_NO_CMNT, MB_OK) else ExecuteWardComments(AnOrder); Selected[i] := False; end; end; procedure TfrmOrders.mnuActChangeClick(Sender: TObject); { loop thru selected orders, present ordering dialog for each with defaults to selected order } var i: Integer; ChangeIFNList: TStringList; ASourceOrderID : string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if not EncounterPresentEDO then exit; ChangeIFNList := TStringList.Create; try if NoneSelected(TX_NOSEL) then Exit; if CheckOrderStatus = True then Exit; ValidateSelected(OA_CHANGE, TX_NO_CHANGE, TC_NO_CHANGE); if (FCurrentView.EventDelay.PtEventIFN>0) and PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName) then Exit; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin ChangeIFNList.Add(TOrder(Items.Objects[i]).ID); ASourceOrderID := TOrder(lstOrders.Items.Objects[i]).ID; end; if ChangeIFNList.Count > 0 then ChangeOrders(ChangeIFNList, FCurrentView.EventDelay); // do we need to deselect the orders? finally ChangeIFNList.Free; end; RedrawOrderList; end; procedure TfrmOrders.mnuActCopyClick(Sender: TObject); { loop thru selected orders, present ordering dialog for each with defaults to selected order } var ThePtEvtID: string; i: Integer; IsNewEvent, needVerify, NewOrderCreated: boolean; CopyIFNList: TStringList; DestPtEvtID: integer; DestPtEvtName: string; DoesDestEvtOccur: boolean; TempEvent: TOrderDelayEvent; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if not EncounterPresentEDO then Exit; DestPtEvtID := 0; DestPtEvtName := ''; DoesDestEvtOccur := False; needVerify := True; CopyIFNList := TStringList.Create; try if NoneSelected(TX_NOSEL) then Exit; NewOrderCreated := False; if CheckOrderStatus = True then Exit; ValidateSelected(OA_COPY, TX_NO_COPY, TC_NO_COPY); if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then CopyIFNList.Add(TOrder(Items.Objects[i]).ID); IsNewEvent := False; //if not ShowMsgOn(CopyIFNList.Count = 0, TX_NOSEL, TC_NOSEL) then if CopyIFNList.Count > 0 then if SetViewForCopy(IsNewEvent,DoesDestEvtOccur,DestPtEvtId,DestPtEvtName) then begin if DoesDestEvtOccur then begin TempEvent.TheParent := TParentEvent.Create; TempEvent.EventIFN := 0; TempEvent.PtEventIFN := 0; TempEvent.EventType := #0; CopyOrders(CopyIFNList, TempEvent, DoesDestEvtOccur, needVerify); if ImmdCopyAct then ImmdCopyAct := False; PtEvtCompleted(DestPtEvtID,DestPtEvtName); Exit; end; FCurrentView.EventDelay.EventName := DestPtEvtName; if (FCurrentView.EventDelay.EventIFN > 0) and (FCurrentView.EventDelay.EventType <> 'D') then begin needVerify := False; uAutoAC := True; end; TempEvent.EventName := DestPtEvtName; //FCurrentView.EventDelay.EventName; TempEvent.PtEventIFN := DestPtEvtId; //FCurrentView.EventDelay.PtEventIFN; if (FCurrentView.EventDelay.EventType = 'D') or ((not Patient.InPatient) and (FCurrentView.EventDelay.EventType = 'T')) then begin if TransferOrders(CopyIFNList, FCurrentView.EventDelay, DoesDestEvtOccur, needVerify) then NewOrderCreated := True; end else if (not Patient.Inpatient) and (FCurrentView.EventDelay.EventType = 'A') then begin if TransferOrders(CopyIFNList, FCurrentView.EventDelay, DoesDestEvtOccur, needVerify) then NewOrderCreated := True; end else begin if CopyOrders(CopyIFNList, FCurrentView.EventDelay, DoesDestEvtOccur, needVerify) then NewOrderCreated := True; end; if (not NewOrderCreated) and Assigned(FCurrentView) and (FCurrentView.EventDelay.EventIFN>0) then if isExistedEvent(Patient.DFN,IntToStr(FCurrentView.EventDelay.EventIFN),ThePtEvtID) then begin if PtEvtEmpty(ThePtEvtID) then begin DeletePtEvent(ThePtEvtID); ChangesUpdate(ThePtEvtID); InitOrderSheetsForEvtDelay; lstSheets.ItemIndex := 0; lstSheetsClick(self); end; end; if ImmdCopyAct then ImmdCopyAct := False; if DoesDestEvtOccur then PtEvtCompleted(DestPtEvtId, DestPtEvtName); end; finally uAutoAC := False; CopyIFNList.Free; end; end; procedure TfrmOrders.mnuActReleaseClick(Sender: TObject); { release orders to services without a signature, do appropriate prints } var SelectedList: TList; ALocation: Integer; AName: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; if Encounter.Location = 0 then // location required for ORCSEND begin LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT); if ALocation > 0 then Encounter.Location := ALocation; frmFrame.DisplayEncounterText; end; if Encounter.Location = 0 then begin InfoBox(TX_REL_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING); Exit; end; if not LockedForOrdering then Exit; SelectedList := TList.Create; try ValidateSelected(OA_RELEASE, TX_NO_REL, TC_NO_REL); // validate release action on each order MakeSelectedList(SelectedList); // build list of orders that remain ExecuteReleaseOrderChecks(SelectedList); // call order checking if not uInit.TimedOut then if ExecuteReleaseOrders(SelectedList) then // confirm, then perform release RemoveSelectedFromChanges(SelectedList); // remove released orders from Changes //SaveSignOrders; UpdateUnsignedOrderAlerts(Patient.DFN); with Notifications do if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then UnsignedOrderAlertFollowup(Piece(RecordID, U, 2)); UpdateExpiringMedAlerts(Patient.DFN); UpdateUnverifiedMedAlerts(Patient.DFN); UpdateUnverifiedOrderAlerts(Patient.DFN); if not uInit.TimedOut then SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0); finally SelectedList.Free; UnlockIfAble; end; end; procedure TfrmOrders.mnuActOnChartClick(Sender: TObject); { mark orders orders as signed on chart, release to services, do appropriate prints } var SelectedList: TList; ALocation: Integer; AName: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL) then Exit; if not AuthorizedUser then Exit; if Encounter.Location = 0 then // location required for ORCSEND begin LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT); if ALocation > 0 then Encounter.Location := ALocation; frmFrame.DisplayEncounterText; end; if Encounter.Location = 0 then begin InfoBox(TX_CHART_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING); Exit; end; if not LockedForOrdering then Exit; SelectedList := TList.Create; try ValidateSelected(OA_ONCHART, TX_NO_CHART, TC_NO_CHART); // validate sign on chart for each MakeSelectedList(SelectedList); // build list of orders that remain ExecuteReleaseOrderChecks(SelectedList); // call order checking if not uInit.TimedOut then if ExecuteOnChartOrders(SelectedList) then // confirm, then perform release RemoveSelectedFromChanges(SelectedList); // remove released orders from Changes UpdateUnsignedOrderAlerts(Patient.DFN); with Notifications do if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then UnsignedOrderAlertFollowup(Piece(RecordID, U, 2)); UpdateExpiringMedAlerts(Patient.DFN); UpdateUnverifiedMedAlerts(Patient.DFN); UpdateUnverifiedOrderAlerts(Patient.DFN); if not uInit.TimedOut then SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0); finally SelectedList.Free; UnlockIfAble; end; end; procedure TfrmOrders.mnuActSignClick(Sender: TObject); { obtain signature for orders, release them to services, do appropriate prints } var SelectedList: TList; ALocation: Integer; AName: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; if NoneSelected(TX_NOSEL_SIGN) then Exit; if not AuthorizedUser then Exit; if (User.OrderRole <> 2) and (User.OrderRole <> 3) then begin // ShowMessage('Sorry, You don''t have the permission to release selected orders manually'); <-- original line. //kt 8/8/2007 ShowMessage(DKLangConstW('fOrders_Sorryx_You_donxxt_have_the_permission_to_release_selected_orders_manually')); //kt added 8/8/2007 Exit; end; if not (FCurrentView.EventDelay.EventIFN>0) then begin if Encounter.Location = 0 then // location required for ORCSEND begin LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT); if ALocation > 0 then Encounter.Location := ALocation; frmFrame.DisplayEncounterText; end; if Encounter.Location = 0 then begin InfoBox(TX_SIGN_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING); Exit; end; end; if not LockedForOrdering then Exit; if (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; SelectedList := TList.Create; try ValidateSelected(OA_SIGN, TX_NO_SIGN, TC_NO_SIGN); // validate sign action on each order MakeSelectedList(SelectedList); {billing Aware} if BILLING_AWARE then begin UBACore.rpcBuildSCIEList(SelectedList); // build list of orders and Billable Status UBACore.CompleteUnsignedBillingInfo(rpcGetUnsignedOrdersBillingData(OrderListSCEI) ); end; {billing Aware} ExecuteReleaseOrderChecks(SelectedList); // call order checking if not uInit.TimedOut then if ExecuteSignOrders(SelectedList) // confirm, sign & release then RemoveSelectedFromChanges(SelectedList); // remove signed orders from Changes UpdateUnsignedOrderAlerts(Patient.DFN); with Notifications do if Active and (FollowUp = NF_ORDER_REQUIRES_ELEC_SIGNATURE) then UnsignedOrderAlertFollowup(Piece(RecordID, U, 2)); if Active then begin UpdateExpiringMedAlerts(Patient.DFN); UpdateUnverifiedMedAlerts(Patient.DFN); UpdateUnverifiedOrderAlerts(Patient.DFN); end; if not uInit.TimedOut then begin SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0); if lstSheets.ItemIndex < 0 then lstSheets.ItemIndex := 0; end; finally SelectedList.Free; UnlockIfAble; end; end; procedure TfrmOrders.mnuOptSaveQuickClick(Sender: TObject); begin inherited; QuickOrderSave; end; procedure TfrmOrders.mnuOptEditCommonClick(Sender: TObject); begin inherited; QuickOrderListEdit; end; procedure TfrmOrders.ProcessNotifications; var OrderIEN, ErrMsg: string; BigOrderID: string; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. //if not User.NoOrdering then LoadWriteOrders(lstWrite.Items) else lstWrite.Clear; {**KCM**} OrderIEN := IntToStr(ExtractInteger(Notifications.AlertData)); case Notifications.FollowUp of NF_FLAGGED_ORDERS : begin // ViewAlertedOrders('', STS_FLAGGED, '', False, True, 'All Services, Flagged'); <-- original line. //kt 8/8/2007 ViewAlertedOrders('', STS_FLAGGED, '', False, True, DKLangConstW('fOrders_All_Servicesx_Flagged')); //kt added 8/8/2007 AutoUnflagAlertedOrders(Patient.DFN, Piece(Notifications.RecordID, U, 2)); end; NF_ORDER_REQUIRES_ELEC_SIGNATURE : begin // ViewAlertedOrders('', STS_UNSIGNED, '', False, True, 'All Services, Unsigned'); <-- original line. //kt 8/8/2007 ViewAlertedOrders('', STS_UNSIGNED, '', False, True, DKLangConstW('fOrders_All_Servicesx_Unsigned')); //kt added 8/8/2007 UnsignedOrderAlertFollowup(Piece(Notifications.RecordID, U, 2)); end; NF_IMAGING_REQUEST_CANCEL_HELD : if Pos('HELD', UpperCase(Notifications.Text)) > 0 then begin // ViewAlertedOrders(OrderIEN, STS_HELD, 'IMAGING', False, True, 'Imaging, On Hold'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_HELD, 'IMAGING', False, True, DKLangConstW('fOrders_Imagingx_On_Hold')); //kt added 8/8/2007 Notifications.Delete; end else begin // ViewAlertedOrders(OrderIEN, STS_DISCONTINUED, 'IMAGING', False, True, 'Imaging, Cancelled'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_DISCONTINUED, 'IMAGING', False, True, DKLangConstW('fOrders_Imagingx_Cancelled')); //kt added 8/8/2007 Notifications.Delete; end; NF_SITE_FLAGGED_RESULTS : begin // ViewAlertedOrders(OrderIEN, STS_COMPLETE, '', False, True, 'All Services, Site-Flagged'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_COMPLETE, '', False, True, DKLangConstW('fOrders_All_Servicesx_SitexFlagged')); //kt added 8/8/2007 with lstOrders do if Selected[ItemIndex] then begin BigOrderID := TOrder(Items.Objects[ItemIndex]).ID; if Length(Piece(BigOrderID,';',1)) > 0 then begin // ReportBox(ResultOrder(BigOrderID), 'Order Results - ' + BigOrderID, True); <-- original line. //kt 8/8/2007 ReportBox(ResultOrder(BigOrderID), DKLangConstW('fOrders_Order_Results_x') + BigOrderID, True); //kt added 8/8/2007 Notifications.Delete; end; end; end; NF_ORDERER_FLAGGED_RESULTS : begin // ViewAlertedOrders(OrderIEN, STS_COMPLETE, '', False, True, 'All Services, Orderer-Flagged'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_COMPLETE, '', False, True, DKLangConstW('fOrders_All_Servicesx_OrdererxFlagged')); //kt added 8/8/2007 with lstOrders do if Selected[ItemIndex] then begin BigOrderID := TOrder(Items.Objects[ItemIndex]).ID; if Length(Piece(BigOrderID,';',1)) > 0 then begin // ReportBox(ResultOrder(BigOrderID), 'Order Results - ' + BigOrderID, True); <-- original line. //kt 8/8/2007 ReportBox(ResultOrder(BigOrderID), DKLangConstW('fOrders_Order_Results_x') + BigOrderID, True); //kt added 8/8/2007 Notifications.Delete; end; end; end; NF_ORDER_REQUIRES_COSIGNATURE : // ViewAlertedOrders('', STS_UNSIGNED, '', False, True, 'All Services, Unsigned'); <-- original line. //kt 8/8/2007 ViewAlertedOrders('', STS_UNSIGNED, '', False, True, DKLangConstW('fOrders_All_Servicesx_Unsigned')); //kt added 8/8/2007 NF_LAB_ORDER_CANCELED : begin // ViewAlertedOrders(OrderIEN, STS_DISCONTINUED, 'LABORATORY', False, True, 'Lab, Cancelled'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_DISCONTINUED, 'LABORATORY', False, True, DKLangConstW('fOrders_Labx_Cancelled')); //kt added 8/8/2007 Notifications.Delete; end; NF_DNR_EXPIRING : // ViewAlertedOrders('', STS_EXPIRING, '', False, True, 'All Services, Expiring'); <-- original line. //kt 8/8/2007 ViewAlertedOrders('', STS_EXPIRING, '', False, True, DKLangConstW('fOrders_All_Servicesx_Expiring')); //kt added 8/8/2007 NF_MEDICATIONS_EXPIRING_INPT : begin // ViewAlertedOrders('', STS_EXPIRING, 'PHARMACY', False, True, 'Medications, Expiring'); <-- original line. //kt 8/8/2007 ViewAlertedOrders('', STS_EXPIRING, 'PHARMACY', False, True, DKLangConstW('fOrders_Medicationsx_Expiring')); //kt added 8/8/2007 end; NF_MEDICATIONS_EXPIRING_OUTPT : begin // ViewAlertedOrders('', STS_EXPIRING, 'PHARMACY', False, True, 'Medications, Expiring'); <-- original line. //kt 8/8/2007 ViewAlertedOrders('', STS_EXPIRING, 'PHARMACY', False, True, DKLangConstW('fOrders_Medicationsx_Expiring')); //kt added 8/8/2007 end; NF_UNVERIFIED_MEDICATION_ORDER : begin // ViewAlertedOrders(OrderIEN, STS_UNVERIFIED, 'PHARMACY', False, True, 'Medications, Unverified'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_UNVERIFIED, 'PHARMACY', False, True, DKLangConstW('fOrders_Medicationsx_Unverified')); //kt added 8/8/2007 if StrToIntDef(OrderIEN, 0) > 0 then {**REV**} begin // Delete alert if user can't verify ValidateOrderAction(OrderIEN, OA_VERIFY, ErrMsg); if Pos('COMPLEX-PSI',ErrMsg)>0 then ErrMsg := TX_COMPLEX; if Length(ErrMsg) > 0 then Notifications.Delete; end; UpdateUnverifiedMedAlerts(Patient.DFN); end; NF_NEW_ORDER : begin // ViewAlertedOrders(OrderIEN, STS_RECENT, '', False, True, 'All Services, Recent Activity'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_RECENT, '', False, True, DKLangConstW('fOrders_All_Servicesx_Recent_Activity')); //kt added 8/8/2007 Notifications.Delete; end; NF_UNVERIFIED_ORDER : begin // ViewAlertedOrders(OrderIEN, STS_UNVERIFIED, '', False, True, 'All Services, Unverified'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_UNVERIFIED, '', False, True, DKLangConstW('fOrders_All_Servicesx_Unverified')); //kt added 8/8/2007 if StrToIntDef(OrderIEN, 0) > 0 then {**REV**} begin // Delete alert if user can't verify ValidateOrderAction(OrderIEN, OA_SIGN, ErrMsg); if Pos('COMPLEX-PSI',ErrMsg)>0 then ErrMsg := TX_COMPLEX; if Length(ErrMsg) > 0 then Notifications.Delete; end; UpdateUnverifiedOrderAlerts(Patient.DFN); end; NF_FLAGGED_OI_RESULTS : begin // ViewAlertedOrders(OrderIEN, STS_COMPLETE, '', False, True, 'All Services, Orderable Item Flagged'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_COMPLETE, '', False, True, DKLangConstW('fOrders_All_Servicesx_Orderable_Item_Flagged')); //kt added 8/8/2007 with lstOrders do if Selected[ItemIndex] then begin BigOrderID := TOrder(Items.Objects[ItemIndex]).ID; if Length(Piece(BigOrderID,';',1)) > 0 then begin // ReportBox(ResultOrder(BigOrderID), 'Order Results - ' + BigOrderID, True); <-- original line. //kt 8/8/2007 ReportBox(ResultOrder(BigOrderID), DKLangConstW('fOrders_Order_Results_x') + BigOrderID, True); //kt added 8/8/2007 Notifications.Delete; end; end; end; NF_DC_ORDER : begin // ViewAlertedOrders(OrderIEN, STS_RECENT, '', False, True, 'All Services, Recent Activity'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_RECENT, '', False, True, DKLangConstW('fOrders_All_Servicesx_Recent_Activity')); //kt added 8/8/2007 Notifications.Delete; end; NF_FLAGGED_OI_EXP_INPT : begin // ViewAlertedOrders('', STS_EXPIRING, '', False, True, 'All Services, Expiring'); <-- original line. //kt 8/8/2007 ViewAlertedOrders('', STS_EXPIRING, '', False, True, DKLangConstW('fOrders_All_Servicesx_Expiring')); //kt added 8/8/2007 UpdateExpiringFlaggedOIAlerts(Patient.DFN, NF_FLAGGED_OI_EXP_INPT); end; NF_FLAGGED_OI_EXP_OUTPT : begin // ViewAlertedOrders('', STS_EXPIRING, '', False, True, 'All Services, Expiring'); <-- original line. //kt 8/8/2007 ViewAlertedOrders('', STS_EXPIRING, '', False, True, DKLangConstW('fOrders_All_Servicesx_Expiring')); //kt added 8/8/2007 UpdateExpiringFlaggedOIAlerts(Patient.DFN, NF_FLAGGED_OI_EXP_OUTPT); end; NF_CONSULT_REQUEST_CANCEL_HOLD : begin OrderIEN := GetConsultOrderNumber(Notifications.AlertData); // ViewAlertedOrders(OrderIEN, STS_DISCONTINUED, 'CONSULTS', False, True, 'Consults, Cancelled'); <-- original line. //kt 8/8/2007 ViewAlertedOrders(OrderIEN, STS_DISCONTINUED, 'CONSULTS', False, True, DKLangConstW('fOrders_Consultsx_Cancelled')); //kt added 8/8/2007 with lstOrders do Selected[ItemIndex] := True; end; else mnuViewUnsignedClick(Self); end; end; procedure TfrmOrders.ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string; BySvc, InvDate: boolean; Title: string); {**KCM**} var i, ADGroup: integer; DGroups: TStrings; begin DGroups := TStringList.Create; try ADGroup := DGroupAll; if Length(DispGrp) > 0 then begin ListDGroupAll(DGroups); for i := 0 to DGroups.Count-1 do if Piece(DGroups.Strings[i], U, 2) = DispGrp then ADGroup := StrToIntDef(Piece(DGroups.Strings[i], U, 1),0); end; finally DGroups.Free; end; SetOrderView(Status, ADGroup, Title, True); with lstOrders do begin if Length(OrderIEN) > 0 then begin for i := 0 to Items.Count-1 do if Piece(TOrder(Items.Objects[i]).ID, ';', 1) = OrderIEN then begin ItemIndex := i; Selected[i] := True; break; end; end else for i := 0 to Items.Count-1 do if Piece(TOrder(Items.Objects[i]).ID, ';', 1) <> '0' then Selected[i] := True; if SelCount = 0 then Notifications.Delete; end; end; procedure TfrmOrders.pnlRightResize(Sender: TObject); begin inherited; imgHide.Left := pnlRight.Width - 19; end; procedure TfrmOrders.RequestPrint; { obtain print devices for selected orders, do appropriate prints } //const //TX_NEW_LOC1 = 'The patient''s location has changed to '; <-- original line. //kt 8/8/2007 //TX_NEW_LOC2 = '.' + CRLF + 'Should the orders be printed using the new location?'; <-- original line. //kt 8/8/2007 //TC_NEW_LOC = 'New Patient Location'; <-- original line. //kt 8/8/2007 var SelectedList: TStringList; ALocation, i: Integer; AName, ASvc, DeviceInfo: string; Nature: char; PrintIt: Boolean; TX_NEW_LOC1 : string; //kt TX_NEW_LOC2 : string; //kt TC_NEW_LOC : string; //kt begin SetupVars; //kt added 8/8/2007 to replace constants with vars. TX_NEW_LOC1 := DKLangConstW('fOrders_The_patientxxs_location_has_changed_to'); //kt added 8/8/2007 TX_NEW_LOC2 := '.' + CRLF + DKLangConstW('fOrders_Should_the_orders_be_printed_using_the_new_locationx'); //kt added 8/8/2007 TC_NEW_LOC := DKLangConstW('fOrders_New_Patient_Location'); //kt added 8/8/2007 inherited; if NoneSelected(TX_NOSEL) then Exit; //if not AuthorizedUser then Exit; removed in v17.1 (RV) SUX-0901-41044 SelectedList := TStringList.Create; Nature := #0; try with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then SelectedList.Add(Piece(TOrder(Items.Objects[i]).ID, U, 1)); CurrentLocationForPatient(Patient.DFN, ALocation, AName, ASvc); if (ALocation > 0) and (ALocation <> Encounter.Location) then begin //gary Encounter.Location := frmClinicWardMeds.ClinicOrWardLocation(Alocation); // if InfoBox(TX_NEW_LOC1 + AName + TX_NEW_LOC2, TC_NEW_LOC, MB_YESNO) = IDYES // then Encounter.Location := ALocation; end; if Encounter.Location = 0 then Encounter.Location := CommonLocationForOrders(SelectedList); if Encounter.Location = 0 then // location required for DEVINFO begin LookupLocation(ALocation, AName, LOC_ALL, TX_LOC_PRINT); if ALocation > 0 then Encounter.Location := ALocation; end; frmFrame.DisplayEncounterText; if Encounter.Location <> 0 then begin SetupOrdersPrint(SelectedList, DeviceInfo, Nature, False, PrintIt); if PrintIt then ExecutePrintOrders(SelectedList, DeviceInfo); SynchListToOrders; end else InfoBox(TX_PRINT_LOC, TC_REQ_LOC, MB_OK or MB_ICONWARNING); finally SelectedList.Free; end; end; procedure TfrmOrders.btnDelayedOrderClick(Sender: TObject); //const //TX_DELAYCAP = ' Delay release of new order(s) until'; <-- original line. //kt 8/8/2007 var AnEvent: TOrderDelayEvent; ADlgLst: TStringList; IsRealeaseNow: boolean; TX_DELAYCAP : string; //kt begin inherited; TX_DELAYCAP := DKLangConstW('fOrders_Delay_release_of_new_orderxsx_until'); //kt added 8/8/2007 if not EncounterPresentEDO then Exit; AnEvent.EventType := #0; AnEvent.TheParent := TParentEvent.Create; AnEvent.EventIFN := 0; AnEvent.PtEventIFN := 0; AnEvent.EventName := ''; if not CloseOrdering then Exit; FCalledFromWDO := True; //frmFrame.UpdatePtInfoOnRefresh; IsRealeaseNow := False; FCompress := True; //treat as lstSheet click ADlgLst := TStringList.Create; //SetEvtIFN(AnEvent.EventIFN); if ShowDelayedEventsTreatingSepecialty(TX_DELAYCAP,AnEvent,ADlgLst,IsRealeaseNow) then begin FEventForCopyActiveOrders := AnEvent; FAskForCancel := False; ResetOrderPage(AnEvent,ADlgLst, IsRealeaseNow); end; FCompress := False; FCalledFromWDO := False; if (FCurrentView <> nil) and (FCurrentView.EventDelay.PtEventIFN>0) and (PtEvtCompleted(FCurrentView.EventDelay.PtEventIFN, FCurrentView.EventDelay.EventName)) then Exit; end; procedure TfrmOrders.CompressEventSection; begin hdrOrders.Sections[0].MaxWidth := 0; hdrOrders.Sections[0].MinWidth := 0; hdrOrders.Sections[0].Width := 0; hdrOrders.Sections[0].Text := ''; end; procedure TfrmOrders.ExpandEventSection; begin hdrOrders.Sections[0].MaxWidth := 10000; hdrOrders.Sections[0].MinWidth := 50; if FEvtColWidth > 0 then hdrOrders.Sections[0].Width := EvtColWidth else hdrOrders.Sections[0].Width := 65; //hdrOrders.Sections[0].Text := 'Event'; <-- original line. //kt 8/8/2007 hdrOrders.Sections[0].Text := DKLangConstW('fOrders_Event'); //kt added 8/8/2007 end; {procedure TfrmOrders.SetEvtIFN(var AnEvtIFN: integer); var APtEvntID,AnEvtInfo: string; begin if lstSheets.ItemIndex < 0 then APtEvntID := Piece(lstSheets.Items[0],'^',1) else APtEvntID := Piece(lstSheets.Items[lstSheets.ItemIndex],'^',1); if CharAt(APtEvntID,1) <> 'C' then begin if Pos('EVT',APtEvntID)>0 then AnEvtIFN := StrToIntDef(Piece(APtEvntID,';',1),0) else begin AnEvtInfo := EventInfo(APtEvntID); AnEvtIFN := StrToIntDef(Piece(AnEvtInfo,'^',2),0); end; end else AnEvtIFN := 0; end;} procedure TfrmOrders.InitOrderSheetsForEvtDelay; begin InitOrderSheets; DfltViewForEvtDelay; end; procedure TfrmOrders.DfltViewForEvtDelay; begin inherited; if not CanChangeOrderView then Exit; lstSheets.ItemIndex := 0; FCurrentView := TOrderView(lstSheets.Items.Objects[0]); LoadOrderViewDefault(FCurrentView); lstSheets.Items[0] := 'C;0^' + FCurrentView.ViewName; end; procedure TfrmOrders.EventRealeasedOrder1Click(Sender: TObject); var AnOrderView: TOrderView; begin inherited; if not CanChangeOrderView then Exit; AnOrderView := TOrderView.Create; AnOrderView.Filter := STS_ACTIVE; AnOrderView.DGroup := DGroupAll; //AnOrderView.ViewName := 'All Services, Active'; <-- original line. //kt 8/8/2007 AnOrderView.ViewName := DKLangConstW('fOrders_All_Servicesx_Active'); //kt added 8/8/2007 AnOrderView.InvChrono := True; AnOrderView.ByService := True; AnOrderView.CtxtTime := 0; AnOrderView.TextView := 0; AnOrderView.EventDelay.EventType := 'C'; AnOrderView.EventDelay.Specialty := 0; AnOrderView.EventDelay.Effective := 0; AnOrderView.EventDelay.EventIFN := 0; //AnOrderView.EventDelay.EventName := 'All Services, Active'; <-- original line. //kt 8/8/2007 AnOrderView.EventDelay.EventName := DKLangConstW('fOrders_All_Servicesx_Active'); //kt added 8/8/2007 SelectEvtReleasedOrders(AnOrderView); with AnOrderView do if Changed then begin mnuActRel.Visible := False; popOrderRel.Visible := False; FCompress := True; lstSheets.ItemIndex := -1; // lblWrite.Caption := 'Write Orders'; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write_Orders'); //kt added 8/8/2007 lstWrite.Clear; LoadWriteOrders(lstWrite.Items); if AnOrderView.EventDelay.PtEventIFN > 0 then RefreshOrderList(FROM_SERVER,IntToStr(AnOrderView.EventDelay.PtEventIFN)); lblOrders.Caption := AnOrderView.ViewName; if ByService then begin if InvChrono then FDfltSort := OVS_CATINV else FDfltSort := OVS_CATFWD; end else begin if InvChrono then FDfltSort := OVS_INVERSE else FDfltSort := OVS_FORWARD; end; end; if FFromDCRelease then FFromDCRelease := False; end; procedure TfrmOrders.ResetOrderPage(AnEvent: TOrderDelayEvent; ADlgLst: TStringList; IsRealeaseNow: boolean); var i,AnIndex,EFilter: integer; APtEvtID: string; // ptr to #100.2 theEvtID: string; // ptr to #100.5 tmptPtEvtID: string; AnOrderView: TOrderView; AnDlgStr: string; begin EFilter := 0; theEvtID := ''; AnDlgStr := ''; IsDefaultDlg := False; AnOrderView := TOrderView.Create; if FCurrentView = nil then begin FCurrentView := TOrderView.Create; with FCurrentView do begin InvChrono := True; ByService := True; end; end; if IsRealeaseNow then lstSheets.ItemIndex := 0; if AnEvent.EventIFN > 0 then with lstSheets do begin AnIndex := -1; for i := 0 to Items.Count - 1 do begin theEvtID := GetEvtIFN(i); if theEvtID = IntToStr(AnEvent.EventIFN) then begin AnIndex := i; theEvtID := ''; Break; end; theEvtID := ''; end; if AnIndex > -1 then begin NewEvent := False; ItemIndex := AnIndex; lstSheetsClick(Self); end else begin NewEvent := True; if TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 2 then begin SaveEvtForOrder(Patient.DFN, AnEvent.EventIFN, ''); AnEvent.IsNewEvent := False; if (ADlgLst.Count > 0) and (Piece(ADlgLst[0],'^',2) <> 'SET') then ADlgLst.Delete(0); end; if (TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0) and (AnEvent.TheParent.ParentIFN > 0) then begin if ((ADlgLst.Count > 0) and (Piece(ADlgLst[0],'^',2) = 'SET')) or (ADlgLst.Count = 0 )then begin SaveEvtForOrder(Patient.DFN, AnEvent.TheParent.ParentIFN, ''); SaveEvtForOrder(Patient.DFN, AnEvent.EventIFN, ''); AnEvent.IsNewEvent := False; end; end; if (TypeOfExistedEvent(Patient.DFN,AnEvent.EventIFN) = 0) and (AnEvent.TheParent.ParentIFN = 0) then begin if ((ADlgLst.Count > 0) and (Piece(ADlgLst[0],'^',2) = 'SET')) or (ADlgLst.Count = 0 )then begin SaveEvtForOrder(Patient.DFN, AnEvent.EventIFN, ''); AnEvent.IsNewEvent := False; end; end; if isExistedEvent(Patient.DFN,IntToStr(AnEvent.EventIFN), APtEvtID) then begin case AnEvent.EventType of 'A': EFilter := 15; 'D': EFilter := 16; 'T': EFilter := 17; end; AnOrderView.DGroup := DGroupAll; AnOrderView.Filter := EFilter; AnOrderView.EventDelay := AnEvent; AnOrderView.CtxtTime := -1; AnOrderView.TextView := 0; // AnOrderView.ViewName := 'Delayed ' + AnEvent.EventName + ' Orders'; <-- original line. //kt 8/8/2007 AnOrderView.ViewName := DKLangConstW('fOrders_Delayed') + AnEvent.EventName + DKLangConstW('fOrders_Orders'); //kt added 8/8/2007 AnOrderView.InvChrono := FCurrentView.InvChrono; AnOrderView.ByService := FCurrentView.ByService; if ItemIndex >= 0 then Items.InsertObject(ItemIndex+1, APtEvtID + U + AnOrderView.ViewName, AnOrderView) else Items.InsertObject(lstSheets.Items.Count, APtEvtID + U + AnOrderView.ViewName, AnOrderView); ItemIndex := lstSheets.Items.IndexOfObject(AnOrderView); FCurrentView := AnOrderView; // lblWrite.Caption := 'Write ' + FCurrentView.ViewName; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write') + FCurrentView.ViewName; //kt added 8/8/2007 lstWrite.Caption := lblWrite.Caption; ClickLstSheet; NewEvent := True; if ADlgLst.Count > 0 then DisplayDefaultDlgList(lstWrite,ADlgLst) else begin if DispOrdersForEvent(IntToStr(FEventForCopyActiveOrders.EventIFN)) then begin if IsExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN),tmptPtEvtID) then begin FEventForCopyActiveOrders.PtEventIFN := StrToIntDef(tmptPtEvtID,0); FEventForCopyActiveOrders.IsNewEvent := False end; CopyActiveOrdersToEvent(FOrderViewForActiveOrders, FEventForCopyActiveOrders); end; FEventForCopyActiveOrders.EventIFN := 0; end; end else begin case AnEvent.EventType of 'A': EFilter := 15; 'D': EFilter := 16; 'T': EFilter := 17; end; if ItemIndex < 0 then ItemIndex := 0; IsDefaultDlg := True; AnOrderView.DGroup := DGroupAll; AnOrderView.Filter := EFilter; AnOrderView.EventDelay := AnEvent; AnOrderView.CtxtTime := -1; AnOrderView.TextView := 0; // AnOrderView.ViewName := 'Delayed ' + AnEvent.EventName + ' Orders'; <-- original line. //kt 8/8/2007 AnOrderView.ViewName := DKLangConstW('fOrders_Delayed') + AnEvent.EventName + DKLangConstW('fOrders_Orders'); //kt added 8/8/2007 if FCurrentView <> nil then begin AnOrderView.InvChrono := FCurrentView.InvChrono; AnOrderView.ByService := FCurrentView.ByService; end; Items.InsertObject(ItemIndex+1, IntToStr(AnEvent.EventIFN)+ ';EVT' + U + AnOrderView.ViewName, AnOrderView); lstSheets.ItemIndex := lstSheets.Items.IndexOfObject(AnOrderView); FCurrentView := AnOrderView; // lblWrite.Caption := 'Write ' + FCurrentView.ViewName; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write') + FCurrentView.ViewName; //kt added 8/8/2007 lstWrite.Caption := lblWrite.Caption; ClickLstSheet; NewEvent := True; if (NewEvent) and (ADlgLst.Count>0) then DisplayDefaultDlgList(lstWrite,ADlgLst); end; end; end else begin // lblWrite.Caption := 'Write Orders'; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write_Orders'); //kt added 8/8/2007 lstWrite.Caption := lblWrite.Caption; RefreshOrderList(FROM_SERVER); end; end; function TfrmOrders.GetEvtIFN(AnIndex: integer): string; begin if AnIndex >= lstSheets.Items.Count then begin Result := ''; exit; end; with lstSheets do begin if Piece(Piece(Items[AnIndex],';',2),'^',1)='EVT' then Result := Piece(Items[AnIndex],';',1) else Result := GetEventIFN(Piece(Items[AnIndex], U, 1)); end; end; function TfrmOrders.PlaceOrderForDefaultDialog(ADlgInfo: string; IsDefaultDialog: boolean; AEvent: TOrderDelayEvent): boolean; { ADlgInfo = DlgIEN;FormID;DGroup;DlgType } var Activated: Boolean; NextIndex,ix: Integer; APtEvtIdA: string; TheEvent: TOrderDelayEvent; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. inherited; Result := False; if FCurrentView = nil then begin FCurrentView := TOrderView.Create; with FCurrentView do begin InvChrono := True; ByService := True; end; end; if AEvent.EventType = #0 then TheEvent := FCurrentView.EventDelay else TheEvent := AEvent; if not ActiveOrdering then SetConfirmEventDelay; NextIndex := lstWrite.ItemIndex; if not ReadyForNewOrder1(TheEvent) then begin lstWrite.ItemIndex := RefNumFor(Self); Exit; end; if AEvent.EventType <> #0 then lstWrite.ItemIndex := -1 else lstWrite.ItemIndex := NextIndex; // (ReadyForNewOrder may reset ItemIndex to -1) with TheEvent do if (EventType = 'D') and (Effective = 0) then if not ObtainEffectiveDate(Effective) then begin lstWrite.ItemIndex := -1; Exit; end; PositionTopOrder(StrToIntDef(Piece(ADlgInfo, ';', 3), 0)); case CharAt(Piece(ADlgInfo, ';', 4), 1) of 'A': Activated := ActivateAction( Piece(ADlgInfo, ';', 1), Self, lstWrite.ItemIndex); 'D', 'Q': Activated := ActivateOrderDialog(Piece(ADlgInfo, ';', 1), TheEvent, Self, lstWrite.ItemIndex); 'H': Activated := ActivateOrderHTML( Piece(ADlgInfo, ';', 1), TheEvent, Self, lstWrite.ItemIndex); 'M': Activated := ActivateOrderMenu( Piece(ADlgInfo, ';', 1), TheEvent, Self, lstWrite.ItemIndex); 'O': Activated := ActivateOrderSet( Piece(ADlgInfo, ';', 1), TheEvent, Self, lstWrite.ItemIndex); else Activated := not (InfoBox(TX_BAD_TYPE, TC_BAD_TYPE, MB_OK) = IDOK); end; if (not Activated) and (IsDefaultDialog) then begin lstWrite.ItemIndex := -1; ix := lstSheets.ItemIndex; if lstSheets.ItemIndex < 0 then Exit; APtEvtIdA := Piece(lstSheets.Items[ix],'^',1); if CharAt(APtEvtIdA,1) <> 'C' then begin if Pos('EVT',APtEvtIdA)>0 then begin lstSheets.Items.Objects[ix].Free; lstSheets.Items.Delete(ix); lstSheets.ItemIndex := 0; lstSheetsClick(Self); // lblWrite.Caption := 'Write Orders'; <-- original line. //kt 8/8/2007 lblWrite.Caption := DKLangConstW('fOrders_Write_Orders'); //kt added 8/8/2007 lstWrite.Caption := lblWrite.Caption; lblOrders.Caption := Piece(lstSheets.Items[0],U,2); lstOrders.Caption := Piece(lstSheets.Items[0],U,2); lstWrite.Clear; LoadWriteOrders(lstWrite.Items); end; end; end; Result := Activated; end; function TfrmOrders.DisplayDefaultDlgList(ADest: TORListBox; ADlgList: TStringList): boolean; var i,j: integer; AnDlgStr: string; AFillEvent: TOrderDelayEvent; APtEvtID,tmpPtEvtID: string; begin AFillEvent.EventType := #0; AFillEvent.EventIFN := 0; AFillEvent.PtEventIFN := 0; AFillEvent.TheParent := TParentEvent.Create; Result := False; for i := 0 to ADlgList.Count - 1 do begin if i = 0 then begin if AnsiCompareText('Set', Piece(ADlgList[i],'^',2)) = 0 then IsDefaultDlg := False; end; if i > 0 then IsDefaultDlg := False; ADest.ItemIndex := -1; for j := 0 to ADest.Items.Count - 1 do begin if Piece(ADest.Items[j],';',1)=Piece(ADlgList[i],'^',1) then begin ADest.ItemIndex := j; break; end; end; if ADest.ItemIndex < 0 then AnDlgStr := GetDlgData(Piece(ADlgList[i],'^',1)) else AnDlgStr := ADest.Items[ADest.ItemIndex]; if IsDefaultDlg then NeedShowModal := True else FNeedShowModal := False; if not IsDefaultDlg then begin if FEventForCopyActiveOrders.EventIFN > 0 then begin if IsExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN),tmpPtEvtID) then begin FEventForCopyActiveOrders.PtEventIFN := StrToIntDef(tmpPtEvtID,0); FEventForCopyActiveOrders.IsNewEvent := False end; if DispOrdersForEvent(IntToStr(FEventForCopyActiveOrders.EventIFN)) then CopyActiveOrdersToEvent(FOrderViewForActiveOrders, FEventForCopyActiveOrders); end; FEventForCopyActiveOrders.EventIFN := 0; end; if PlaceOrderForDefaultDialog(AnDlgStr,IsDefaultDlg, AFillEvent) then begin if isExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN), APtEvtID) then begin FCurrentView.EventDelay.PtEventIFN := StrToIntDef(APtEvtID,0); FCurrentView.EventDelay.IsNewEvent := False; end; if FEventForCopyActiveOrders.EventIFN > 0 then begin if IsExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN),tmpPtEvtID) then begin FEventForCopyActiveOrders.PtEventIFN := StrToIntDef(tmpPtEvtID,0); FEventForCopyActiveOrders.IsNewEvent := False end; if DispOrdersForEvent(IntToStr(FEventForCopyActiveOrders.EventIFN)) then CopyActiveOrdersToEvent(FOrderViewForActiveOrders, FEventForCopyActiveOrders); end; {if isExistedEvent(Patient.DFN,IntToStr(FEventForCopyActiveOrders.EventIFN), APtEvtID) then begin FCurrentView.EventDelay.PtEventIFN := StrToIntDef(APtEvtID,0); FCurrentView.EventDelay.IsNewEvent := False; end;} EventDefaultOrder := ''; FEventForCopyActiveOrders.EventIFN := 0; Result := IsDefaultDlg end else break; end; end; procedure TfrmOrders.ClickLstSheet; begin FAskForCancel := False; lstSheetsClick(Self); FAskForCancel := True; end; procedure TfrmOrders.lblWriteMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin inherited; lblWrite.Hint := lblWrite.Caption; end; procedure TfrmOrders.InitOrderSheets2(AnItem: string); var i: Integer; begin InitOrderSheets; LoadOrderViewDefault(TOrderView(lstSheets.Items.Objects[0])); lstSheets.Items[0] := 'C;0^' + TOrderView(lstSheets.Items.Objects[0]).ViewName; if Length(AnItem)>0 then begin with lstSheets do for i := 0 to Items.Count - 1 do begin if AnsiCompareText(TOrderView(Items.Objects[i]).ViewName, AnItem)=0 then begin ItemIndex := i; FCurrentView := TOrderView(lstSheets.Items.Objects[i]); break; end; end; end; if lstSheets.ItemIndex < -1 then lstSheets.ItemIndex := 0; lstSheetsClick(Self); end; procedure TfrmOrders.SetFontSize( FontSize: integer); begin inherited SetFontSize( FontSize ); RedrawOrderList; mnuOptimizeFieldsClick(self); lstSheets.Repaint; lstWrite.Repaint; btnDelayedOrder.Repaint; end; procedure TfrmOrders.popOrderPopup(Sender: TObject); begin inherited; if PatientStatusChanged then exit; //frmFrame.UpdatePtInfoOnRefresh; end; procedure TfrmOrders.mnuViewClick(Sender: TObject); begin inherited; if PatientStatusChanged then exit; //frmFrame.UpdatePtInfoOnRefresh; end; procedure TfrmOrders.mnuActClick(Sender: TObject); begin inherited; if PatientStatusChanged then exit; //frmFrame.UpdatePtInfoOnRefresh; end; procedure TfrmOrders.mnuOptClick(Sender: TObject); begin inherited; if PatientStatusChanged then exit; //frmFrame.UpdatePtInfoOnRefresh; end; procedure TfrmOrders.AddToListBox(AnOrderList: TList); var idx: integer; AnOrder: TOrder; i: integer; begin with AnOrderList do for idx := 0 to Count - 1 do begin AnOrder := TOrder(Items[idx]); if (AnOrder.OrderTime <= 0) then Continue; i := lstOrders.Items.AddObject(AnOrder.ID, AnOrder); lstOrders.Items[i] := GetPlainText(AnOrder,i); end; end; procedure TfrmOrders.ChangesUpdate(APtEvtID: string); var jdx: integer; APrtEvtId, tempEvtId,EvtOrderID: string; begin APrtEvtId := TheParentPtEvt(APtEvtID); if Length(APrtEvtId)>0 then tempEvtId := APrtEvtId else tempEvtId := APtEvtID; for jdx := EvtOrderList.Count - 1 downto 0 do if AnsiCompareStr(Piece(EvtOrderList[jdx],'^',1),tempEvtID) = 0 then begin EvtOrderID := Piece(EvtOrderList[jdx],'^',2); Changes.Remove(CH_ORD,EvtOrderID); EvtOrderList.Delete(jdx); end; end; function TfrmOrders.PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean): boolean; begin SetupVars; //kt added 8/8/2007 to replace constants with vars. Result := False; if IsCompletedPtEvt(APtEvtID) then begin if FromMeds then // InfoBox('The event "Delayed ' + APtEvtName + '" ' + TX_CMPTEVT_MEDSTAB, 'Warning', MB_OK or MB_ICONWARNING) <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOrders_The_event_xDelayed')+' ' + APtEvtName + '" ' + TX_CMPTEVT_MEDSTAB, DKLangConstW('fOrders_Warning'), MB_OK or MB_ICONWARNING) //kt added 8/8/2007 else // InfoBox('The event "Delayed ' + APtEvtName + '" ' + TX_CMPTEVT, 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOrders_The_event_xDelayed') + APtEvtName + '" ' + TX_CMPTEVT, DKLangConstW('fOrders_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 // GroupChangesUpdate('Delayed ' + APtEvtName); <-- original line. //kt 8/8/2007 GroupChangesUpdate(DKLangConstW('fOrders_Delayed') + APtEvtName); //kt added 8/8/2007 InitOrderSheetsForEvtDelay; lstSheets.ItemIndex := 0; lstSheetsClick(self); RefreshOrderList(True); Result := True; end; end; procedure TfrmOrders.RefreshToFirstItem; begin InitOrderSheetsForEvtDelay; lstSheets.ItemIndex := 0; RefreshOrderList(True); end; procedure TfrmOrders.GroupChangesUpdate(GrpName: string); var ji: integer; theChangeItem: TChangeItem; begin Changes.ChangeOrderGrp(GrpName,''); for ji := 0 to Changes.Orders.Count - 1 do begin theChangeItem := TChangeItem(Changes.Orders.Items[ji]); if AnsiCompareText(theChangeItem.GroupName,GrpName)=0 then Changes.ReplaceODGrpName(theChangeItem.ID,''); end; end; procedure TfrmOrders.UMEventOccur(var Message: TMessage); begin SetupVars; //kt added 8/8/2007 to replace constants with vars. //InfoBox('The event "Delayed ' + FCurrentView.EventDelay.EventName + '" ' + TX_CMPTEVT, 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOrders_The_event_xDelayed') + FCurrentView.EventDelay.EventName + '" ' + TX_CMPTEVT, DKLangConstW('fOrders_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 //GroupChangesUpdate('Delayed '+ frmOrders.TheCurrentView.EventDelay.EventName); <-- original line. //kt 8/8/2007 GroupChangesUpdate(DKLangConstW('fOrders_Delayed')+ frmOrders.TheCurrentView.EventDelay.EventName); //kt added 8/8/2007 InitOrderSheetsForEvtDelay; lstSheets.ItemIndex := 0; lstSheetsClick(self); RefreshOrderList(True); end; procedure TfrmOrders.setSectionWidths; var i: integer; begin //CQ6170 for i := 0 to 9 do origWidths[i] := hdrOrders.Sections[i].Width; //end CQ6170 end; function TfrmOrders.getTotalSectionsWidth : integer; var i: integer; begin //CQ6170 Result := 0; for i := 0 to hdrOrders.Sections.Count - 1 do Result := Result + hdrOrders.Sections[i].Width; //end CQ6170 end; procedure TfrmOrders.FormShow(Sender: TObject); begin inherited; //force horizontal scrollbar //lstOrders.ScrollWidth := lstOrders.ClientWidth+1000; //CQ6170 end; procedure TfrmOrders.hdrOrdersMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i: integer; totalSectionsWidth, originalwidth: integer; begin inherited; //CQ6170 totalSectionsWidth := getTotalSectionsWidth; if totalSectionsWidth > lstOrders.Width - 5 then begin originalwidth := 0; for i := 0 to hdrOrders.Sections.Count - 1 do originalwidth := originalwidth + origWidths[i]; if originalwidth < totalSectionsWidth then begin for i := 0 to hdrOrders.Sections.Count - 1 do hdrOrders.Sections[i].Width := origWidths[i]; lstOrders.Invalidate; end; end; //end CQ6170 end; procedure TfrmOrders.hdrOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; setSectionWidths; //CQ6170 end; function TfrmOrders.PatientStatusChanged: boolean; //const //msgTxt1 = 'Patient status was changed from '; <-- original line. //kt 8/8/2007 //msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.'; <-- original line. //kt 8/8/2007 //GE CQ9537 - Change message text //msgTxt3 = 'Patient has been admitted. '; <-- original line. //kt 8/8/2007 //msgTxt4 = CRLF + 'You will be prompted to sign your orders. Any new orders subsequently' + <-- original line. //kt 8/8/2007 // CRLF +'entered and signed will be directed to the inpatient staff.'; <-- original line. //kt 8/8/2007 var PtSelect: TPtSelect; IsInpatientNow: boolean; ptSts: string; msgTxt1 : string; //kt msgTxt2 : string; //kt msgTxt3 : string; //kt msgTxt4 : string; //kt begin msgTxt1 := DKLangConstW('fOrders_Patient_status_was_changed_from'); //kt added 8/8/2007 msgTxt2 := DKLangConstW('fOrders_CPRS_needs_to_refresh_patient_information_to_display_patient_latest_recordx'); //kt added 8/8/2007 msgTxt3 := DKLangConstW('fOrders_Patient_has_been_admittedx'); //kt added 8/8/2007 msgTxt4 := CRLF + DKLangConstW('fOrders_You_will_be_prompted_to_sign_your_ordersx__Any_new_orders_subsequently') + //kt added 8/8/2007 CRLF +DKLangConstW('fOrders_entered_and_signed_will_be_directed_to_the_inpatient_staffx'); //kt added 8/8/2007 result := False; SelectPatient(Patient.DFN, PtSelect); IsInpatientNow := Length(PtSelect.Location) > 0; if Patient.Inpatient <> IsInpatientNow then begin if (not Patient.Inpatient) then //GE CQ9537 - Change message text MessageDlg(msgTxt3 + msgTxt4, mtWarning, [mbOK], 0) else begin // if Patient.Inpatient then ptSts := 'Inpatient to Outpatient.'; <-- original line. //kt 8/8/2007 if Patient.Inpatient then ptSts := DKLangConstW('fOrders_Inpatient_to_Outpatientx'); //kt added 8/8/2007 MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0); end; frmFrame.mnuFileRefreshClick(Application); Result := True; end; end; function TfrmOrders.CheckOrderStatus: boolean; var i: integer; AnOrder: TOrder; begin Result := False; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin AnOrder := TOrder(Items.Objects[i]); if AnORder.Status <> GetOrderStatus(AnOrder.ID) then begin // MessageDlg('The Order status has changed.' + #13#10#13 + 'CPRS needs to refresh patient information to display the correct order status', mtWarning, [mbOK], 0); <-- original line. //kt 8/8/2007 MessageDlg(DKLangConstW('fOrders_The_Order_status_has_changedx') + #13#10#13 + DKLangConstW('fOrders_CPRS_needs_to_refresh_patient_information_to_display_the_correct_order_status'), mtWarning, [mbOK], 0); //kt added 8/8/2007 frmFrame.mnuFileRefreshClick(Application); Result := True; EXIT; end; end; end; (*procedure TfrmOrders.ActivateDeactiveRenew; var i: Integer; AnOrder: TOrder; tmpArr: TStringList; begin tmpArr := TStringList.Create; with lstOrders do for i := 0 to Items.Count - 1 do if Selected[i] then begin AnOrder := TOrder(Items.Objects[i]); if AnOrder.Status = 5 then tmpArr.Add(AnOrder.ID); end; if tmpArr <> nil then frmActivateDeactive.fActivateDeactive(tmpArr); end; *) procedure TfrmOrders.ViewInfo(Sender: TObject); begin inherited; frmFrame.ViewInfo(Sender); end; procedure TfrmOrders.mnuViewInformationClick(Sender: TObject); begin inherited; mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled; mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled; mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled; mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No'); mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No'); mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled; mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled; mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled; mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled; end; procedure TfrmOrders.mnuOptimizeFieldsClick(Sender: TObject); var totalSectionsWidth, unitvalue: integer; begin totalSectionsWidth := pnlRight.Width - 3; if totalSectionsWidth < 16 then exit; unitvalue := round(totalSectionsWidth / 16); with hdrOrders do begin Sections[1].Width := unitvalue; Sections[2].Width := pnlRight.Width - (unitvalue * 10) - 5; Sections[3].Width := unitvalue * 2; Sections[4].Width := unitvalue * 2; Sections[5].Width := unitvalue; Sections[6].Width := unitvalue; Sections[7].Width := unitvalue; Sections[8].Width := unitvalue; Sections[9].Width := unitvalue; end; hdrOrdersSectionResize(hdrOrders, hdrOrders.Sections[0]); hdrOrders.Repaint; end; procedure TfrmOrders.hdrOrdersSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); begin inherited; //if Section = hdrOrders.Sections[1] then mnuOptimizeFieldsClick(self); end; procedure TfrmOrders.sptHorzMoved(Sender: TObject); begin inherited; mnuOptimizeFieldsClick(self); end; end.