Module

fFrame

Path

C:\CPRS\CPRS30\fFrame.pas

Last Modified

3/11/2015 8:41:44 AM

Comments

This is the m
ain form for the CPRS GUI.  It provides a patient-encounter-user framework
  which all the other forms of the GUI use.

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmFrame);

Finalization Code

finalization


end.

Units Used in Interface

Name Comments
fBase508Form -
fPage -
uConst -
VERGENCECONTEXTORLib_TLB -
XuDsigS -

Units Used in Implementation

Name Comments
fAbout -
fAlertForward -
fBAOptionsDiagnoses -
fCombatVet -
fConsults -
fCover -
fDCSumm -
fDefaultEvent -
fDeviceSelect -
fDrawers -
fEncnt -
fGraphData -
fGraphs -
fIconLegend -
fIVRoutes -
fLabInfo -
fLabs -
fLabTests -
fMeds -
fMHTest -
fNotes -
fOptions -
fOrders -
fOrdersRenew -
fOrdersSign -
fOtherSchedule -
fPatientFlagMulti -
fPrintLocation -
fProbs -
fPtCWAD -
fPtDemo -
fPtSel -
fPtSelMsg -
fPtSelOptns -
fReminderDialog -
fReminderTree -
fReports -
fReview -
fRptBox -
fSplash -
fSurgery -
fTemplateDialog -
fTemplateEditor -
fxBroker -
fxLists -
fxServer -
rCore -
rECS -
rMisc -
rODAllergy -
rOrders -
rReports -
rSurgery -
rTemplates -
rVitals -
UBACore -
UBAGlobals -
uCore -
uEventHooks -
uFormMonitor -
uInit -
uOrders -
uOrPtf -
uReminders -
uSignItems -
uSpell -
uVA508CPRSCompatibility -
uVitals -

Classes

Name Comments
TfrmFrame -

Procedures

Name Owner Declaration Scope Comments
AppActivated TfrmFrame procedure AppActivated(Sender: TObject); Private -
AppDeActivated TfrmFrame procedure AppDeActivated(Sender: TObject); Private Close Treatment Factor hint window if alt-tab pressed.
AppEventsActivate TfrmFrame procedure AppEventsActivate(Sender: TObject); Public/Published -
AppEventsShortCut TfrmFrame procedure AppEventsShortCut(var Msg: TWMKey; var Handled: Boolean); Public/Published -
AppException TfrmFrame procedure AppException(Sender: TObject; E: Exception); Private General Functions and Procedures
btnCombatVetClick TfrmFrame procedure btnCombatVetClick(Sender: TObject); Public/Published -
ChangeFont TfrmFrame procedure ChangeFont(NewFontSize: Integer); Private
Makes changes in all components whenever the font size is changed.  This is hardcoded and
  based on MS Sans Serif for now, as only the font size may be selected. Courier New is used
  wherever non-proportional fonts are required.
CheckForDifferentPatient TfrmFrame procedure CheckForDifferentPatient(aContextItemCollection: IDispatch; var PtChanged: boolean); Private -
CheckForDifferentUser TfrmFrame procedure CheckForDifferentUser(aContextItemCollection: IDispatch; var UserChanged: boolean); Private -
CheckHyperlinkResponse TfrmFrame procedure CheckHyperlinkResponse(aContextItemCollection: IDispatch; var HyperlinkReason: string); Private -
ClearPatient TfrmFrame procedure ClearPatient; Private Call all pages to make sure patient related information is cleared (when switching patients)
CloseCPRS - procedure CloseCPRS; Local -
compAccessTabPageCaptionQuery TfrmFrame procedure compAccessTabPageCaptionQuery(Sender: TObject; var Text: string); Public/Published -
CreateTab TfrmFrame procedure CreateTab(ATabID: integer; ALabel: string); Private Procedure CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
ctxContextorCanceled TfrmFrame procedure ctxContextorCanceled(Sender: TObject); Public/Published -
ctxContextorCommitted TfrmFrame procedure ctxContextorCommitted(Sender: TObject); Public/Published -
ctxContextorPending TfrmFrame procedure ctxContextorPending(Sender: TObject; const aContextItemCollection: IDispatch); Public/Published -
DetermineNextTab TfrmFrame procedure DetermineNextTab; Private -
DigitalSigningSetup1Click TfrmFrame procedure DigitalSigningSetup1Click(Sender: TObject); Public/Published -
DisplayEncounterText TfrmFrame procedure DisplayEncounterText; Public Updates the display in the header bar of encounter related information (location & provider)
FindNextBestDFN - procedure FindNextBestDFN; Local -
FitToolbar TfrmFrame procedure FitToolbar; Private
Resizes and repositions the panels & labels used in the toolbar 
var
WidthNeeded: integer;
FocusApplicationTopForm TfrmFrame procedure FocusApplicationTopForm; Private -
FormActivate TfrmFrame procedure FormActivate(Sender: TObject); Public/Published -
FormClose TfrmFrame procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCloseQuery TfrmFrame procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); Public/Published Cancels close if the user cancels the ReviewChanges screen
FormCreate TfrmFrame procedure FormCreate(Sender: TObject); Public/Published Connect to server, create tab pages, select a patient, & initialize core objects
FormDestroy TfrmFrame procedure FormDestroy(Sender: TObject); Public/Published Free core objects used by CPRS
FormKeyDown TfrmFrame procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
FormResize TfrmFrame procedure FormResize(Sender: TObject); Public/Published
Need to resize tab forms specifically since they don't inherit resize event (because they
  are derived from TForm itself)
HandleCCOWError TfrmFrame procedure HandleCCOWError(AMessage: string); Private =========================== CCOW main changes ========================
HideEverything TfrmFrame procedure HideEverything(AMessage: string = 'No patient is currently selected.'); Private -
LabInfo1Click TfrmFrame procedure LabInfo1Click(Sender: TObject); Public/Published -
laMHVClick TfrmFrame procedure laMHVClick(Sender: TObject); Public/Published -
laVAA2Click TfrmFrame procedure laVAA2Click(Sender: TObject); Public/Published
Var
  InsuranceSubscriberName: string;
  ReportString: TStringList; //CQ7782
LoadSizesForUser TfrmFrame procedure LoadSizesForUser; Private Resize and Font-Change procedures --------------------------------------------------------
LoadUserPreferences TfrmFrame procedure LoadUserPreferences; Private -
lstCIRNLocationsChange TfrmFrame procedure lstCIRNLocationsChange(Sender: TObject); Public/Published -
lstCIRNLocationsClick TfrmFrame procedure lstCIRNLocationsClick(Sender: TObject); Public/Published -
lstCIRNLocationsExit TfrmFrame procedure lstCIRNLocationsExit(Sender: TObject); Public/Published -
mnuAlertForwardClick TfrmFrame procedure mnuAlertForwardClick(Sender: TObject); Public/Published -
mnuAlertRenewClick TfrmFrame procedure mnuAlertRenewClick(Sender: TObject); Public/Published -
mnuChartTabClick TfrmFrame procedure mnuChartTabClick(Sender: TObject); Public/Published Use the Tag property of the menu item to switch to proper page
mnuEditClick TfrmFrame procedure mnuEditClick(Sender: TObject); Public/Published -
mnuEditCopyClick TfrmFrame procedure mnuEditCopyClick(Sender: TObject); Public/Published -
mnuEditCutClick TfrmFrame procedure mnuEditCutClick(Sender: TObject); Public/Published -
mnuEditPasteClick TfrmFrame procedure mnuEditPasteClick(Sender: TObject); Public/Published -
mnuEditRedoClick TfrmFrame procedure mnuEditRedoClick(Sender: TObject); Public/Published -
mnuEditUndoClick TfrmFrame procedure mnuEditUndoClick(Sender: TObject); Public/Published -
mnuFileBreakContextClick TfrmFrame procedure mnuFileBreakContextClick(Sender: TObject); Public/Published -
mnuFileEncounterClick TfrmFrame procedure mnuFileEncounterClick(Sender: TObject); Public/Published Displays encounter window and updates encounter display in case encounter was updated
mnuFileExitClick TfrmFrame procedure mnuFileExitClick(Sender: TObject); Public/Published See the CloseQuery event
mnuFileNextClick TfrmFrame procedure mnuFileNextClick(Sender: TObject); Public/Published -
mnuFileNotifRemoveClick TfrmFrame procedure mnuFileNotifRemoveClick(Sender: TObject); Public/Published -
mnuFileOpenClick TfrmFrame procedure mnuFileOpenClick(Sender: TObject); Public/Published
Select a new patient & update the header displays (patient id, encounter, postings) 
NextTab: Integer;     // moved up for visibility - v23.4  rV
i: smallint;
mnuFilePrintClick TfrmFrame procedure mnuFilePrintClick(Sender: TObject); Public/Published -
mnuFilePrintSelectedItemsClick TfrmFrame procedure mnuFilePrintSelectedItemsClick(Sender: TObject); Public/Published -
mnuFilePrintSetupClick TfrmFrame procedure mnuFilePrintSetupClick(Sender: TObject); Public/Published -
mnuFileRefreshClick TfrmFrame procedure mnuFileRefreshClick(Sender: TObject); Public/Published -
mnuFileResumeContextGetClick TfrmFrame procedure mnuFileResumeContextGetClick(Sender: TObject); Public/Published -
mnuFileResumeContextSetClick TfrmFrame procedure mnuFileResumeContextSetClick(Sender: TObject); Public/Published -
mnuFileReviewClick TfrmFrame procedure mnuFileReviewClick(Sender: TObject); Public/Published Displays the Review Changes window (which resets the Encounter object)
mnuFontSizeClick TfrmFrame procedure mnuFontSizeClick(Sender: TObject); Public/Published -
mnuGECStatusClick TfrmFrame procedure mnuGECStatusClick(Sender: TObject); Public/Published -
mnuHelpAboutClick TfrmFrame procedure mnuHelpAboutClick(Sender: TObject); Public/Published Displays the about screen
mnuHelpBrokerClick TfrmFrame procedure mnuHelpBrokerClick(Sender: TObject); Public/Published
Help Menu Events ------------------------------------------------------------------------- 

 used for debugging - shows last n broker calls
mnuHelpListsClick TfrmFrame procedure mnuHelpListsClick(Sender: TObject); Public/Published Used for debugging - shows internal contents of TORListBox
mnuHelpSymbolsClick TfrmFrame procedure mnuHelpSymbolsClick(Sender: TObject); Public/Published Used for debugging - shows current symbol table
mnuToolsGraphingClick TfrmFrame procedure mnuToolsGraphingClick(Sender: TObject); Public/Published -
mnuToolsOptionsClick TfrmFrame procedure mnuToolsOptionsClick(Sender: TObject); Public/Published Personal preferences - changes may need to be applied to chart
mnuViewInformationClick TfrmFrame procedure mnuViewInformationClick(Sender: TObject); Public/Published -
mnuViewPostingsClick TfrmFrame procedure mnuViewPostingsClick(Sender: TObject); Public/Published View Menu Events -------------------------------------------------------------------------
NextButtonClick TfrmFrame procedure NextButtonClick(Sender: TObject); Private -
NextButtonMouseDown TfrmFrame procedure NextButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Private -
pnlCIRNClick TfrmFrame procedure pnlCIRNClick(Sender: TObject); Public/Published -
pnlCIRNMouseDown TfrmFrame procedure pnlCIRNMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlCIRNMouseUp TfrmFrame procedure pnlCIRNMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlFlagClick TfrmFrame procedure pnlFlagClick(Sender: TObject); Public/Published -
pnlFlagEnter TfrmFrame procedure pnlFlagEnter(Sender: TObject); Public/Published -
pnlFlagExit TfrmFrame procedure pnlFlagExit(Sender: TObject); Public/Published -
pnlFlagMouseDown TfrmFrame procedure pnlFlagMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlFlagMouseUp TfrmFrame procedure pnlFlagMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlPatientClick TfrmFrame procedure pnlPatientClick(Sender: TObject); Public/Published -
pnlPatientMouseDown TfrmFrame procedure pnlPatientMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published
Toolbar Methods (make panels act like buttons) ------------------------------------------- 

 emulate a button press in the patient identification panel
pnlPatientMouseUp TfrmFrame procedure pnlPatientMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published Emulate the button raising in the patient identification panel & call Patient Inquiry
pnlPostingsClick TfrmFrame procedure pnlPostingsClick(Sender: TObject); Public/Published -
pnlPostingsMouseDown TfrmFrame procedure pnlPostingsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published Emulate a button press in the postings panel
pnlPostingsMouseUp TfrmFrame procedure pnlPostingsMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published Emulate a button raising in the posting panel and call Postings
pnlPrimaryCareClick TfrmFrame procedure pnlPrimaryCareClick(Sender: TObject); Public/Published -
pnlPrimaryCareEnter TfrmFrame procedure pnlPrimaryCareEnter(Sender: TObject); Public/Published -
pnlPrimaryCareExit TfrmFrame procedure pnlPrimaryCareExit(Sender: TObject); Public/Published -
pnlPrimaryCareMouseDown TfrmFrame procedure pnlPrimaryCareMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlPrimaryCareMouseUp TfrmFrame procedure pnlPrimaryCareMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlRemindersClick TfrmFrame procedure pnlRemindersClick(Sender: TObject); Public/Published -
pnlRemindersMouseDown TfrmFrame procedure pnlRemindersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlRemindersMouseUp TfrmFrame procedure pnlRemindersMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlVisitClick TfrmFrame procedure pnlVisitClick(Sender: TObject); Public/Published -
pnlVisitMouseDown TfrmFrame procedure pnlVisitMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published Emulate a button press in the encounter panel
pnlVisitMouseUp TfrmFrame procedure pnlVisitMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published Emulate a button raising in the encounter panel and call Update Provider/Location
pnlVistaWebClick TfrmFrame procedure pnlVistaWebClick(Sender: TObject); Public/Published -
pnlVistaWebMouseDown TfrmFrame procedure pnlVistaWebMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlVistaWebMouseUp TfrmFrame procedure pnlVistaWebMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
popCIRNCloseClick TfrmFrame procedure popCIRNCloseClick(Sender: TObject); Public/Published -
popCIRNSelectAllClick TfrmFrame procedure popCIRNSelectAllClick(Sender: TObject); Public/Published -
popCIRNSelectNoneClick TfrmFrame procedure popCIRNSelectNoneClick(Sender: TObject); Public/Published -
RefreshFixedStatusWidth TfrmFrame procedure RefreshFixedStatusWidth; Private Form Events (Create, Destroy) -----------------------------------------------------------
RemindersChanged TfrmFrame procedure RemindersChanged(Sender: TObject); Private Procedure SetUpCIRN;
ReportsOnlyDisplay TfrmFrame procedure ReportsOnlyDisplay; Private -
SaveSizesForUser TfrmFrame procedure SaveSizesForUser; Private -
SaveUserPreferences TfrmFrame procedure SaveUserPreferences; Private -
ScreenActiveFormChange TfrmFrame procedure ScreenActiveFormChange(Sender: TObject); Public/Published -
SetActiveTab TfrmFrame procedure SetActiveTab(PageID: Integer); Public -
SetBADxList TfrmFrame procedure SetBADxList; Public -
SetDebugMenu TfrmFrame procedure SetDebugMenu; Private -
SetUpCIRN TfrmFrame procedure SetUpCIRN; Public --------------------- CIRN-related procedures --------------------------------
SetUpNextButton TfrmFrame procedure SetUpNextButton; Private -
SetupPatient TfrmFrame procedure SetupPatient(AFlaggedList : TStringList = nil); Private File Menu Events -------------------------------------------------------------------------
SetUserTools TfrmFrame procedure SetUserTools; Private OptionsClick: TNotifyEvent;
ShowEverything TfrmFrame procedure ShowEverything; Private -
ShowHideChartTabMenus TfrmFrame procedure ShowHideChartTabMenus(AMenuItem: TMenuItem); Public -
StartCCOWContextor TfrmFrame procedure StartCCOWContextor; Private -
StopProcessingNotifs - procedure StopProcessingNotifs; Local -
Substitute - procedure Substitute(const Key, Data: string); Local Look for 'macros' on the command line and expand them using current context
SwitchToPage TfrmFrame procedure SwitchToPage(NewForm: TfrmPage); Private Unmerge/merge menus, bring page to top of z-order, call form-specific OnDisplay code
tabPageChange TfrmFrame procedure tabPageChange(Sender: TObject); Public/Published Switches to form linked to NewTab
tabPageMouseDown TfrmFrame procedure tabPageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
tabPageMouseUp TfrmFrame procedure tabPageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
TimeOutAction TfrmFrame procedure TimeOutAction; Private -
ToggleMenuItemChecked TfrmFrame procedure ToggleMenuItemChecked(Sender: TObject); Public Temporary Calls --------------------------------------------------------------------------
ToolClick TfrmFrame procedure ToolClick(Sender: TObject); Public/Published
Executes the program associated with an item on the Tools menu, the command line is stored
  in the item's hint property
UMInitiate TfrmFrame procedure UMInitiate(var Message: TMessage); message UM_INITIATE; Private -
UMNewOrder TfrmFrame procedure UMNewOrder(var Message: TMessage); message UM_NEWORDER; Private
Updates posted to MainForm --------------------------------------------------------------- 

 post a notice of change in orders to all TPages, wParam=OrderAction, lParam=TOrder
UMShowPage TfrmFrame procedure UMShowPage(var Message: TMessage); message UM_SHOWPAGE; Private Shows a page when the UM_SHOWPAGE message is received
UMStatusText TfrmFrame procedure UMStatusText(var Message: TMessage); message UM_STATUSTEXT; Private
Status Bar Methods 

 displays status bar text (using the pointer to a text buffer passed in LParam)
UpdateCCOWContext TfrmFrame procedure UpdateCCOWContext; Private -
UpdateECSParameter TfrmFrame procedure UpdateECSParameter(var CmdParameter: string); Private ECS
UpdatePatientInfoForAlert - procedure UpdatePatientInfoForAlert; Local -
UpdatePtInfoOnRefresh TfrmFrame procedure UpdatePtInfoOnRefresh; Public -
ViewInfo TfrmFrame procedure ViewInfo(Sender: TObject); Public/Published -
WMSetFocus TfrmFrame procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS; Private Tab Selection (navigate between pages) ---------------------------------------------------
WMSysCommand TfrmFrame procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND; Private -

Functions

Name Owner Declaration Scope Comments
AllowCCOWContextChange TfrmFrame function AllowCCOWContextChange(var CCOWResponse: UserResponse; NewDFN: string): boolean; Private -
AllowContextChangeAll TfrmFrame function AllowContextChangeAll(var Reason: string): Boolean; Private -
DLLActive TfrmFrame function DLLActive: boolean; Public -
ExcuteEC - function ExcuteEC(AFile,APara: string): boolean; Local -
ExcuteECS - function ExcuteECS(AFile, APara: string; var currPath: string): boolean; Local -
ExpandCommand TfrmFrame function ExpandCommand(x: string): string; Private
Tool Menu Events ------------------------------------------------------------------------- 

 look for 'macros' on the command line and expand them using current context
FindBestCCOWDFN TfrmFrame function FindBestCCOWDFN: string; Private
Function FindBestCCOWDFN(var APatientName: string): string;
function TfrmFrame.FindBestCCOWDFN(var APatientName: string): string;
GetTimedOut TfrmFrame function GetTimedOut: boolean; Private -
PageIDToTab TfrmFrame function PageIDToTab(PageID: Integer): Integer; Public Returns the tab index that corresponds to a given PageID
TabExists TfrmFrame function TabExists(ATabID: integer): boolean; Public -
TabToPageID TfrmFrame function TabToPageID(Tab: Integer): Integer; Private Returns the constant that identifies the page given a TabIndex
TakeOutAmps - function TakeOutAmps(AString: string): string; Local -
TimeoutCondition TfrmFrame function TimeoutCondition: boolean; Private -
ValidECSUser TfrmFrame function ValidECSUser: boolean; Private ECS

Global Variables

Name Type Declaration Comments
ChangingTab Integer NextTab, LastTab, ChangingTab: Integer; -
ctxContextor TContextorControl ctxContextor : TContextorControl; -
DEAContext Boolean DEAContext: Boolean = False; -
DelayReviewChanges Boolean DelayReviewChanges: Boolean = False; -
FlaggedPTList TStringList FlaggedPTList: TStringList; -
frmFrame TfrmFrame frmFrame: TfrmFrame; -
GraphFloat TfrmGraphs GraphFloat: TfrmGraphs; -
IsRunExecuted Boolean IsRunExecuted: Boolean = FALSE; RV 05/11/04
LastTab Integer NextTab, LastTab, ChangingTab: Integer; -
NextTab Integer NextTab, LastTab, ChangingTab: Integer; -
ProbTabClicked Boolean ProbTabClicked: boolean = FALSE; -
PTSwitchRefresh Boolean PTSwitchRefresh: boolean = FALSE; Flag for patient refresh or switch of patients
TabCtrlClicked Boolean TabCtrlClicked: Boolean = FALSE; -
uLabRepID UnicodeString uRemoteType, uReportID, uLabRepID : string; -
uRemoteType UnicodeString uRemoteType, uReportID, uLabRepID : string; -
uReportID UnicodeString uRemoteType, uReportID, uLabRepID : string; -
uTabList TStringList uTabList: TStringList; -
uUseVistaWeb Boolean uUseVistaWeb: boolean; -

Constants

Name Declaration Scope Comments
FCP_CHKVER 40 Global Form create about to check version
FCP_FINISH 99 Global Form create finished successfully
FCP_FORMS 60 Global Form create about to create child forms
FCP_OBJECTS 50 Global Form create about to create core objects
FCP_PTSEL 70 Global Form create about to select patient
FCP_SERVER 30 Global Form create about to connect to server
FCP_SETHOOK 20 Global Form create about to set timeout hooks
FCP_UPDATE 10 Global
Moved to uConst - RV v16
  CT_NOPAGE   = -1;                             // chart tab - none selected
  CT_UNKNOWN  =  0;                             // chart tab - unknown (shouldn't happen)
  CT_COVER    =  1;                             // chart tab - cover sheet
  CT_PROBLEMS =  2;                             // chart tab - problem list
  CT_MEDS     =  3;                             // chart tab - medications screen
  CT_ORDERS   =  4;                             // chart tab - doctor's orders
  CT_HP       =  5;                             // chart tab - history & physical
  CT_NOTES    =  6;                             // chart tab - progress notes
  CT_CONSULTS =  7;                             // chart tab - consults
  CT_DCSUMM   =  8;                             // chart tab - discharge summaries
  CT_LABS     =  9;                             // chart tab - laboratory results
  CT_REPORTS  = 10;                             // chart tab - reports
  CT_SURGERY  = 11;                             // chart tab - surgery

 form create about to check auto-update
PASSCODE '_gghwn7pghCrOJvOV61PtPvgdeEU2u5cRsGvpkVDjKT_H7SdKE_hqFYWsUIVT1H7JwT6Yz8oCtd2u2PALqWxibNXx3Yo8GPcTYsNaxW' + 'ZFo8OgT11D5TIvpu3cDQuZd3Yh_nV9jhkvb0ZBGdO9n-uNXPPEK7xfYWCI2Wp3Dsu9YDSd_EM34nvrgy64cqu9_jFJKJnGiXY96Lf1ecLiv4LT9qtmJ-BawYt7O9JZGAswi344BmmCbNxfgvgf0gfGZea' Interfaced -
SHOW_NOTIFICATIONS True Global -
TC_CCOW_ERROR 'CCOW Error' Global -
TC_CLIERR 'Client Specifications Mismatch' Global -
TC_DGSR_DENY 'Remote Access Denied' Global -
TC_DGSR_ERR 'Remote Data Error' Global -
TC_DGSR_SHOW 'Restricted Remote Record' Global -
TC_NO_SURG_NOTIF 'Surgery Tab Not Available' Global -
TC_NOTIF_STOP 'Currently Processing Notifications' Global -
TC_UNK_NOTIF 'Follow Up Action Not Implemented' Global -
TC_VER 'Server/Client Incompatibility' Global -
TX_CCOW_BROKEN 'Clinical link broken' Global -
TX_CCOW_CHANGING 'Clinical link changing' Global -
TX_CCOW_ERROR 'CPRS was unable to communicate with the CCOW Context Vault' + CRLF + Global -
TX_CCOW_LINKED 'Clinical Link On' Global -
TX_DGSR_YESNO CRLF + 'Do you want to continue accessing this remote patient record?' Global -
TX_ECSOPT 'EC GUI CONTEXT' Global -
TX_IN_USE 'VistA CPRS in use by: ' Global Use same as with CPRSInstances in fTimeout
TX_NO_SURG_NOTIF 'This notification must be processed using the Surgery tab, ' + CRLF + Global -
TX_NOTIF_STOP 'Stop processing notifications?' Global -
TX_OPTION 'OR CPRS GUI CHART' Global -
TX_PTINQ 'Retrieving demographic information...' Global -
TX_UNK_NOTIF 'Unable to process the follow up action for this notification' Global -
TX_VER_NEW CRLF + 'The program cannot be run until the server is upgraded.' Global -
TX_VER_OLD CRLF + 'It is strongly recommended that you upgrade.' Global -
TX_VER_OLD2 CRLF + 'The program cannot be run until the client is upgraded.' Global -
TX_VER_REQ ' version server is required.' Global -
TX_VER1 'This is version ' Global -
TX_VER2 ' of CPRSChart.exe.' Global -
TX_VER3 CRLF + 'The running server version is ' Global -


Module Source

1     unit fFrame;
2     { This is the m
3     ain form for the CPRS GUI.  It provides a patient-encounter-user framework
4       which all the other forms of the GUI use. }
5     
6     {$OPTIMIZATION OFF}                              // REMOVE AFTER UNIT IS DEBUGGED
7     {$WARN SYMBOL_PLATFORM OFF}
8     {$DEFINE CCOWBROKER}                              
9                                    
10    {.$define debug}
11    
12    interface
13    
14    uses
15      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Tabs, ComCtrls,
16      ExtCtrls, Menus, StdCtrls, Buttons, ORFn, fPage, uConst, ORCtrls, Trpcb,
17      OleCtrls, VERGENCECONTEXTORLib_TLB, ComObj, AppEvnts, fBase508Form,
18      VA508AccessibilityManager, RichEdit, XuDsigS;
19    
20    type
21      TfrmFrame = class(TfrmBase508Form)
22        pnlToolbar: TPanel;
23        stsArea: TStatusBar;
24        tabPage: TTabControl;
25        pnlPage: TPanel;
26        bvlPageTop: TBevel;
27        bvlToolTop: TBevel;
28        pnlPatient: TKeyClickPanel;
29        lblPtName: TStaticText;
30        lblPtSSN: TStaticText;
31        lblPtAge: TStaticText;
32        pnlVisit: TKeyClickPanel;
33        lblPtLocation: TStaticText;
34        lblPtProvider: TStaticText;
35        mnuFrame: TMainMenu;
36        mnuFile: TMenuItem;
37        mnuFileExit: TMenuItem;
38        mnuFileOpen: TMenuItem;
39        mnuFileReview: TMenuItem;
40        Z1: TMenuItem;
41        mnuFilePrint: TMenuItem;
42        mnuEdit: TMenuItem;
43        mnuEditUndo: TMenuItem;
44        Z3: TMenuItem;
45        mnuEditCut: TMenuItem;
46        mnuEditCopy: TMenuItem;
47        mnuEditPaste: TMenuItem;
48        Z4: TMenuItem;
49        mnuEditPref: TMenuItem;
50        Prefs1: TMenuItem;
51        mnu18pt1: TMenuItem;
52        mnu14pt1: TMenuItem;
53        mnu12pt1: TMenuItem;
54        mnu10pt1: TMenuItem;
55        mnu8pt: TMenuItem;
56        mnuHelp: TMenuItem;
57        mnuHelpContents: TMenuItem;
58        mnuHelpTutor: TMenuItem;
59        Z5: TMenuItem;
60        mnuHelpAbout: TMenuItem;
61        mnuTools: TMenuItem;
62        mnuView: TMenuItem;
63        mnuViewChart: TMenuItem;
64        mnuChartReports: TMenuItem;
65        mnuChartLabs: TMenuItem;
66        mnuChartDCSumm: TMenuItem;
67        mnuChartCslts: TMenuItem;
68        mnuChartNotes: TMenuItem;
69        mnuChartOrders: TMenuItem;
70        mnuChartMeds: TMenuItem;
71        mnuChartProbs: TMenuItem;
72        mnuChartCover: TMenuItem;
73        mnuHelpBroker: TMenuItem;
74        mnuFileEncounter: TMenuItem;
75        mnuViewDemo: TMenuItem;
76        mnuViewPostings: TMenuItem;
77        mnuHelpLists: TMenuItem;
78        Z6: TMenuItem;
79        mnuHelpSymbols: TMenuItem;
80        mnuFileNext: TMenuItem;
81        Z7: TMenuItem;
82        mnuFileRefresh: TMenuItem;
83        pnlPrimaryCare: TKeyClickPanel;
84        lblPtCare: TStaticText;
85        lblPtAttending: TStaticText;
86        pnlReminders: TKeyClickPanel;
87        imgReminder: TImage;
88        mnuViewReminders: TMenuItem;
89        anmtRemSearch: TAnimate;
90        lstCIRNLocations: TORListBox;
91        popCIRN: TPopupMenu;
92        popCIRNSelectAll: TMenuItem;
93        popCIRNSelectNone: TMenuItem;
94        popCIRNClose: TMenuItem;
95        mnuFilePrintSetup: TMenuItem;
96        LabInfo1: TMenuItem;
97        mnuFileNotifRemove: TMenuItem;
98        Z8: TMenuItem;
99        mnuToolsOptions: TMenuItem;
100       mnuChartSurgery: TMenuItem;
101       OROpenDlg: TOpenDialog;
102       mnuFileResumeContext: TMenuItem;
103       mnuFileResumeContextSet: TMenuItem;
104       Useexistingcontext1: TMenuItem;
105       mnuFileBreakContext: TMenuItem;
106       pnlCCOW: TPanel;
107       imgCCOW: TImage;
108       pnlPatientSelected: TPanel;
109       pnlNoPatientSelected: TPanel;
110       pnlPostings: TKeyClickPanel;
111       lblPtPostings: TStaticText;
112       lblPtCWAD: TStaticText;
113       mnuFilePrintSelectedItems: TMenuItem;
114       popAlerts: TPopupMenu;
115       mnuAlertContinue: TMenuItem;
116       mnuAlertForward: TMenuItem;
117       mnuAlertRenew: TMenuItem;
118       AppEvents: TApplicationEvents;
119       paVAA: TKeyClickPanel;
120       mnuToolsGraphing: TMenuItem;
121       laVAA2: TButton;
122       laMHV: TButton;
123       mnuViewInformation: TMenuItem;
124       mnuViewVisits: TMenuItem;
125       mnuViewPrimaryCare: TMenuItem;
126       mnuViewMyHealtheVet: TMenuItem;
127       mnuInsurance: TMenuItem;
128       mnuViewFlags: TMenuItem;
129       mnuViewRemoteData: TMenuItem;
130       compAccessTabPage: TVA508ComponentAccessibility;
131       pnlCVnFlag: TPanel;
132       btnCombatVet: TButton;
133       pnlFlag: TKeyClickPanel;
134       lblFlag: TLabel;
135       pnlRemoteData: TKeyClickPanel;
136       pnlVistaWeb: TKeyClickPanel;
137       lblVistaWeb: TLabel;
138       pnlCIRN: TKeyClickPanel;
139       lblCIRN: TLabel;
140       mnuEditRedo: TMenuItem;
141       lblPtMHTC: TStaticText;
142       DigitalSigningSetup1: TMenuItem;
143       procedure tabPageChange(Sender: TObject);
144       procedure FormCreate(Sender: TObject);
145       procedure FormResize(Sender: TObject);
146       procedure pnlPatientMouseDown(Sender: TObject; Button: TMouseButton;
147         Shift: TShiftState; X, Y: Integer);
148       procedure pnlPatientMouseUp(Sender: TObject; Button: TMouseButton;
149         Shift: TShiftState; X, Y: Integer);
150       procedure pnlVisitMouseDown(Sender: TObject; Button: TMouseButton;
151         Shift: TShiftState; X, Y: Integer);
152       procedure pnlVisitMouseUp(Sender: TObject; Button: TMouseButton;
153         Shift: TShiftState; X, Y: Integer);
154       procedure mnuFileExitClick(Sender: TObject);
155       procedure pnlPostingsMouseDown(Sender: TObject; Button: TMouseButton;
156         Shift: TShiftState; X, Y: Integer);
157       procedure pnlPostingsMouseUp(Sender: TObject; Button: TMouseButton;
158         Shift: TShiftState; X, Y: Integer);
159       procedure mnuFontSizeClick(Sender: TObject);
160       procedure mnuChartTabClick(Sender: TObject);
161       procedure FormDestroy(Sender: TObject);
162       procedure mnuFileOpenClick(Sender: TObject);
163       procedure mnuHelpBrokerClick(Sender: TObject);
164       procedure mnuFileEncounterClick(Sender: TObject);
165       procedure mnuViewPostingsClick(Sender: TObject);
166       procedure mnuHelpAboutClick(Sender: TObject);
167       procedure mnuFileReviewClick(Sender: TObject);
168       procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
169       procedure mnuHelpListsClick(Sender: TObject);
170       procedure ToolClick(Sender: TObject);
171       procedure mnuEditClick(Sender: TObject);
172       procedure mnuEditUndoClick(Sender: TObject);
173       procedure mnuEditCutClick(Sender: TObject);
174       procedure mnuEditCopyClick(Sender: TObject);
175       procedure mnuEditPasteClick(Sender: TObject);
176       procedure mnuHelpSymbolsClick(Sender: TObject);
177       procedure FormClose(Sender: TObject; var Action: TCloseAction);
178       procedure mnuFilePrintClick(Sender: TObject);
179       procedure mnuGECStatusClick(Sender: TObject);
180       procedure mnuFileNextClick(Sender: TObject);
181       procedure pnlPrimaryCareMouseDown(Sender: TObject;
182         Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
183       procedure pnlPrimaryCareMouseUp(Sender: TObject; Button: TMouseButton;
184         Shift: TShiftState; X, Y: Integer);
185       procedure pnlRemindersMouseDown(Sender: TObject; Button: TMouseButton;
186         Shift: TShiftState; X, Y: Integer);
187       procedure pnlRemindersMouseUp(Sender: TObject; Button: TMouseButton;
188         Shift: TShiftState; X, Y: Integer);
189       procedure pnlCIRNClick(Sender: TObject);
190       procedure lstCIRNLocationsClick(Sender: TObject);
191       procedure popCIRNCloseClick(Sender: TObject);
192       procedure popCIRNSelectAllClick(Sender: TObject);
193       procedure popCIRNSelectNoneClick(Sender: TObject);
194       procedure mnuFilePrintSetupClick(Sender: TObject);
195       procedure lstCIRNLocationsChange(Sender: TObject);
196       procedure LabInfo1Click(Sender: TObject);
197       procedure mnuFileNotifRemoveClick(Sender: TObject);
198       procedure mnuToolsOptionsClick(Sender: TObject);
199       procedure mnuFileRefreshClick(Sender: TObject);
200       procedure FormKeyDown(Sender: TObject; var Key: Word;
201         Shift: TShiftState);
202       procedure FormActivate(Sender: TObject);
203       procedure pnlPrimaryCareEnter(Sender: TObject);
204       procedure pnlPrimaryCareExit(Sender: TObject);
205       procedure pnlPatientClick(Sender: TObject);
206       procedure pnlVisitClick(Sender: TObject);
207       procedure pnlPrimaryCareClick(Sender: TObject);
208       procedure pnlRemindersClick(Sender: TObject);
209       procedure pnlPostingsClick(Sender: TObject);
210       procedure ctxContextorCanceled(Sender: TObject);
211       procedure ctxContextorCommitted(Sender: TObject);
212       procedure ctxContextorPending(Sender: TObject;
213         const aContextItemCollection: IDispatch);
214       procedure mnuFileBreakContextClick(Sender: TObject);
215       procedure mnuFileResumeContextGetClick(Sender: TObject);
216       procedure mnuFileResumeContextSetClick(Sender: TObject);
217       procedure pnlFlagMouseDown(Sender: TObject; Button: TMouseButton;
218         Shift: TShiftState; X, Y: Integer);
219       procedure pnlFlagMouseUp(Sender: TObject; Button: TMouseButton;
220         Shift: TShiftState; X, Y: Integer);
221       procedure pnlFlagClick(Sender: TObject);
222       procedure mnuFilePrintSelectedItemsClick(Sender: TObject);
223       procedure mnuAlertRenewClick(Sender: TObject);
224       procedure mnuAlertForwardClick(Sender: TObject);
225       procedure pnlFlagEnter(Sender: TObject);
226       procedure pnlFlagExit(Sender: TObject);
227       procedure tabPageMouseUp(Sender: TObject; Button: TMouseButton;
228         Shift: TShiftState; X, Y: Integer);
229       procedure lstCIRNLocationsExit(Sender: TObject);
230       procedure AppEventsActivate(Sender: TObject);
231       procedure ScreenActiveFormChange(Sender: TObject);
232       procedure AppEventsShortCut(var Msg: TWMKey; var Handled: Boolean);
233       procedure mnuToolsGraphingClick(Sender: TObject);
234       procedure pnlCIRNMouseDown(Sender: TObject; Button: TMouseButton;
235         Shift: TShiftState; X, Y: Integer);
236       procedure pnlCIRNMouseUp(Sender: TObject; Button: TMouseButton;
237         Shift: TShiftState; X, Y: Integer);
238       procedure laMHVClick(Sender: TObject);
239       procedure laVAA2Click(Sender: TObject);
240       procedure ViewInfo(Sender: TObject);
241       procedure mnuViewInformationClick(Sender: TObject);
242       procedure compAccessTabPageCaptionQuery(Sender: TObject;
243         var Text: string);
244       procedure btnCombatVetClick(Sender: TObject);
245       procedure pnlVistaWebClick(Sender: TObject);
246       procedure pnlVistaWebMouseUp(Sender: TObject; Button: TMouseButton;
247         Shift: TShiftState; X, Y: Integer);
248       procedure pnlVistaWebMouseDown(Sender: TObject; Button: TMouseButton;
249         Shift: TShiftState; X, Y: Integer);
250       procedure mnuEditRedoClick(Sender: TObject);
251       procedure tabPageMouseDown(Sender: TObject; Button: TMouseButton;
252         Shift: TShiftState; X, Y: Integer);
253       procedure DigitalSigningSetup1Click(Sender: TObject);
254     private
255       FProccessingNextClick : boolean;
256       FJustEnteredApp : boolean;
257       FCCOWInstalled: boolean;
258       FCCOWContextChanging: boolean;
259       FCCOWIconName: string;
260       FCCOWDrivedChange: boolean;
261       FCCOWBusy: boolean;
262       FCCOWError: boolean;
263       FNoPatientSelected: boolean;
264       FRefreshing: boolean;
265       FClosing: boolean;
266       FContextChanging: Boolean;
267       FChangeSource: Integer;
268       FCreateProgress: Integer;
269       FEditCtrl: TCustomEdit;
270       FLastPage: TfrmPage;
271       FNextButtonL: Integer;
272       FNextButtonR: Integer;
273       FNextButtonActive: Boolean;
274       FNextButtonBitmap: TBitmap;
275       FNextButton: TBitBtn;
276       FTerminate: Boolean;
277       FTabChanged: TNotifyEvent;
278       FOldActivate: TNotifyEvent;
279       FOldActiveFormChange: TNotifyEvent;
280       FECSAuthUser: Boolean;
281       FFixedStatusWidth: integer;
282       FPrevInPatient: Boolean;
283       FFirstLoad:    Boolean;
284       FFlagList: TStringList;
285       FPrevPtID: string;
286       FGraphFloatActive: boolean;
287       FGraphContext: string;
288       FDoNotChangeEncWindow: boolean;
289       FOrderPrintForm: boolean;
290       FReviewclick: boolean;
291       FCtrlTabUsed: boolean;
292       procedure RefreshFixedStatusWidth;
293       procedure FocusApplicationTopForm;
294       procedure AppActivated(Sender: TObject);
295       procedure AppDeActivated(Sender: TObject);
296       procedure AppException(Sender: TObject; E: Exception);
297       function AllowContextChangeAll(var Reason: string):  Boolean;
298       procedure ClearPatient;
299       procedure ChangeFont(NewFontSize: Integer);
300       //procedure CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
301       procedure CreateTab(ATabID: integer; ALabel: string);
302       procedure DetermineNextTab;
303       function ExpandCommand(x: string): string;
304       procedure FitToolbar;
305       procedure LoadSizesForUser;
306       procedure SaveSizesForUser;
307       procedure LoadUserPreferences;
308       procedure SaveUserPreferences;
309       procedure SwitchToPage(NewForm: TfrmPage);
310       function TabToPageID(Tab: Integer): Integer;
311       function TimeoutCondition: boolean;
312       function GetTimedOut: boolean;
313       procedure TimeOutAction;
314       procedure SetUserTools;
315       procedure SetDebugMenu;
316       procedure SetupPatient(AFlaggedList : TStringList = nil);
317       //procedure SetUpCIRN;
318       procedure RemindersChanged(Sender: TObject);
319       procedure ReportsOnlyDisplay;
320       procedure UMInitiate(var Message: TMessage);   message UM_INITIATE;
321       procedure UMNewOrder(var Message: TMessage);   message UM_NEWORDER;
322       procedure UMStatusText(var Message: TMessage); message UM_STATUSTEXT;
323       procedure UMShowPage(var Message: TMessage);   message UM_SHOWPAGE;
324       procedure WMSetFocus(var Message: TMessage);   message WM_SETFOCUS;
325       procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
326       procedure UpdateECSParameter(var CmdParameter: string);
327       function  ValidECSUser: boolean;
328       procedure StartCCOWContextor;
329       function  AllowCCOWContextChange(var CCOWResponse: UserResponse; NewDFN: string): boolean;
330       procedure UpdateCCOWContext;
331       procedure CheckHyperlinkResponse(aContextItemCollection: IDispatch; var HyperlinkReason: string);
332       procedure CheckForDifferentPatient(aContextItemCollection: IDispatch; var PtChanged: boolean);
333   {$IFDEF CCOWBROKER}
334       procedure CheckForDifferentUser(aContextItemCollection: IDispatch; var UserChanged: boolean);
335   {$ENDIF}
336       procedure HideEverything(AMessage: string = 'No patient is currently selected.');
337       procedure ShowEverything;
338       //function FindBestCCOWDFN(var APatientName: string): string;
339       function FindBestCCOWDFN: string;
340       procedure HandleCCOWError(AMessage: string);
341       procedure SetUpNextButton;
342       procedure NextButtonClick(Sender: TObject);
343       procedure NextButtonMouseDown(Sender: TObject; Button: TMouseButton;
344         Shift: TShiftState; X, Y: Integer);
345     public
346       EnduringPtSelSplitterPos, frmFrameHeight, pnlPatientSelectedHeight: integer;
347       EnduringPtSelColumns: string;
348       procedure SetBADxList;
349       procedure SetActiveTab(PageID: Integer);
350   
351       function PageIDToTab(PageID: Integer): Integer;
352       procedure ShowHideChartTabMenus(AMenuItem: TMenuItem);
353       procedure UpdatePtInfoOnRefresh;
354       function  TabExists(ATabID: integer): boolean;
355       procedure DisplayEncounterText;
356       function DLLActive: boolean;
357       property ChangeSource:    Integer read FChangeSource;
358       property CCOWContextChanging: Boolean read FCCOWContextChanging;
359       property CCOWDrivedChange: Boolean  read FCCOWDrivedChange;
360       property CCOWBusy: Boolean    read FCCOWBusy  write FCCOWBusy;
361       property ContextChanging: Boolean read FContextChanging;
362       property TimedOut:        Boolean read GetTimedOut;
363       property Closing:         Boolean read FClosing;
364       property OnTabChanged:    TNotifyEvent read FTabChanged write FTabChanged;
365       property GraphFloatActive: boolean read FGraphFloatActive write FGraphFloatActive;
366       property GraphContext: string read FGraphContext write FGraphContext;
367       procedure ToggleMenuItemChecked(Sender: TObject);
368       procedure SetUpCIRN;
369       property DoNotChangeEncWindow: boolean read FDoNotChangeEncWindow write FDoNotChangeEncWindow;
370       property OrderPrintForm: boolean read FOrderPrintForm write FOrderPrintForm;
371     end;
372   
373   var
374     frmFrame: TfrmFrame;
375     uTabList: TStringList;
376     uRemoteType, uReportID, uLabRepID : string;
377     FlaggedPTList: TStringList;
378     ctxContextor : TContextorControl;
379     NextTab, LastTab, ChangingTab: Integer;
380     uUseVistaWeb: boolean;
381     PTSwitchRefresh: boolean = FALSE;  //flag for patient refresh or switch of patients
382     ProbTabClicked: boolean = FALSE;
383     TabCtrlClicked: Boolean = FALSE;
384     DEAContext: Boolean = False;
385     DelayReviewChanges: Boolean = False;
386   
387   const
388     PASSCODE = '_gghwn7pghCrOJvOV61PtPvgdeEU2u5cRsGvpkVDjKT_H7SdKE_hqFYWsUIVT1H7JwT6Yz8oCtd2u2PALqWxibNXx3Yo8GPcTYsNaxW' + 'ZFo8OgT11D5TIvpu3cDQuZd3Yh_nV9jhkvb0ZBGdO9n-uNXPPEK7xfYWCI2Wp3Dsu9YDSd_EM34nvrgy64cqu9_jFJKJnGiXY96Lf1ecLiv4LT9qtmJ-BawYt7O9JZGAswi344BmmCbNxfgvgf0gfGZea';
389   
390   implementation
391   
392   {$R *.DFM}
393   {$R sBitmaps}
394   {$R sRemSrch}
395   
396   uses
397     ORNet, rCore, fPtSelMsg, fPtSel, fCover, fProbs, fMeds, fOrders, rOrders, fNotes, fConsults, fDCSumm,
398     rMisc, Clipbrd, fLabs, fReports, rReports, fPtDemo, fEncnt, fPtCWAD, uCore, fAbout, fReview, fxBroker,
399     fxLists, fxServer, ORSystem, fRptBox, fSplash, rODAllergy, uInit, fLabTests, fLabInfo,
400     uReminders, fReminderTree, ORClasses, fDeviceSelect, fDrawers, fReminderDialog, ShellAPI, rVitals,
401     fOptions, fGraphs, fGraphData, rTemplates, fSurgery, rSurgery, uEventHooks, uSignItems,
402     fDefaultEvent, rECS, fIconLegend, uOrders, fPtSelOptns, DateUtils, uSpell, uOrPtf, fPatientFlagMulti,
403     fAlertForward, UBAGlobals, fBAOptionsDiagnoses, UBACore, fOrdersSign, uVitals, fOrdersRenew, fMHTest, uFormMonitor
404     {$IFDEF CCOWBROKER}
405     , CCOW_const
406     {$ENDIF}
407     , VA508AccessibilityRouter, fOtherSchedule, VAUtils, uVA508CPRSCompatibility, fIVRoutes,
408     fPrintLocation, fTemplateEditor, fTemplateDialog, fCombatVet;
409   
410   var                                 //  RV 05/11/04
411     IsRunExecuted: Boolean = FALSE;           //  RV 05/11/04
412     GraphFloat: TfrmGraphs;
413   
414   const
415    //  moved to uConst - RV v16
416   (*  CT_NOPAGE   = -1;                             // chart tab - none selected
417     CT_UNKNOWN  =  0;                             // chart tab - unknown (shouldn't happen)
418     CT_COVER    =  1;                             // chart tab - cover sheet
419     CT_PROBLEMS =  2;                             // chart tab - problem list
420     CT_MEDS     =  3;                             // chart tab - medications screen
421     CT_ORDERS   =  4;                             // chart tab - doctor's orders
422     CT_HP       =  5;                             // chart tab - history & physical
423     CT_NOTES    =  6;                             // chart tab - progress notes
424     CT_CONSULTS =  7;                             // chart tab - consults
425     CT_DCSUMM   =  8;                             // chart tab - discharge summaries
426     CT_LABS     =  9;                             // chart tab - laboratory results
427     CT_REPORTS  = 10;                             // chart tab - reports
428     CT_SURGERY  = 11;                             // chart tab - surgery*)
429   
430     FCP_UPDATE  = 10;                             // form create about to check auto-update
431     FCP_SETHOOK = 20;                             // form create about to set timeout hooks
432     FCP_SERVER  = 30;                             // form create about to connect to server
433     FCP_CHKVER  = 40;                             // form create about to check version
434     FCP_OBJECTS = 50;                             // form create about to create core objects
435     FCP_FORMS   = 60;                             // form create about to create child forms
436     FCP_PTSEL   = 70;                             // form create about to select patient
437     FCP_FINISH  = 99;                             // form create finished successfully
438   
439     TX_IN_USE     = 'VistA CPRS in use by: ';     // use same as with CPRSInstances in fTimeout
440     TX_OPTION     = 'OR CPRS GUI CHART';
441     TX_ECSOPT     = 'EC GUI CONTEXT';
442     TX_PTINQ      = 'Retrieving demographic information...';
443     TX_NOTIF_STOP = 'Stop processing notifications?';
444     TC_NOTIF_STOP = 'Currently Processing Notifications';
445     TX_UNK_NOTIF  = 'Unable to process the follow up action for this notification';
446     TC_UNK_NOTIF  = 'Follow Up Action Not Implemented';
447     TX_NO_SURG_NOTIF = 'This notification must be processed using the Surgery tab, ' + CRLF +
448                        'which is not currently available to you.';
449     TC_NO_SURG_NOTIF = 'Surgery Tab Not Available';
450     TX_VER1       = 'This is version ';
451     TX_VER2       = ' of CPRSChart.exe.';
452     TX_VER3       = CRLF + 'The running server version is ';
453     TX_VER_REQ    = ' version server is required.';
454     TX_VER_OLD    = CRLF + 'It is strongly recommended that you upgrade.';
455     TX_VER_OLD2   = CRLF + 'The program cannot be run until the client is upgraded.';
456     TX_VER_NEW    = CRLF + 'The program cannot be run until the server is upgraded.';
457     TC_VER        = 'Server/Client Incompatibility';
458     TC_CLIERR     = 'Client Specifications Mismatch';
459   
460     SHOW_NOTIFICATIONS = True;
461   
462     TC_DGSR_ERR    = 'Remote Data Error';
463     TC_DGSR_SHOW   = 'Restricted Remote Record';
464     TC_DGSR_DENY   = 'Remote Access Denied';
465     TX_DGSR_YESNO  = CRLF + 'Do you want to continue accessing this remote patient record?';
466   
467     TX_CCOW_LINKED   = 'Clinical Link On';
468     TX_CCOW_CHANGING = 'Clinical link changing';
469     TX_CCOW_BROKEN   = 'Clinical link broken';
470     TX_CCOW_ERROR    = 'CPRS was unable to communicate with the CCOW Context Vault' + CRLF +
471                        'CCOW patient synchronization will be unavailable for the remainder of this session.';
472     TC_CCOW_ERROR    = 'CCOW Error';
473   
474   function TfrmFrame.TimeoutCondition: boolean;
475   begin
476     Result := (FCreateProgress < FCP_PTSEL);
477   end;
478   
479   function TfrmFrame.GetTimedOut: boolean;
480   begin
481     Result := uInit.TimedOut;
482   end;
483   
484   procedure TfrmFrame.TimeOutAction;
485   var
486     ClosingCPRS: boolean;
487   
488     procedure CloseCPRS;
489     begin
490       if ClosingCPRS then
491         halt;
492       try
493         ClosingCPRS := TRUE; 
494         Close;
495       except
496         halt;
497       end;
498     end;
499   
500   begin
501     ClosingCPRS := FALSE;
502     try
503       if assigned(frmOtherSchedule) then frmOtherSchedule.Close;
504       if assigned (frmIVRoutes) then frmIVRoutes.Close;
505       if frmFrame.DLLActive then
506       begin
507          CloseVitalsDLL();
508          CloseMHDLL();
509       end;
510       CloseCPRS;
511     except
512       CloseCPRS;
513     end;
514   end;
515   
516   { General Functions and Procedures }
517   
518   procedure TfrmFrame.AppException(Sender: TObject; E: Exception);
519   var
520     AnAddr: Pointer;
521     ErrMsg: string;
522   begin
523     Application.NormalizeTopMosts;
524     if (E is EIntError) then
525     begin
526       ErrMsg := E.Message + CRLF +
527                 'CreateProgress: ' + IntToStr(FCreateProgress) + CRLF +
528                 'RPC Info: ' + RPCLastCall;
529       if EExternal(E).ExceptionRecord <> nil then
530       begin
531         AnAddr := EExternal(E).ExceptionRecord^.ExceptionAddress;
532         ErrMsg := ErrMsg + CRLF + 'Address was ' + IntToStr(Integer(AnAddr));
533       end;
534       ShowMsg(ErrMsg);
535     end
536     else if (E is EBrokerError) then
537     begin
538       Application.ShowException(E);
539       FCreateProgress := FCP_FORMS;
540       Close;
541     end
542     else if (E is EOleException) then
543     begin
544       Application.ShowException(E);
545       FCreateProgress := FCP_FORMS;
546       Close;
547     end
548     else Application.ShowException(E);
549     Application.RestoreTopMosts;
550   end;
551   
552   procedure TfrmFrame.btnCombatVetClick(Sender: TObject);
553   begin
554     inherited;
555     frmCombatVet := TfrmCombatVet.Create(frmFrame);
556     frmCombatVet.ShowModal;
557     frmCombatVet.Free;
558   end;
559   
560   function TfrmFrame.AllowContextChangeAll(var Reason: string): Boolean;
561   var
562     Silent: Boolean;
563   begin
564     if pnlNoPatientSelected.Visible then
565     begin
566       Result := True;
567       exit;
568     end;
569     FContextChanging := True;
570     Result := True;
571     if COMObjectActive or SpellCheckInProgress or DLLActive then
572       begin
573         Reason := 'COM_OBJECT_ACTIVE';
574         Result:= False;
575       end;
576     if Result then Result := frmCover.AllowContextChange(Reason);
577     if Result then Result := frmProblems.AllowContextChange(Reason);
578     if Result then Result := frmMeds.AllowContextChange(Reason);
579     if Result then Result := frmOrders.AllowContextChange(Reason);
580     if Result then Result := frmNotes.AllowContextChange(Reason);
581     if Result then Result := frmConsults.AllowContextChange(Reason);
582     if Result then Result := frmDCSumm.AllowContextChange(Reason);
583     if Result then
584       if Assigned(frmSurgery) then Result := frmSurgery.AllowContextChange(Reason);;
585     if Result then Result := frmLabs.AllowContextChange(Reason);;
586     if Result then Result := frmReports.AllowContextChange(Reason);
587     if Result then Result := frmGraphData.AllowContextChange(Reason);
588     if (not User.IsReportsOnly) then
589       if Result and Changes.RequireReview then //Result := ReviewChanges(TimedOut);
590         case BOOLCHAR[FCCOWContextChanging] of
591           '1': begin
592                  if Changes.RequireReview then
593                    begin
594                      Reason := 'Items will be left unsigned.';
595                      Result := False;
596                    end
597                  else
598                    Result := True;
599                end;
600           '0': begin
601                  Silent := (TimedOut) or (Reason = 'COMMIT');
602                  Result := ReviewChanges(Silent);
603                end;
604         end;
605     FContextChanging := False;
606   end;
607   
608   procedure TfrmFrame.ClearPatient;
609   { call all pages to make sure patient related information is cleared (when switching patients) }
610   begin
611     //if frmFrame.Timedout then Exit; // added to correct Access Violation when "Refresh Patient Information" selected
612     lblPtName.Caption     := '';
613     lblPtSSN.Caption      := '';
614     lblPtAge.Caption      := '';
615     pnlPatient.Caption    := '';
616     lblPtCWAD.Caption     := '';
617     if DoNotChangeEncWindow = false then
618        begin
619         lblPtLocation.Caption := 'Visit Not Selected';
620         lblPtProvider.Caption := 'Current Provider Not Selected';
621         pnlVisit.Caption      := lblPtLocation.Caption + CRLF + lblPtProvider.Caption;
622        end;
623     lblPtCare.Caption     := 'Primary Care Team Unassigned';
624     lblPtAttending.Caption := '';
625     lblPtMHTC.Caption := '';
626     pnlPrimaryCare.Caption := lblPtCare.Caption + ' ' + lblPtAttending.Caption + ' ' + lblPtMHTC.Caption;
627     frmCover.ClearPtData;
628     frmProblems.ClearPtData;
629     frmMeds.ClearPtData;
630     frmOrders.ClearPtData;
631     frmNotes.ClearPtData;
632     frmConsults.ClearPtData;
633     frmDCSumm.ClearPtData;
634     if Assigned(frmSurgery) then frmSurgery.ClearPtData;
635     frmLabs.ClearPtData;
636     frmGraphData.ClearPtData;
637     frmReports.ClearPtData;
638     tabPage.TabIndex := PageIDToTab(CT_NOPAGE);       // to make sure DisplayPage gets called
639     tabPageChange(tabPage);
640     ClearReminderData;
641     SigItems.Clear;
642     Changes.Clear;
643     lstCIRNLocations.Clear;
644     ClearFlag;
645     if Assigned(FlagList) then FlagList.Clear;
646     HasFlag := False;
647     HidePatientSelectMessages;
648     if (GraphFloat <> nil) and GraphFloatActive then
649     with GraphFloat do
650     begin
651       Initialize;
652       DisplayData('top');
653       DisplayData('bottom');
654       //GtslCheck.Clear;
655       Caption := 'CPRS Graphing - Patient: ' + MixedCase(Patient.Name);
656     end;
657     if frmFrame.TimedOut then
658     begin
659       infoBox('CPRS has encountered a serious problem and is unable to display the selected patient''s data. '
660               + 'To prevent patient safety issues, CPRS is shutting down. Shutting down and then restarting CPRS will correct the problem, and you may continue working in CPRS.'
661                + CRLF + CRLF + 'Please report all occurrences of this problem by contacting your CPRS Help Desk.', 'CPRS Error', MB_OK);
662       frmFrame.Close;
663     end;
664   end;
665   
666   procedure TfrmFrame.DigitalSigningSetup1Click(Sender: TObject);
667   begin
668     inherited;
669     LastPINvalue := '';
670     SetSAN(Self);
671     LastPINvalue := '';
672   end;
673   
674   procedure TfrmFrame.DisplayEncounterText;
675   { updates the display in the header bar of encounter related information (location & provider) }
676   begin
677     if DoNotChangeEncWindow = true then exit;
678     with Encounter do
679     begin
680       if Length(LocationText) > 0
681         then lblPtLocation.Caption := LocationText
682         else lblPtLocation.Caption := 'Visit Not Selected';
683       if Length(ProviderName) > 0
684         then lblPtProvider.Caption := 'Provider:  ' + ProviderName
685         else lblPtProvider.Caption := 'Current Provider Not Selected';
686     end;
687     pnlVisit.Caption := lblPtLocation.Caption + CRLF + lblPtProvider.Caption;
688     FitToolbar;
689   end;
690   
691   function TfrmFrame.DLLActive: boolean;
692   begin
693     Result := (VitalsDLLHandle <> 0) or (MHDLLHandle <> 0);
694   end;
695   
696   { Form Events (Create, Destroy) ----------------------------------------------------------- }
697   
698   
699   procedure TfrmFrame.RefreshFixedStatusWidth;
700   begin
701     with stsArea do
702       FFixedStatusWidth := Panels[0].Width + Panels[2].Width + Panels[3].Width + Panels[4].Width;
703   end;
704   
705   procedure TfrmFrame.FormCreate(Sender: TObject);
706   { connect to server, create tab pages, select a patient, & initialize core objects }
707   var
708     ClientVer, ServerVer, ServerReq, SAN: string;
709   begin
710     FJustEnteredApp := false;
711     SizeHolder := TSizeHolder.Create;
712     FOldActiveFormChange := Screen.OnActiveFormChange;
713     Screen.OnActiveFormChange := ScreenActiveFormChange;
714     if not (ParamSearch('CCOW')='DISABLE') then
715       try
716         StartCCOWContextor;
717       except
718         IsRunExecuted := False;
719         FCCOWInstalled := False;
720         pnlCCOW.Visible := False;
721         mnuFileResumeContext.Visible := False;
722         mnuFileBreakContext.Visible := False;
723       end
724     else
725       begin
726         IsRunExecuted := False;
727         FCCOWInstalled := False;
728         pnlCCOW.Visible := False;
729         mnuFileResumeContext.Visible := False;
730         mnuFileBreakContext.Visible := False;
731       end;
732     
733     RefreshFixedStatusWidth;
734     FTerminate := False;
735     AutoUpdateCheck;
736   
737     FFlagList := TStringList.Create;
738   
739     // setup initial timeout here so can timeout logon
740     FCreateProgress := FCP_SETHOOK;
741     InitTimeOut(TimeoutCondition, TimeOutAction);
742   
743     // connect to the server and create an option context
744     FCreateProgress := FCP_SERVER;
745   
746   {$IFDEF CCOWBROKER}
747     EnsureBroker;
748     if ctxContextor <> nil then
749     begin
750       if ParamSearch('CCOW') = 'PATIENTONLY' then
751         RPCBrokerV.Contextor := nil
752       else
753         RPCBrokerV.Contextor := ctxContextor;
754     end
755     else
756       RPCBrokerV.Contextor := nil;
757   {$ENDIF}
758   
759     if not ConnectToServer(TX_OPTION) then
760     begin
761       if Assigned(RPCBrokerV) then
762         InfoBox(RPCBrokerV.RPCBError, 'Error', MB_OK or MB_ICONERROR);
763       Close;
764       Exit;
765     end;
766   
767     if ctxContextor <> nil then
768     begin
769       if not (ParamSearch('CCOW') = 'PATIENTONLY') then
770         ctxContextor.NotificationFilter := ctxContextor.NotificationFilter + ';User';
771     end;
772   
773     FECSAuthUser := ValidECSUser;
774     uECSReport := TECSReport.Create;
775     uECSReport.ECSPermit := FECSAuthUser;
776     RPCBrokerV.CreateContext(TX_OPTION);
777     Application.OnException := AppException;
778     FOldActivate := Application.OnActivate;
779     Application.OnActivate := AppActivated;
780     Application.OnDeActivate := AppDeActivated;
781     
782     // create initial core objects
783     FCreateProgress := FCP_OBJECTS;
784     User := TUser.Create;
785   
786     // make sure we're using the matching server version
787     FCreateProgress := FCP_CHKVER;
788     ClientVer := ClientVersion(Application.ExeName);
789     ServerVer := ServerVersion(TX_OPTION, ClientVer);
790     if (ServerVer = '0.0.0.0') then
791     begin
792       InfoBox('Unable to determine current version of server.', TX_OPTION, MB_OK);
793       Close;
794       Exit;
795     end;
796     ServerReq := Piece(FileVersionValue(Application.ExeName, FILE_VER_INTERNALNAME), ' ', 1);
797     if (ClientVer <> ServerReq) then
798     begin
799       InfoBox('Client "version" does not match client "required" server.', TC_CLIERR, MB_OK);
800       Close;
801       Exit;
802     end; 
803     SAN := sCallV('XUS PKI GET UPN', []);
804     if SAN='' then DigitalSigningSetup1.Visible := True
805     else DigitalSigningSetup1.Visible := False;
806     if (CompareVersion(ServerVer, ServerReq) <> 0) then
807     begin
808       if (sCallV('ORWU DEFAULT DIVISION', [nil]) = '1') then
809       begin
810         if (InfoBox('Proceed with mismatched Client and Server versions?', TC_CLIERR, MB_YESNO) = ID_NO) then
811         begin
812           Close;
813           Exit;
814         end;
815       end
816       else
817       begin
818         if (CompareVersion(ServerVer, ServerReq) > 0) then // Server newer than Required
819         begin
820           // NEXT LINE COMMENTED OUT - CHANGED FOR VERSION 19.16, PATCH OR*3*155:
821           //      if GetUserParam('ORWOR REQUIRE CURRENT CLIENT') = '1' then
822           if (true) then // "True" statement guarantees "required" current version client.
823           begin
824             InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD2, TC_VER, MB_OK);
825             Close;
826             Exit;
827           end;
828         end
829         else InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_OLD, TC_VER, MB_OK);
830       end;
831       if (CompareVersion(ServerVer, ServerReq) < 0) then // Server older then Required
832       begin
833         InfoBox(TX_VER1 + ClientVer + TX_VER2 + CRLF + ServerReq + TX_VER_REQ + TX_VER3 + ServerVer + '.' + TX_VER_NEW, TC_VER, MB_OK);
834         Close;
835         Exit;
836       end;
837     end;
838   
839     // Add future tabs here as they are created/implemented:
840     if (
841        (not User.HasCorTabs) and
842        (not User.HasRptTab)
843        )
844     then
845     begin
846       InfoBox('No valid tabs assigned', 'Tab Access Problem', MB_OK);
847       Close;
848       Exit;
849     end;
850   
851     // create creating core objects
852     Patient := TPatient.Create;
853     Encounter := TEncounter.Create;
854     Changes := TChanges.Create;
855     Notifications := TNotifications.Create;
856     RemoteSites := TRemoteSiteList.Create;
857     RemoteReports := TRemoteReportList.Create;
858     uTabList := TStringList.Create;
859     FlaggedPTList := TStringList.Create;
860     HasFlag  := False;
861     FlagList := TStringList.Create;
862     // set up structures specific to the user
863     Caption := TX_IN_USE + MixedCase(User.Name) + '  (' + RPCBrokerV.Server + ')';
864     SetDebugMenu;
865     if InteractiveRemindersActive then
866       NotifyWhenRemindersChange(RemindersChanged);
867     // load all the tab pages
868     FCreateProgress := FCP_FORMS;
869     //CreateTab(TObject(frmProblems), TfrmProblems, CT_PROBLEMS, 'Problems');
870     CreateTab(CT_PROBLEMS, 'Problems');
871     CreateTab(CT_MEDS,     'Meds');
872     CreateTab(CT_ORDERS,   'Orders');
873     CreateTab(CT_NOTES,    'Notes');
874     CreateTab(CT_CONSULTS, 'Consults');
875     if ShowSurgeryTab then CreateTab(CT_SURGERY,  'Surgery');
876     CreateTab(CT_DCSUMM,   'D/C Summ');
877     CreateTab(CT_LABS,     'Labs');
878     CreateTab(CT_REPORTS,  'Reports');
879     CreateTab(CT_COVER,    'Cover Sheet');
880     ShowHideChartTabMenus(mnuViewChart);
881     //  We defer calling LoadUserPreferences to UMInitiate, so that the font sizing
882     // routines recognize this as the application's main form (this hasn't been
883     // set yet).
884     FNextButtonBitmap := TBitmap.Create;
885     FNextButtonBitmap.LoadFromResourceName(hInstance, 'BMP_HANDRIGHT');
886     // set the timeout to DTIME now that there is a connection
887     UpdateTimeOutInterval(User.DTIME * 1000);  // DTIME * 1000 mSec
888     // get a patient
889     HandleNeeded;                              // make sure handle is there for ORWPT SHARE call
890     FCreateProgress := FCP_PTSEL;
891     Enabled := False;
892     FFirstLoad := True;                       // First time to initialize the fFrame
893     FCreateProgress := FCP_FINISH;
894     pnlReminders.Visible := InteractiveRemindersActive;
895     GraphFloatActive := false;
896     GraphContext := '';
897     frmGraphData := TfrmGraphData.Create(self);        // form is only visible for testing
898     GraphDataOnUser;
899     uRemoteType := '';
900     uReportID := '';
901     uLabRepID := '';
902     FPrevPtID := '';
903     SetUserTools;
904     EnduringPtSelSplitterPos := 0;
905     EnduringPtSelColumns := '';
906     if User.IsReportsOnly then // Reports Only tab.
907       ReportsOnlyDisplay; // Calls procedure to hide all components/menus not needed.
908     InitialOrderVariables;
909     PostMessage(Handle, UM_INITIATE, 0, 0);    // select patient after main form is created
910   //  mnuFileOpenClick(Self);
911   //  if Patient.DFN = '' then  //*DFN*
912   //  begin
913   //    Close;
914   //    Exit;
915   //  end;
916   //  if WindowState = wsMinimized then WindowState := wsNormal;
917     SetFormMonitoring(true);
918   end;
919   
920   procedure TfrmFrame.StartCCOWContextor;
921   begin
922     try
923       ctxContextor := TContextorControl.Create(Self);
924       with ctxContextor do
925         begin
926           OnPending := ctxContextorPending;
927           OnCommitted := ctxContextorCommitted;
928           OnCanceled := ctxContextorCanceled;
929         end;
930       FCCOWBusy := False;
931       FCCOWInstalled := True;
932       FCCOWDrivedChange := False;
933       ctxContextor.Run('CPRSChart', '', TRUE, 'Patient');
934       IsRunExecuted := True;
935     except
936       on exc : EOleException do
937       begin
938         IsRunExecuted := False;
939         FreeAndNil(ctxContextor);
940         try
941           ctxContextor := TContextorControl.Create(Self);
942           with ctxContextor do
943             begin
944               OnPending := ctxContextorPending;
945               OnCommitted := ctxContextorCommitted;
946               OnCanceled := ctxContextorCanceled;
947             end;
948           FCCOWBusy := False;
949           FCCOWInstalled := True;
950           FCCOWDrivedChange := False;
951           ctxContextor.Run('CPRSChart' + '#', '', TRUE, 'Patient');
952           IsRunExecuted := True;
953           if ParamSearch('CCOW') = 'FORCE' then
954           begin
955             mnuFileResumeContext.Enabled := False;
956             mnuFileBreakContext.Visible := True;
957             mnuFileBreakContext.Enabled := True;
958           end
959           else
960           begin
961             ctxContextor.Suspend;
962             mnuFileResumeContext.Visible := True;
963             mnuFileBreakContext.Visible := True;
964             mnuFileBreakContext.Enabled := False;
965           end;
966         except
967           IsRunExecuted := False;
968           FCCOWInstalled := False;
969           FreeAndNil(ctxContextor);
970           pnlCCOW.Visible := False;
971           mnuFileResumeContext.Visible := False;
972           mnuFileBreakContext.Visible := False;
973         end;
974       end;
975     end
976   end;
977   
978   procedure TfrmFrame.UMInitiate(var Message: TMessage);
979   begin
980     NotifyOtherApps(NAE_OPEN, IntToStr(User.DUZ));
981     LoadUserPreferences;
982     GetBAStatus(User.DUZ,Patient.DFN);
983     mnuFileOpenClick(Self);
984     Enabled := True;
985     // If TimedOut, Close has already been called.
986     if not TimedOut and (Patient.DFN = '') then Close;
987   end;
988   
989   procedure TfrmFrame.FormDestroy(Sender: TObject);
990   { free core objects used by CPRS }
991   begin
992     Application.OnActivate := FOldActivate;
993     Screen.OnActiveFormChange := FOldActiveFormChange;
994     FNextButtonBitmap.Free;
995     if FNextButton <> nil then FNextButton.Free;
996     uTabList.Free;
997     FlaggedPTList.Free;
998     RemoteSites.Free;
999     RemoteReports.Free;
1000    Notifications.Free;
1001    Changes.Free;
1002    Encounter.Free;
1003    Patient.Free;
1004    User.Free;
1005    SizeHolder.Free;
1006    ctxContextor.Free;
1007  end;
1008  
1009  procedure TfrmFrame.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
1010  { cancels close if the user cancels the ReviewChanges screen }
1011  var
1012    Reason: string;
1013  begin
1014    if (FCreateProgress < FCP_FINISH) then Exit;
1015    if User.IsReportsOnly then // Reports Only tab.
1016      exit;
1017    if TimedOut then
1018      begin
1019        if Changes.RequireReview then ReviewChanges(TimedOut);
1020        Exit;
1021      end;
1022    if not AllowContextChangeAll(Reason) then CanClose := False;
1023  end;
1024  
1025  procedure TfrmFrame.SetUserTools;
1026  var
1027    item, parent: TToolMenuItem;
1028    ok: boolean;
1029    index, i, idx, count: Integer;
1030    UserTool: TMenuItem;
1031    Menus: TStringList;
1032    //  OptionsClick: TNotifyEvent;
1033  begin
1034    if User.IsReportsOnly then // Reports Only tab.
1035    begin
1036      mnuTools.Clear; // Remove all current items.
1037      UserTool := TMenuItem.Create(Self);
1038      UserTool.Caption := 'Options...';
1039      UserTool.Hint := 'Options';
1040      UserTool.OnClick := mnuToolsOptionsClick;
1041      mnuTools.Add(UserTool); // Add back the "Options" menu.
1042      exit;
1043    end;
1044    if User.GECStatus then
1045    begin
1046      UserTool := TMenuItem.Create(self);
1047      UserTool.Caption := 'GEC Referral Status Display';
1048      UserTool.Hint := 'GEC Referral Status Display';
1049      UserTool.OnClick := mnuGECStatusClick;
1050      mnuTools.Add(UserTool); // Add back the "Options" menu.
1051      //exit;
1052    end;
1053    GetToolMenu; // For all other users, proceed normally with creation of Tools menu:
1054    for i := uToolMenuItems.Count-1 downto 0 do
1055    begin
1056      item := TToolMenuItem(uToolMenuItems[i]);
1057      if (AnsiCompareText(item.Caption, 'Event Capture Interface') = 0 ) and
1058         (not uECSReport.ECSPermit) then
1059      begin
1060        uToolMenuItems.Delete(i);
1061        Break;
1062      end;
1063    end;
1064    Menus := TStringList.Create;
1065    try
1066      count := 0;
1067      idx := 0;
1068      index := 0;
1069      while count < uToolMenuItems.Count do
1070      begin
1071        for I := 0 to uToolMenuItems.Count - 1 do
1072        begin
1073          item := TToolMenuItem(uToolMenuItems[i]);
1074          if assigned(item.MenuItem) then continue;        
1075          if item.SubMenuID = '' then
1076            ok := True
1077          else
1078          begin
1079            idx := Menus.IndexOf(item.SubMenuID);
1080            ok := (idx >= 0);
1081          end;
1082          if ok then
1083          begin
1084            inc(count);
1085            UserTool := TMenuItem.Create(Self);
1086            UserTool.Caption := Item.Caption;
1087            if Item.Action <> '' then
1088            begin
1089              UserTool.Hint := Item.Action;
1090              UserTool.OnClick := ToolClick;
1091            end;
1092            Item.MenuItem := UserTool;
1093            if item.SubMenuID = '' then
1094            begin
1095              mnuTools.Insert(Index,UserTool);
1096              inc(Index);
1097            end
1098            else
1099            begin
1100              parent := TToolMenuItem(Menus.Objects[idx]);
1101              parent.MenuItem.Add(UserTool);
1102            end;
1103            if item.MenuID <> '' then
1104              Menus.AddObject(item.MenuID, item);
1105          end;
1106        end;
1107      end;
1108    finally
1109      Menus.Free;
1110    end;
1111    FreeAndNil(uToolMenuItems);
1112  end;
1113  
1114  procedure TfrmFrame.UpdateECSParameter(var CmdParameter: string);  //ECS
1115  var
1116    vstID,AccVer,Svr,SvrPort,VUser: string;
1117  begin
1118    AccVer  := '';
1119    Svr     := '';
1120    SvrPort := '';
1121    VUser   := '';
1122    if RPCBrokerV <> nil then
1123    begin
1124      AccVer  := RPCBrokerV.AccessVerifyCodes;
1125      Svr     := RPCBrokerV.Server;
1126      SvrPort := IntToStr(RPCBrokerV.ListenerPort);
1127      VUser   := RPCBrokerV.User.DUZ;
1128    end;
1129    vstID := GetVisitID;
1130    CmdParameter :=' Svr=' +Svr
1131                   +' SvrPort='+SvrPort
1132                   +' VUser='+ VUser
1133                   +' PtIEN='+ Patient.DFN
1134                   +' PdIEN='+IntToStr(Encounter.Provider)
1135                   +' vstIEN='+vstID
1136                   +' locIEN='+IntToStr(Encounter.Location)
1137                   +' Date=0'
1138                   +' Division='+GetDivisionID;
1139  
1140  end;
1141  
1142  procedure TfrmFrame.compAccessTabPageCaptionQuery(Sender: TObject;
1143    var Text: string);
1144  begin
1145    Text := GetTabText;
1146  end;
1147  
1148  function TfrmFrame.ValidECSUser: boolean;   //ECS
1149  var
1150    isTrue: boolean;
1151  begin
1152    Result := True;
1153    with RPCBrokerV do
1154    begin
1155      ShowErrorMsgs := semQuiet;
1156      Connected     := True;
1157     try
1158        isTrue := CreateContext(TX_ECSOPT);
1159        if not isTrue then
1160          Result := False;
1161        ShowErrorMsgs := semRaise;
1162      except
1163        on E: Exception do
1164        begin
1165          ShowErrorMsgs := semRaise;
1166          Result := False;
1167        end;
1168      end;
1169    end;
1170  end;
1171  
1172  procedure TfrmFrame.FormClose(Sender: TObject; var Action: TCloseAction);
1173  begin
1174    FClosing := TRUE;
1175    SetFormMonitoring(false);
1176    if FCreateProgress < FCP_FINISH then FTerminate := True;
1177  
1178    FlushNotifierBuffer;
1179    if FCreateProgress = FCP_FINISH then NotifyOtherApps(NAE_CLOSE, '');
1180    TerminateOtherAppNotification;
1181  
1182    if GraphFloat <> nil then
1183    begin
1184      if frmFrame.GraphFloatActive then
1185        GraphFloat.Close;
1186      GraphFloat.Release;
1187    end;
1188  
1189    // unhook the timeout hooks
1190    ShutDownTimeOut;
1191    // clearing changes will unlock notes
1192    if FCreateProgress = FCP_FINISH then Changes.Clear;
1193    // clear server side flag global tmp
1194    if FCreateProgress = FCP_FINISH then ClearFlag;
1195    // save user preferences
1196    if FCreateProgress = FCP_FINISH then SaveUserPreferences;
1197    // call close for each page in case there is any special processing
1198    if FCreateProgress > FCP_FORMS then
1199    begin
1200      mnuFrame.Merge(nil);
1201      frmCover.Close;      //frmCover.Release;
1202      frmProblems.Close;   //frmProblems.Release;
1203      frmMeds.Close;       //frmMeds.Release;
1204      frmOrders.Close;     //frmOrders.Release;
1205      frmNotes.Close;      //frmNotes.Release;
1206      frmConsults.Close;   //frmConsults.Release;
1207      frmDCSumm.Close;     //frmDCSumm.Release;
1208      if Assigned(frmSurgery) then frmSurgery.Close;    //frmSurgery.Release;
1209      frmLabs.Close;       //frmLabs.Release;
1210      frmReports.Close;    //frmReports.Release;
1211      frmGraphData.Close;  //frmGraphData.Release;
1212    
1213    end;
1214  //  with mnuTools do for i := Count - 1 downto 0 do
1215  //  begin
1216  //    UserTool := Items[i];
1217  //    if UserTool <> nil then
1218  //    begin
1219  //      Delete(i);
1220  //      UserTool.Free;
1221  //    end;
1222  //  end;
1223    //Application.ProcessMessages;  // so everything finishes closing
1224    // if < FCP_FINISH we came here from inside FormCreate, so need to call terminate
1225    //if GraphFloat <> nil then GraphFloat.Release;
1226    if FCreateProgress < FCP_FINISH then Application.Terminate;
1227  end;
1228  
1229  procedure TfrmFrame.SetDebugMenu;
1230  var
1231    IsProgrammer: Boolean;
1232  begin
1233    IsProgrammer := User.HasKey('XUPROGMODE') or (ShowRPCList = True);
1234    mnuHelpBroker.Visible  := IsProgrammer;
1235    mnuHelpLists.Visible   := IsProgrammer;
1236    mnuHelpSymbols.Visible := IsProgrammer;
1237    Z6.Visible             := IsProgrammer;
1238  end;
1239  
1240  { Updates posted to MainForm --------------------------------------------------------------- }
1241  
1242  procedure TfrmFrame.UMNewOrder(var Message: TMessage);
1243  { post a notice of change in orders to all TPages, wParam=OrderAction, lParam=TOrder }
1244  var
1245    OrderAct: string;
1246  begin
1247    with Message do
1248    begin
1249      frmCover.NotifyOrder(WParam, TOrder(LParam));
1250      frmProblems.NotifyOrder(WParam, TOrder(LParam));
1251      frmMeds.NotifyOrder(WParam, TOrder(LParam));
1252      frmOrders.NotifyOrder(WParam, TOrder(LParam));
1253      frmNotes.NotifyOrder(WParam, TOrder(LParam));
1254      frmConsults.NotifyOrder(WParam, TOrder(LParam));
1255      frmDCSumm.NotifyOrder(WParam, TOrder(LParam));
1256      if Assigned(frmSurgery) then frmSurgery.NotifyOrder(WParam, TOrder(LParam));
1257      frmLabs.NotifyOrder(WParam, TOrder(LParam));
1258      frmReports.NotifyOrder(WParam, TOrder(LParam));
1259      lblPtCWAD.Caption := GetCWADInfo(Patient.DFN);
1260      if Length(lblPtCWAD.Caption) > 0
1261        then lblPtPostings.Caption := 'Postings'
1262        else lblPtPostings.Caption := 'No Postings';
1263      pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption;
1264      OrderAct := '';
1265      case WParam of
1266      ORDER_NEW:   OrderAct := 'NW';
1267      ORDER_DC:    OrderAct := 'DC';
1268      ORDER_RENEW: OrderAct := 'RN';
1269      ORDER_HOLD:  OrderAct := 'HD';
1270      ORDER_EDIT:  OrderAct := 'XX';
1271      ORDER_ACT:   OrderAct := 'AC';
1272      end;
1273      if Length(OrderAct) > 0 then NotifyOtherApps(NAE_ORDER, OrderAct + U + TOrder(LParam).ID);  // add FillerID
1274    end;
1275  end;
1276  
1277  { Tab Selection (navigate between pages) --------------------------------------------------- }
1278  
1279  procedure TfrmFrame.WMSetFocus(var Message: TMessage);
1280  begin
1281    if (FLastPage <> nil) and (not TimedOut) and
1282       (not (csDestroying in FLastPage.ComponentState)) and FLastPage.Visible
1283      then FLastPage.FocusFirstControl;
1284  end;
1285  
1286  procedure TfrmFrame.UMShowPage(var Message: TMessage);
1287  { shows a page when the UM_SHOWPAGE message is received }
1288  begin
1289    if FCCOWDrivedChange then FCCOWDrivedChange := False;
1290    if FLastPage <> nil then FLastPage.DisplayPage;
1291    FChangeSource := CC_CLICK;  // reset to click so we're only dealing with exceptions to click
1292    if assigned(FTabChanged) then
1293      FTabChanged(Self);
1294  end;
1295  
1296  procedure TfrmFrame.SwitchToPage(NewForm: TfrmPage);
1297  { unmerge/merge menus, bring page to top of z-order, call form-specific OnDisplay code }
1298  begin
1299    if FLastPage = NewForm then
1300      begin
1301        if Notifications.Active and Assigned(NewForm) then PostMessage(Handle, UM_SHOWPAGE, 0, 0);
1302        Exit;
1303      end;
1304    if (FLastPage <> nil) then
1305    begin
1306      mnuFrame.Unmerge(FLastPage.Menu);
1307      FLastPage.Hide;
1308    end;
1309    if Assigned(NewForm) then
1310    begin
1311      {if ((FLastPage = frmOrders) and (NewForm.Name <> frmMeds.Name))
1312        or ((FLastPage = frmMeds) and (NewForm.Name <> frmOrders.Name)) then
1313      begin
1314        if not CloseOrdering then
1315          Exit;
1316      end;}
1317      mnuFrame.Merge(NewForm.Menu);
1318      NewForm.Show;
1319    end;
1320    lstCIRNLocations.Visible := False;
1321    pnlCIRN.BevelOuter := bvRaised;
1322    lstCIRNLocations.SendToBack;
1323    mnuFilePrint.Enabled := False;           // let individual page enable this
1324    mnuFilePrintSetup.Enabled := False;      // let individual page enable this
1325    mnuFilePrintSelectedItems.Enabled := False;
1326    FLastPage := NewForm;
1327    if NewForm <> nil then
1328    begin
1329      if NewForm.Name = frmNotes.Name then frmNotes.Align := alClient
1330        else frmNotes.Align := alNone;
1331      if NewForm.Name = frmConsults.Name then frmConsults.Align := alClient
1332        else frmConsults.Align := alNone;
1333      if NewForm.Name = frmReports.Name then frmReports.Align := alClient
1334        else frmReports.Align := alNone;
1335      if NewForm.Name = frmDCSumm.Name then frmDCSumm.Align := alClient
1336        else frmDCSumm.Align := alNone;
1337      if Assigned(frmSurgery) then
1338        if NewForm.Name = frmSurgery.Name then frmSurgery.Align := alclient
1339          else frmSurgery.Align := alNone;
1340      NewForm.BringToFront;                    // to cause tab switch to happen immediately
1341  //CQ12232 NewForm.FocusFirstControl;
1342      Application.ProcessMessages;
1343      PostMessage(Handle, UM_SHOWPAGE, 0, 0);  // this calls DisplayPage for the form
1344    end;
1345  end;
1346  
1347  procedure TfrmFrame.mnuChartTabClick(Sender: TObject);
1348  { use the Tag property of the menu item to switch to proper page }
1349  begin
1350    with Sender as TMenuItem do tabPage.TabIndex := PageIDToTab(Tag);
1351    LastTab := TabToPageID(tabPage.TabIndex) ;
1352    tabPageChange(tabPage);
1353  end;
1354  
1355  procedure TfrmFrame.tabPageChange(Sender: TObject);
1356  { switches to form linked to NewTab }
1357  var
1358    PageID : integer;
1359  begin
1360    PageID := TabToPageID((sender as TTabControl).TabIndex);
1361    if (PageID <> CT_NOPAGE) and (TabPage.CanFocus) and Assigned(FLastPage) and
1362       (not TabPage.Focused) then
1363      TabPage.SetFocus;  //CQ: 14854
1364    if (not User.IsReportsOnly) then
1365    begin
1366      case PageID of
1367        CT_NOPAGE:   SwitchToPage(nil);
1368        CT_COVER:    SwitchToPage(frmCover);
1369        CT_PROBLEMS: SwitchToPage(frmProblems);
1370        CT_MEDS:     SwitchToPage(frmMeds);
1371        CT_ORDERS:   SwitchToPage(frmOrders);
1372        CT_NOTES:    SwitchToPage(frmNotes);
1373        CT_CONSULTS: SwitchToPage(frmConsults);
1374        CT_DCSUMM:   SwitchToPage(frmDCSumm);
1375        CT_SURGERY:  SwitchToPage(frmSurgery);
1376        CT_LABS:     SwitchToPage(frmLabs);
1377        CT_REPORTS:  SwitchToPage(frmReports);
1378      end; {case}
1379    end
1380    else // Reports Only tab.
1381      SwitchToPage(frmReports);
1382    if ScreenReaderSystemActive and FCtrlTabUsed then
1383      SpeakPatient;
1384    ChangingTab := PageID;
1385  end;
1386  
1387  function TfrmFrame.PageIDToTab(PageID: Integer): Integer;
1388  { returns the tab index that corresponds to a given PageID }
1389  VAR
1390    i: integer;
1391  begin
1392    i :=  uTabList.IndexOf(IntToStr(PageID));
1393    Result := i;
1394    //Result := uTabList.IndexOf(IntToStr(PageID));
1395    (*
1396    Result := -1;
1397    case PageID of
1398      CT_NOPAGE:   Result := -1;
1399      CT_COVER:    Result :=  0;
1400      CT_PROBLEMS: Result :=  1;
1401      CT_MEDS:     Result :=  2;
1402      CT_ORDERS:   Result :=  3;
1403     {CT_HP:       Result :=  4;}
1404      CT_NOTES:    Result :=  4;
1405      CT_CONSULTS: Result :=  5;
1406      CT_DCSUMM:   Result :=  6;
1407      CT_LABS:     Result :=  7;
1408      CT_REPORTS:  Result :=  8;
1409    end;*)
1410  end;
1411  
1412  function TfrmFrame.TabToPageID(Tab: Integer): Integer;
1413  { returns the constant that identifies the page given a TabIndex }
1414  begin
1415    if (Tab > -1) and (Tab < uTabList.Count) then
1416      Result := StrToIntDef(uTabList[Tab], CT_UNKNOWN)
1417    else
1418      Result := CT_NOPAGE;
1419  (*  case Tab of
1420     -1: Result := CT_NOPAGE;
1421      0: Result := CT_COVER;
1422      1: Result := CT_PROBLEMS;
1423      2: Result := CT_MEDS;
1424      3: Result := CT_ORDERS;
1425     {4: Result := CT_HP;}
1426      4: Result := CT_NOTES;
1427      5: Result := CT_CONSULTS;
1428      6: Result := CT_DCSUMM;
1429      7: Result := CT_LABS;
1430      8: Result := CT_REPORTS;
1431    end;*)
1432  end;
1433  
1434  { File Menu Events ------------------------------------------------------------------------- }
1435  
1436  procedure TfrmFrame.SetupPatient(AFlaggedList : TStringList);
1437  var
1438    AMsg, SelectMsg: string;
1439  begin
1440    with Patient do
1441    begin
1442      ClearPatient;  // must be called to avoid leaving previous patient's information visible!
1443      btnCombatVet.Caption := 'CV '+ CombatVet.ExpirationDate;
1444      btnCombatVet.Visible := Patient.CombatVet.IsEligible;
1445      Visible := True;
1446      Application.ProcessMessages;
1447      lblPtName.Caption := Name + Status; //CQ #17491: Allow for the display of the patient status indicator in header bar.
1448      lblPtSSN.Caption := SSN;
1449      lblPtAge.Caption := FormatFMDateTime('mmm dd,yyyy', DOB) + ' (' + IntToStr(Age) + ')';
1450      pnlPatient.Caption := lblPtName.Caption + ' ' + lblPtSSN.Caption + ' ' + lblPtAge.Caption;
1451      if Length(CWAD) > 0
1452        then lblPtPostings.Caption := 'Postings'
1453        else lblPtPostings.Caption := 'No Postings';
1454      lblPtCWAD.Caption := CWAD;
1455      pnlPostings.Caption := lblPtPostings.Caption + ' ' + lblPtCWAD.Caption;
1456      if (Length(PrimaryTeam) > 0) or (Length(PrimaryProvider) > 0) then
1457      begin
1458        lblPtCare.Caption := PrimaryTeam + ' / ' + MixedCase(PrimaryProvider);
1459        if Length(Associate)>0 then lblPtCare.Caption :=  lblPtCare.Caption + ' / ' + MixedCase(Associate);
1460      end;
1461      if Length(Attending) > 0 then lblPtAttending.Caption := '(Inpatient) Attending:  ' + MixedCase(Attending);
1462      pnlPrimaryCare.Caption := lblPtCare.Caption + ' ' + lblPtAttending.Caption;
1463      if Length(InProvider) > 0  then lblPtAttending.Caption := lblPtAttending.Caption + ' - (Inpatient) Provider: ' + MixedCase(InProvider);
1464      if Length(MHTC) > 0 then lblPtMHTC.Caption := 'MH Treatment Coordinator: ' + MixedCase(MHTC);
1465      if (Length(MHTC) = 0) and (Inpatient = True) and (SpecialtySvc = 'P') then
1466        lblPtMHTC.Caption := 'MH Treatment Coordinator Unassigned';
1467      pnlPrimaryCare.Caption := lblPtCare.Caption + ' ' + lblPtAttending.Caption + ' ' + lblPtMHTC.Caption;
1468      SetUpCIRN;
1469      DisplayEncounterText;
1470      SetShareNode(DFN, Handle);
1471      with Patient do
1472        NotifyOtherApps(NAE_NEWPT, SSN + U + FloatToStr(DOB) + U + Name);
1473      SelectMsg := '';
1474      if MeansTestRequired(Patient.DFN, AMsg) then SelectMsg := AMsg;
1475      if HasLegacyData(Patient.DFN, AMsg)     then SelectMsg := SelectMsg + CRLF + AMsg;
1476  
1477      HasActiveFlg(FlagList, HasFlag, Patient.DFN);
1478      if HasFlag then
1479      begin
1480        pnlFlag.Enabled := True;
1481        lblFlag.Font.Color := Get508CompliantColor(clMaroon);
1482        lblFlag.Enabled := True;
1483        if (not FReFreshing) and (TriggerPRFPopUp(Patient.DFN)) then
1484          ShowFlags;
1485      end else
1486      begin
1487        pnlFlag.Enabled := False;
1488        lblFlag.Font.Color := clBtnFace;
1489        lblFlag.Enabled := False;
1490      end;
1491      FPrevPtID := patient.DFN;
1492      frmCover.UpdateVAAButton; //VAA CQ7525  (moved here in v26.30 (RV))
1493      ProcessPatientChangeEventHook;
1494      if Length(SelectMsg) > 0 then ShowPatientSelectMessages(SelectMsg);
1495    end;
1496  end;
1497  
1498  procedure TfrmFrame.mnuFileNextClick(Sender: TObject);
1499  var
1500    SaveDFN, NewDFN: string; // *DFN*
1501    NextIndex: Integer;
1502    Reason: string;
1503    CCOWResponse: UserResponse;
1504    AccessStatus: integer;
1505  
1506      procedure UpdatePatientInfoForAlert;
1507      begin
1508        if Patient.Inpatient then
1509        begin
1510          Encounter.Inpatient := True;
1511          Encounter.Location := Patient.Location;
1512          Encounter.DateTime := Patient.AdmitTime;
1513          Encounter.VisitCategory := 'H';
1514        end;
1515        if User.IsProvider then Encounter.Provider := User.DUZ;
1516        SetupPatient(FlaggedPTList);
1517        if (FlaggedPTList.IndexOf(Patient.DFN) < 0) then
1518          FlaggedPTList.Add(Patient.DFN);
1519      end;
1520  
1521  begin
1522    DoNotChangeEncWindow := False;
1523    OrderPrintForm := False;
1524    mnuFile.Tag := 0;
1525    SaveDFN := Patient.DFN;
1526    Notifications.Next;
1527    if Notifications.Active then
1528    begin
1529      NewDFN := Notifications.DFN;
1530      //Patient.DFN := Notifications.DFN;
1531      //if SaveDFN <> Patient.DFN then
1532      if SaveDFN <> NewDFN then
1533      begin
1534        // newdfn does not have new patient.co information for CCOW call
1535        if ((Sender = mnuFileOpen) or (AllowContextChangeAll(Reason)))
1536            and AllowAccessToSensitivePatient(NewDFN, AccessStatus) then
1537        begin
1538          RemindersStarted := FALSE;
1539          Patient.DFN := NewDFN;
1540          Encounter.Clear;
1541          Changes.Clear;
1542          if Assigned(FlagList) then
1543          begin
1544           FlagList.Clear;
1545           HasFlag := False;
1546           HasActiveFlg(FlagList, HasFlag, NewDFN);
1547          end;
1548          if FCCOWInstalled and (ctxContextor.State = csParticipating) then
1549            begin
1550              if (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
1551                UpdatePatientInfoForAlert
1552              else
1553                begin
1554                  case CCOWResponse of
1555                    urCancel:
1556                      begin
1557                        Patient.DFN := SaveDFN;
1558                        Notifications.Prior;
1559                        Exit;
1560                      end;
1561                    urBreak:
1562                      begin
1563                        // do not revert to old DFN if context was manually broken by user - v26 (RV)
1564                        if (ctxContextor.State = csParticipating) then Patient.DFN := SaveDFN;
1565                        UpdatePatientInfoForAlert;
1566                      end;
1567                    else
1568                      UpdatePatientInfoForAlert;
1569                  end;
1570                end;
1571            end
1572          else
1573            UpdatePatientInfoForAlert
1574        end else
1575        begin
1576          if AccessStatus in [DGSR_ASK, DGSR_DENY] then
1577          begin
1578            Notifications.Clear;
1579            // hide the 'next notification' button
1580            FNextButtonActive := False;
1581            FNextButton.Free;
1582            FNextButton := nil;
1583            mnuFileNext.Enabled := False;
1584            mnuFileNotifRemove.Enabled := False;
1585            Patient.DFN := '';
1586            mnuFileOpenClick(mnuFileNext);
1587            exit;
1588          end
1589          else
1590          if SaveDFN <> '' then
1591          begin
1592            Patient.DFN := SaveDFN;
1593            Notifications.Prior;
1594            Exit;
1595          end
1596          else
1597          begin
1598            Notifications.Clear;
1599  (*          // hide the 'next notification' button
1600            FNextButtonActive := False;
1601            FNextButton.Free;
1602            FNextButton := nil;
1603            mnuFileNext.Enabled := False;
1604            mnuFileNotifRemove.Enabled := False;*)
1605            Patient.DFN := '';
1606            mnuFileOpenClick(mnuFileNext);
1607            exit;
1608          end;
1609        end;
1610      end;
1611      stsArea.Panels.Items[1].Text := Notifications.Text;
1612      FChangeSource := CC_NOTIFICATION;
1613      NextIndex := PageIDToTab(CT_COVER);
1614      tabPage.TabIndex := CT_NOPAGE;
1615      tabPageChange(tabPage);
1616      mnuFileNotifRemove.Enabled := Notifications.Followup in [NF_FLAGGED_ORDERS,
1617                                                               NF_ORDER_REQUIRES_ELEC_SIGNATURE,
1618                                                               NF_MEDICATIONS_EXPIRING_INPT,
1619                                                               NF_MEDICATIONS_EXPIRING_OUTPT,
1620                                                               NF_UNVERIFIED_MEDICATION_ORDER,
1621                                                               NF_UNVERIFIED_ORDER,
1622                                                               NF_FLAGGED_OI_EXP_INPT,
1623                                                               NF_FLAGGED_OI_EXP_OUTPT];
1624      case Notifications.FollowUp of
1625      NF_LAB_RESULTS                   : NextIndex := PageIDToTab(CT_LABS);
1626      NF_FLAGGED_ORDERS                : NextIndex := PageIDToTab(CT_ORDERS);
1627      NF_ORDER_REQUIRES_ELEC_SIGNATURE : NextIndex := PageIDToTab(CT_ORDERS);
1628      NF_ABNORMAL_LAB_RESULTS          : NextIndex := PageIDToTab(CT_LABS);
1629      NF_IMAGING_RESULTS               : NextIndex := PageIDToTab(CT_REPORTS);
1630      NF_CONSULT_REQUEST_RESOLUTION    : NextIndex := PageIDToTab(CT_CONSULTS);
1631      NF_ABNORMAL_IMAGING_RESULTS      : NextIndex := PageIDToTab(CT_REPORTS);
1632      NF_IMAGING_REQUEST_CANCEL_HELD   : NextIndex := PageIDToTab(CT_ORDERS);
1633      NF_NEW_SERVICE_CONSULT_REQUEST   : NextIndex := PageIDToTab(CT_CONSULTS);
1634      NF_CONSULT_REQUEST_CANCEL_HOLD   : NextIndex := PageIDToTab(CT_CONSULTS);
1635      NF_SITE_FLAGGED_RESULTS          : NextIndex := PageIDToTab(CT_ORDERS);
1636      NF_ORDERER_FLAGGED_RESULTS       : NextIndex := PageIDToTab(CT_ORDERS);
1637      NF_ORDER_REQUIRES_COSIGNATURE    : NextIndex := PageIDToTab(CT_ORDERS);
1638      NF_LAB_ORDER_CANCELED            : NextIndex := PageIDToTab(CT_ORDERS);
1639      NF_STAT_RESULTS                  :
1640        if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'LRCH' then
1641          NextIndex := PageIDToTab(CT_LABS)
1642        else if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'GMRC' then
1643          NextIndex := PageIDToTab(CT_CONSULTS)
1644        else if Piece(Piece(Notifications.AlertData, '|', 2), '@', 2) = 'RA' then
1645          NextIndex := PageIDToTab(CT_REPORTS);
1646      NF_DNR_EXPIRING                  : NextIndex := PageIDToTab(CT_ORDERS);
1647      NF_MEDICATIONS_EXPIRING_INPT     : NextIndex := PageIDToTab(CT_ORDERS);
1648      NF_MEDICATIONS_EXPIRING_OUTPT    : NextIndex := PageIDToTab(CT_ORDERS);
1649      NF_UNVERIFIED_MEDICATION_ORDER   : NextIndex := PageIDToTab(CT_ORDERS);
1650      NF_NEW_ORDER                     : NextIndex := PageIDToTab(CT_ORDERS);
1651      NF_IMAGING_RESULTS_AMENDED       : NextIndex := PageIDToTab(CT_REPORTS);
1652      NF_CRITICAL_LAB_RESULTS          : NextIndex := PageIDToTab(CT_LABS);
1653      NF_UNVERIFIED_ORDER              : NextIndex := PageIDToTab(CT_ORDERS);
1654      NF_FLAGGED_OI_RESULTS            : NextIndex := PageIDToTab(CT_ORDERS);
1655      NF_FLAGGED_OI_ORDER              : NextIndex := PageIDToTab(CT_ORDERS);
1656      NF_DC_ORDER                      : NextIndex := PageIDToTab(CT_ORDERS);
1657      NF_DEA_AUTO_DC_CS_MED_ORDER      : NextIndex := PageIDToTab(CT_ORDERS);
1658      NF_DEA_CERT_REVOKED              : NextIndex := PageIDToTab(CT_ORDERS);
1659      NF_CONSULT_UNSIGNED_NOTE         : NextIndex := PageIDToTab(CT_CONSULTS);
1660      NF_DCSUMM_UNSIGNED_NOTE          : NextIndex := PageIDToTab(CT_DCSUMM);
1661      NF_NOTES_UNSIGNED_NOTE           : NextIndex := PageIDToTab(CT_NOTES);
1662      NF_CONSULT_REQUEST_UPDATED       : NextIndex := PageIDToTab(CT_CONSULTS);
1663      NF_FLAGGED_OI_EXP_INPT           : NextIndex := PageIDToTab(CT_ORDERS);
1664      NF_FLAGGED_OI_EXP_OUTPT          : NextIndex := PageIDToTab(CT_ORDERS);
1665      NF_CONSULT_PROC_INTERPRETATION   : NextIndex := PageIDToTab(CT_CONSULTS);
1666      NF_IMAGING_REQUEST_CHANGED       :
1667          begin
1668             ReportBox(GetNotificationFollowUpText(Patient.DFN, Notifications.FollowUp, Notifications.AlertData), Pieces(Piece(Notifications.RecordID, U, 1), ':', 2, 3), True);
1669             Notifications.Delete;
1670          end;
1671      NF_LAB_THRESHOLD_EXCEEDED        : NextIndex := PageIDToTab(CT_LABS);
1672      NF_MAMMOGRAM_RESULTS             : NextIndex := PageIDToTab(CT_REPORTS);
1673      NF_PAP_SMEAR_RESULTS             : NextIndex := PageIDToTab(CT_REPORTS);
1674      NF_ANATOMIC_PATHOLOGY_RESULTS    : NextIndex := PageIDToTab(CT_REPORTS);
1675      NF_SURGERY_UNSIGNED_NOTE         : if TabExists(CT_SURGERY) then
1676                                           NextIndex := PageIDToTab(CT_SURGERY)
1677                                         else
1678                                           InfoBox(TX_NO_SURG_NOTIF, TC_NO_SURG_NOTIF, MB_OK);
1679                                           //NextIndex := PageIDToTab(CT_NOTES);
1680      else InfoBox(TX_UNK_NOTIF, TC_UNK_NOTIF, MB_OK);
1681      end;
1682      tabPage.TabIndex := NextIndex;
1683      tabPageChange(tabPage);
1684    end
1685    else mnuFileOpenClick(mnuFileNext);
1686  end;
1687  
1688  procedure TfrmFrame.SetBADxList;
1689  var
1690    i: smallint;
1691  begin
1692    if not Assigned(UBAGlobals.tempDxList) then
1693       begin
1694       UBAGlobals.tempDxList := TList.Create;
1695       UBAGlobals.tempDxList.Count := 0;
1696       Application.ProcessMessages;
1697       end
1698    else
1699       begin
1700       //Kill the old Dx list
1701       for i := 0 to pred(UBAGlobals.tempDxList.Count) do
1702          TObject(UBAGlobals.tempDxList[i]).Free;
1703  
1704       UBAGlobals.tempDxList.Clear;
1705       Application.ProcessMessages;
1706  
1707       //Create new Dx list for newly selected patient
1708        if not Assigned(UBAGlobals.tempDxList) then
1709           begin
1710           UBAGlobals.tempDxList := TList.Create;
1711           UBAGlobals.tempDxList.Count := 0;
1712           Application.ProcessMessages;
1713           end;
1714       end;
1715  end;
1716  
1717  procedure TfrmFrame.mnuFileOpenClick(Sender: TObject);
1718  { select a new patient & update the header displays (patient id, encounter, postings) }
1719  var
1720    SaveDFN, Reason: string;
1721    //NextTab: Integer;     // moved up for visibility - v23.4  rV
1722    ok, OldRemindersStarted, PtSelCancelled: boolean;
1723    //i: smallint;
1724    CCOWResponse: UserResponse;
1725  begin
1726    pnlPatient.Enabled := false;
1727    if (Sender = mnuFileOpen) or (FRefreshing) then PTSwitchRefresh := True
1728    else PTSwitchRefresh := False;  //part of a change to CQ #11529
1729    PtSelCancelled := FALSE;
1730    if not FRefreshing then mnuFile.Tag := 0
1731    else mnuFile.Tag := 1;
1732    DetermineNextTab;
1733  (*  if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
1734      NextTab := TabToPageID(tabPage.TabIndex)
1735    else
1736      NextTab := User.InitialTab;
1737    if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1738    if User.IsReportsOnly then // Reports Only tab.
1739      NextTab := 0; // Only one tab should exist by this point in "REPORTS ONLY" mode.
1740    if not TabExists(NextTab) then NextTab := CT_COVER;
1741    if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1742    if NextTab = CT_ORDERS then
1743      if frmOrders <> nil then with frmOrders do
1744      begin
1745        if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
1746          PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
1747      end;*)
1748    //if Sender <> mnuFileNext then        //CQ 16273 & 16419 - Missing Review/Sign Changes dialog when clicking 'Next' button.
1749      if not AllowContextChangeAll(Reason) then
1750        begin
1751          pnlPatient.Enabled := True;
1752          Exit;
1753        end;
1754    // update status text here
1755    stsArea.Panels.Items[1].Text := '';
1756    if (not User.IsReportsOnly) then
1757    begin
1758      if not FRefreshing then
1759      begin
1760        Notifications.Next;   // avoid prompt if no more alerts selected to process  {v14a RV}
1761        if Notifications.Active then
1762        begin
1763          if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
1764          begin
1765            Notifications.Prior;
1766            pnlPatient.Enabled := True;
1767            Exit;
1768          end;
1769        end;
1770        if Notifications.Active then Notifications.Prior;
1771      end;
1772    end;
1773  
1774    if FNoPatientSelected then
1775      SaveDFN := ''
1776    else
1777      SaveDFN := Patient.DFN;
1778      
1779    OldRemindersStarted := RemindersStarted;
1780    RemindersStarted := FALSE;
1781    try
1782      if FRefreshing then
1783      begin
1784        UpdatePtInfoOnRefresh;
1785        ok := TRUE;
1786      end
1787      else
1788      begin
1789        ok := FALSE;
1790        if (not User.IsReportsOnly) then
1791        begin
1792          if FCCOWInstalled and (ctxContextor.State = csParticipating) then
1793            begin
1794              UpdateCCOWContext;
1795              if not FCCOWError then
1796              begin
1797                FCCOWIconName := 'BMP_CCOW_LINKED';
1798                pnlCCOW.Hint := TX_CCOW_LINKED;
1799                imgCCOW.Picture.Bitmap.LoadFromResourceName(hInstance, FCCOWIconName);
1800              end;
1801            end
1802          else
1803            begin
1804              FCCOWIconName := 'BMP_CCOW_BROKEN';
1805              pnlCCOW.Hint := TX_CCOW_BROKEN;
1806              imgCCOW.Picture.BitMap.LoadFromResourceName(hInstance, FCCOWIconName);
1807            end;
1808          if (Patient.DFN = '') or (Sender = mnuFileOpen) or (Sender = mnuFileNext) or (Sender = mnuViewDemo) then
1809            SelectPatient(SHOW_NOTIFICATIONS, Font.Size, PtSelCancelled);
1810          if PtSelCancelled then
1811            begin
1812              pnlPatient.Enabled := True;
1813              exit;
1814            end;
1815          ShowEverything;
1816          //HideEverything('Retrieving information - please wait....');  //v27 (pending) RV
1817          DisplayEncounterText;
1818          FPrevInPatient := Patient.Inpatient;
1819          if Notifications.Active then
1820          begin
1821            // display 'next notification' button
1822            SetUpNextButton;
1823            FNextButtonActive := True;
1824            mnuFileNext.Enabled := True;
1825            mnuFileNextClick(mnuFileOpen);
1826          end
1827          else
1828          begin
1829            // hide the 'next notification' button
1830            FNextButtonActive := False;
1831            FNextButton.Free;
1832            FNextButton := nil;
1833            mnuFileNext.Enabled := False;
1834            mnuFileNotifRemove.Enabled := False;
1835            if Patient.DFN <> SaveDFN then
1836              ok := TRUE;
1837          end
1838        end
1839        else
1840        begin
1841          Notifications.Clear;
1842          SelectPatient(False, Font.Size, PtSelCancelled); // Call Pt. Sel. w/o notifications.
1843          if PtSelCancelled then exit;
1844          ShowEverything;
1845          DisplayEncounterText;
1846          FPrevInPatient := Patient.Inpatient;
1847          ok := TRUE;
1848        end;
1849      end;
1850      if ok then
1851      begin
1852        if FCCOWInstalled and (ctxContextor.State = csParticipating) and (not FRefreshing) then
1853          begin
1854            if (AllowCCOWContextChange(CCOWResponse, Patient.DFN)) then
1855              begin
1856                SetupPatient;
1857                tabPage.TabIndex := PageIDToTab(NextTab);
1858                tabPageChange(tabPage);
1859              end
1860            else
1861              begin
1862                case CCOWResponse of
1863                  urCancel: UpdateCCOWContext;
1864                  urBreak:
1865                    begin
1866                      // do not revert to old DFN if context was manually broken by user - v26 (RV)
1867                      if (ctxContextor.State = csParticipating) then Patient.DFN := SaveDFN;
1868                      SetupPatient;
1869                      tabPage.TabIndex := PageIDToTab(NextTab);
1870                      tabPageChange(tabPage);
1871                    end;
1872                  else
1873                    begin
1874                      SetupPatient;
1875                      tabPage.TabIndex := PageIDToTab(NextTab);
1876                      tabPageChange(tabPage);
1877                    end;
1878                end;
1879              end;
1880          end
1881        else
1882          begin
1883            SetupPatient;
1884            tabPage.TabIndex := PageIDToTab(NextTab);
1885            tabPageChange(tabPage);
1886          end;
1887      end;
1888    finally
1889      if (not FRefreshing) and (Patient.DFN = SaveDFN) then
1890        RemindersStarted := OldRemindersStarted;
1891      FFirstLoad := False;
1892    end;
1893   {Begin BillingAware}
1894    if  BILLING_AWARE then frmFrame.SetBADxList; //end IsBillingAware
1895   {End BillingAware}
1896   //ShowEverything;  //v27 (pending) RV
1897   if not FRefreshing then
1898     begin
1899        DoNotChangeEncWindow := false;
1900        OrderPrintForm := false;
1901        uCore.TempEncounterLoc := 0;
1902        uCore.TempEncounterLocName := '';
1903     end;
1904   pnlPatient.Enabled := True;
1905   //frmCover.UpdateVAAButton; //VAA CQ7525   CQ#7933 - moved to SetupPatient, before event hook execution (RV)
1906  end;
1907  
1908  procedure TfrmFrame.DetermineNextTab;
1909  begin
1910    if (FRefreshing or User.UseLastTab) and (not FFirstLoad) then
1911      begin
1912        if (tabPage.TabIndex < 0) then
1913          NextTab := LastTab
1914        else
1915          NextTab := TabToPageID(tabPage.TabIndex);
1916      end
1917    else
1918      NextTab := User.InitialTab;
1919    if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1920    if User.IsReportsOnly then // Reports Only tab.
1921      NextTab := CT_REPORTS; // Only one tab should exist by this point in "REPORTS ONLY" mode.
1922    if not TabExists(NextTab) then NextTab := CT_COVER;
1923    if NextTab = CT_NOPAGE then NextTab := User.InitialTab;
1924    if NextTab = CT_ORDERS then
1925      if frmOrders <> nil then with frmOrders do
1926      begin
1927        if (lstSheets.ItemIndex > -1 ) and (TheCurrentView <> nil) and (theCurrentView.EventDelay.PtEventIFN>0) then
1928          PtEvtCompleted(TheCurrentView.EventDelay.PtEventIFN, TheCurrentView.EventDelay.EventName);
1929      end;
1930  end;
1931  
1932  procedure TfrmFrame.mnuFileEncounterClick(Sender: TObject);
1933  { displays encounter window and updates encounter display in case encounter was updated }
1934  begin
1935    UpdateEncounter(NPF_ALL); {*KCM*}
1936    DisplayEncounterText;
1937  end;
1938  
1939  procedure TfrmFrame.mnuFileReviewClick(Sender: TObject);
1940  { displays the Review Changes window (which resets the Encounter object) }
1941  var
1942    EventChanges: boolean;
1943    NameNeedLook: string;
1944  begin
1945    FReviewClick := True;
1946    mnuFile.Tag := 1;
1947    EventChanges := False;
1948    NameNeedLook := '';
1949    //UpdatePtInfoOnRefresh;
1950    if Changes.Count > 0 then
1951    begin
1952     if (frmOrders <> nil) and (frmOrders.TheCurrentView <> nil) and ( frmOrders.TheCurrentView.EventDelay.EventIFN>0) then
1953     begin
1954       EventChanges := True;
1955       NameNeedLook := frmOrders.TheCurrentView.ViewName;
1956       frmOrders.PtEvtCompleted(frmOrders.TheCurrentView.EventDelay.PtEventIFN, frmOrders.TheCurrentView.EventDelay.EventName);
1957     end;
1958     ReviewChanges(TimedOut, EventChanges);
1959     if TabToPageID(tabPage.TabIndex)= CT_MEDS then
1960     begin
1961       frmOrders.InitOrderSheets2(NameNeedLook);
1962     end;
1963    end
1964    else InfoBox('No new changes to review/sign.', 'Review Changes', MB_OK);
1965    //CQ #17491: Moved UpdatePtInfoOnRefresh here to allow for the updating of the patient status indicator
1966    //in the header bar (after the Review Changes dialog closes) if the patient becomes admitted/discharged.
1967    UpdatePtInfoOnRefresh;
1968    FOrderPrintForm := false;
1969    FReviewClick := false;
1970  end;
1971  
1972  procedure TfrmFrame.mnuFileExitClick(Sender: TObject);
1973  { see the CloseQuery event }
1974  var
1975    i: smallint;
1976  begin
1977    try
1978       if  BILLING_AWARE then
1979           begin
1980           if Assigned(tempDxList) then
1981              for i := 0 to pred(UBAGlobals.tempDxList.Count) do
1982                 TObject(UBAGlobals.tempDxList[i]).Free;
1983  
1984           UBAGlobals.tempDxList.Clear;
1985           Application.ProcessMessages;
1986           end; //end IsBillingAware
1987    except
1988       on EAccessViolation do
1989          begin
1990          {$ifdef debug}Show508Message('Access Violation in procedure TfrmFrame.mnuFileExitClick()');{$endif}
1991          raise;
1992          end;
1993       on E: Exception do
1994          begin
1995          {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmFrame.mnuFileExitClick()');{$endif}
1996          raise;
1997          end;
1998    end;
1999  
2000    Close;
2001  end;
2002  
2003  { View Menu Events ------------------------------------------------------------------------- }
2004  
2005  procedure TfrmFrame.mnuViewPostingsClick(Sender: TObject);
2006  begin
2007  end;
2008  
2009  { Tool Menu Events ------------------------------------------------------------------------- }
2010  
2011  function TfrmFrame.ExpandCommand(x: string): string;
2012  { look for 'macros' on the command line and expand them using current context }
2013  
2014    procedure Substitute(const Key, Data: string);
2015    var
2016      Stop, Start: Integer;
2017    begin
2018      Stop  := Pos(Key, x) - 1;
2019      Start := Stop + Length(Key) + 1;
2020      x := Copy(x, 1, Stop) + Data + Copy(x, Start, Length(x));
2021    end;
2022  
2023  begin
2024    if Pos('%MREF', x) > 0 then Substitute('%MREF',
2025      '^TMP(''ORWCHART'',' + MScalar('$J') + ',''' + DottedIPStr + ''',' + IntToHex(Handle, 8) + ')');
2026    if Pos('%SRV',  x) > 0 then Substitute('%SRV',  RPCBrokerV.Server);
2027    if Pos('%PORT', x) > 0 then Substitute('%PORT', IntToStr(RPCBrokerV.ListenerPort));
2028    if Pos('%DFN',  x) > 0 then Substitute('%DFN',  Patient.DFN);  //*DFN*
2029    if Pos('%DUZ',  x) > 0 then Substitute('%DUZ',  IntToStr(User.DUZ));
2030    Result := x;
2031  end;
2032  
2033  procedure TfrmFrame.ToolClick(Sender: TObject);
2034  { executes the program associated with an item on the Tools menu, the command line is stored
2035    in the item's hint property }
2036  const
2037    TXT_ECS_NOTFOUND = 'The ECS application is not found at the default directory,' + #13 + 'would you like manually search it?';
2038    TC_ECS_NOTFOUND = 'Application Not Found';
2039  var
2040    x, AFile, Param, MenuCommand, ECSAppend, CapNm, curPath : string;
2041    IsECSInterface: boolean;
2042  
2043    function TakeOutAmps(AString: string): string;
2044    var
2045      S1,S2: string;
2046    begin
2047      if Pos('&',AString)=0 then
2048      begin
2049        Result := AString;
2050        Exit;
2051      end;
2052      S1 := Piece(AString,'&',1);
2053      S2 := Piece(AString,'&',2);
2054      Result := S1 + S2;
2055    end;
2056  
2057    function ExcuteEC(AFile,APara: string): boolean;
2058    begin
2059      if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL) > 32 ) then Result := True
2060      else
2061      begin
2062        if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
2063        begin
2064          if OROpenDlg.Execute then
2065          begin
2066             AFile := OROpenDlg.FileName;
2067             if Pos('ecs gui.exe',lowerCase(AFile))<1 then
2068             begin
2069               ShowMsg('This is not a valid ECS application.');
2070               Result := True;
2071             end else
2072             begin
2073               if (ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL)<32) then Result := False
2074               else Result := True;
2075             end;
2076          end
2077          else Result := True;
2078        end else Result := True;
2079      end;
2080    end;
2081  
2082    function ExcuteECS(AFile, APara: string; var currPath: string): boolean;
2083    var
2084      commandline,RPCHandle: string;
2085      StartupInfo: TStartupInfo;
2086      ProcessInfo: TProcessInformation;
2087    begin
2088      FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
2089      with StartupInfo do
2090      begin
2091        cb := SizeOf(TStartupInfo);
2092        dwFlags := STARTF_USESHOWWINDOW;
2093        wShowWindow := SW_SHOWNORMAL;
2094      end;
2095      commandline := AFile + Param;
2096      RPCHandle := GetAppHandle(RPCBrokerV);
2097      commandline := commandline + ' H=' + RPCHandle;
2098      if CreateProcess(nil, PChar(commandline), nil, nil, False,
2099        NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then Result := True
2100      else
2101      begin
2102        if InfoBox(TXT_ECS_NOTFOUND, TC_ECS_NOTFOUND, MB_YESNO or MB_ICONERROR) = IDYES then
2103        begin
2104          if OROpenDlg.Execute then
2105          begin
2106             AFile := OROpenDlg.FileName;
2107             if Pos('ecs gui.exe',lowerCase(AFile))<1 then
2108             begin
2109               ShowMsg('This is not a valid ECS application.');
2110               Result := True;
2111             end else
2112             begin
2113               SaveUserPath('Event Capture Interface='+AFile, currPath);
2114               FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
2115               with StartupInfo do
2116               begin
2117                 cb := SizeOf(TStartupInfo);
2118                 dwFlags := STARTF_USESHOWWINDOW;
2119                 wShowWindow := SW_SHOWNORMAL;
2120               end;
2121               commandline := AFile + Param;
2122               RPCHandle := GetAppHandle(RPCBrokerV);
2123               commandline := commandline + ' H=' + RPCHandle;
2124               if not CreateProcess(nil, PChar(commandline), nil, nil, False,
2125                  NORMAL_PRIORITY_CLASS, nil, nil,StartupInfo,ProcessInfo) then Result := False
2126               else Result := True;
2127             end;
2128          end
2129          else Result := True;
2130        end else Result := True;
2131      end;
2132    end;
2133  
2134  begin
2135    MenuCommand := '';
2136    ECSAppend   := '';
2137    IsECSInterface := False;
2138    curPath := '';
2139    CapNm := LowerCase(TMenuItem(Sender).Caption);
2140    CapNm := TakeOutAmps(CapNm);
2141    if AnsiCompareText('event capture interface',CapNm)=0 then
2142    begin
2143      IsECSInterface := True;
2144      if FECSAuthUser then UpdateECSParameter(ECSAppend)
2145      else begin
2146        ShowMsg('You don''t have permission to use ECS.');
2147        exit;
2148      end;
2149    end;
2150    MenuCommand := TMenuItem(Sender).Hint + ECSAppend;
2151    x := ExpandCommand(MenuCommand);
2152    if CharAt(x, 1) = '"' then
2153    begin
2154      x     := Copy(x, 2, Length(x));
2155      AFile := Copy(x, 1, Pos('"',x)-1);
2156      Param := Copy(x, Pos('"',x)+1, Length(x));
2157    end else
2158    begin
2159      AFile := Piece(x, ' ', 1);
2160      Param := Copy(x, Length(AFile)+1, Length(x));
2161    end;
2162    if IsECSInterface then
2163    begin
2164      if not ExcuteECS(AFile,Param,curPath) then
2165        ExcuteECS(AFile,Param,curPath);
2166      if Length(curPath)>0 then
2167        TMenuItem(Sender).Hint := curPath;
2168    end
2169    else if (Pos('ecs',LowerCase(AFile))>0) and (not IsECSInterface) then
2170    begin
2171      if not ExcuteEC(AFile,Param) then
2172        ExcuteEC(AFile,Param);
2173    end else
2174    begin
2175      ShellExecute(Handle, 'open', PChar(AFile), PChar(Param), '', SW_NORMAL);
2176    end;
2177  end;
2178  
2179  { Help Menu Events ------------------------------------------------------------------------- }
2180  
2181  procedure TfrmFrame.mnuHelpBrokerClick(Sender: TObject);
2182  { used for debugging - shows last n broker calls }
2183  begin
2184    ShowBroker;
2185  end;
2186  
2187  procedure TfrmFrame.mnuHelpListsClick(Sender: TObject);
2188  { used for debugging - shows internal contents of TORListBox }
2189  begin
2190    if Screen.ActiveControl is TListBox
2191      then DebugListItems(TListBox(Screen.ActiveControl))
2192      else InfoBox('Focus control is not a listbox', 'ListBox Data', MB_OK);
2193  end;
2194  
2195  procedure TfrmFrame.mnuHelpSymbolsClick(Sender: TObject);
2196  { used for debugging - shows current symbol table }
2197  begin
2198    DebugShowServer;
2199  end;
2200  
2201  procedure TfrmFrame.mnuHelpAboutClick(Sender: TObject);
2202  { displays the about screen }
2203  begin
2204    ShowAbout;
2205  end;
2206  
2207  { Status Bar Methods }
2208  
2209  procedure TfrmFrame.UMStatusText(var Message: TMessage);
2210  { displays status bar text (using the pointer to a text buffer passed in LParam) }
2211  begin
2212    stsArea.Panels.Items[0].Text := StrPas(PChar(Message.LParam));
2213    stsArea.Refresh;
2214  end;
2215  
2216  { Toolbar Methods (make panels act like buttons) ------------------------------------------- }
2217  
2218  procedure TfrmFrame.pnlPatientMouseDown(Sender: TObject; Button: TMouseButton;
2219    Shift: TShiftState; X, Y: Integer);
2220  { emulate a button press in the patient identification panel }
2221  begin
2222    if pnlPatient.BevelOuter = bvLowered then exit;
2223    pnlPatient.BevelOuter := bvLowered;
2224    with lblPtName do SetBounds(Left+2, Top+2, Width, Height);
2225    with lblPtSSN  do SetBounds(Left+2, Top+2, Width, Height);
2226    with lblPtAge  do SetBounds(Left+2, Top+2, Width, Height);
2227  end;
2228  
2229  procedure TfrmFrame.pnlPatientMouseUp(Sender: TObject; Button: TMouseButton;
2230    Shift: TShiftState; X, Y: Integer);
2231  { emulate the button raising in the patient identification panel & call Patient Inquiry }
2232  begin
2233    if pnlPatient.BevelOuter = bvRaised then exit;
2234    pnlPatient.BevelOuter := bvRaised;
2235    with lblPtName do SetBounds(Left-2, Top-2, Width, Height);
2236    with lblPtSSN  do SetBounds(Left-2, Top-2, Width, Height);
2237    with lblPtAge  do SetBounds(Left-2, Top-2, Width, Height);
2238  end;
2239  
2240  procedure TfrmFrame.pnlVisitMouseDown(Sender: TObject; Button: TMouseButton;
2241    Shift: TShiftState; X, Y: Integer);
2242  { emulate a button press in the encounter panel }
2243  begin
2244    if User.IsReportsOnly then
2245      exit;
2246    if pnlVisit.BevelOuter = bvLowered then exit;
2247    pnlVisit.BevelOuter := bvLowered;
2248    //with lblStLocation do SetBounds(Left+2, Top+2, Width, Height);
2249    with lblPtLocation do SetBounds(Left+2, Top+2, Width, Height);
2250    with lblPtProvider do SetBounds(Left+2, Top+2, Width, Height);
2251  end;
2252  
2253  procedure TfrmFrame.pnlVisitMouseUp(Sender: TObject; Button: TMouseButton;
2254    Shift: TShiftState; X, Y: Integer);
2255  { emulate a button raising in the encounter panel and call Update Provider/Location }
2256  begin
2257    if User.IsReportsOnly then
2258      exit;
2259    if pnlVisit.BevelOuter = bvRaised then exit;
2260    pnlVisit.BevelOuter := bvRaised;
2261    //with lblStLocation do SetBounds(Left-2, Top-2, Width, Height);
2262    with lblPtLocation do SetBounds(Left-2, Top-2, Width, Height);
2263    with lblPtProvider do SetBounds(Left-2, Top-2, Width, Height);
2264  end;
2265  
2266  procedure TfrmFrame.pnlVistaWebClick(Sender: TObject);
2267  begin
2268    inherited;
2269    uUseVistaWeb := true;
2270    pnlVistaWeb.BevelOuter := bvLowered;
2271    pnlCIRNClick(self);
2272    uUseVistaWeb := false;
2273  end;
2274  
2275  procedure TfrmFrame.pnlVistaWebMouseDown(Sender: TObject; Button: TMouseButton;
2276    Shift: TShiftState; X, Y: Integer);
2277  begin
2278    inherited;
2279    pnlVistaWeb.BevelOuter := bvLowered;
2280  end;
2281  
2282  procedure TfrmFrame.pnlVistaWebMouseUp(Sender: TObject; Button: TMouseButton;
2283    Shift: TShiftState; X, Y: Integer);
2284  begin
2285    inherited;
2286    pnlVistaWeb.BevelOuter := bvRaised;
2287  end;
2288  
2289  procedure TfrmFrame.pnlPrimaryCareMouseDown(Sender: TObject;
2290    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2291  begin
2292    if pnlPrimaryCare.BevelOuter = bvLowered then exit;
2293    pnlPrimaryCare.BevelOuter := bvLowered;
2294    with lblPtCare      do SetBounds(Left+2, Top+2, Width, Height);
2295    with lblPtAttending do SetBounds(Left+2, Top+2, Width, Height);
2296    with lblPtMHTC do SetBounds(Left+2, Top+2, Width, Height);
2297  end;
2298  
2299  procedure TfrmFrame.pnlPrimaryCareMouseUp(Sender: TObject;
2300    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2301  begin
2302    if pnlPrimaryCare.BevelOuter = bvRaised then exit;
2303    pnlPrimaryCare.BevelOuter := bvRaised;
2304    with lblPtCare      do SetBounds(Left-2, Top-2, Width, Height);
2305    with lblPtAttending do SetBounds(Left-2, Top-2, Width, Height);
2306    with lblPtMHTC      do SetBounds(Left-2, Top-2, Width, Height);
2307  end;
2308  
2309  procedure TfrmFrame.pnlPostingsMouseDown(Sender: TObject;
2310    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2311  { emulate a button press in the postings panel }
2312  begin
2313    if pnlPostings.BevelOuter = bvLowered then exit;
2314    pnlPostings.BevelOuter := bvLowered;
2315    with lblPtPostings do SetBounds(Left+2, Top+2, Width, Height);
2316    with lblPtCWAD     do SetBounds(Left+2, Top+2, Width, Height);
2317  end;
2318  
2319  procedure TfrmFrame.pnlPostingsMouseUp(Sender: TObject;
2320    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2321  { emulate a button raising in the posting panel and call Postings }
2322  begin
2323    if pnlPostings.BevelOuter = bvRaised then exit;
2324    pnlPostings.BevelOuter := bvRaised;
2325    with lblPtPostings do SetBounds(Left-2, Top-2, Width, Height);
2326    with lblPtCWAD     do SetBounds(Left-2, Top-2, Width, Height);
2327  end;
2328  
2329  { Resize and Font-Change procedures -------------------------------------------------------- }
2330  
2331  procedure TfrmFrame.LoadSizesForUser;
2332  var
2333    s1, s2, s3, s4, Dummy: integer;
2334    panelBottom, panelMedIn : integer;
2335  
2336  begin
2337    ChangeFont(UserFontSize);
2338    SetUserBounds(TControl(frmFrame));
2339    SetUserWidths(TControl(frmProblems.pnlLeft));
2340    //SetUserWidths(TControl(frmMeds.pnlLeft));
2341    SetUserWidths(TControl(frmOrders.pnlLeft));
2342    SetUserWidths(TControl(frmNotes.pnlLeft));
2343    SetUserWidths(TControl(frmConsults.pnlLeft));
2344    SetUserWidths(TControl(frmDCSumm.pnlLeft));
2345    if Assigned(frmSurgery) then SetUserWidths(TControl(frmSurgery.pnlLeft));
2346    SetUserWidths(TControl(frmLabs.pnlLeft));
2347    SetUserWidths(TControl(frmReports.pnlLeft));
2348    SetUserColumns(TControl(frmOrders.hdrOrders));
2349    SetUserColumns(TControl(frmMeds.hdrMedsIn));  // still need conversion
2350    SetUserColumns(TControl(frmMeds.hdrMedsOut));
2351    SetUserString('frmPtSel.lstvAlerts',EnduringPtSelColumns);
2352    SetUserString(SpellCheckerSettingName, SpellCheckerSettings);
2353    SetUserBounds2(TemplateEditorSplitters, tmplEditorSplitterMiddle,
2354                   tmplEditorSplitterProperties, tmplEditorSplitterMain, tmplEditorSplitterBoil);
2355    SetUserBounds2(TemplateEditorSplitters2, tmplEditorSplitterNotes, Dummy, Dummy, Dummy);
2356    SetUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight);
2357    SetUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight);
2358    SetUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, Dummy ,Dummy);
2359    SetUserBounds2(DrawerSplitters,s1, s2, s3, Dummy);
2360    if Assigned(frmSurgery) then frmSurgery.Drawers.LastOpenSize := Dummy; //CQ7315
2361    frmNotes.Drawers.LastOpenSize := s1;
2362    frmConsults.Drawers.LastOpenSize := s2;
2363    frmDCSumm.Drawers.LastOpenSize := s3;
2364  
2365    with frmMeds do
2366       begin
2367       SetUserBounds2(frmMeds.Name+'Split', panelBottom, panelMedIn, Dummy, Dummy);
2368       if (panelBottom > frmMeds.Height-50) then panelBottom := frmMeds.Height-50;
2369       if (panelMedIn > panelBottom-50) then panelMedIn := panelBottom-50;
2370       frmMeds.pnlBottom.Height := panelBottom;
2371       frmMeds.pnlMedIn.Height := panelMedIn;
2372       //Meds Tab Non-VA meds columns
2373       SetUserColumns(TControl(hdrMedsNonVA)); //CQ7314
2374       end;
2375  
2376       frmCover.DisableAlign;
2377    try
2378      SetUserBounds2(CoverSplitters1, s1, s2, s3, s4);
2379      if s1 > 0 then
2380        frmCover.pnl_1.Width := LowerOf( frmCover.pnl_not3.ClientWidth - 5, s1);
2381      if s2 > 0 then
2382        frmCover.pnl_3.Width := LowerOf( frmCover.pnlTop.ClientWidth - 5, s2);
2383      if s3 > 0 then
2384        frmCover.pnlTop.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s3);
2385      if s4 > 0 then
2386        frmCover.pnl_4.Width := LowerOf( frmCover.pnlMiddle.ClientWidth - 5, s4);
2387  
2388      SetUserBounds2(CoverSplitters2, s1, s2, s3, Dummy);
2389      if s1 > 0 then
2390        frmCover.pnlBottom.Height := LowerOf( frmCover.pnlBase.ClientHeight - 5, s1);
2391      if s2 > 0 then
2392        frmCover.pnl_6.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s2);
2393      if s3 > 0 then
2394        frmCover.pnl_8.Width := LowerOf( frmCover.pnlBottom.ClientWidth - 5, s3);
2395  
2396    finally
2397     frmCover.EnableAlign;
2398    end;
2399    if ParamSearch('rez') = '640' then SetBounds(Left, Top, 648, 488);  // for testing
2400  end;
2401  
2402  procedure TfrmFrame.SaveSizesForUser;
2403  var
2404    SizeList: TStringList;
2405    SurgTempHt: integer;
2406  begin
2407    SaveUserFontSize(MainFontSize);
2408    SizeList := TStringList.Create;
2409    try
2410      with SizeList do
2411      begin
2412        Add(StrUserBounds(frmFrame));
2413        Add(StrUserWidth(frmProblems.pnlLeft));
2414        //Add(StrUserWidth(frmMeds.pnlLeft));
2415        Add(StrUserWidth(frmOrders.pnlLeft));
2416        Add(StrUserWidth(frmNotes.pnlLeft));
2417        Add(StrUserWidth(frmConsults.pnlLeft));
2418        Add(StrUserWidth(frmDCSumm.pnlLeft));
2419        if Assigned(frmSurgery) then Add(StrUserWidth(frmSurgery.pnlLeft));
2420        Add(StrUserWidth(frmLabs.pnlLeft));
2421        Add(StrUserWidth(frmReports.pnlLeft));
2422        Add(StrUserColumns(frmOrders.hdrOrders));
2423        Add(StrUserColumns(frmMeds.hdrMedsIn));
2424        Add(StrUserColumns(frmMeds.hdrMedsOut));
2425        Add(StrUserString(SpellCheckerSettingName, SpellCheckerSettings));
2426        Add(StrUserBounds2(TemplateEditorSplitters, tmplEditorSplitterMiddle,
2427                tmplEditorSplitterProperties, tmplEditorSplitterMain, tmplEditorSplitterBoil));
2428        Add(StrUserBounds2(TemplateEditorSplitters2, tmplEditorSplitterNotes, 0, 0, 0));
2429        Add(StrUserBounds2(ReminderTreeName, RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight));
2430        Add(StrUserBounds2(RemDlgName, RemDlgLeft, RemDlgTop, RemDlgWidth, RemDlgHeight));
2431        Add(StrUserBounds2(RemDlgSplitters, RemDlgSpltr1, RemDlgSpltr2, 0 ,0));
2432  
2433        //v26.47 - RV - access violation if Surgery Tab not enabled.  Set to designer height as default.
2434        if Assigned(frmSurgery) then SurgTempHt := frmSurgery.Drawers.pnlTemplates.Height else SurgTempHt := 85;
2435        Add(StrUserBounds2(DrawerSplitters, frmNotes.Drawers.LastOpenSize,
2436                                               frmConsults.Drawers.LastOpenSize,
2437                                               frmDCSumm.Drawers.LastOpenSize,
2438                                               SurgTempHt)); // last parameter = CQ7315
2439  
2440        Add(StrUserBounds2(CoverSplitters1,
2441          frmCover.pnl_1.Width,
2442          frmCover.pnl_3.Width,
2443          frmCover.pnlTop.Height,
2444          frmCover.pnl_4.Width));
2445        Add(StrUserBounds2(CoverSplitters2,
2446          frmCover.pnlBottom.Height,
2447          frmCover.pnl_6.Width,
2448          frmCover.pnl_8.Width,
2449          0));
2450  
2451        //Meds Tab Splitters
2452        Add(StrUserBounds2(frmMeds.Name+'Split',frmMeds.pnlBottom.Height,frmMeds.pnlMedIn.Height,0,0));
2453  
2454        //Meds Tab Non-VA meds columns
2455        Add(StrUserColumns(fMeds.frmMeds.hdrMedsNonVA)); //CQ7314
2456  
2457        //Orders Tab columns
2458        Add(StrUserColumns(fOrders.frmOrders.hdrOrders)); //CQ6328
2459  
2460        if EnduringPtSelSplitterPos <> 0 then
2461          Add(StrUserBounds2('frmPtSel.sptVert', EnduringPtSelSplitterPos, 0, 0, 0));
2462        if EnduringPtSelColumns <> '' then
2463          Add('C^frmPtSel.lstvAlerts^' + EnduringPtSelColumns);
2464      end;
2465      //Add sizes for forms that used SaveUserBounds() to save thier positions
2466      SizeHolder.AddSizesToStrList(SizeList);
2467      //Send the SizeList to the Database
2468      SaveUserSizes(SizeList);
2469    finally
2470      SizeList.Free;
2471    end;
2472  end;
2473  
2474  procedure TfrmFrame.FormResize(Sender: TObject);
2475  { need to resize tab forms specifically since they don't inherit resize event (because they
2476    are derived from TForm itself) }
2477  begin
2478    if FTerminate or FClosing then Exit;
2479    if csDestroying in ComponentState then Exit;
2480    MoveWindow(frmCover.Handle,    0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2481    MoveWindow(frmProblems.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2482    MoveWindow(frmMeds.Handle,     0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2483    MoveWindow(frmOrders.Handle,   0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2484    MoveWindow(frmNotes.Handle,    0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2485    MoveWindow(frmConsults.Handle, 0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2486    MoveWindow(frmDCSumm.Handle,   0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2487    if Assigned(frmSurgery) then MoveWindow(frmSurgery.Handle,     0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2488    MoveWindow(frmLabs.Handle,     0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2489    MoveWindow(frmReports.Handle,  0, 0, pnlPage.ClientWidth, pnlPage.ClientHeight, True);
2490    with stsArea do
2491    begin
2492      Panels[1].Width := stsArea.Width - FFixedStatusWidth;
2493      FNextButtonL := Panels[0].Width + Panels[1].Width;
2494      FNextButtonR := FNextButtonL + Panels[2].Width;
2495    end;
2496    if Notifications.Active then SetUpNextButton;
2497    lstCIRNLocations.Left  := FNextButtonL - ScrollBarWidth - 100;
2498    lstCIRNLocations.Width := ClientWidth - lstCIRNLocations.Left;
2499    //cq: 15641
2500    if frmFrame.FNextButtonActive then // keeps button alligned if cancel is pressed
2501    begin
2502      FNextButton.Left := FNextButtonL;
2503      FNextButton.Top := stsArea.Top;
2504    end;
2505    Self.Repaint;
2506  end;
2507  
2508  procedure TfrmFrame.ChangeFont(NewFontSize: Integer);
2509  { Makes changes in all components whenever the font size is changed.  This is hardcoded and
2510    based on MS Sans Serif for now, as only the font size may be selected. Courier New is used
2511    wherever non-proportional fonts are required. }
2512  const
2513    TAB_VOFFSET = 7;
2514  var
2515    OldFont: TFont;
2516  begin
2517  // Ho ho!  ResizeAnchoredFormToFont(self) doesn't work here because the
2518  // Form size is aliased with MainFormSize.
2519    OldFont := TFont.Create;
2520    try
2521      DisableAlign;
2522      try
2523        OldFont.Assign(Font);
2524        with Self          do Font.Size := NewFontSize;
2525        with lblPtName     do Font.Size := NewFontSize;   // must change BOLDED labels by hand
2526        with lblPtSSN      do Font.Size := NewFontSize;
2527        with lblPtAge      do Font.Size := NewFontSize;
2528        with lblPtLocation do Font.Size := NewFontSize;
2529        with lblPtProvider do Font.Size := NewFontSize;
2530        with lblPtPostings do Font.Size := NewFontSize;
2531        with lblPtCare     do Font.Size := NewFontSize;
2532        with lblPtAttending do Font.Size := NewFontSize;
2533        with lblPtMHTC      do Font.Size := NewFontSize;
2534        with lblFlag       do Font.Size := NewFontSize;
2535        with lblPtCWAD     do Font.Size := NewFontSize;
2536        with lblCIRN       do Font.Size := NewFontSize;
2537        with lblVistaWeb   do Font.Size := NewFontSize;
2538        with lstCIRNLocations do
2539          begin
2540            Font.Size := NewFontSize;
2541            ItemHeight := NewFontSize + 6;
2542          end;
2543        with tabPage       do Font.Size := NewFontSize;
2544        with laMHV         do Font.Size := NewFontSize; //VAA
2545        with laVAA2        do Font.Size := NewFontSize; //VAA
2546  
2547        frmFrameHeight := frmFrame.Height;
2548        pnlPatientSelectedHeight := pnlPatientSelected.Height;
2549        tabPage.Height := MainFontHeight + TAB_VOFFSET;   // resize tab selector
2550        FitToolbar;                                       // resize toolbar
2551        stsArea.Font.Size := NewFontSize;
2552        stsArea.Height := MainFontHeight + TAB_VOFFSET;
2553        stsArea.Panels[0].Width := ResizeWidth( OldFont, Font, stsArea.Panels[0].Width);
2554        stsArea.Panels[2].Width := ResizeWidth( OldFont, Font, stsArea.Panels[2].Width);
2555  
2556        //VAA CQ8271
2557        if ((fCover.PtIsVAA and fCover.PtIsMHV)) then
2558          begin
2559           laMHV.Height := (pnlToolBar.Height div 2) -1;
2560           with laVAA2 do
2561             begin
2562             Top := laMHV.Top + laMHV.Height;
2563             Height := (pnlToolBar.Height div 2) -1;
2564             end;
2565           end;
2566        //end VAA
2567  
2568        RefreshFixedStatusWidth;
2569        FormResize( self );
2570      finally
2571        EnableAlign;
2572      end;
2573    finally
2574      OldFont.Free;
2575    end;
2576  
2577    case (NewFontSize) of
2578     8: mnu8pt.Checked := true;
2579    10: mnu10pt1.Checked := true;
2580    12: mnu12pt1.Checked := true;
2581    14: mnu14pt1.Checked := true;
2582    18: mnu18pt1.Checked := true;
2583    end;
2584  
2585    //Now that the form elements are resized, the pages will know what size to take.
2586    frmCover.SetFontSize(NewFontSize);                // child pages lack a ParentFont property
2587    frmProblems.SetFontSize(NewFontSize);
2588    frmMeds.SetFontSize(NewFontSize);
2589    frmOrders.SetFontSize(NewFontSize);
2590    frmNotes.SetFontSize(NewFontSize);
2591    frmConsults.SetFontSize(NewFontSize);
2592    frmDCSumm.SetFontSize(NewFontSize);
2593    if Assigned(frmSurgery) then frmSurgery.SetFontSize(NewFontSize);
2594    frmLabs.SetFontSize(NewFontSize);
2595    frmReports.SetFontSize(NewFontSize);
2596    TfrmIconLegend.SetFontSize(NewFontSize);
2597    uOrders.SetFontSize(NewFontSize);
2598    if Assigned(frmRemDlg) then frmRemDlg.SetFontSize;
2599    if Assigned(frmReminderTree) then frmReminderTree.SetFontSize(NewFontSize);
2600    if GraphFloat <> nil then ResizeAnchoredFormToFont(GraphFloat);
2601  end;
2602  
2603  procedure TfrmFrame.FitToolbar;
2604  { resizes and repositions the panels & labels used in the toolbar }
2605  const
2606    PATIENT_WIDTH = 29;
2607    VISIT_WIDTH   = 36;
2608    POSTING_WIDTH = 11.5;
2609    FLAG_WIDTH    = 5;
2610    CV_WIDTH      = 15; //14; WAT
2611    CIRN_WIDTH    = 11;
2612    MHV_WIDTH     = 6;
2613    LINES_HIGH2    = 2;
2614    LINES_HIGH3    = 3;    //lblPtMHTC line change
2615    M_HORIZ       = 4;
2616    M_MIDDLE      = 2;
2617    M_NVERT       = 4;
2618    M_WVERT       = 6;
2619    TINY_MARGIN   = 2;
2620  //var
2621    //WidthNeeded: integer;
2622  begin
2623    if lblPtMHTC.caption = '' then
2624    begin
2625      lblPtMHTC.Visible := false;
2626      pnlToolbar.Height  := (LINES_HIGH2 * lblPtName.Height) + M_HORIZ + M_MIDDLE + M_HORIZ + M_MIDDLE
2627    end
2628    else
2629    begin
2630      if (lblPtAttending.Caption <> '') and (lblPtAttending.Caption <> lblPtMHTC.Caption) then
2631      begin
2632        lblPtMHTC.Visible := true;
2633        pnlToolbar.Height  := (LINES_HIGH3 * lblPtName.Height) + M_HORIZ + M_MIDDLE + M_HORIZ + M_HORIZ;
2634      end;
2635      if lblPtAttending.Caption = '' then
2636      begin
2637        lblPtAttending.Caption := lblPtMHTC.Caption;
2638        lblPtMHTC.Visible := false;
2639        pnlToolbar.Height  := (LINES_HIGH2 * lblPtName.Height) + M_HORIZ + M_MIDDLE + M_HORIZ + M_MIDDLE;
2640      end;
2641    end;
2642    pnlPatient.Width   := HigherOf(PATIENT_WIDTH * MainFontWidth, lblPtName.Width + (M_WVERT * 2));
2643    lblPtSSN.Top       := M_HORIZ + lblPtName.Height + M_MIDDLE;
2644    lblPtAge.Top       := lblPtSSN.Top;
2645    lblPtAge.Left      := pnlPatient.Width - lblPtAge.Width - M_WVERT;
2646    pnlVisit.Width     := HigherOf(LowerOf(VISIT_WIDTH * MainFontWidth,
2647                                           HigherOf(lblPtProvider.Width + (M_WVERT * 2),
2648                                                    lblPtLocation.Width + (M_WVERT * 2))),
2649                                   PATIENT_WIDTH * MainFontWidth);
2650    lblPtProvider.Top  := lblPtSSN.Top;
2651    lblPtAttending.Top := lblPtSSN.Top;
2652    lblPtMHTC.Top       := M_MIDDLE + lblPtSSN.Height + lblPtSSN.Top;
2653    pnlPostings.Width  := Round(POSTING_WIDTH * MainFontWidth);
2654    if btnCombatVet.Visible then
2655     begin
2656      pnlCVnFlag.Width   := Round(CV_WIDTH * MainFontWidth);
2657      pnlFlag.Width      := Round(CV_WIDTH * MainFontWidth);
2658      btnCombatVet.Height := Round(pnlCVnFlag.Height div 2);
2659     end
2660    else
2661     begin
2662      pnlCVnFlag.Width   := Round(FLAG_WIDTH * MainFontWidth);
2663      pnlFlag.Width      := Round(FLAG_WIDTH * MainFontWidth);
2664     end;
2665    pnlRemoteData.Width := Round(CIRN_WIDTH * MainFontWidth) + M_WVERT;
2666    pnlVistaWeb.Height := pnlRemoteData.Height div 2;
2667    paVAA.Width        := Round(MHV_WIDTH * MainFontWidth) + M_WVERT + 2;
2668    with lblPtPostings do
2669      SetBounds(M_WVERT, M_HORIZ, pnlPostings.Width-M_WVERT-M_WVERT, lblPtName.Height);
2670    with lblPtCWAD     do
2671      SetBounds(M_WVERT, lblPtSSN.Top, lblPtPostings.Width, lblPtName.Height);
2672    //Low resolution handling: First, try to fit everything on by shrinking fields
2673    if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, HigherOf(lblPtAttending.Left + lblPtAttending.Width,lblPtMHTC.Left + lblPtMHTC.Width)) + TINY_MARGIN then
2674    //if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
2675    begin
2676      lblPtAge.Left := lblPtAge.Left - (lblPtName.Left - TINY_MARGIN);
2677      lblPtName.Left := TINY_MARGIN;
2678      lblPTSSN.Left := TINY_MARGIN;
2679      pnlPatient.Width := HigherOf( lblPtName.Left + lblPtName.Width, lblPtAge.Left + lblPtAge.Width)+ TINY_MARGIN;
2680      lblPtLocation.Left := TINY_MARGIN;
2681      lblPtProvider.Left := TINY_MARGIN;
2682      pnlVisit.Width := HigherOf( lblPtLocation.Left + lblPtLocation.Width, lblPtProvider.Left + lblPtProvider.Width)+ TINY_MARGIN;
2683    end;
2684    //If that is not enough, add scroll bars to form
2685    {if pnlPrimaryCare.Width < HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN then
2686    begin
2687      WidthNeeded := HigherOf( lblPtCare.Left + lblPtCare.Width, lblPtAttending.Left + lblPtAttending.Width) + TINY_MARGIN - pnlPrimaryCare.Width;
2688      HorzScrollBar.Range := ClientWidth + WidthNeeded;
2689      Width := Width + WidthNeeded;
2690    end
2691    else }   // commented out - BA
2692      HorzScrollBar.Range := 0;
2693  end;
2694  
2695  { Temporary Calls -------------------------------------------------------------------------- }
2696  
2697  procedure TfrmFrame.ToggleMenuItemChecked(Sender: TObject);
2698  begin
2699    with (Sender as TMenuItem) do
2700       begin
2701       if not Checked then
2702          Checked := true
2703       else
2704          Checked := false;
2705       end;
2706  end;
2707  
2708  procedure TfrmFrame.mnuFontSizeClick(Sender: TObject);
2709  begin
2710    if (frmRemDlg <> nil) then
2711      ShowMsg('Please close the reminder dialog before changing font sizes.')
2712    else
2713       if (dlgProbs <> nil) then
2714      ShowMsg('Font size cannot be changed while adding or editing a problem.')
2715    else
2716       begin
2717       with (Sender as TMenuItem) do
2718          begin
2719          ToggleMenuItemChecked(Sender);
2720          fMeds.oldFont := MainFontSize; //CQ9182
2721          ChangeFont(Tag);
2722          end;
2723       end;
2724  end;
2725  
2726  procedure TfrmFrame.mnuEditClick(Sender: TObject);
2727  var
2728    IsReadOnly: Boolean;
2729  begin
2730    FEditCtrl := nil;
2731    if Screen.ActiveControl is TCustomEdit then FEditCtrl := TCustomEdit(Screen.ActiveControl);
2732    if FEditCtrl <> nil then
2733    begin
2734      if      FEditCtrl is TMemo     then IsReadOnly := TMemo(FEditCtrl).ReadOnly
2735      else if FEditCtrl is TEdit     then IsReadOnly := TEdit(FEditCtrl).ReadOnly
2736      else if FEditCtrl is TRichEdit then IsReadOnly := TRichEdit(FEditCtrl).ReadOnly
2737      else IsReadOnly := True;
2738  
2739      mnuEditRedo.Enabled := FEditCtrl.Perform(EM_CANREDO, 0, 0) <> 0;
2740      mnuEditUndo.Enabled := (FEditCtrl.Perform(EM_CANUNDO, 0, 0) <> 0) and (FEditCtrl.Perform(EM_CANREDO, 0, 0) = 0);
2741  
2742      mnuEditCut.Enabled := FEditCtrl.SelLength > 0;
2743      mnuEditCopy.Enabled := mnuEditCut.Enabled;
2744      mnuEditPaste.Enabled := (IsReadOnly = False) and Clipboard.HasFormat(CF_TEXT);
2745    end else
2746    begin
2747      mnuEditUndo.Enabled  := False;
2748      mnuEditCut.Enabled   := False;
2749      mnuEditCopy.Enabled  := False;
2750      mnuEditPaste.Enabled := False;
2751    end;
2752  end;
2753  
2754  procedure TfrmFrame.mnuEditUndoClick(Sender: TObject);
2755  begin
2756    FEditCtrl.Perform(EM_UNDO, 0, 0);
2757  end;
2758  
2759  procedure TfrmFrame.mnuEditRedoClick(Sender: TObject);
2760  begin
2761    FEditCtrl.Perform(EM_REDO, 0, 0);
2762  end;
2763  
2764  
2765  procedure TfrmFrame.mnuEditCutClick(Sender: TObject);
2766  begin
2767    FEditCtrl.CutToClipboard;
2768  end;
2769  
2770  procedure TfrmFrame.mnuEditCopyClick(Sender: TObject);
2771  begin
2772    FEditCtrl.CopyToClipboard;
2773  end;
2774  
2775  procedure TfrmFrame.mnuEditPasteClick(Sender: TObject);
2776  begin
2777    FEditCtrl.SelText := Clipboard.AsText;
2778    //FEditCtrl.PasteFromClipboard;  // use AsText to prevent formatting from being pasted
2779  end;
2780  
2781  procedure TfrmFrame.mnuFilePrintClick(Sender: TObject);
2782  begin
2783    case mnuFilePrint.Tag of
2784    CT_NOTES:    frmNotes.RequestPrint;
2785    CT_CONSULTS: frmConsults.RequestPrint;
2786    CT_DCSUMM:   frmDCSumm.RequestPrint;
2787    CT_REPORTS:  frmReports.RequestPrint;
2788    CT_LABS:     frmLabs.RequestPrint;
2789    CT_ORDERS:   frmOrders.RequestPrint;
2790    CT_PROBLEMS: frmProblems.RequestPrint;
2791    CT_SURGERY:  if Assigned(frmSurgery) then frmSurgery.RequestPrint;
2792    end;
2793  end;
2794  
2795  procedure TfrmFrame.WMSysCommand(var Message: TMessage);
2796  begin
2797    case TabToPageID(tabPage.TabIndex) of
2798      CT_NOTES:
2799          if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
2800            with Message do
2801              begin
2802                SendMessage(frmNotes.Handle, Msg, WParam, LParam);
2803                Result := 0;
2804              end
2805          else
2806            inherited;
2807      CT_DCSUMM:
2808          if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboAttending') then
2809            with Message do
2810              begin
2811                SendMessage(frmDCSumm.Handle, Msg, WParam, lParam);
2812                Result := 0;
2813              end
2814          else
2815            inherited;
2816      CT_CONSULTS:
2817          if Assigned(Screen.ActiveControl.Parent) and (Screen.ActiveControl.Parent.Name = 'cboCosigner') then
2818            with Message do
2819              begin
2820                SendMessage(frmConsults.Handle, Msg, WParam, lParam);
2821                Result := 0;
2822              end
2823          else
2824            inherited;
2825    else
2826      inherited;
2827    end;
2828    if Message.WParam = SC_MAXIMIZE then
2829    begin
2830      // form becomes maximized;
2831      frmOrders.mnuOptimizeFieldsClick(self);
2832      frmProblems.mnuOptimizeFieldsClick(self);
2833      frmMeds.mnuOptimizeFieldsClick(self);
2834    end
2835    else if Message.WParam = SC_MINIMIZE then
2836    begin
2837      // form becomes maximized;
2838    end
2839    else if Message.WParam = SC_RESTORE then
2840    begin
2841      // form is restored (from maximized);
2842      frmOrders.mnuOptimizeFieldsClick(self);
2843      frmProblems.mnuOptimizeFieldsClick(self);
2844      frmMeds.mnuOptimizeFieldsClick(self);
2845    end;
2846  end;
2847  
2848  procedure TfrmFrame.RemindersChanged(Sender: TObject);
2849  var
2850    ImgName: string;
2851  begin
2852    pnlReminders.tag := HAVE_REMINDERS;
2853    pnlReminders.Hint := 'Click to display reminders';
2854    case GetReminderStatus of
2855      rsUnknown:
2856        begin
2857          ImgName := 'BMP_REMINDERS_UNKNOWN';
2858          pnlReminders.Caption := 'Reminders';
2859        end;
2860      rsDue:
2861        begin
2862          ImgName := 'BMP_REMINDERS_DUE';
2863          pnlReminders.Caption := 'Due Reminders';
2864        end;
2865      rsApplicable:
2866        begin
2867          ImgName := 'BMP_REMINDERS_APPLICABLE';
2868          pnlReminders.Caption := 'Applicable Reminders';
2869        end;
2870      rsNotApplicable:
2871        begin
2872          ImgName := 'BMP_REMINDERS_OTHER';
2873          pnlReminders.Caption := 'Other Reminders';
2874        end;
2875      else
2876        begin
2877          ImgName := 'BMP_REMINDERS_NONE';
2878          pnlReminders.Hint := 'There are currently no reminders available';
2879          pnlReminders.Caption := pnlReminders.Hint;
2880          pnlReminders.tag := NO_REMINDERS;
2881        end;
2882    end;
2883    if(RemindersEvaluatingInBackground) then
2884    begin
2885      if(anmtRemSearch.ResName = '') then
2886      begin
2887        TORExposedAnimate(anmtRemSearch).OnMouseDown := pnlRemindersMouseDown;
2888        TORExposedAnimate(anmtRemSearch).OnMouseUp   := pnlRemindersMouseUp;
2889        anmtRemSearch.ResHandle := 0;
2890        anmtRemSearch.ResName := 'REMSEARCHAVI';
2891      end;
2892      imgReminder.Visible := FALSE;
2893      anmtRemSearch.Active := TRUE;
2894      anmtRemSearch.Visible := TRUE;
2895      if(pnlReminders.Hint <> '') then
2896        pnlReminders.Hint := CRLF + pnlReminders.Hint + '.';
2897      pnlReminders.Hint := 'Evaluating Reminders...  ' + pnlReminders.Hint;
2898      pnlReminders.Caption := pnlReminders.Hint;
2899    end
2900    else
2901    begin
2902      anmtRemSearch.Visible := FALSE;
2903      imgReminder.Visible := TRUE;
2904      imgReminder.Picture.Bitmap.LoadFromResourceName(hInstance, ImgName);
2905      anmtRemSearch.Active := FALSE;
2906    end;
2907    mnuViewReminders.Enabled := (pnlReminders.tag = HAVE_REMINDERS);
2908  end;
2909  
2910  procedure TfrmFrame.pnlRemindersMouseDown(Sender: TObject;
2911    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2912  begin
2913    if(not InitialRemindersLoaded) then
2914      StartupReminders;
2915    if(pnlReminders.tag = HAVE_REMINDERS) then
2916      pnlReminders.BevelOuter := bvLowered;
2917  end;
2918  
2919  procedure TfrmFrame.pnlRemindersMouseUp(Sender: TObject;
2920    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
2921  begin
2922    pnlReminders.BevelOuter := bvRaised;
2923    if(pnlReminders.tag = HAVE_REMINDERS) then
2924      ViewInfo(mnuViewReminders);
2925  end;
2926  
2927  //--------------------- CIRN-related procedures --------------------------------
2928  
2929  procedure TfrmFrame.SetUpCIRN;
2930  var
2931    i: integer;
2932    aAutoQuery: string;
2933    ASite: TRemoteSite;
2934  begin
2935    uUseVistaWeb := false;
2936    with RemoteSites do
2937    begin
2938      ChangePatient(Patient.DFN);
2939      lblCIRN.Caption := ' Remote Data';
2940      lblCIRN.Alignment := taCenter;
2941      pnlVistaWeb.BevelOuter := bvRaised;
2942      if RemoteDataExists and (RemoteSites.Count > 0) then
2943        begin
2944          lblCIRN.Enabled     := True;
2945          pnlCIRN.TabStop     := True;
2946          lblCIRN.Font.Color  := Get508CompliantColor(clBlue);
2947          lstCIRNLocations.Font.Color  := Get508CompliantColor(clBlue);
2948          lblCIRN.Caption := 'Remote Data';
2949          pnlCIRN.Hint := 'Click to display other facilities having data for this patient.';
2950          lblVistaWeb.Font.Color := Get508CompliantColor(clBlue);
2951          pnlVistaWeb.Hint := 'Click to go to VistaWeb to see data from other facilities for this patient.';
2952          if RemoteSites.Count > 0 then
2953            lstCIRNLocations.Items.Add('0' + U + 'All Available Sites');
2954          for i := 0 to RemoteSites.Count - 1 do
2955            begin
2956              ASite := TRemoteSite(SiteList[i]);
2957              lstCIRNLocations.Items.Add(ASite.SiteID + U + ASite.SiteName + U +
2958                FormatFMDateTime('mmm dd yyyy hh:nn', ASite.LastDate));
2959            end;
2960        end
2961      else
2962        begin
2963          lblCIRN.Font.Color  := clWindowText;
2964          lblVistaWeb.Font.Color := clWindowText;
2965          lblCIRN.Enabled     := False;
2966          pnlCIRN.TabStop     := False;
2967          pnlCIRN.Hint := NoDataReason;
2968        end;
2969      aAutoQuery := AutoRDV;        //Check to see if Remote Queries should be used for all available sites
2970      if (aAutoQuery = '1') and (lstCIRNLocations.Count > 0) then
2971        begin
2972          lstCIRNLocations.ItemIndex := 1;
2973          lstCIRNLocations.Checked[1] := true;
2974          lstCIRNLocationsClick(self);
2975        end;
2976    end;
2977  end;
2978  
2979  procedure TfrmFrame.pnlCIRNClick(Sender: TObject);
2980  begin
2981    ViewInfo(mnuViewRemoteData);
2982  end;
2983  
2984  procedure TfrmFrame.lstCIRNLocationsClick(Sender: TObject);
2985  var
2986    iIndex,j,iAll,iCur: integer;
2987    aMsg,s: string;
2988    AccessStatus: integer;
2989  begin
2990    iAll := 1;
2991    AccessStatus := 0;
2992    iIndex := lstCIRNLocations.ItemIndex;
2993    if not CheckHL7TCPLink then
2994      begin
2995        InfoBox('Local HL7 TCP Link is down.' + CRLF + 'Unable to retrieve remote data.', TC_DGSR_ERR, MB_OK);
2996        lstCIRNLocations.Checked[iIndex] := false;
2997        Exit;
2998      end;
2999    if lstCIRNLocations.Items.Count > 1 then
3000      if piece(lstCIRNLocations.Items[1],'^',1) = '0' then
3001        iAll := 2;
3002    with frmReports do
3003      if piece(uRemoteType,'^',2) = 'V' then
3004        begin
3005          lvReports.Items.BeginUpdate;
3006          lvReports.Items.Clear;
3007          lvReports.Columns.Clear;
3008          lvReports.Items.EndUpdate;
3009        end;
3010    uReportInstruction := '';
3011    frmReports.TabControl1.Tabs.Clear;
3012    frmLabs.TabControl1.Tabs.Clear;
3013    frmReports.TabControl1.Tabs.AddObject('Local',nil);
3014    frmLabs.TabControl1.Tabs.AddObject('Local',nil);
3015    StatusText('Checking Remote Sites...');
3016    if piece(lstCIRNLocations.Items[iIndex],'^',1) = '0' then // All sites have been clicked
3017      if lstCIRNLocations.Checked[iIndex] = false then // All selection is being turned off
3018        begin
3019          with RemoteSites.SiteList do
3020          for j := 0 to Count - 1 do
3021            if lstCIRNLocations.Checked[j+1] = true then
3022              begin
3023                lstCIRNLocations.Checked[j+1] := false;
3024                TRemoteSite(RemoteSites.SiteList[j]).Selected := false;
3025                TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3026                TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3027              end;
3028        end
3029      else
3030        begin
3031          with RemoteSites.SiteList do
3032          for j := 0 to Count - 1 do
3033              begin
3034                Screen.Cursor := crHourGlass;
3035                {CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[j]).SiteID,
3036                  AccessStatus);}
3037                Screen.Cursor := crDefault;
3038                aMsg := aMsg + ' at site: ' + TRemoteSite(Items[j]).SiteName;
3039                s := lstCIRNLocations.Items[j+1];
3040                lstCIRNLocations.Items[j+1] := pieces(s, '^', 1, 3);
3041                case AccessStatus of
3042                DGSR_FAIL: begin
3043                             if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility
3044                               begin
3045                                 lstCIRNLocations.Checked[j+1] := true;
3046                                 TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3047                                 TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3048                                 TRemoteSite(Items[j]).Selected := true;
3049                               end
3050                             else
3051                               begin
3052                                 InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
3053                                 lstCIRNLocations.Checked[j+1] := false;
3054                                 lstCIRNLocations.Items[j+1] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
3055                                 TRemoteSite(Items[j]).Selected := false;
3056                                 Continue;
3057                               end;
3058                           end;
3059                DGSR_NONE: begin
3060                             lstCIRNLocations.Checked[j+1] := true;
3061                             TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3062                             TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3063                             TRemoteSite(Items[j]).Selected := true;
3064                           end;
3065                DGSR_SHOW: begin
3066                             InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
3067                             lstCIRNLocations.Checked[j+1] := true;
3068                             TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3069                             TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3070                             TRemoteSite(Items[j]).Selected := true;
3071                           end;
3072                DGSR_ASK:  if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
3073                             MB_DEFBUTTON2) = IDYES then
3074                             begin
3075                               lstCIRNLocations.Checked[j+1] := true;
3076                               TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
3077                               TRemoteSite(RemoteSites.SiteList[j]).LabClear;
3078                               TRemoteSite(Items[j]).Selected := true;
3079                             end
3080                             else
3081                               begin
3082                                 lstCIRNLocations.Checked[j+1] := false;
3083                                 lstCIRNLocations.Items[j+1] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
3084                                 TRemoteSite(Items[j]).Selected := false;
3085                                 Continue;
3086                               end;
3087                else       begin
3088                             InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
3089                             lstCIRNLocations.Checked[j+1] := false;
3090                             lstCIRNLocations.Items[j+1] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
3091                             TRemoteSite(Items[j]).Selected := false;
3092                             Continue;
3093                           end;
3094                end;
3095              end;
3096        end
3097    else
3098      begin
3099        if iIndex > 0 then
3100          begin
3101            iCur := iIndex - iAll;
3102            TRemoteSite(RemoteSites.SiteList[iCur]).Selected :=
3103              lstCIRNLocations.Checked[iIndex];
3104            if lstCIRNLocations.Checked[iIndex] = true then
3105              with RemoteSites.SiteList do
3106              begin
3107                Screen.Cursor := crHourGlass;
3108                {CheckRemotePatient(aMsg, Patient.DFN + ';' + Patient.ICN,TRemoteSite(Items[iCur]).SiteID,
3109                  AccessStatus);}
3110                Screen.Cursor := crDefault;
3111                aMsg := aMsg + ' at site: ' + TRemoteSite(Items[iCur]).SiteName;
3112                s := lstCIRNLocations.Items[iIndex];
3113                lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3);
3114                case AccessStatus of
3115                DGSR_FAIL: begin
3116                             if piece(aMsg,':',1) = 'RPC name not found at site' then //Allow for backward compatibility
3117                               begin
3118                                 lstCIRNLocations.Checked[iIndex] := true;
3119                                 TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3120                                 TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3121                                 TRemoteSite(Items[iCur]).Selected := true;
3122                               end
3123                             else
3124                               begin
3125                                 InfoBox(aMsg, TC_DGSR_ERR, MB_OK);
3126                                 lstCIRNLocations.Checked[iIndex] := false;
3127                                 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_ERR;
3128                                 TRemoteSite(Items[iCur]).Selected := false;
3129                               end;
3130                           end;
3131                DGSR_NONE: begin
3132                             lstCIRNLocations.Checked[iIndex] := true;
3133                             TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3134                             TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3135                             TRemoteSite(Items[iCur]).Selected := true;
3136                           end;
3137                DGSR_SHOW: begin
3138                             InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
3139                             lstCIRNLocations.Checked[iIndex] := true;
3140                             TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3141                             TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3142                             TRemoteSite(Items[iCur]).Selected := true;
3143                           end;
3144                DGSR_ASK:  if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
3145                             MB_DEFBUTTON2) = IDYES then
3146                             begin
3147                               lstCIRNLocations.Checked[iIndex] := true;
3148                               TRemoteSite(RemoteSites.SiteList[iCur]).ReportClear;
3149                               TRemoteSite(RemoteSites.SiteList[iCur]).LabClear;
3150                               TRemoteSite(Items[iCur]).Selected := true;
3151                             end
3152                             else
3153                               begin
3154                                 lstCIRNLocations.Checked[iIndex] := false;
3155                                 lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_SHOW;
3156                               end;
3157                else       begin
3158                             InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
3159                             lstCIRNLocations.Checked[iIndex] := false;
3160                             lstCIRNLocations.Items[iIndex] := pieces(s, '^', 1, 3) + '^' + TC_DGSR_DENY;
3161                             TRemoteSite(Items[iCur]).Selected := false;
3162                           end;
3163                end;
3164                with frmReports do
3165                  if piece(uRemoteType,'^',1) = '1' then
3166                    if not(piece(uRemoteType,'^',2) = 'V') then
3167                      begin
3168                        TabControl1.Visible := true;
3169                        pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
3170                      end;
3171                with frmLabs do
3172                  if piece(uRemoteType,'^',1) = '1' then
3173                    if not(piece(uRemoteType,'^',2) = 'V') then
3174                      begin
3175                        TabControl1.Visible := true;
3176                        pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
3177                      end;
3178                  {if lstReports.ItemIndex > -1 then
3179                    if piece(lstReports.Items[lstReports.ItemIndex],'^',3) = '1' then
3180                      if not(piece(lstReports.Items[lstReports.ItemIndex],'^',5) = 'V') then
3181                        TabControl1.Visible := true;}
3182              end;
3183          end;
3184      end;
3185    with RemoteSites.SiteList do
3186      for j := 0 to Count - 1 do
3187        if TRemoteSite(Items[j]).Selected then
3188          begin
3189            frmReports.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
3190              TRemoteSite(Items[j]));
3191            frmLabs.TabControl1.Tabs.AddObject(TRemoteSite(Items[j]).SiteName,
3192              TRemoteSite(Items[j]));
3193          end;
3194    //uReportID, uLabRepID = Report ID's set when report is selected (from file 101.24)
3195    if not(Piece(uReportID,':',1) = 'OR_VWAL')
3196      and not(Piece(uReportID,':',1) = 'OR_VWRX')
3197      and not(Piece(uReportID,':',1) = 'OR_VWVS')
3198      and (frmReports.tvReports.SelectionCount > 0) then frmReports.tvReportsClick(self);
3199    if not(uLabRepID = '6:GRAPH') and not(uLabRepID = '5:WORKSHEET')
3200      and not(uLabRepID = '4:SELECTED TESTS BY DATE')
3201      and (frmLabs.tvReports.SelectionCount > 0) then frmLabs.tvReportsClick(self);
3202    //if frmLabs.lstReports.ItemIndex > -1 then frmLabs.ExtlstReportsClick(self, true);
3203    StatusText('');
3204  end;
3205  
3206  procedure TfrmFrame.popCIRNCloseClick(Sender: TObject);
3207  begin
3208    lstCIRNLocations.Visible := False;
3209    lstCirnLocations.SendToBack;
3210    pnlCIRN.BevelOuter := bvRaised;
3211  end;
3212  
3213  procedure TfrmFrame.popCIRNSelectAllClick(Sender: TObject);
3214  
3215  begin
3216    lstCIRNLocations.ItemIndex := 0;
3217    lstCIRNLocations.Checked[0] := true;
3218    lstCIRNLocations.OnClick(Self);
3219  end;
3220  
3221  procedure TfrmFrame.popCIRNSelectNoneClick(Sender: TObject);
3222  
3223  begin
3224    lstCIRNLocations.ItemIndex := 0;
3225    lstCIRNLocations.Checked[0] := false;
3226    lstCIRNLocations.OnClick(Self);
3227  end;
3228  
3229  procedure TfrmFrame.mnuFilePrintSetupClick(Sender: TObject);
3230  var
3231    CurrPrt: string;
3232  begin
3233    CurrPrt := SelectDevice(Self, Encounter.Location, True, 'Print Device Selection');
3234    User.CurrentPrinter := Piece(CurrPrt, U, 1);
3235  end;
3236  
3237  procedure TfrmFrame.lstCIRNLocationsChange(Sender: TObject);
3238  begin
3239    {if lstCIRNLocations.ItemIndex > 0 then
3240      if (lstCIRNLocations.Selected[lstCIRNLocations.ItemIndex] = true) and (uUpdateStat = false) then
3241        if not (piece(lstCIRNLocations.Items[1],'^',1) = '0') then
3242          lstCIRNLocations.OnClick(nil);
3243    // Causing Access Violations}
3244  end;
3245  
3246  procedure TfrmFrame.LabInfo1Click(Sender: TObject);
3247  begin
3248    ExecuteLabInfo;
3249  end;
3250  
3251  procedure TfrmFrame.mnuFileNotifRemoveClick(Sender: TObject);
3252  const
3253    TC_REMOVE_ALERT  = 'Remove Current Alert';
3254    TX_REMOVE_ALERT1 = 'This action will delete the alert you are currently processing; the alert will ' + CRLF +
3255          'disappear automatically when all orders have been acted on, but this action may' + CRLF +
3256          'be used to remove the alert if some orders are to be left unchanged.' + CRLF + CRLF +
3257          'Your ';
3258    TX_REMOVE_ALERT2 = ' alert for ';
3259    TX_REMOVE_ALERT3 = ' will be deleted!' + CRLF + CRLF + 'Are you sure?';
3260  var
3261    AlertMsg, AlertType: string;
3262  
3263    procedure StopProcessingNotifs;
3264      begin
3265        Notifications.Clear;
3266        FNextButtonActive := False;
3267        stsArea.Panels[2].Bevel := pbLowered;
3268        mnuFileNext.Enabled := False;
3269        mnuFileNotifRemove.Enabled := False;
3270      end;
3271  
3272  begin
3273    if not Notifications.Active then Exit;
3274    case Notifications.Followup of
3275      NF_MEDICATIONS_EXPIRING_INPT    : AlertType := 'Expiring Medications';
3276      NF_MEDICATIONS_EXPIRING_OUTPT   : AlertType := 'Expiring Medications';
3277      NF_ORDER_REQUIRES_ELEC_SIGNATURE: AlertType := 'Unsigned Orders';
3278      NF_FLAGGED_ORDERS               : AlertType := 'Flagged Orders (for clarification)';
3279      NF_UNVERIFIED_MEDICATION_ORDER  : AlertType := 'Unverified Medication Order';
3280      NF_UNVERIFIED_ORDER             : AlertType := 'Unverified Order';
3281      NF_FLAGGED_OI_EXP_INPT          : AlertType := 'Flagged Orderable Item (INPT)';
3282      NF_FLAGGED_OI_EXP_OUTPT         : AlertType := 'Flagged Orderable Item (OUTPT)';
3283    else
3284      Exit;
3285    end;
3286    AlertMsg := TX_REMOVE_ALERT1 + AlertType + TX_REMOVE_ALERT2 + Patient.Name + TX_REMOVE_ALERT3;
3287    if InfoBox(AlertMsg, TC_REMOVE_ALERT, MB_YESNO) = ID_YES then
3288      begin
3289        Notifications.DeleteForCurrentUser;
3290        Notifications.Next;   // avoid prompt if no more alerts selected to process  {v14a RV}
3291        if Notifications.Active then
3292          begin
3293            if (InfoBox(TX_NOTIF_STOP, TC_NOTIF_STOP, MB_YESNO) = ID_NO) then
3294              begin
3295                Notifications.Prior;
3296                mnuFileNextClick(Self);
3297              end
3298            else
3299              StopProcessingNotifs;
3300          end
3301        else
3302          StopProcessingNotifs;
3303      end;
3304  end;
3305  
3306  procedure TfrmFrame.mnuToolsOptionsClick(Sender: TObject);
3307  // personal preferences - changes may need to be applied to chart
3308  var
3309    i: integer;
3310  begin
3311    i := 0;
3312    DialogOptions(i);
3313  end;
3314  
3315  procedure TfrmFrame.LoadUserPreferences;
3316  begin
3317    LoadSizesForUser;
3318    GetUserTemplateDefaults(TRUE);
3319  end;
3320  
3321  procedure TfrmFrame.SaveUserPreferences;
3322  begin
3323    SaveSizesForUser;         // position & size settings
3324    SaveUserTemplateDefaults;
3325  end;
3326  
3327  procedure TfrmFrame.mnuFileRefreshClick(Sender: TObject);
3328  begin
3329    FRefreshing := TRUE;
3330    try
3331      mnuFileOpenClick(Self);
3332    finally
3333      FRefreshing := FALSE;
3334      OrderPrintForm := FALSE;
3335    end;
3336  end;
3337  
3338  procedure TfrmFrame.AppActivated(Sender: TObject);
3339  begin
3340    if assigned(FOldActivate) then
3341      FOldActivate(Sender);
3342    SetActiveWindow(Application.Handle);
3343    if ScreenReaderSystemActive and assigned(Patient) and (Patient.Name <> '') and (Patient.Status <> '') then
3344        SpeakTabAndPatient;
3345  end;
3346  
3347  // close Treatment Factor hint window if alt-tab pressed.
3348  procedure TfrmFrame.AppDeActivated(Sender: TObject);
3349  begin
3350    if FRVTFhintWindowActive then
3351    begin
3352       FRVTFHintWindow.ReleaseHandle;
3353       FRVTFHintWindowActive := False;
3354    end
3355    else
3356    if FOSTFHintWndActive then
3357    begin
3358       FOSTFhintWindow.ReleaseHandle;
3359       FOSTFHintWndActive := False ;
3360    end;
3361    if FHintWinActive then   // graphing - hints on values
3362    begin
3363      FHintWin.ReleaseHandle;
3364      FHintWinActive := false;
3365    end;
3366  end;
3367  
3368  
3369  procedure TfrmFrame.CreateTab(ATabID: integer; ALabel: string);
3370  begin
3371    //  old comment - try making owner self (instead of application) to see if solves TMenuItem.Insert bug
3372    case ATabID of
3373      CT_PROBLEMS : begin
3374                      frmProblems := TfrmProblems.Create(Self);
3375                      frmProblems.Parent := pnlPage;
3376                    end;
3377      CT_MEDS     : begin
3378                      frmMeds := TfrmMeds.Create(Self);
3379                      frmMeds.Parent := pnlPage;
3380                      frmMeds.InitfMedsSize;
3381                    end;
3382      CT_ORDERS   : begin
3383                      frmOrders := TfrmOrders.Create(Self);
3384                      frmOrders.Parent := pnlPage;
3385                    end;
3386      CT_HP       : begin
3387                      // not yet
3388                    end;
3389      CT_NOTES    : begin
3390                      frmNotes := TfrmNotes.Create(Self);
3391                      frmNotes.Parent := pnlPage;
3392                    end;
3393      CT_CONSULTS : begin
3394                      frmConsults := TfrmConsults.Create(Self);
3395                      frmConsults.Parent := pnlPage;
3396                    end;
3397      CT_DCSUMM   : begin
3398                      frmDCSumm := TfrmDCSumm.Create(Self);
3399                      frmDCSumm.Parent := pnlPage;
3400                    end;
3401      CT_LABS     : begin
3402                      frmLabs := TfrmLabs.Create(Self);
3403                      frmLabs.Parent := pnlPage;
3404                    end;
3405      CT_REPORTS  : begin
3406                      frmReports := TfrmReports.Create(Self);
3407                      frmReports.Parent := pnlPage;
3408                    end;
3409      CT_SURGERY  : begin
3410                      frmSurgery := TfrmSurgery.Create(Self);
3411                      frmSurgery.Parent := pnlPage;
3412                    end;
3413      CT_COVER    : begin
3414                      frmCover := TfrmCover.Create(Self);
3415                      frmCover.Parent := pnlPage;
3416                    end;
3417    else
3418      Exit;
3419    end;
3420    if ATabID = CT_COVER then
3421      begin
3422        uTabList.Insert(0, IntToStr(ATabID));
3423        tabPage.Tabs.Insert(0, ALabel);
3424        tabPage.TabIndex := 0;
3425      end
3426    else
3427      begin
3428        uTabList.Add(IntToStr(ATabID));
3429        tabPage.Tabs.Add(ALabel);
3430      end;
3431  end;
3432  
3433  procedure TfrmFrame.ShowHideChartTabMenus(AMenuItem: TMenuItem);
3434  var
3435    i: integer;
3436  begin
3437    for i := 0 to AMenuItem.Count - 1 do
3438      AMenuItem.Items[i].Visible := TabExists(AMenuItem.Items[i].Tag);
3439  end;
3440  
3441  function TfrmFrame.TabExists(ATabID: integer): boolean;
3442  begin
3443    Result := (uTabList.IndexOf(IntToStr(ATabID)) > -1)
3444  end;
3445  
3446  procedure TfrmFrame.ReportsOnlyDisplay;
3447  begin
3448  
3449  // Configure