Module

fOrders

Path

C:\CPRS\CPRS30\Orders\fOrders.pas

Last Modified

7/15/2014 3:26:42 PM

Comments

REMOVE AFTER UNIT IS DEBUGGED

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmOrders);

end.

Units Used in Interface

Name Comments
fBase508Form -
fHSplit -
fODBase -
rOrders -
UBACore -
UBAGlobals -
uConst -
uCore -
uOrders -

Units Used in Implementation

Name Comments
fActivateDeactivate -
fBALocalDiagnoses -
fClinicWardMeds -
fEffectDate -
fEncnt -
fFrame -
fLkUpLocation -
fMeds -
fOCSession -
fODActive -
fODAuto -
fODChild -
fODConsult -
fODReleaseEvent -
fODValidateAction -
fOMNavA -
fOMVerify -
fOrderComment -
fOrderFlag -
fOrdersAlert -
fOrderSaveQuick -
fOrdersComplete -
fOrdersCopy -
fOrdersCV -
fOrdersDC -
fOrdersEvntRelease -
fOrdersHold -
fOrdersOnChart -
fOrdersPrint -
fOrdersRelease -
fOrdersRenew -
fOrdersSign -
fOrdersTS -
fOrdersUnhold -
fOrdersVerify -
fOrderUnflag -
fOrderVw -
fRptBox -
rCore -
rMeds -
rODBase -
rODMeds -
uInit -
uODBase -

Classes

Name Comments
TfrmOrders -

Procedures

Name Owner Declaration Scope Comments
ActivateDeactiveRenew TfrmOrders procedure ActivateDeactiveRenew; Private -
AddToListBox TfrmOrders procedure AddToListBox(AnOrderList: TList); Private -
btnDelayedOrderClick TfrmOrders procedure btnDelayedOrderClick(Sender: TObject); Public/Published -
ChangesUpdate TfrmOrders procedure ChangesUpdate(APtEvtID: string); Public -
ClearOrderSheets TfrmOrders procedure ClearOrderSheets; Private
LstSheets events ------------------------------------------------------------------------- 

 delete all order sheets & associated TOrderView objects, set current view to nil
ClearPtData TfrmOrders procedure ClearPtData; override; Public -
ClickLstSheet TfrmOrders procedure ClickLstSheet; Public -
CompressEventSection TfrmOrders procedure CompressEventSection; Private -
DfltViewForEvtDelay TfrmOrders procedure DfltViewForEvtDelay; Private -
DisplayPage TfrmOrders procedure DisplayPage; override; Public -
EventRealeasedOrder1Click TfrmOrders procedure EventRealeasedOrder1Click(Sender: TObject); Public/Published -
ExpandEventSection TfrmOrders procedure ExpandEventSection; Private -
FormCreate TfrmOrders procedure FormCreate(Sender: TObject); Public/Published Form events ------------------------------------------------------------------------------
FormDestroy TfrmOrders procedure FormDestroy(Sender: TObject); Public/Published -
FormShow TfrmOrders procedure FormShow(Sender: TObject); Public/Published -
GroupChangesUpdate TfrmOrders procedure GroupChangesUpdate(GrpName: string); Public -
hdrOrdersMouseDown TfrmOrders procedure hdrOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
hdrOrdersMouseUp TfrmOrders procedure hdrOrdersMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
hdrOrdersSectionClick TfrmOrders procedure hdrOrdersSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
hdrOrdersSectionResize TfrmOrders procedure hdrOrdersSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
InitOrderSheets TfrmOrders procedure InitOrderSheets; Private Sets up list of order sheets based on what orders are on the server in delayed status for pt
InitOrderSheets2 TfrmOrders procedure InitOrderSheets2(AnItem: string = ''); Public -
InitOrderSheetsForEvtDelay TfrmOrders procedure InitOrderSheetsForEvtDelay; Public
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;
lblWriteMouseMove TfrmOrders procedure lblWriteMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Public/Published -
lstOrdersDblClick TfrmOrders procedure lstOrdersDblClick(Sender: TObject); Public/Published -
lstOrdersDrawItem TfrmOrders procedure lstOrdersDrawItem(Control: TWinControl; Index: Integer; TheRect: TRect; State: TOwnerDrawState); Public/Published -
lstOrdersMeasureItem TfrmOrders procedure lstOrdersMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); Public/Published -
lstSheetsClick TfrmOrders procedure lstSheetsClick(Sender: TObject); Public/Published -
lstWriteClick TfrmOrders procedure lstWriteClick(Sender: TObject); Public/Published
Writing Orders 

 ItemID = DlgIEN;FormID;DGroup;DlgType
MakeSelectedList TfrmOrders procedure MakeSelectedList(AList: TList); Private Make a list of selected orders
mnuActAlertClick TfrmOrders procedure mnuActAlertClick(Sender: TObject); Public/Published Set selected orders to send alerts when results are available, - no new orders created
mnuActChangeClick TfrmOrders procedure mnuActChangeClick(Sender: TObject); Public/Published Loop thru selected orders, present ordering dialog for each with defaults to selected order
mnuActChartRevClick TfrmOrders procedure mnuActChartRevClick(Sender: TObject); Public/Published -
mnuActChgEvntClick TfrmOrders procedure mnuActChgEvntClick(Sender: TObject); Public/Published -
mnuActClick TfrmOrders procedure mnuActClick(Sender: TObject); Public/Published -
mnuActCommentClick TfrmOrders procedure mnuActCommentClick(Sender: TObject); Public/Published Loop thru selected orders, allowing ward comments to be edited for each
mnuActCompleteClick TfrmOrders procedure mnuActCompleteClick(Sender: TObject); Public/Published Complete generic orders, no signature required - no new orders created
mnuActCopyClick TfrmOrders procedure mnuActCopyClick(Sender: TObject); Public/Published Loop thru selected orders, present ordering dialog for each with defaults to selected order
mnuActDCClick TfrmOrders procedure mnuActDCClick(Sender: TObject); Public/Published Discontinue/cancel/delete the selected orders (as appropriate for each order
mnuActFlagClick TfrmOrders procedure mnuActFlagClick(Sender: TObject); Public/Published -
mnuActHoldClick TfrmOrders procedure mnuActHoldClick(Sender: TObject); Public/Published Place the selected orders on hold, creates new orders
mnuActOnChartClick TfrmOrders procedure mnuActOnChartClick(Sender: TObject); Public/Published Mark orders orders as signed on chart, release to services, do appropriate prints
mnuActRelClick TfrmOrders procedure mnuActRelClick(Sender: TObject); Public/Published -
mnuActReleaseClick TfrmOrders procedure mnuActReleaseClick(Sender: TObject); Public/Published Release orders to services without a signature, do appropriate prints
mnuActRenewClick TfrmOrders procedure mnuActRenewClick(Sender: TObject); Public/Published Renew the selected orders (as appropriate for each order
mnuActSignClick TfrmOrders procedure mnuActSignClick(Sender: TObject); Public/Published Obtain signature for orders, release them to services, do appropriate prints
mnuActUnflagClick TfrmOrders procedure mnuActUnflagClick(Sender: TObject); Public/Published -
mnuActUnholdClick TfrmOrders procedure mnuActUnholdClick(Sender: TObject); Public/Published Release orders from hold, no signature required - no new orders created
mnuActVerifyClick TfrmOrders procedure mnuActVerifyClick(Sender: TObject); Public/Published Verify orders, signature required but no new orders created
mnuChartTabClick TfrmOrders procedure mnuChartTabClick(Sender: TObject); Public/Published -
mnuOptClick TfrmOrders procedure mnuOptClick(Sender: TObject); Public/Published -
mnuOptEditCommonClick TfrmOrders procedure mnuOptEditCommonClick(Sender: TObject); Public/Published -
mnuOptimizeFieldsClick TfrmOrders procedure mnuOptimizeFieldsClick(Sender: TObject); Public/Published -
mnuOptSaveQuickClick TfrmOrders procedure mnuOptSaveQuickClick(Sender: TObject); Public/Published -
mnuViewActiveClick TfrmOrders procedure mnuViewActiveClick(Sender: TObject); Public/Published -
mnuViewClick TfrmOrders procedure mnuViewClick(Sender: TObject); Public/Published -
mnuViewCurrentClick TfrmOrders procedure mnuViewCurrentClick(Sender: TObject); Public/Published -
mnuViewCustomClick TfrmOrders procedure mnuViewCustomClick(Sender: TObject); Public/Published -
mnuViewDetailClick TfrmOrders procedure mnuViewDetailClick(Sender: TObject); Public/Published -
mnuViewDfltSaveClick TfrmOrders procedure mnuViewDfltSaveClick(Sender: TObject); Public/Published -
mnuViewDfltShowClick TfrmOrders procedure mnuViewDfltShowClick(Sender: TObject); Public/Published -
mnuViewExpiredClick TfrmOrders procedure mnuViewExpiredClick(Sender: TObject); Public/Published -
mnuViewExpiringClick TfrmOrders procedure mnuViewExpiringClick(Sender: TObject); Public/Published -
mnuViewInformationClick TfrmOrders procedure mnuViewInformationClick(Sender: TObject); Public/Published -
mnuViewResultClick TfrmOrders procedure mnuViewResultClick(Sender: TObject); Public/Published -
mnuViewResultsHistoryClick TfrmOrders procedure mnuViewResultsHistoryClick(Sender: TObject); Public/Published -
mnuViewUnsignedClick TfrmOrders procedure mnuViewUnsignedClick(Sender: TObject); Public/Published -
NotifyOrder TfrmOrders procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override; Public -
pnlRightResize TfrmOrders procedure pnlRightResize(Sender: TObject); Public/Published -
popOrderPopup TfrmOrders procedure popOrderPopup(Sender: TObject); Public/Published -
PositionTopOrder TfrmOrders procedure PositionTopOrder(DGroup: Integer); Private View menu events -------------------------------------------------------------------------
ProcessNotifications TfrmOrders procedure ProcessNotifications; Private -
RedrawOrderList TfrmOrders procedure RedrawOrderList; Private Redraws the Orders list, compensates for changes in item height by re-adding everything
RefreshOrderList TfrmOrders procedure RefreshOrderList(FromServer: Boolean; APtEvtID: string = ''); Private -
RefreshToFirstItem TfrmOrders procedure RefreshToFirstItem; Public -
RemoveFromOrderList - procedure RemoveFromOrderList(ChildOrderID: string); Local -
RemoveSelectedFromChanges TfrmOrders procedure RemoveSelectedFromChanges(AList: TList); Private Remove from Changes orders that were signed or released
RequestPrint TfrmOrders procedure RequestPrint; override; Public Obtain print devices for selected orders, do appropriate prints
ResetOrderPage TfrmOrders procedure ResetOrderPage(AnEvent: TOrderDelayEvent; ADlgLst: TStringList; IsRealeaseNow: boolean); Public -
RetrieveVisibleOrders TfrmOrders procedure RetrieveVisibleOrders(AnIndex: Integer); Private LstOrders events -------------------------------------------------------------------------
RightClickMessageHandler TfrmOrders procedure RightClickMessageHandler(var Msg: TMessage; var Handled: Boolean); Private -
SaveSignOrders TfrmOrders procedure SaveSignOrders; Public -
SetFontSize TfrmOrders procedure SetFontSize( FontSize: integer); override; Public -
SetOrderView TfrmOrders procedure SetOrderView(AFilter, ADGroup: Integer; const AViewName: string; NotifSort: Boolean); Private Sets up a 'canned' order view, assumes the date range is never restricted
setSectionWidths TfrmOrders procedure setSectionWidths; Public CQ6170
sptHorzMoved TfrmOrders procedure sptHorzMoved(Sender: TObject); Public/Published -
sptVertMoved TfrmOrders procedure sptVertMoved(Sender: TObject); Public/Published -
SynchListToOrders TfrmOrders procedure SynchListToOrders; Private Make sure lstOrders now reflects the current state of orders
UMDestroy TfrmOrders procedure UMDestroy(var Message: TMessage); message UM_DESTROY; Private Sent by ordering dialog when it is closing
UMEventOccur TfrmOrders procedure UMEventOccur(var Message: TMessage); message UM_EVENTOCCUR; Private Function PatientStatusChanged: boolean;
UseDefaultSort TfrmOrders procedure UseDefaultSort; Private Procedure SetEvtIFN(var AnEvtIFN: integer);
ValidateSelected TfrmOrders procedure ValidateSelected(const AnAction, WarningMsg, WarningTitle: string); Private
Action menu events ----------------------------------------------------------------------- 

 loop to validate action on each selected order, deselect if not valid
ViewAlertedOrders TfrmOrders procedure ViewAlertedOrders(OrderIEN: string; Status: integer; DispGrp: string; BySvc, InvDate: boolean; Title: string); Private -
ViewInfo TfrmOrders procedure ViewInfo(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
AllowContextChange TfrmOrders function AllowContextChange(var WhyNot: string): Boolean; override; Public TPage common methods ---------------------------------------------------------------------
CanChangeOrderView TfrmOrders function CanChangeOrderView: Boolean; Private Disallows changing view while doing delayed release orders.
CheckOrderStatus TfrmOrders function CheckOrderStatus: boolean; Private
Function TfrmOrders.PatientStatusChanged: boolean;
const

  msgTxt1 = 'Patient status was changed from ';
  msgTxt2 = 'CPRS needs to refresh patient information to display patient latest record.';
   //GE CQ9537  - Change message text
  msgTxt3 = 'Patient has been admitted. ';
  msgTxt4 = CRLF + 'You will be prompted to sign your orders.  Any new orders subsequently' +
            CRLF +'entered and signed will be directed to the inpatient staff.';
var
  PtSelect: TPtSelect;
  IsInpatientNow: boolean;
  ptSts: string;
begin
  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.';
          MessageDlg(msgTxt1 + ptSts + #13#10#13 + msgTxt2, mtWarning, [mbOK], 0);
       end;
    frmFrame.mnuFileRefreshClick(Application);
    Result := True;
  end;
end;
DisplayDefaultDlgList TfrmOrders function DisplayDefaultDlgList(ADest: TORListBox; ADlgList: TStringList): boolean; Private -
GetEvtIFN TfrmOrders function GetEvtIFN(AnIndex: integer): string; Private -
GetOrderText TfrmOrders function GetOrderText(AnOrder: TOrder; Index: integer; Column: integer): string; Private -
GetPlainText TfrmOrders function GetPlainText(AnOrder: TOrder; index: integer):string; Private -
GetStartStopText TfrmOrders function GetStartStopText(StartTime: string; StopTime: string): string; Private -
getTotalSectionsWidth TfrmOrders function getTotalSectionsWidth : integer; Public CQ6170
MeasureColumnHeight TfrmOrders function MeasureColumnHeight(AnOrder: TOrder; Index: Integer; Column: integer):integer; Private -
NoneSelected TfrmOrders function NoneSelected(const ErrMsg: string): Boolean; Private -
PlaceOrderForDefaultDialog TfrmOrders function PlaceOrderForDefaultDialog(ADlgInfo: string; IsDefaultDialog: boolean; AEvent: TOrderDelayEvent): boolean; Public ADlgInfo = DlgIEN;FormID;DGroup;DlgType
PtEvtCompleted TfrmOrders function PtEvtCompleted(APtEvtID: integer; APtEvtName: string; FromMeds: boolean = False; Signing: boolean = False): boolean; Public -

Global Variables

Name Type Declaration Comments
frmOrders TfrmOrders frmOrders: TfrmOrders; -
origWidths origWidths: arOrigSecWidths; CQ6170
uEvtDCList TList uEvtDCList, uEvtRLList: TList; -
uEvtRLList TList uEvtDCList, uEvtRLList: TList; -
uOrderList TList uOrderList: TList; -

Constants

Name Declaration Scope Comments
CT_ORDERS 4 Global Chart tab - doctor's orders
FM_DATE_ONLY 7 Global -
FROM_SELF False Global -
FROM_SERVER True Global -
OVS_CATFWD 1 Global -
OVS_CATINV 0 Global -
OVS_FORWARD 3 Global -
OVS_INVERSE 2 Global -
STS_ACTIVE 2 Global -
STS_COMPLETE 4 Global -
STS_CURRENT 23 Global -
STS_DISCONTINUED 3 Global -
STS_EXPIRED 27 Global -
STS_EXPIRING 5 Global -
STS_FLAGGED 12 Global -
STS_HELD 18 Global -
STS_NEW 19 Global -
STS_RECENT 6 Global -
STS_UNSIGNED 11 Global -
STS_UNVER_NURSE 9 Global -
STS_UNVERIFIED 8 Global -
TC_BAD_TYPE 'Unsupported Ordering Item' Global -
TC_DELAY 'Ordering Information' Global -
TC_NO_ALERT 'Unable to Set Alert' Global -
TC_NO_CHANGE 'Unable to Change Order' Global -
TC_NO_CHART 'Unable to Release Orders' Global -
TC_NO_CMNT 'Unable to Edit Comments' Global -
TC_NO_COPY 'Unable to Copy Order' Global -
TC_NO_CPLT 'Unable to Complete' Global -
TC_NO_CV 'Unable to Change Release Event' Global -
TC_NO_DC 'Unable to Discontinue' Global -
TC_NO_FLAG 'Unable to Flag Order' Global -
TC_NO_HOLD 'Unable to Hold' Global -
TC_NO_REL 'Unable to be Released to Service' Global -
TC_NO_RENEW 'Unable to Renew Order' Global -
TC_NO_SIGN 'Unable to Sign Order' Global -
TC_NO_UNFLAG 'Unable to Unflag Order' Global -
TC_NO_UNHOLD 'Unable to Release from Hold' Global -
TC_NO_VERIFY 'Unable to Verify' Global -
TC_NOCHG_VIEW 'Order View Restriction' Global -
TC_NOSEL 'No Orders Selected' Global -
TC_REQ_LOC 'Location Required' Global -
TC_VWSAVE 'Save Default Order View' Global -
TX_BAD_TYPE 'This item is a type that is not supported in the graphical interface.' Global -
TX_CHART_LOC 'A location must be selected to mark orders "signed on chart".' Global -
TX_CMPTEVT ' occurred since you started writing delayed orders. ' Global -
TX_CMPTEVT_MEDSTAB ' occurred since you started writing delayed orders. ' Global -
TX_COMPLEX 'You can not take this action on a complex medication.' + #13 + 'You must enter a new order.' Global -
TX_DEAFAIL 'Signing provider does not have a current, valid DEA# on record.' Global -
TX_DELAY1 'Now writing orders for ' Global -
TX_EXP_DEA1 'Signing provider''s DEA# expired on ' Global -
TX_EXP_DEA2 ' and no VA# is assigned.' Global -
TX_EXP_DETOX 'Signing provider''s Detoxification/Maintenance ID number expired due to an expired DEA# on ' Global -
TX_LOC_PRINT 'The selected location will be used to determine where orders are printed.' Global -
TX_NO_ALERT CRLF + CRLF + '- cannot be set to send an alert.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_CHANGE CRLF + CRLF + '- cannot be changed' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_CHART CRLF + CRLF + '- cannot be marked "Signed on Chart".' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_CMNT CRLF + CRLF + '- cannot have comments edited.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_COPY CRLF + CRLF + '- cannot be copied.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_CPLT CRLF + CRLF + '- cannot be completed.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_CV CRLF + 'The release event cannot be changed.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_DC CRLF + CRLF + '- cannot be discontinued.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_DETOX 'Signing provider does not have a valid Detoxification/Maintenance ID number on record.' Global -
TX_NO_FLAG CRLF + CRLF + '- cannot be flagged.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_HOLD CRLF + CRLF + '- cannot be placed on hold.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_REL CRLF + 'Cannot be released to the service(s).' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_RENEW CRLF + CRLF + '- cannot be changed.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_SIGN CRLF + CRLF + '- cannot be signed.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_UNFLAG CRLF + CRLF + '- cannot be unflagged.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_UNHOLD CRLF + CRLF + '- cannot be released from hold.' + CRLF + CRLF + 'Reason: ' Global -
TX_NO_VERIFY CRLF + CRLF + '- cannot be verified.' + CRLF + CRLF + 'Reason: ' Global -
TX_NOCHG_VIEW 'The view of orders may not be changed while an ordering dialog is' + CRLF + Global -
TX_NOSEL 'No orders are highlighted. Highlight the orders' + CRLF + Global -
TX_NOSEL_SIGN 'No orders are highlighted. Highlight orders you want to sign or' + CRLF + Global -
TX_PRINT_LOC 'A location must be selected to print orders.' Global -
TX_REL_LOC 'A location must be selected to release orders.' Global -
TX_SCHFAIL 'Signing provider is not authorized to prescribe medications in Federal Schedule ' Global -
TX_SIGN_LOC 'A location must be selected to sign orders.' Global -
TX_VWSAVE1 'The current order view is: ' + CRLF + CRLF Global -
TX_VWSAVE2 CRLF + CRLF + 'Do you wish to save this as your default view?' Global -


Module Source

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