1661 lines
52 KiB
Plaintext
1661 lines
52 KiB
Plaintext
unit uCore;
|
|
{ The core objects- patient, user, and encounter are defined here. All other clinical objects
|
|
in the GUI assume that these core objects exist. }
|
|
|
|
{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
|
|
|
|
interface
|
|
|
|
uses SysUtils, Windows, Classes, Forms, ORFn, rCore, uConst, ORClasses, uCombatVet;
|
|
|
|
type
|
|
TUser = class(TObject)
|
|
private
|
|
FDUZ: Int64; // User DUZ (IEN in New Person file)
|
|
FName: string; // User Name (mixed case)
|
|
FUserClass: Integer; // User Class (based on OR keys for now)
|
|
FCanSignOrders: Boolean; // Has ORES key
|
|
FIsProvider: Boolean; // Has VA Provider key
|
|
FOrderRole: Integer;
|
|
FNoOrdering: Boolean;
|
|
FEnableVerify: Boolean;
|
|
FDTIME: Integer;
|
|
FCountDown: Integer;
|
|
FCurrentPrinter: string;
|
|
FNotifyAppsWM: Boolean;
|
|
FDomain: string;
|
|
FPtMsgHang: Integer;
|
|
FService: Integer;
|
|
FAutoSave: Integer;
|
|
FInitialTab: Integer;
|
|
FUseLastTab: Boolean;
|
|
FWebAccess: Boolean;
|
|
FIsRPL: string;
|
|
FRPLList: string;
|
|
FHasCorTabs: Boolean;
|
|
FHasRptTab: Boolean;
|
|
FIsReportsOnly: Boolean;
|
|
FToolsRptEdit: Boolean;
|
|
FDisableHold: Boolean;
|
|
FGECStatus: Boolean;
|
|
FStationNumber: string;
|
|
FIsProductionAccount: boolean;
|
|
public
|
|
constructor Create;
|
|
function HasKey(const KeyName: string): Boolean;
|
|
procedure SetCurrentPrinter(Value: string);
|
|
property DUZ: Int64 read FDUZ;
|
|
property Name: string read FName;
|
|
property UserClass: Integer read FUserClass;
|
|
property CanSignOrders: Boolean read FCanSignOrders;
|
|
property IsProvider: Boolean read FIsProvider;
|
|
property OrderRole: Integer read FOrderRole;
|
|
property NoOrdering: Boolean read FNoOrdering;
|
|
property EnableVerify: Boolean read FEnableVerify;
|
|
property DTIME: Integer read FDTIME;
|
|
property CountDown: Integer read FCountDown;
|
|
property PtMsgHang: Integer read FPtMsgHang;
|
|
property Service: Integer read FService;
|
|
property AutoSave: Integer read FAutoSave;
|
|
property InitialTab: Integer read FInitialTab;
|
|
property UseLastTab: Boolean read FUseLastTab;
|
|
property WebAccess: Boolean read FWebAccess;
|
|
property DisableHold: Boolean read FDisableHold;
|
|
property IsRPL: string read FIsRPL;
|
|
property RPLList: string read FRPLList;
|
|
property HasCorTabs: Boolean read FHasCorTabs;
|
|
property HasRptTab: Boolean read FHasRptTab;
|
|
property IsReportsOnly: Boolean read FIsReportsOnly;
|
|
property ToolsRptEdit: Boolean read FToolsRptEdit;
|
|
property CurrentPrinter: string read FCurrentPrinter write SetCurrentPrinter;
|
|
property GECStatus: Boolean read FGECStatus;
|
|
property StationNumber: string read FStationNumber;
|
|
property IsProductionAccount: boolean read FIsProductionAccount;
|
|
end;
|
|
|
|
TPatient = class(TObject)
|
|
private
|
|
FDFN: string; // Internal Entry Number in Patient file //*DFN*
|
|
FICN: string; // Integration Control Number from MPI
|
|
FName: string; // Patient Name (mixed case)
|
|
FSSN: string; // Patient Identifier (generally SSN)
|
|
FDOB: TFMDateTime; // Date of Birth in Fileman format
|
|
FAge: Integer; // Patient Age
|
|
FSex: Char; // Male, Female, Unknown
|
|
FCWAD: string; // chars identify if pt has CWAD warnings
|
|
FRestricted: Boolean; // True if this is a restricted record
|
|
FInpatient: Boolean; // True if that patient is an inpatient
|
|
FStatus: string; // Patient status indicator (Inpatient or Outpatient)
|
|
FLocation: Integer; // IEN in Hosp Loc if inpatient
|
|
FWardService: string;
|
|
FSpecialty: Integer; // IEN of the treating specialty if inpatient
|
|
FAdmitTime: TFMDateTime; // Admit date/time if inpatient
|
|
FSrvConn: Boolean; // True if patient is service connected
|
|
FSCPercent: Integer; // Per Cent Service Connection
|
|
FPrimTeam: string; // name of primary care team
|
|
FPrimProv: string; // name of primary care provider
|
|
FAttending: string; // if inpatient, name of attending
|
|
FAssociate: string; // if inpatient, name of associate
|
|
FDateDied: TFMDateTime; // Date of Patient Death (<=0 or still alive)
|
|
FDateDiedLoaded: boolean; // Used to determine of DateDied has been loaded
|
|
FCombatVet : TCombatVet; // Object Holding CombatVet Data
|
|
procedure SetDFN(const Value: string);
|
|
function GetDateDied: TFMDateTime;
|
|
function GetCombatVet: TCombatVet; // *DFN*
|
|
public
|
|
procedure Clear;
|
|
destructor Destroy; override;
|
|
property DFN: string read FDFN write SetDFN; //*DFN*
|
|
property ICN: string read FICN;
|
|
property Name: string read FName;
|
|
property SSN: string read FSSN;
|
|
property DOB: TFMDateTime read FDOB;
|
|
property Age: Integer read FAge;
|
|
property Sex: Char read FSex;
|
|
property CWAD: string read FCWAD;
|
|
property Inpatient: Boolean read FInpatient;
|
|
property Status: string read FStatus;
|
|
property Location: Integer read FLocation;
|
|
property WardService: string read FWardService;
|
|
property Specialty: Integer read FSpecialty;
|
|
property AdmitTime: TFMDateTime read FAdmitTime;
|
|
property DateDied: TFMDateTime read GetDateDied;
|
|
property ServiceConnected: Boolean read FSrvConn;
|
|
property SCPercent: Integer read FSCPercent;
|
|
property PrimaryTeam: string read FPrimTeam;
|
|
property PrimaryProvider: string read FPrimProv;
|
|
property Attending: string read FAttending;
|
|
property Associate: string read FAssociate;
|
|
property CombatVet: TCombatVet read GetCombatVet;
|
|
end;
|
|
|
|
TEncounter = class(TObject, IORNotifier)
|
|
private
|
|
FChanged: Boolean; // one or more visit fields have changed
|
|
FDateTime: TFMDateTime; // date/time of encounter (appt, admission)
|
|
FInpatient: Boolean; // true if this is an inpatient encounter
|
|
FLocation: Integer; // IEN in Hospital Location file
|
|
FLocationName: string; // Name in Hospital Location file
|
|
FLocationText: string; // Name + Date/Time or Name + RoomBed
|
|
FProvider: Int64 ; // IEN in New Person file
|
|
FProviderName: string; // Name in New Person file
|
|
FVisitCategory: Char; // A=ambulatory,T=Telephone,H=inpt,E=historic
|
|
FStandAlone: Boolean; // true if visit not related to appointment
|
|
FNotifier: IORNotifier; // Event handlers for location changes
|
|
function GetLocationName: string;
|
|
function GetLocationText: string;
|
|
function GetProviderName: string;
|
|
function GetVisitCategory: Char;
|
|
function GetVisitStr: string;
|
|
procedure SetDateTime(Value: TFMDateTime);
|
|
procedure SetInpatient(Value: Boolean);
|
|
procedure SetLocation(Value: Integer);
|
|
procedure SetProvider(Value: Int64);
|
|
procedure SetStandAlone(Value: Boolean);
|
|
procedure SetVisitCategory(Value: Char);
|
|
procedure UpdateText;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure EncounterSwitch(Loc: integer; LocName, LocText: string; DT: TFMDateTime; vCat: Char);
|
|
function NeedVisit: Boolean;
|
|
property DateTime: TFMDateTime read FDateTime write SetDateTime;
|
|
property Inpatient: Boolean read FInpatient write SetInpatient;
|
|
property Location: Integer read FLocation write SetLocation;
|
|
property LocationName: string read GetLocationName write FLocationName;
|
|
property LocationText: string read GetLocationText write FLocationText;
|
|
property Provider: Int64 read FProvider write SetProvider;
|
|
property ProviderName: string read GetProviderName;
|
|
property StandAlone: Boolean read FStandAlone write SetStandAlone;
|
|
property VisitCategory: Char read GetVisitCategory write SetVisitCategory;
|
|
property VisitStr: string read GetVisitStr;
|
|
property Notifier: IORNotifier read FNotifier implements IORNotifier;
|
|
end;
|
|
|
|
TChangeItem = class
|
|
private
|
|
FItemType: Integer;
|
|
FID: string;
|
|
FText: string;
|
|
FGroupName: string;
|
|
FSignState: Integer;
|
|
FParentID : string;
|
|
FUser : Int64;
|
|
FOrderDG : String;
|
|
FDCOrder : boolean;
|
|
FDelay : boolean;
|
|
constructor Create(AnItemType: Integer; const AnID, AText, AGroupName: string;
|
|
ASignState: Integer; AParentID: string = ''; User: int64 = 0; OrderDG: string = ''; DCOrder: boolean = False; Delay: boolean = False);
|
|
public
|
|
property ItemType: Integer read FItemType;
|
|
property ID: string read FID;
|
|
property Text: string read FText;
|
|
property GroupName: string read FGroupName;
|
|
property SignState: Integer read FSignState write FSignState;
|
|
property ParentID : string read FParentID;
|
|
property User: Int64 read FUser write FUser;
|
|
property OrderDG: string read FOrderDG write FOrderDG;
|
|
property DCOrder: boolean read FDCOrder write FDCOrder;
|
|
property Delay: boolean read FDelay write FDelay;
|
|
end;
|
|
|
|
TORRemoveChangesEvent = procedure(Sender: TObject; ChangeItem: TChangeItem) of object; {**RV**}
|
|
|
|
TChanges = class
|
|
private
|
|
FCount: Integer;
|
|
FDocuments: TList;
|
|
FOrders: TList;
|
|
FOrderGrp: TStringList;
|
|
FPCE: TList;
|
|
FPCEGrp: TStringList;
|
|
FOnRemove: TORRemoveChangesEvent; {**RV**}
|
|
private
|
|
procedure AddUnsignedToChanges;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Add(ItemType: Integer; const AnID, ItemText, GroupName: string; SignState: Integer; AParentID: string = '';
|
|
User: int64 = 0; OrderDG: String = ''; DCOrder: boolean = FALSE; Delay: boolean = False);
|
|
procedure Clear;
|
|
function CanSign: Boolean;
|
|
function Exist(ItemType: Integer; const AnID: string): Boolean;
|
|
function ExistForOrder(const AnID: string): Boolean;
|
|
function Locate(ItemType: Integer; const AnID: string): TChangeItem;
|
|
procedure Remove(ItemType: Integer; const AnID: string);
|
|
procedure ReplaceID(ItemType: Integer; const OldID, NewID: string);
|
|
procedure ReplaceSignState(ItemType: Integer; const AnID: string; NewState: Integer);
|
|
procedure ReplaceText(ItemType: Integer; const AnID, NewText: string);
|
|
procedure ReplaceODGrpName(const AnODID, NewGrp: string);
|
|
procedure ChangeOrderGrp(const oldGrpName,newGrpName: string);
|
|
function RequireReview: Boolean;
|
|
property Count: Integer read FCount;
|
|
property Documents: TList read FDocuments;
|
|
property OnRemove: TORRemoveChangesEvent read FOnRemove write FOnRemove; {**RV**}
|
|
property Orders: TList read FOrders;
|
|
property PCE: TList read FPCE;
|
|
property OrderGrp: TStringList read FOrderGrp;
|
|
property PCEGrp: TStringList read FPCEGrp;
|
|
end;
|
|
|
|
TNotifyItem = class
|
|
private
|
|
DFN: string;
|
|
FollowUp: Integer;
|
|
//AlertData: string;
|
|
RecordID: string;
|
|
HighLightSection: String;
|
|
end;
|
|
|
|
TNotifications = class
|
|
private
|
|
FActive: Boolean;
|
|
FList: TList;
|
|
FCurrentIndex: Integer;
|
|
FNotifyItem: TNotifyItem;
|
|
function GetDFN: string; //*DFN*
|
|
function GetFollowUp: Integer;
|
|
function GetAlertData: string;
|
|
function GetHighLightSection: String; //CB
|
|
function GetRecordID: string;
|
|
function GetText: string;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Add(const ADFN: string; AFollowUp: Integer; const ARecordID: string; AHighLightSection : string = ''); //*DFN* CB
|
|
procedure Clear;
|
|
procedure Next;
|
|
procedure Prior;
|
|
procedure Delete;
|
|
procedure DeleteForCurrentUser;
|
|
property Active: Boolean read FActive;
|
|
property DFN: string read GetDFN; //*DFN*
|
|
property FollowUp: Integer read GetFollowUp;
|
|
property AlertData: string read GetAlertData;
|
|
property RecordID: string read GetRecordID;
|
|
property Text: string read GetText;
|
|
property HighLightSection: String read GetHighLightSection; //cb
|
|
end;
|
|
|
|
TRemoteSite = class
|
|
private
|
|
FSiteID: string;
|
|
FSiteName: string;
|
|
FLastDate: TFMDateTime;
|
|
FSelected: Boolean;
|
|
FRemoteHandle: string;
|
|
FLabRemoteHandle: string;
|
|
FQueryStatus: string;
|
|
FLabQueryStatus: string;
|
|
FData: TStringList;
|
|
FLabData: TStringList;
|
|
FCurrentLabQuery: string;
|
|
FCurrentReportQuery: string;
|
|
procedure SetSelected(Value: Boolean);
|
|
public
|
|
destructor Destroy; override;
|
|
constructor Create(ASite: string);
|
|
procedure ReportClear;
|
|
procedure LabClear;
|
|
property SiteID : string read FSiteID;
|
|
property SiteName: string read FSiteName;
|
|
property LastDate: TFMDateTime read FLastDate;
|
|
property Selected: boolean read FSelected write SetSelected;
|
|
property RemoteHandle: string read FRemoteHandle write FRemoteHandle;
|
|
property QueryStatus: string read FQueryStatus write FQueryStatus;
|
|
property Data: TStringList read FData write FData;
|
|
property LabRemoteHandle: string read FLabRemoteHandle write FLabRemoteHandle;
|
|
property LabQueryStatus: string read FLabQueryStatus write FLabQueryStatus;
|
|
property LabData: TStringList read FLabData write FLabData;
|
|
property CurrentLabQuery: string read FCurrentLabQuery write FCurrentLabQuery;
|
|
property CurrentReportQuery: string read FCurrentReportQuery write FCurrentReportQuery;
|
|
end;
|
|
|
|
TRemoteSiteList = class
|
|
private
|
|
FCount: integer;
|
|
FSiteList: TList;
|
|
FRemoteDataExists: Boolean;
|
|
FNoDataReason: string;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Add(ASite: string);
|
|
procedure ChangePatient(const DFN: string);
|
|
procedure Clear;
|
|
property Count : integer read FCount;
|
|
property SiteList : TList read FSiteList;
|
|
property RemoteDataExists: Boolean read FRemoteDataExists;
|
|
property NoDataReason : string read FNoDataReason;
|
|
end;
|
|
|
|
TRemoteReport = class
|
|
private
|
|
FReport: string;
|
|
FHandle: string;
|
|
public
|
|
constructor Create(AReport: string);
|
|
destructor Destroy; override;
|
|
property Handle :string read FHandle write FHandle;
|
|
property Report :string read FReport write FReport;
|
|
end;
|
|
|
|
TRemoteReportList = class
|
|
private
|
|
FCount: integer;
|
|
FReportList: TList;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Add(AReportList, AHandle: string);
|
|
procedure Clear;
|
|
property Count :integer read FCount;
|
|
property ReportList :TList read FReportList;
|
|
end;
|
|
|
|
PReportTreeObject = ^TReportTreeObject;
|
|
TReportTreeObject = Record
|
|
ID : String; //Report ID
|
|
Heading : String; //Report Heading
|
|
Remote : String; //Remote Data Capable
|
|
RptType : String; //Report Type
|
|
Category : String; //Report Category
|
|
RPCName : String; //Associated RPC
|
|
IFN : String; //IFN of report in file 101.24
|
|
HDR : String; //HDR is source of data if = 1
|
|
end;
|
|
|
|
var
|
|
User: TUser;
|
|
Patient: TPatient;
|
|
Encounter: TEncounter = nil;
|
|
Changes: TChanges;
|
|
RemoteSites: TRemoteSiteList;
|
|
RemoteReports: TRemoteReportList;
|
|
Notifications: TNotifications;
|
|
HasFlag: boolean;
|
|
FlagList: TStringList;
|
|
//hds7591 Clinic/Ward movement.
|
|
TempEncounterLoc: Integer; // used to Save Encounter Location when user selected "Review Sign Changes" from "File"
|
|
TempEncounterLocName: string; // since in the path PatientRefresh is done prior to checking if patient has been admitted while entering OPT orders.
|
|
TempEncounterText: string;
|
|
TempEncounterDateTime: TFMDateTime;
|
|
TempEncounterVistCat: Char;
|
|
//TempOutEncounterLoc: Integer;
|
|
//TempOutEncounterLocName: string;
|
|
|
|
procedure NotifyOtherApps(const AppEvent, AppData: string);
|
|
procedure FlushNotifierBuffer;
|
|
procedure TerminateOtherAppNotification;
|
|
procedure GotoWebPage(const URL: WideString);
|
|
function AllowAccessToSensitivePatient(NewDFN: string; var AccessStatus: integer): boolean;
|
|
|
|
|
|
implementation
|
|
|
|
uses rTIU, rOrders, rConsults, uOrders;
|
|
|
|
type
|
|
HlinkNavProc = function(pUnk: IUnknown; szTarget: PWideChar): HResult; stdcall;
|
|
|
|
var
|
|
uVistaMsg, uVistaDomMsg: UINT;
|
|
URLMonHandle: THandle = 0;
|
|
HlinkNav: HlinkNavProc;
|
|
|
|
type
|
|
TNotifyAppsThread = class(TThread)
|
|
private
|
|
FRunning: boolean;
|
|
public
|
|
constructor CreateThread;
|
|
procedure ResumeIfIdle;
|
|
procedure ResumeAndTerminate;
|
|
procedure Execute; override;
|
|
property Running: boolean read FRunning;
|
|
end;
|
|
|
|
TMsgType = (mtVistaMessage, mtVistaDomainMessage);
|
|
|
|
var
|
|
uSynchronizer: TMultiReadExclusiveWriteSynchronizer = nil;
|
|
uNotifyAppsThread: TNotifyAppsThread = nil;
|
|
uNotifyAppsQueue: TStringList = nil;
|
|
uNotifyAppsActive: boolean = TRUE;
|
|
AnAtom: ATOM = 0;
|
|
|
|
const
|
|
LONG_BROADCAST_TIMEOUT = 30000; // 30 seconds
|
|
SHORT_BROADCAST_TIMEOUT = 2000; // 2 seconds
|
|
MSG_TYPE: array[TMsgType] of String = ('V','D');
|
|
|
|
function AllowAccessToSensitivePatient(NewDFN: string; var AccessStatus: integer): boolean;
|
|
const
|
|
TX_DGSR_ERR = 'Unable to perform sensitive record checks';
|
|
TC_DGSR_ERR = 'Error';
|
|
TC_DGSR_SHOW = 'Restricted Record';
|
|
TC_DGSR_DENY = 'Access Denied';
|
|
TX_DGSR_YESNO = CRLF + 'Do you want to continue processing this patient record?';
|
|
TC_NEXT_NOTIF = 'NEXT NOTIFICATION: ';
|
|
var
|
|
//AccessStatus: integer;
|
|
AMsg, PrefixC, PrefixT: string;
|
|
begin
|
|
Result := TRUE;
|
|
if Notifications.Active then
|
|
begin
|
|
PrefixT := Piece(Notifications.RecordID, U, 1) + CRLF + CRLF;
|
|
PrefixC := TC_NEXT_NOTIF;
|
|
end
|
|
else
|
|
begin
|
|
PrefixT := '';
|
|
PrefixC := '';
|
|
end;
|
|
CheckSensitiveRecordAccess(NewDFN, AccessStatus, AMsg);
|
|
case AccessStatus of
|
|
DGSR_FAIL: begin
|
|
InfoBox(PrefixT + TX_DGSR_ERR, PrefixC + TC_DGSR_ERR, MB_OK);
|
|
Result := FALSE;
|
|
end;
|
|
DGSR_NONE: { Nothing - allow access to the patient. };
|
|
DGSR_SHOW: InfoBox(PrefixT + AMsg, PrefixC + TC_DGSR_SHOW, MB_OK);
|
|
DGSR_ASK: if InfoBox(PrefixT + AMsg + TX_DGSR_YESNO, PrefixC + TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
|
|
MB_DEFBUTTON2) = IDYES then LogSensitiveRecordAccess(NewDFN)
|
|
else Result := FALSE;
|
|
else begin
|
|
InfoBox(PrefixT + AMsg, PrefixC + TC_DGSR_DENY, MB_OK);
|
|
if Notifications.Active then Notifications.DeleteForCurrentUser;
|
|
Result := FALSE;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function QueuePending: boolean;
|
|
begin
|
|
uSynchronizer.BeginRead;
|
|
try
|
|
Result := (uNotifyAppsQueue.Count > 0);
|
|
finally
|
|
uSynchronizer.EndRead;
|
|
end;
|
|
end;
|
|
|
|
procedure ProcessQueue(ShortTimout: boolean);
|
|
var
|
|
msg: String;
|
|
process: boolean;
|
|
AResult: LPDWORD;
|
|
MsgCode, timeout: UINT;
|
|
TypeCode: String;
|
|
|
|
begin
|
|
if(not QueuePending) then exit;
|
|
uSynchronizer.BeginWrite;
|
|
try
|
|
process := (uNotifyAppsQueue.Count > 0);
|
|
if(process) then
|
|
begin
|
|
msg := uNotifyAppsQueue.Strings[0];
|
|
uNotifyAppsQueue.Delete(0);
|
|
end;
|
|
finally
|
|
uSynchronizer.EndWrite;
|
|
end;
|
|
if(process) then
|
|
begin
|
|
TypeCode := copy(msg,1,1);
|
|
delete(msg,1,1);
|
|
if(TypeCode = MSG_TYPE[mtVistaMessage]) then
|
|
MsgCode := uVistaMsg
|
|
else
|
|
MsgCode := uVistaDomMsg;
|
|
|
|
if(ShortTimout) then
|
|
timeout := SHORT_BROADCAST_TIMEOUT
|
|
else
|
|
timeout := LONG_BROADCAST_TIMEOUT;
|
|
|
|
// put text in the global atom table
|
|
AnAtom := GlobalAddAtom(PChar(msg));
|
|
if (AnAtom <> 0) then
|
|
begin
|
|
try
|
|
// broadcast 'VistA Domain Event - Clinical' to all main windows
|
|
//SendMessage(HWND_BROADCAST, uVistaDomMsg, WPARAM(Application.MainForm.Handle), LPARAM(AnAtom));
|
|
//
|
|
//Changed to SendMessageTimeout to prevent hang when other app unresponsive (RV)
|
|
AResult := nil;
|
|
SendMessageTimeout(HWND_BROADCAST, MsgCode, WPARAM(Application.MainForm.Handle), LPARAM(AnAtom),
|
|
SMTO_ABORTIFHUNG or SMTO_BLOCK, timeout, AResult^);
|
|
finally
|
|
// after all windows have processed the message, remove the text from the table
|
|
GlobalDeleteAtom(AnAtom);
|
|
AnAtom := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TNotifyAppsThread.CreateThread;
|
|
begin
|
|
inherited Create(TRUE);
|
|
FRunning := TRUE;
|
|
end;
|
|
|
|
procedure TNotifyAppsThread.ResumeIfIdle;
|
|
begin
|
|
if(Suspended) then
|
|
Resume;
|
|
end;
|
|
|
|
procedure TNotifyAppsThread.ResumeAndTerminate;
|
|
begin
|
|
Terminate;
|
|
if(Suspended) then
|
|
Resume;
|
|
end;
|
|
|
|
procedure TNotifyAppsThread.Execute;
|
|
begin
|
|
while(not Terminated) do
|
|
begin
|
|
if(QueuePending) then
|
|
ProcessQueue(FALSE)
|
|
else if(not Terminated) then
|
|
Suspend;
|
|
end;
|
|
FRunning := FALSE;
|
|
end;
|
|
|
|
function AppNotificationEnabled: boolean;
|
|
begin
|
|
Result := FALSE;
|
|
if(not uNotifyAppsActive) then exit;
|
|
if Application.MainForm = nil then Exit;
|
|
if User = nil then exit;
|
|
if not User.FNotifyAppsWM then Exit;
|
|
// register the message with windows to get a unique message number (if not already registered)
|
|
if uVistaMsg = 0 then uVistaMsg := RegisterWindowMessage('VistA Event - Clinical');
|
|
if uVistaDomMsg = 0 then uVistaDomMsg := RegisterWindowMessage('VistA Domain Event - Clinical');
|
|
if (uVistaMsg = 0) or (uVistaDomMsg = 0) then Exit;
|
|
if(not assigned(uNotifyAppsQueue)) then
|
|
uNotifyAppsQueue := TStringList.Create;
|
|
if(not assigned(uSynchronizer)) then
|
|
uSynchronizer := TMultiReadExclusiveWriteSynchronizer.Create;
|
|
if(not assigned(uNotifyAppsThread)) then
|
|
uNotifyAppsThread := TNotifyAppsThread.CreateThread;
|
|
Result := TRUE;
|
|
end;
|
|
|
|
procedure ReleaseAppNotification;
|
|
var
|
|
waitState: DWORD;
|
|
|
|
begin
|
|
uNotifyAppsActive := FALSE;
|
|
if(assigned(uNotifyAppsThread)) then
|
|
begin
|
|
uNotifyAppsThread.ResumeAndTerminate;
|
|
sleep(10);
|
|
if(uNotifyAppsThread.Running) then
|
|
begin
|
|
waitState := WaitForSingleObject(uNotifyAppsThread.Handle, SHORT_BROADCAST_TIMEOUT);
|
|
if((waitState = WAIT_TIMEOUT) or
|
|
(waitState = WAIT_FAILED) or
|
|
(waitState = WAIT_ABANDONED)) then
|
|
begin
|
|
TerminateThread(uNotifyAppsThread.Handle, 0);
|
|
if(AnAtom <> 0) then
|
|
begin
|
|
GlobalDeleteAtom(AnAtom);
|
|
AnAtom := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
FreeAndNil(uNotifyAppsThread);
|
|
end;
|
|
if(assigned(uSynchronizer)) and
|
|
(assigned(uNotifyAppsQueue)) then
|
|
begin
|
|
while(QueuePending) do
|
|
ProcessQueue(TRUE);
|
|
end;
|
|
FreeAndNil(uSynchronizer);
|
|
FreeAndNil(uNotifyAppsQueue);
|
|
end;
|
|
|
|
procedure NotifyOtherApps(const AppEvent, AppData: string);
|
|
var
|
|
m1: string;
|
|
m2: string;
|
|
|
|
begin
|
|
if(AppNotificationEnabled) then
|
|
begin
|
|
// first send the domain version of the message
|
|
m1 := MSG_TYPE[mtVistaDomainMessage] + AppEvent + U + 'CPRS;' + User.FDomain + U + Patient.DFN + U + AppData;
|
|
// for backward compatibility, send the message without the domain
|
|
m2 := MSG_TYPE[mtVistaMessage] + AppEvent + U + 'CPRS' + U + Patient.DFN + U + AppData;
|
|
uSynchronizer.BeginWrite;
|
|
try
|
|
uNotifyAppsQueue.Add(m1);
|
|
uNotifyAppsQueue.Add(m2);
|
|
finally
|
|
uSynchronizer.EndWrite;
|
|
end;
|
|
uNotifyAppsThread.ResumeIfIdle;
|
|
end;
|
|
end;
|
|
|
|
procedure FlushNotifierBuffer;
|
|
begin
|
|
if(AppNotificationEnabled) then
|
|
begin
|
|
uSynchronizer.BeginWrite;
|
|
try
|
|
uNotifyAppsQueue.Clear;
|
|
finally
|
|
uSynchronizer.EndWrite;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TerminateOtherAppNotification;
|
|
begin
|
|
ReleaseAppNotification;
|
|
end;
|
|
|
|
{ TUser methods ---------------------------------------------------------------------------- }
|
|
|
|
constructor TUser.Create;
|
|
{ create the User object for the currently logged in user }
|
|
var
|
|
UserInfo: TUserInfo;
|
|
begin
|
|
UserInfo := GetUserInfo;
|
|
FDUZ := UserInfo.DUZ;
|
|
FName := UserInfo.Name;
|
|
FUserClass := UserInfo.UserClass;
|
|
FCanSignOrders := UserInfo.CanSignOrders;
|
|
FIsProvider := UserInfo.IsProvider;
|
|
FOrderRole := UserInfo.OrderRole;
|
|
FNoOrdering := UserInfo.NoOrdering;
|
|
FEnableVerify := UserInfo.EnableVerify;
|
|
FDTIME := UserInfo.DTIME;
|
|
FCountDown := UserInfo.CountDown;
|
|
FNotifyAppsWM := UserInfo.NotifyAppsWM;
|
|
FDomain := UserInfo.Domain;
|
|
FPtMsgHang := UserInfo.PtMsgHang;
|
|
FService := UserInfo.Service;
|
|
FAutoSave := UserInfo.AutoSave;
|
|
FInitialTab := UserInfo.InitialTab;
|
|
FUseLastTab := UserInfo.UseLastTab;
|
|
if(URLMonHandle = 0) then
|
|
FWebAccess := FALSE
|
|
else
|
|
FWebAccess := UserInfo.WebAccess;
|
|
FDisableHold := UserInfo.DisableHold;
|
|
FIsRPL := UserInfo.IsRPL;
|
|
FRPLList := UserInfo.RPLList;
|
|
FHasCorTabs := UserInfo.HasCorTabs;
|
|
FHasRptTab := UserInfo.HasRptTab;
|
|
FIsReportsOnly := UserInfo.IsReportsOnly;
|
|
FToolsRptEdit := UserInfo.ToolsRptEdit;
|
|
FCurrentPrinter := GetDefaultPrinter(DUZ, 0);
|
|
FGECStatus := UserInfo.GECStatusCheck;
|
|
FStationNumber := UserInfo.StationNumber;
|
|
FIsProductionAccount := UserInfo.IsProductionAccount;
|
|
end;
|
|
|
|
function TUser.HasKey(const KeyName: string): Boolean;
|
|
{ returns true if the current user has the given security key }
|
|
begin
|
|
Result := HasSecurityKey(KeyName);
|
|
end;
|
|
|
|
{ TPatient methods ------------------------------------------------------------------------- }
|
|
|
|
procedure TPatient.Clear;
|
|
{ clears all fields in the Patient object }
|
|
begin
|
|
FDFN := '';
|
|
FName := '';
|
|
FSSN := '';
|
|
FDOB := 0;
|
|
FAge := 0;
|
|
FSex := 'U';
|
|
FCWAD := '';
|
|
FRestricted := False;
|
|
FInpatient := False;
|
|
FStatus := '';
|
|
FLocation := 0;
|
|
FWardService := '';
|
|
FSpecialty := 0;
|
|
FAdmitTime := 0;
|
|
FSrvConn := False;
|
|
FSCPercent := 0;
|
|
FPrimTeam := '';
|
|
FPrimProv := '';
|
|
FAttending := '';
|
|
FreeAndNil(FCombatVet);
|
|
end;
|
|
|
|
destructor TPatient.Destroy;
|
|
begin
|
|
FreeAndNil(FCombatVet);
|
|
inherited;
|
|
end;
|
|
|
|
function TPatient.GetCombatVet: TCombatVet;
|
|
begin
|
|
if FCombatVet = nil then
|
|
FCombatVet := TCombatVet.Create(FDFN);
|
|
Result := FCombatVet;
|
|
end;
|
|
|
|
function TPatient.GetDateDied: TFMDateTime;
|
|
begin
|
|
if(not FDateDiedLoaded) then
|
|
begin
|
|
FDateDied := DateOfDeath(FDFN);
|
|
FDateDiedLoaded := TRUE;
|
|
end;
|
|
Result := FDateDied;
|
|
end;
|
|
|
|
procedure TPatient.SetDFN(const Value: string); //*DFN*
|
|
{ selects a patient and sets up the Patient object for the patient }
|
|
var
|
|
PtSelect: TPtSelect;
|
|
begin
|
|
if (Value = '') or (Value = FDFN) then Exit; //*DFN*
|
|
Clear;
|
|
SelectPatient(Value, PtSelect);
|
|
FDFN := Value;
|
|
FName := PtSelect.Name;
|
|
FICN := PtSelect.ICN;
|
|
FSSN := PtSelect.SSN;
|
|
FDOB := PtSelect.DOB;
|
|
FAge := PtSelect.Age;
|
|
FSex := PtSelect.Sex;
|
|
FCWAD := PtSelect.CWAD;
|
|
FRestricted := PtSelect.Restricted;
|
|
FInpatient := Length(PtSelect.Location) > 0;
|
|
if FInpatient then FStatus := ' (INPATIENT)'
|
|
else FStatus := ' (OUTPATIENT)';
|
|
FWardService :=PtSelect.WardService;
|
|
FLocation := PtSelect.LocationIEN;
|
|
FSpecialty := PtSelect.SpecialtyIEN;
|
|
FAdmitTime := PtSelect.AdmitTime;
|
|
FSrvConn := PtSelect.ServiceConnected;
|
|
FSCPercent := PtSelect.SCPercent;
|
|
FPrimTeam := PtSelect.PrimaryTeam;
|
|
FPrimProv := PtSelect.PrimaryProvider;
|
|
FAttending := PtSelect.Attending;
|
|
FAssociate := PtSelect.Associate;
|
|
end;
|
|
|
|
{ TEncounter ------------------------------------------------------------------------------- }
|
|
|
|
constructor TEncounter.Create;
|
|
begin
|
|
inherited;
|
|
FNotifier := TORNotifier.Create(Self, TRUE);
|
|
end;
|
|
|
|
destructor TEncounter.Destroy;
|
|
begin
|
|
FNotifier := nil; // Frees instance
|
|
inherited;
|
|
end;
|
|
|
|
procedure TEncounter.EncounterSwitch(Loc: integer; LocName, LocText: string; DT: TFMDateTime; vCat: Char);
|
|
begin
|
|
Encounter.Location := Loc;
|
|
Encounter.LocationName := LocName;
|
|
Encounter.LocationText := LocText;
|
|
Encounter.VisitCategory := vCat;
|
|
Encounter.DateTime := DT;;
|
|
end;
|
|
|
|
procedure TEncounter.Clear;
|
|
{ clears all the fields of an Encounter (usually done upon patient selection }
|
|
begin
|
|
FChanged := False;
|
|
FDateTime := 0;
|
|
FInpatient := False;
|
|
FLocationName := '';
|
|
FLocationText := '';
|
|
FProvider := 0;
|
|
FProviderName := '';
|
|
FStandAlone := False;
|
|
FVisitCategory := #0;
|
|
SetLocation(0); // Used to call Notifications - do it last so everything else is set
|
|
end;
|
|
|
|
function TEncounter.GetLocationText: string;
|
|
{ returns abbreviated hospital location + room/bed (or date/time for appt) }
|
|
begin
|
|
if FChanged then UpdateText;
|
|
Result := FLocationText;
|
|
end;
|
|
|
|
function TEncounter.GetLocationName: string;
|
|
{ returns external text value for hospital location }
|
|
begin
|
|
if FChanged then UpdateText;
|
|
Result := FLocationName;
|
|
end;
|
|
|
|
function TEncounter.GetProviderName: string;
|
|
{ returns external text value for provider name }
|
|
begin
|
|
if FChanged then UpdateText;
|
|
Result := FProviderName;
|
|
end;
|
|
|
|
function TEncounter.GetVisitCategory: Char;
|
|
begin
|
|
Result := FVisitCategory;
|
|
if Result = #0 then Result := 'A';
|
|
end;
|
|
|
|
function TEncounter.GetVisitStr: string;
|
|
begin
|
|
Result := IntToStr(FLocation) + ';' + FloatToStr(FDateTime) + ';' + VisitCategory;
|
|
// use VisitCategory property to insure non-null character
|
|
end;
|
|
|
|
function TEncounter.NeedVisit: Boolean;
|
|
{ returns true if required fields for visit creation are present }
|
|
begin
|
|
// added "<" to FDateTime check to trap "-1" visit dates - v23.12 (RV)
|
|
if (FDateTime <= 0) or (FLocation = 0) then Result := True else Result := False;
|
|
end;
|
|
|
|
procedure TEncounter.SetDateTime(Value: TFMDateTime);
|
|
{ sets the date/time for the encounter - causes the visit to be reset }
|
|
begin
|
|
if Value <> FDateTime then
|
|
begin
|
|
FDateTime := Value;
|
|
FChanged := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TEncounter.SetInpatient(Value: Boolean);
|
|
{ sets the inpatient flag for the encounter - causes the visit to be reset }
|
|
begin
|
|
if Value <> FInpatient then
|
|
begin
|
|
FInpatient := Value;
|
|
FChanged := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TEncounter.SetLocation(Value: Integer);
|
|
{ sets the location for the encounter - causes the visit to be reset }
|
|
begin
|
|
if Value <> FLocation then
|
|
begin
|
|
FLocation := Value;
|
|
FChanged := True;
|
|
FNotifier.Notify(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TEncounter.SetProvider(Value: Int64);
|
|
{ sets the provider for the encounter - causes the visit to be reset }
|
|
begin
|
|
if Value <> FProvider then
|
|
begin
|
|
FProvider := Value;
|
|
FChanged := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TEncounter.SetStandAlone(Value: Boolean);
|
|
{ StandAlone should be true if this encounter isn't related to an appointment }
|
|
begin
|
|
if Value <> FStandAlone then
|
|
begin
|
|
FStandAlone := Value;
|
|
FChanged := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TEncounter.SetVisitCategory(Value: Char);
|
|
{ sets the visit type for this encounter - causes to visit to be reset }
|
|
begin
|
|
if Value <> FVisitCategory then
|
|
begin
|
|
FVisitCategory := Value;
|
|
FChanged := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TEncounter.UpdateText;
|
|
{ retrieve external values for provider name, hospital location }
|
|
var
|
|
EncounterText: TEncounterText;
|
|
begin
|
|
{ this references the Patient object which is assumed to be created }
|
|
EncounterText := GetEncounterText(Patient.DFN, FLocation, FProvider);
|
|
with EncounterText do
|
|
begin
|
|
FLocationName := LocationName;
|
|
if Length(LocationAbbr) > 0
|
|
then FLocationText := LocationAbbr
|
|
else FLocationText := LocationName;
|
|
if Length(LocationName) > 0 then
|
|
begin
|
|
if (FVisitCategory = 'H') //FInpatient
|
|
then FLocationText := FLocationText + ' ' + RoomBed
|
|
else FLocationText := FLocationText + ' ' +
|
|
FormatFMDateTime('mmm dd,yy hh:nn', FDateTime);
|
|
end
|
|
else FLocationText := '';
|
|
if Length(ProviderName) > 0 // ProviderName is the field in EncounterText
|
|
then FProviderName := ProviderName
|
|
else FProviderName := '';
|
|
end;
|
|
FChanged := False;
|
|
end;
|
|
|
|
{ TChangeItem ------------------------------------------------------------------------------ }
|
|
|
|
constructor TChangeItem.Create(AnItemType: Integer; const AnID, AText, AGroupName: string;
|
|
ASignState: Integer; AParentID: string; user: int64; OrderDG: string; DCOrder, Delay: boolean);
|
|
begin
|
|
FItemType := AnItemType;
|
|
FID := AnID;
|
|
FText := AText;
|
|
FGroupName := AGroupName;
|
|
FSignState := ASignState;
|
|
FParentID := AParentID;
|
|
FUser := User;
|
|
FOrderDG := OrderDG;
|
|
FDCOrder := DCOrder;
|
|
FDelay := Delay;
|
|
end;
|
|
|
|
{ TChanges --------------------------------------------------------------------------------- }
|
|
|
|
constructor TChanges.Create;
|
|
begin
|
|
FDocuments := TList.Create;
|
|
FOrders := TList.Create;
|
|
FPCE := TList.Create;
|
|
FOrderGrp := TStringList.Create;
|
|
FPCEGrp := TStringList.Create;
|
|
FCount := 0;
|
|
end;
|
|
|
|
destructor TChanges.Destroy;
|
|
begin
|
|
Clear;
|
|
FDocuments.Free;
|
|
FOrders.Free;
|
|
FPCE.Free;
|
|
FOrderGrp.Free;
|
|
FPCEGrp.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TChanges.Add(ItemType: Integer; const AnID, ItemText, GroupName: string;
|
|
SignState: Integer; AParentID: string; User: int64; OrderDG: String; DCOrder, Delay: boolean);
|
|
var
|
|
i: Integer;
|
|
Found: Boolean;
|
|
ChangeList: TList;
|
|
NewChangeItem: TChangeItem;
|
|
begin
|
|
ChangeList := nil;
|
|
case ItemType of
|
|
CH_DOC: ChangeList := FDocuments;
|
|
CH_SUM: ChangeList := FDocuments; {*REV*}
|
|
CH_CON: ChangeList := FDocuments;
|
|
CH_SUR: ChangeList := FDocuments;
|
|
CH_ORD: ChangeList := FOrders;
|
|
CH_PCE: ChangeList := FPCE;
|
|
end;
|
|
Found := False;
|
|
if ChangeList <> nil then with ChangeList do for i := 0 to Count - 1 do
|
|
with TChangeItem(Items[i]) do if ID = AnID then
|
|
begin
|
|
Found := True;
|
|
// can't change ItemType, ID, or GroupName, must call Remove first
|
|
FText := ItemText;
|
|
FSignState := SignState;
|
|
end;
|
|
if not Found then
|
|
begin
|
|
NewChangeItem := TChangeItem.Create(ItemType, AnID, ItemText, GroupName, SignState, AParentID, User, OrderDG, DCOrder, Delay);
|
|
case ItemType of
|
|
CH_DOC: begin
|
|
FDocuments.Add(NewChangeItem);
|
|
end;
|
|
CH_SUM: begin {*REV*}
|
|
FDocuments.Add(NewChangeItem);
|
|
end;
|
|
CH_CON: begin
|
|
FDocuments.Add(NewChangeItem);
|
|
end;
|
|
CH_SUR: begin
|
|
FDocuments.Add(NewChangeItem);
|
|
end;
|
|
CH_ORD: begin
|
|
FOrders.Add(NewChangeItem);
|
|
with FOrderGrp do if IndexOf(GroupName) < 0 then Add(GroupName);
|
|
end;
|
|
CH_PCE: begin
|
|
FPCE.Add(NewChangeItem);
|
|
with FPCEGrp do if IndexOf(GroupName) < 0 then Add(GroupName);
|
|
end;
|
|
end;
|
|
Inc(FCount);
|
|
end;
|
|
end;
|
|
|
|
function TChanges.CanSign: Boolean;
|
|
{ returns true if any items in the changes list can be signed by the user }
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
with FDocuments do for i := 0 to Count - 1 do
|
|
with TChangeItem(Items[i]) do if FSignState <> CH_SIGN_NA then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
with FOrders do for i := 0 to Count - 1 do
|
|
with TChangeItem(Items[i]) do if FSignState <> CH_SIGN_NA then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
// don't have to worry about FPCE - it never requires signatures
|
|
end;
|
|
|
|
procedure TChanges.Clear;
|
|
var
|
|
i, ConsultIEN: Integer;
|
|
DocIEN: Int64;
|
|
OrderID: string;
|
|
begin
|
|
with FDocuments do for i := 0 to Count - 1 do
|
|
begin
|
|
DocIEN := StrToInt64Def(TChangeItem(Items[i]).ID, 0);
|
|
UnlockDocument(DocIEN);
|
|
ConsultIEN := GetConsultIENforNote(DocIEN);
|
|
if ConsultIEN > -1 then
|
|
begin
|
|
OrderID := GetConsultOrderIEN(ConsultIEN);
|
|
UnlockOrderIfAble(OrderID);
|
|
end;
|
|
TChangeItem(Items[i]).Free;
|
|
end;
|
|
with FOrders do for i := 0 to Count - 1 do TChangeItem(Items[i]).Free;
|
|
with FPCE do for i := 0 to Count - 1 do TChangeItem(Items[i]).Free;
|
|
FDocuments.Clear;
|
|
FOrders.Clear;
|
|
FPCE.Clear;
|
|
FOrderGrp.Clear;
|
|
FPCEGrp.Clear;
|
|
FCount := 0;
|
|
end;
|
|
|
|
function TChanges.Exist(ItemType: Integer; const AnID: string): Boolean;
|
|
var
|
|
ChangeList: TList;
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
ChangeList := nil;
|
|
case ItemType of
|
|
CH_DOC: ChangeList := FDocuments;
|
|
CH_SUM: ChangeList := FDocuments; {*REV*}
|
|
CH_CON: ChangeList := FDocuments;
|
|
CH_SUR: ChangeList := FDocuments;
|
|
CH_ORD: ChangeList := FOrders;
|
|
CH_PCE: ChangeList := FPCE;
|
|
end;
|
|
if ChangeList <> nil then with ChangeList do
|
|
for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnID then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TChanges.ExistForOrder(const AnID: string): Boolean;
|
|
{ returns TRUE if any item in the list of orders has matching order number (ignores action) }
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
if FOrders <> nil then with FOrders do
|
|
for i := 0 to Count - 1 do
|
|
if Piece(TChangeItem(Items[i]).ID, ';', 1) = Piece(AnID, ';', 1) then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TChanges.Locate(ItemType: Integer; const AnID: string): TChangeItem;
|
|
var
|
|
ChangeList: TList;
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
ChangeList := nil;
|
|
case ItemType of
|
|
CH_DOC: ChangeList := FDocuments;
|
|
CH_SUM: ChangeList := FDocuments; {*REV*}
|
|
CH_CON: ChangeList := FDocuments;
|
|
CH_SUR: ChangeList := FDocuments;
|
|
CH_ORD: ChangeList := FOrders;
|
|
CH_PCE: ChangeList := FPCE;
|
|
end;
|
|
if ChangeList <> nil then with ChangeList do
|
|
for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnID then
|
|
begin
|
|
Result := TChangeItem(Items[i]);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TChanges.Remove(ItemType: Integer; const AnID: string);
|
|
{ remove a change item from the appropriate list of changes (depending on type)
|
|
this doesn't check groupnames, may leave a groupname without any associated items }
|
|
var
|
|
ChangeList: TList;
|
|
i,j: Integer;
|
|
needRemove: boolean;
|
|
begin
|
|
ChangeList := nil;
|
|
case ItemType of
|
|
CH_DOC: ChangeList := FDocuments;
|
|
CH_SUM: ChangeList := FDocuments;
|
|
CH_CON: ChangeList := FDocuments;
|
|
CH_SUR: ChangeList := FDocuments;
|
|
CH_ORD: ChangeList := FOrders;
|
|
CH_PCE: ChangeList := FPCE;
|
|
end;
|
|
if ChangeList <> nil then with ChangeList do
|
|
for i := Count - 1 downto 0 do if TChangeItem(Items[i]).ID = AnID then
|
|
begin
|
|
if Assigned(FOnRemove) then FOnRemove(Self, TChangeItem(Items[i])) {**RV**}
|
|
else TChangeItem(Items[i]).Free; {**RV**}
|
|
//TChangeItem(Items[i]).Free; {**RV**}
|
|
// set TChangeItem(Items[i]) = nil?
|
|
Delete(i);
|
|
Dec(FCount);
|
|
end;
|
|
if ItemType = CH_ORD then
|
|
begin
|
|
for i := OrderGrp.Count - 1 downto 0 do
|
|
begin
|
|
needRemove := True;
|
|
for j := 0 to FOrders.Count - 1 do
|
|
if (AnsiCompareText(TChangeItem(FOrders[j]).GroupName,OrderGrp[i]) = 0 ) then
|
|
needRemove := False;
|
|
if needRemove then
|
|
OrderGrp.Delete(i);
|
|
end;
|
|
end;
|
|
if ItemType = CH_ORD then UnlockOrder(AnID);
|
|
if ItemType = CH_DOC then UnlockDocument(StrToIntDef(AnID, 0));
|
|
if ItemType = CH_CON then UnlockDocument(StrToIntDef(AnID, 0));
|
|
if ItemType = CH_SUM then UnlockDocument(StrToIntDef(AnID, 0));
|
|
if ItemType = CH_SUR then UnlockDocument(StrToIntDef(AnID, 0));
|
|
end;
|
|
|
|
procedure TChanges.ReplaceID(ItemType: Integer; const OldID, NewID: string);
|
|
var
|
|
ChangeList: TList;
|
|
i: Integer;
|
|
begin
|
|
ChangeList := nil;
|
|
case ItemType of
|
|
CH_DOC: ChangeList := FDocuments;
|
|
CH_SUM: ChangeList := FDocuments; {*REV*}
|
|
CH_CON: ChangeList := FDocuments;
|
|
CH_SUR: ChangeList := FDocuments;
|
|
CH_ORD: ChangeList := FOrders;
|
|
CH_PCE: ChangeList := FPCE;
|
|
end;
|
|
if ChangeList <> nil then with ChangeList do
|
|
for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = OldID then
|
|
begin
|
|
TChangeItem(Items[i]).FID := NewID;
|
|
end;
|
|
end;
|
|
|
|
procedure TChanges.ReplaceSignState(ItemType: Integer; const AnID: string; NewState: Integer);
|
|
var
|
|
ChangeList: TList;
|
|
i: Integer;
|
|
begin
|
|
ChangeList := nil;
|
|
case ItemType of
|
|
CH_DOC: ChangeList := FDocuments;
|
|
CH_SUM: ChangeList := FDocuments; {*REV*}
|
|
CH_CON: ChangeList := FDocuments;
|
|
CH_SUR: ChangeList := FDocuments;
|
|
CH_ORD: ChangeList := FOrders;
|
|
CH_PCE: ChangeList := FPCE;
|
|
end;
|
|
if ChangeList <> nil then with ChangeList do
|
|
for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnID then
|
|
begin
|
|
TChangeItem(Items[i]).FSignState := NewState;
|
|
end;
|
|
end;
|
|
|
|
procedure TChanges.ReplaceText(ItemType: Integer; const AnID, NewText: string);
|
|
var
|
|
ChangeList: TList;
|
|
i: Integer;
|
|
begin
|
|
ChangeList := nil;
|
|
case ItemType of
|
|
CH_DOC: ChangeList := FDocuments;
|
|
CH_SUM: ChangeList := FDocuments; {*REV*}
|
|
CH_CON: ChangeList := FDocuments;
|
|
CH_SUR: ChangeList := FDocuments;
|
|
CH_ORD: ChangeList := FOrders;
|
|
CH_PCE: ChangeList := FPCE;
|
|
end;
|
|
if ChangeList <> nil then with ChangeList do
|
|
for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnID then
|
|
begin
|
|
TChangeItem(Items[i]).FText := NewText;
|
|
end;
|
|
end;
|
|
|
|
function TChanges.RequireReview: Boolean;
|
|
{ returns true if documents can be signed or if any orders exist in Changes }
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
AddUnsignedToChanges;
|
|
if FOrders.Count > 0 then Result := True;
|
|
if Result = False then with FDocuments do for i := 0 to Count - 1 do
|
|
with TChangeItem(Items[i]) do if FSignState <> CH_SIGN_NA then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TChanges.AddUnsignedToChanges;
|
|
{ retrieves unsigned orders outside this session based on OR UNSIGNED ORDERS ON EXIT }
|
|
var
|
|
i, CanSign(*, OrderUser*): Integer;
|
|
OrderUser: int64;
|
|
AnID, Display: string;
|
|
HaveOrders, OtherOrders: TStringList;
|
|
AChangeItem: TChangeItem;
|
|
IsDiscontinue, IsDelay: boolean;
|
|
begin
|
|
if Patient.DFN = '' then Exit;
|
|
// exit if there is already an 'Other Unsigned' group?
|
|
HaveOrders := TStringList.Create;
|
|
OtherOrders := TStringList.Create;
|
|
try
|
|
StatusText('Looking for unsigned orders...');
|
|
for i := 0 to Pred(FOrders.Count) do
|
|
begin
|
|
AChangeItem := FOrders[i];
|
|
HaveOrders.Add(AChangeItem.ID);
|
|
end;
|
|
LoadUnsignedOrders(OtherOrders, HaveOrders);
|
|
if (Encounter.Provider = User.DUZ) and User.CanSignOrders
|
|
then CanSign := CH_SIGN_YES
|
|
else CanSign := CH_SIGN_NA;
|
|
for i := 0 to Pred(OtherOrders.Count) do
|
|
begin
|
|
AnID := Piece(OtherOrders[i],U,1);
|
|
if Piece(OtherOrders[i],U,2) = '' then OrderUser := 0
|
|
else OrderUser := StrtoInt64(Piece(OtherOrders[i],U,2));
|
|
//agp change the M code to pass back the value for the new order properties
|
|
Display := Piece(OtherOrders[i],U,3);
|
|
if Piece(OtherOrders[i],U,4) = '1' then IsDiscontinue := True
|
|
else IsDiscontinue := False;
|
|
if Piece(OtherOrders[i],U,5) = '1' then IsDelay := True
|
|
else IsDelay := False;
|
|
Add(CH_ORD, AnID, TextForOrder(AnID), 'Other Unsigned', CanSign,'', OrderUser, Display, IsDiscontinue, IsDelay);
|
|
end;
|
|
finally
|
|
StatusText('');
|
|
HaveOrders.Free;
|
|
OtherOrders.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TNotifications ---------------------------------------------------------------------------- }
|
|
|
|
constructor TNotifications.Create;
|
|
begin
|
|
FList := TList.Create;
|
|
FCurrentIndex := -1;
|
|
FActive := False;
|
|
end;
|
|
|
|
destructor TNotifications.Destroy;
|
|
begin
|
|
Clear;
|
|
FList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TNotifications.Add(const ADFN: string; AFollowUp: Integer; const ARecordID: string; AHighLightSection : string = ''); //*DFN*
|
|
var
|
|
NotifyItem: TNotifyItem;
|
|
begin
|
|
NotifyItem := TNotifyItem.Create;
|
|
NotifyItem.DFN := ADFN;
|
|
NotifyItem.FollowUp := AFollowUp;
|
|
NotifyItem.RecordID := ARecordId;
|
|
If AHighLightSection <> '' then NotifyItem.HighLightSection := AHighLightSection;
|
|
FList.Add(NotifyItem);
|
|
FActive := True;
|
|
end;
|
|
|
|
procedure TNotifications.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with FList do for i := 0 to Count - 1 do with TNotifyItem(Items[i]) do Free;
|
|
FList.Clear;
|
|
FActive := False;
|
|
FCurrentIndex := -1;
|
|
FNotifyItem := nil;
|
|
end;
|
|
|
|
function TNotifications.GetDFN: string; //*DFN*
|
|
begin
|
|
if FNotifyItem <> nil then Result := FNotifyItem.DFN else Result := ''; //*DFN*
|
|
end;
|
|
|
|
function TNotifications.GetFollowUp: Integer;
|
|
begin
|
|
if FNotifyItem <> nil then Result := FNotifyItem.FollowUp else Result := 0;
|
|
end;
|
|
|
|
function TNotifications.GetAlertData: string;
|
|
begin
|
|
if FNotifyItem <> nil
|
|
then Result := GetXQAData(Piece(FNotifyItem.RecordID, U, 2))
|
|
else Result := '';
|
|
end;
|
|
|
|
function TNotifications.GetRecordID: string;
|
|
begin
|
|
if FNotifyItem <> nil then Result := FNotifyItem.RecordID else Result := '';
|
|
end;
|
|
|
|
function TNotifications.GetText: string;
|
|
begin
|
|
if FNotifyItem <> nil
|
|
then Result := Piece(Piece(FNotifyItem.RecordID, U, 1 ), ':', 2)
|
|
else Result := '';
|
|
end;
|
|
|
|
function TNotifications.GetHighLightSection: String; //CB
|
|
begin
|
|
if FNotifyItem <> nil then Result := FNotifyItem.HighLightSection else Result := '';
|
|
end;
|
|
|
|
|
|
procedure TNotifications.Next;
|
|
begin
|
|
Inc(FCurrentIndex);
|
|
if FCurrentIndex < FList.Count then FNotifyItem := TNotifyItem(FList[FCurrentIndex]) else
|
|
begin
|
|
FActive := False;
|
|
FNotifyItem := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TNotifications.Prior;
|
|
begin
|
|
Dec(FCurrentIndex);
|
|
if FCurrentIndex < 0
|
|
then FNotifyItem := nil
|
|
else FNotifyItem := TNotifyItem(FList[FCurrentIndex]);
|
|
if FList.Count > 0 then FActive := True;
|
|
end;
|
|
|
|
procedure TNotifications.Delete;
|
|
begin
|
|
if FNotifyItem <> nil then DeleteAlert(Piece(FNotifyItem.RecordID, U, 2));
|
|
end;
|
|
|
|
procedure TNotifications.DeleteForCurrentUser;
|
|
begin
|
|
if FNotifyItem <> nil then DeleteAlertForUser(Piece(FNotifyItem.RecordID, U, 2));
|
|
end;
|
|
|
|
{ TRemoteSite methods ---------------------------------------------------------------------------- }
|
|
|
|
constructor TRemoteSite.Create(ASite: string);
|
|
begin
|
|
FSiteID := Piece(ASite, U, 1);
|
|
FSiteName := MixedCase(Piece(ASite, U, 2));
|
|
FLastDate := StrToFMDateTime(Piece(ASite, U, 3));
|
|
FSelected := False;
|
|
FQueryStatus := '';
|
|
FData := TStringList.Create;
|
|
FLabQueryStatus := '';
|
|
FLabData := TStringList.Create;
|
|
FCurrentLabQuery := '';
|
|
FCurrentReportQuery := '';
|
|
end;
|
|
|
|
destructor TRemoteSite.Destroy;
|
|
begin
|
|
LabClear;
|
|
ReportClear;
|
|
FData.Free;
|
|
FLabData.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TRemoteSite.ReportClear;
|
|
begin
|
|
FData.Clear;
|
|
FQueryStatus := '';
|
|
end;
|
|
|
|
procedure TRemoteSite.LabClear;
|
|
begin
|
|
FLabData.Clear;
|
|
FLabQueryStatus := '';
|
|
end;
|
|
|
|
procedure TRemoteSite.SetSelected(Value: boolean);
|
|
begin
|
|
FSelected := Value;
|
|
end;
|
|
|
|
constructor TRemoteReport.Create(AReport: string);
|
|
begin
|
|
FReport := AReport;
|
|
FHandle := '';
|
|
end;
|
|
|
|
destructor TRemoteReport.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
constructor TRemoteReportList.Create;
|
|
begin
|
|
FReportList := TList.Create;
|
|
FCount := 0;
|
|
end;
|
|
|
|
destructor TRemoteReportList.Destroy;
|
|
begin
|
|
//Clear;
|
|
FReportList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TRemoteReportList.Add(AReportList, AHandle: string);
|
|
var
|
|
ARemoteReport: TRemoteReport;
|
|
begin
|
|
ARemoteReport := TRemoteReport.Create(AReportList);
|
|
ARemoteReport.Handle := AHandle;
|
|
ARemoteReport.Report := AReportList;
|
|
FReportList.Add(ARemoteReport);
|
|
FCount := FReportList.Count;
|
|
end;
|
|
|
|
procedure TRemoteReportList.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with FReportList do
|
|
for i := 0 to Count - 1 do
|
|
with TRemoteReport(Items[i]) do Free;
|
|
FReportList.Clear;
|
|
FCount := 0;
|
|
end;
|
|
|
|
constructor TRemoteSiteList.Create;
|
|
begin
|
|
FSiteList := TList.Create;
|
|
FCount := 0;
|
|
end;
|
|
|
|
destructor TRemoteSiteList.Destroy;
|
|
begin
|
|
Clear;
|
|
FSiteList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TRemoteSiteList.Add(ASite: string);
|
|
var
|
|
ARemoteSite: TRemoteSite;
|
|
begin
|
|
ARemoteSite := TRemoteSite.Create(ASite);
|
|
FSiteList.Add(ARemoteSite);
|
|
FCount := FSiteList.Count;
|
|
end;
|
|
|
|
procedure TRemoteSiteList.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with FSiteList do for i := 0 to Count - 1 do with TRemoteSite(Items[i]) do Free;
|
|
FSiteList.Clear;
|
|
FCount := 0;
|
|
end;
|
|
|
|
procedure TRemoteSiteList.ChangePatient(const DFN: string);
|
|
var
|
|
ALocations: TStringList;
|
|
i: integer;
|
|
begin
|
|
Clear;
|
|
ALocations := TStringList.Create;
|
|
try
|
|
FRemoteDataExists := HasRemoteData(DFN, ALocations);
|
|
if FRemoteDataExists then
|
|
begin
|
|
SortByPiece(ALocations, '^', 2);
|
|
for i := 0 to ALocations.Count - 1 do
|
|
if piece(ALocations[i],'^',5) = '1' then
|
|
Add(ALocations.Strings[i]);
|
|
FNoDataReason := '';
|
|
end
|
|
else
|
|
FNoDataReason := Piece(ALocations[0], U, 2);
|
|
FCount := FSiteList.Count;
|
|
finally
|
|
ALocations.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TUser.SetCurrentPrinter(Value: string);
|
|
begin
|
|
FCurrentPrinter := Value;
|
|
end;
|
|
|
|
procedure GotoWebPage(const URL: WideString);
|
|
begin
|
|
if(URLMonHandle <> 0) then
|
|
HlinkNav(nil, PWideChar(URL));
|
|
end;
|
|
|
|
procedure LoadURLMon;
|
|
const
|
|
UrlMonLib = 'URLMON.DLL';
|
|
HlinkName = 'HlinkNavigateString';
|
|
|
|
begin
|
|
URLMonHandle := LoadLibrary(PChar(UrlMonLib));
|
|
if URLMonHandle <= HINSTANCE_ERROR then
|
|
URLMonHandle := 0
|
|
else
|
|
begin
|
|
HlinkNav := GetProcAddress(URLMonHandle, HlinkName);
|
|
if(not assigned(HlinkNav)) then
|
|
begin
|
|
FreeLibrary(URLMonHandle);
|
|
URLMonHandle := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ReleaseURLMon;
|
|
begin
|
|
if(URLMonHandle <> 0) then
|
|
begin
|
|
FreeLibrary(URLMonHandle);
|
|
URLMonHandle := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TChanges.ReplaceODGrpName(const AnODID, NewGrp: string);
|
|
var
|
|
ChangeList: TList;
|
|
i: Integer;
|
|
begin
|
|
ChangeList := FOrders;
|
|
if ChangeList <> nil then with ChangeList do
|
|
for i := 0 to Count - 1 do if TChangeItem(Items[i]).ID = AnODID then
|
|
TChangeItem(Items[i]).FGroupName := NewGrp;
|
|
end;
|
|
|
|
procedure TChanges.ChangeOrderGrp(const oldGrpName,newGrpName: string);
|
|
var
|
|
i : integer;
|
|
begin
|
|
for i := 0 to FOrderGrp.Count - 1 do
|
|
begin
|
|
if AnsiCompareText(FOrderGrp[i],oldGrpName)= 0 then
|
|
FOrderGrp[i] := newGrpName;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
uVistaMsg := 0;
|
|
LoadURLMon;
|
|
|
|
finalization
|
|
ReleaseURLMon;
|
|
ReleaseAppNotification;
|
|
|
|
end.
|