Upgrading to version 27
This commit is contained in:
kdtop3
parent
7bc2d7b38d
commit
308d89e9cf
File diff suppressed because it is too large
Load Diff
|
|
@ -1,150 +0,0 @@
|
|||
unit XuDigSigSC_TLB;
|
||||
|
||||
// ************************************************************************ //
|
||||
// WARNING
|
||||
// -------
|
||||
// The types declared in this file were generated from data read from a
|
||||
// Type Library. If this type library is explicitly or indirectly (via
|
||||
// another type library referring to this type library) re-imported, or the
|
||||
// 'Refresh' command of the Type Library Editor activated while editing the
|
||||
// Type Library, the contents of this file will be regenerated and all
|
||||
// manual modifications will be lost.
|
||||
// ************************************************************************ //
|
||||
|
||||
// PASTLWTR : $Revision: 1.130.1.0.1.0.1.6 $
|
||||
// File generated on 6/12/2003 4:03:57 PM from Type Library described below.
|
||||
|
||||
// ************************************************************************ //
|
||||
// Type Lib: C:\Projects\CryptoAPI2\SignCOM\XuDigSigSC.tlb (1)
|
||||
// LIBID: {37B1AC3C-8CFB-41C2-951B-D1BCBD90DBBE}
|
||||
// LCID: 0
|
||||
// Helpfile:
|
||||
// DepndLst:
|
||||
// (1) v2.0 stdole, (C:\WINNT\System32\stdole2.tlb)
|
||||
// (2) v4.0 StdVCL, (C:\WINNT\System32\STDVCL40.DLL)
|
||||
// ************************************************************************ //
|
||||
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
|
||||
{$WARN SYMBOL_PLATFORM OFF}
|
||||
{$WRITEABLECONST ON}
|
||||
{$VARPROPSETTER ON}
|
||||
interface
|
||||
|
||||
uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
|
||||
|
||||
|
||||
// *********************************************************************//
|
||||
// GUIDS declared in the TypeLibrary. Following prefixes are used:
|
||||
// Type Libraries : LIBID_xxxx
|
||||
// CoClasses : CLASS_xxxx
|
||||
// DISPInterfaces : DIID_xxxx
|
||||
// Non-DISP interfaces: IID_xxxx
|
||||
// *********************************************************************//
|
||||
const
|
||||
// TypeLibrary Major and minor versions
|
||||
XuDigSigSCMajorVersion = 1;
|
||||
XuDigSigSCMinorVersion = 1;
|
||||
|
||||
LIBID_XuDigSigSC: TGUID = '{37B1AC3C-8CFB-41C2-951B-D1BCBD90DBBE}';
|
||||
|
||||
IID_IXuDigSigS: TGUID = '{4F007CD0-ED3A-4022-AC5F-01D8494B02CF}';
|
||||
CLASS_XuDigSigS: TGUID = '{12037083-5899-495D-818D-BF4EC57C42C7}';
|
||||
type
|
||||
|
||||
// *********************************************************************//
|
||||
// Forward declaration of types defined in TypeLibrary
|
||||
// *********************************************************************//
|
||||
IXuDigSigS = interface;
|
||||
IXuDigSigSDisp = dispinterface;
|
||||
|
||||
// *********************************************************************//
|
||||
// Declaration of CoClasses defined in Type Library
|
||||
// (NOTE: Here we map each CoClass to its Default Interface)
|
||||
// *********************************************************************//
|
||||
XuDigSigS = IXuDigSigS;
|
||||
|
||||
|
||||
// *********************************************************************//
|
||||
// Interface: IXuDigSigS
|
||||
// Flags: (4416) Dual OleAutomation Dispatchable
|
||||
// GUID: {4F007CD0-ED3A-4022-AC5F-01D8494B02CF}
|
||||
// *********************************************************************//
|
||||
IXuDigSigS = interface(IDispatch)
|
||||
['{4F007CD0-ED3A-4022-AC5F-01D8494B02CF}']
|
||||
procedure Set_DataBuffer(const Param1: WideString); safecall;
|
||||
procedure Set_UsrNumber(const Param1: WideString); safecall;
|
||||
function Get_DEAsig: WordBool; safecall;
|
||||
procedure Set_DEAsig(Value: WordBool); safecall;
|
||||
function Get_DEAInfo: WideString; safecall;
|
||||
function Get_HashValue: WideString; safecall;
|
||||
function Get_Signature: WideString; safecall;
|
||||
procedure Set_DrugSch(const Param1: WideString); safecall;
|
||||
function Signdata: WordBool; safecall;
|
||||
function Get_Reason: WideString; safecall;
|
||||
procedure Set_UsrName(const Param1: WideString); safecall;
|
||||
function Get_CrlUrl: WideString; safecall;
|
||||
procedure Reset; safecall;
|
||||
procedure GetCSP; safecall;
|
||||
function Get_SubReason: WideString; safecall;
|
||||
property DataBuffer: WideString write Set_DataBuffer;
|
||||
property UsrNumber: WideString write Set_UsrNumber;
|
||||
property DEAsig: WordBool read Get_DEAsig write Set_DEAsig;
|
||||
property DEAInfo: WideString read Get_DEAInfo;
|
||||
property HashValue: WideString read Get_HashValue;
|
||||
property Signature: WideString read Get_Signature;
|
||||
property DrugSch: WideString write Set_DrugSch;
|
||||
property Reason: WideString read Get_Reason;
|
||||
property UsrName: WideString write Set_UsrName;
|
||||
property CrlUrl: WideString read Get_CrlUrl;
|
||||
property SubReason: WideString read Get_SubReason;
|
||||
end;
|
||||
|
||||
// *********************************************************************//
|
||||
// DispIntf: IXuDigSigSDisp
|
||||
// Flags: (4416) Dual OleAutomation Dispatchable
|
||||
// GUID: {4F007CD0-ED3A-4022-AC5F-01D8494B02CF}
|
||||
// *********************************************************************//
|
||||
IXuDigSigSDisp = dispinterface
|
||||
['{4F007CD0-ED3A-4022-AC5F-01D8494B02CF}']
|
||||
property DataBuffer: WideString writeonly dispid 1;
|
||||
property UsrNumber: WideString writeonly dispid 2;
|
||||
property DEAsig: WordBool dispid 3;
|
||||
property DEAInfo: WideString readonly dispid 4;
|
||||
property HashValue: WideString readonly dispid 5;
|
||||
property Signature: WideString readonly dispid 6;
|
||||
property DrugSch: WideString writeonly dispid 7;
|
||||
function Signdata: WordBool; dispid 8;
|
||||
property Reason: WideString readonly dispid 9;
|
||||
property UsrName: WideString writeonly dispid 10;
|
||||
property CrlUrl: WideString readonly dispid 11;
|
||||
procedure Reset; dispid 12;
|
||||
procedure GetCSP; dispid 13;
|
||||
property SubReason: WideString readonly dispid 14;
|
||||
end;
|
||||
|
||||
// *********************************************************************//
|
||||
// The Class CoXuDigSigS provides a Create and CreateRemote method to
|
||||
// create instances of the default interface IXuDigSigS exposed by
|
||||
// the CoClass XuDigSigS. The functions are intended to be used by
|
||||
// clients wishing to automate the CoClass objects exposed by the
|
||||
// server of this typelibrary.
|
||||
// *********************************************************************//
|
||||
CoXuDigSigS = class
|
||||
class function Create: IXuDigSigS;
|
||||
class function CreateRemote(const MachineName: string): IXuDigSigS;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses ComObj;
|
||||
|
||||
class function CoXuDigSigS.Create: IXuDigSigS;
|
||||
begin
|
||||
Result := CreateComObject(CLASS_XuDigSigS) as IXuDigSigS;
|
||||
end;
|
||||
|
||||
class function CoXuDigSigS.CreateRemote(const MachineName: string): IXuDigSigS;
|
||||
begin
|
||||
Result := CreateRemoteComObject(MachineName, CLASS_XuDigSigS) as IXuDigSigS;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
@ -1,67 +0,0 @@
|
|||
object frmLaunch: TfrmLaunch
|
||||
Left = 557
|
||||
Top = 271
|
||||
Width = 231
|
||||
Height = 189
|
||||
Caption = 'Lauch Stuff'
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = True
|
||||
Position = poScreenCenter
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Top = 120
|
||||
Width = 46
|
||||
Height = 13
|
||||
Caption = 'Visit Type'
|
||||
end
|
||||
object grpFontSize: TRadioGroup
|
||||
Left = 8
|
||||
Top = 8
|
||||
Width = 65
|
||||
Height = 105
|
||||
Caption = 'Font Size'
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'8 pt'
|
||||
'10 pt'
|
||||
'12 pt'
|
||||
'14 pt'
|
||||
'18 pt')
|
||||
TabOrder = 0
|
||||
end
|
||||
object cmdShow: TButton
|
||||
Left = 88
|
||||
Top = 12
|
||||
Width = 129
|
||||
Height = 25
|
||||
Caption = 'Show Visit Type'
|
||||
Default = True
|
||||
TabOrder = 1
|
||||
OnClick = cmdShowClick
|
||||
end
|
||||
object Edit1: TEdit
|
||||
Left = 8
|
||||
Top = 136
|
||||
Width = 209
|
||||
Height = 21
|
||||
TabOrder = 2
|
||||
end
|
||||
object cmdClose: TButton
|
||||
Left = 88
|
||||
Top = 88
|
||||
Width = 129
|
||||
Height = 25
|
||||
Cancel = True
|
||||
Caption = 'Close'
|
||||
TabOrder = 3
|
||||
OnClick = cmdCloseClick
|
||||
end
|
||||
end
|
||||
|
|
@ -1,428 +0,0 @@
|
|||
{ *********************************************************************** }
|
||||
{ }
|
||||
{ Delphi Runtime Library }
|
||||
{ }
|
||||
{ Copyright (c) 1997-2001 Borland Software Corporation }
|
||||
{ }
|
||||
{ *********************************************************************** }
|
||||
|
||||
{*******************************************************}
|
||||
{ COM server support }
|
||||
{*******************************************************}
|
||||
|
||||
unit uComServ;
|
||||
|
||||
{$DENYPACKAGEUNIT}
|
||||
|
||||
interface
|
||||
|
||||
uses Windows, Messages, ActiveX, SysUtils, ComObj;
|
||||
|
||||
type
|
||||
|
||||
{ Application start mode }
|
||||
|
||||
TStartMode = (smStandalone, smAutomation, smRegServer, smUnregServer);
|
||||
|
||||
{ Class manager event types }
|
||||
|
||||
TLastReleaseEvent = procedure(var Shutdown: Boolean) of object;
|
||||
|
||||
{ TComServer }
|
||||
|
||||
TComServer = class(TComServerObject)
|
||||
private
|
||||
FObjectCount: Integer;
|
||||
FFactoryCount: Integer;
|
||||
FTypeLib: ITypeLib;
|
||||
FServerName: string;
|
||||
FHelpFileName: string;
|
||||
FIsInprocServer: Boolean;
|
||||
FStartMode: TStartMode;
|
||||
FStartSuspended: Boolean;
|
||||
FRegister: Boolean;
|
||||
FUIInteractive: Boolean;
|
||||
FOnLastRelease: TLastReleaseEvent;
|
||||
procedure FactoryFree(Factory: TComObjectFactory);
|
||||
procedure FactoryRegisterClassObject(Factory: TComObjectFactory);
|
||||
procedure FactoryUpdateRegistry(Factory: TComObjectFactory);
|
||||
procedure LastReleased;
|
||||
protected
|
||||
function CountObject(Created: Boolean): Integer; override;
|
||||
function CountFactory(Created: Boolean): Integer; override;
|
||||
function GetHelpFileName: string; override;
|
||||
function GetServerFileName: string; override;
|
||||
function GetServerKey: string; override;
|
||||
function GetServerName: string; override;
|
||||
function GetStartSuspended: Boolean; override;
|
||||
function GetTypeLib: ITypeLib; override;
|
||||
procedure SetHelpFileName(const Value: string); override;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Initialize;
|
||||
procedure LoadTypeLib;
|
||||
procedure SetServerName(const Name: string);
|
||||
procedure UpdateRegistry(Register: Boolean);
|
||||
property IsInprocServer: Boolean read FIsInprocServer write FIsInprocServer;
|
||||
property ObjectCount: Integer read FObjectCount;
|
||||
property StartMode: TStartMode read FStartMode;
|
||||
property UIInteractive: Boolean read FUIInteractive write FUIInteractive;
|
||||
property OnLastRelease: TLastReleaseEvent read FOnLastRelease write FOnLastRelease;
|
||||
end;
|
||||
|
||||
var
|
||||
ComServer: TComServer;
|
||||
|
||||
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
|
||||
function DllCanUnloadNow: HResult; stdcall;
|
||||
function DllRegisterServer: HResult; stdcall;
|
||||
function DllUnregisterServer: HResult; stdcall;
|
||||
|
||||
implementation
|
||||
|
||||
uses ComConst;
|
||||
|
||||
function GetModuleFileName: string;
|
||||
var
|
||||
Buffer: array[0..261] of Char;
|
||||
begin
|
||||
SetString(Result, Buffer, Windows.GetModuleFileName(HInstance,
|
||||
Buffer, SizeOf(Buffer)));
|
||||
end;
|
||||
|
||||
function GetModuleName: string;
|
||||
begin
|
||||
Result := ChangeFileExt(ExtractFileName(GetModuleFileName), '');
|
||||
end;
|
||||
|
||||
function LoadTypeLibrary(const ModuleName: string): ITypeLib;
|
||||
begin
|
||||
OleCheck(LoadTypeLib(PWideChar(WideString(ModuleName)), Result));
|
||||
end;
|
||||
|
||||
procedure RegisterTypeLibrary(TypeLib: ITypeLib; const ModuleName: string);
|
||||
var
|
||||
Name: WideString;
|
||||
HelpPath: WideString;
|
||||
begin
|
||||
Name := ModuleName;
|
||||
HelpPath := ExtractFilePath(ModuleName);
|
||||
OleCheck(RegisterTypeLib(TypeLib, PWideChar(Name), PWideChar(HelpPath)));
|
||||
end;
|
||||
|
||||
procedure UnregisterTypeLibrary(TypeLib: ITypeLib);
|
||||
type
|
||||
TUnregisterProc = function(const GUID: TGUID; VerMajor, VerMinor: Word;
|
||||
LCID: TLCID; SysKind: TSysKind): HResult stdcall;
|
||||
var
|
||||
Handle: THandle;
|
||||
UnregisterProc: TUnregisterProc;
|
||||
LibAttr: PTLibAttr;
|
||||
begin
|
||||
Handle := GetModuleHandle('OLEAUT32.DLL');
|
||||
if Handle <> 0 then
|
||||
begin
|
||||
@UnregisterProc := GetProcAddress(Handle, 'UnRegisterTypeLib');
|
||||
if @UnregisterProc <> nil then
|
||||
begin
|
||||
OleCheck(ComServer.TypeLib.GetLibAttr(LibAttr));
|
||||
with LibAttr^ do
|
||||
UnregisterProc(guid, wMajorVerNum, wMinorVerNum, lcid, syskind);
|
||||
ComServer.TypeLib.ReleaseTLibAttr(LibAttr);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetTypeLibName(TypeLib: ITypeLib): string;
|
||||
var
|
||||
Name: WideString;
|
||||
begin
|
||||
OleCheck(TypeLib.GetDocumentation(-1, @Name, nil, nil, nil));
|
||||
Result := Name;
|
||||
end;
|
||||
|
||||
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult;
|
||||
var
|
||||
Factory: TComObjectFactory;
|
||||
begin
|
||||
Factory := ComClassManager.GetFactoryFromClassID(CLSID);
|
||||
if Factory <> nil then
|
||||
if Factory.GetInterface(IID, Obj) then
|
||||
Result := S_OK
|
||||
else
|
||||
Result := E_NOINTERFACE
|
||||
else
|
||||
begin
|
||||
Pointer(Obj) := nil;
|
||||
Result := CLASS_E_CLASSNOTAVAILABLE;
|
||||
end;
|
||||
end;
|
||||
|
||||
function DllCanUnloadNow: HResult;
|
||||
begin
|
||||
if (ComServer = nil) or
|
||||
((ComServer.FObjectCount = 0) and (ComServer.FFactoryCount = 0)) then
|
||||
Result := S_OK
|
||||
else
|
||||
Result := S_FALSE;
|
||||
end;
|
||||
|
||||
function DllRegisterServer: HResult;
|
||||
begin
|
||||
Result := S_OK;
|
||||
try
|
||||
ComServer.UpdateRegistry(True);
|
||||
except
|
||||
Result := E_FAIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
function DllUnregisterServer: HResult;
|
||||
begin
|
||||
Result := S_OK;
|
||||
try
|
||||
ComServer.UpdateRegistry(False);
|
||||
except
|
||||
Result := E_FAIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Automation TerminateProc }
|
||||
|
||||
function AutomationTerminateProc: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
if (ComServer <> nil) and (ComServer.ObjectCount > 0) and ComServer.UIInteractive then
|
||||
begin
|
||||
Result := MessageBox(0, PChar(SNoCloseActiveServer1 + SNoCloseActiveServer2),
|
||||
PChar(SAutomationWarning), MB_YESNO or MB_TASKMODAL or
|
||||
MB_ICONWARNING or MB_DEFBUTTON2) = IDYES;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TComServer }
|
||||
|
||||
constructor TComServer.Create;
|
||||
|
||||
function FindSwitch(const Switch: string): Boolean;
|
||||
begin
|
||||
Result := FindCmdLineSwitch(Switch, ['-', '/'], True);
|
||||
end;
|
||||
|
||||
begin
|
||||
FTypeLib := nil;
|
||||
FIsInprocServer := ModuleIsLib;
|
||||
if FindSwitch('AUTOMATION') or FindSwitch('EMBEDDING') then
|
||||
FStartMode := smAutomation
|
||||
else if FindSwitch('REGSERVER') then
|
||||
FStartMode := smRegServer
|
||||
else if FindSwitch('UNREGSERVER') then
|
||||
FStartMode := smUnregServer;
|
||||
FUIInteractive := True;
|
||||
end;
|
||||
|
||||
destructor TComServer.Destroy;
|
||||
begin
|
||||
ComClassManager.ForEachFactory(Self, FactoryFree);
|
||||
end;
|
||||
|
||||
function TComServer.CountObject(Created: Boolean): Integer;
|
||||
begin
|
||||
if Created then
|
||||
begin
|
||||
Result := InterlockedIncrement(FObjectCount);
|
||||
if (not IsInProcServer) and (StartMode = smAutomation)
|
||||
and Assigned(ComObj.CoAddRefServerProcess) then
|
||||
ComObj.CoAddRefServerProcess;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := InterlockedDecrement(FObjectCount);
|
||||
if (not IsInProcServer) and (StartMode = smAutomation)
|
||||
and Assigned(ComObj.CoReleaseServerProcess) then
|
||||
begin
|
||||
if ComObj.CoReleaseServerProcess = 0 then
|
||||
LastReleased;
|
||||
end
|
||||
else if Result = 0 then
|
||||
LastReleased;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TComServer.CountFactory(Created: Boolean): Integer;
|
||||
begin
|
||||
if Created then
|
||||
Result := InterlockedIncrement(FFactoryCount)
|
||||
else
|
||||
Result := InterlockedDecrement(FFactoryCount);
|
||||
end;
|
||||
|
||||
procedure TComServer.FactoryFree(Factory: TComObjectFactory);
|
||||
begin
|
||||
Factory.Free;
|
||||
end;
|
||||
|
||||
procedure TComServer.FactoryRegisterClassObject(Factory: TComObjectFactory);
|
||||
begin
|
||||
Factory.RegisterClassObject;
|
||||
end;
|
||||
|
||||
procedure TComServer.FactoryUpdateRegistry(Factory: TComObjectFactory);
|
||||
begin
|
||||
if Factory.Instancing <> ciInternal then
|
||||
Factory.UpdateRegistry(FRegister);
|
||||
end;
|
||||
|
||||
function TComServer.GetHelpFileName: string;
|
||||
begin
|
||||
Result := FHelpFileName;
|
||||
end;
|
||||
|
||||
function TComServer.GetServerFileName: string;
|
||||
begin
|
||||
Result := GetModuleFileName;
|
||||
end;
|
||||
|
||||
function TComServer.GetServerKey: string;
|
||||
begin
|
||||
if FIsInprocServer then
|
||||
Result := 'InprocServer32' else
|
||||
Result := 'LocalServer32';
|
||||
end;
|
||||
|
||||
function TComServer.GetServerName: string;
|
||||
begin
|
||||
if FServerName <> '' then
|
||||
Result := FServerName
|
||||
else
|
||||
if FTypeLib <> nil then
|
||||
Result := GetTypeLibName(FTypeLib)
|
||||
else
|
||||
Result := GetModuleName;
|
||||
end;
|
||||
|
||||
procedure TComServer.SetServerName(const Name: string);
|
||||
begin
|
||||
if FTypeLib = nil then
|
||||
FServerName := Name;
|
||||
end;
|
||||
|
||||
function TComServer.GetTypeLib: ITypeLib;
|
||||
begin
|
||||
LoadTypeLib;
|
||||
Result := FTypeLib;
|
||||
end;
|
||||
|
||||
|
||||
procedure TComServer.LastReleased;
|
||||
var
|
||||
Shutdown: Boolean;
|
||||
begin
|
||||
if not FIsInprocServer then
|
||||
begin
|
||||
Shutdown := FStartMode = smAutomation;
|
||||
try
|
||||
if Assigned(FOnLastRelease) then FOnLastRelease(Shutdown);
|
||||
finally
|
||||
if Shutdown then PostThreadMessage(MainThreadID, WM_QUIT, 0, 0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TComServer.LoadTypeLib;
|
||||
var
|
||||
Temp: ITypeLib;
|
||||
begin
|
||||
if FTypeLib = nil then
|
||||
begin
|
||||
// this may load typelib more than once, but avoids need for critical section
|
||||
// and releases the interface correctly
|
||||
Temp := LoadTypeLibrary(GetModuleFileName);
|
||||
Integer(Temp) := InterlockedExchange(Integer(FTypeLib), Integer(Temp));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TComServer.UpdateRegistry(Register: Boolean);
|
||||
begin
|
||||
if FTypeLib <> nil then
|
||||
if Register then
|
||||
RegisterTypeLibrary(FTypeLib, GetModuleFileName) else
|
||||
UnregisterTypeLibrary(FTypeLib);
|
||||
FRegister := Register;
|
||||
ComClassManager.ForEachFactory(Self, FactoryUpdateRegistry);
|
||||
end;
|
||||
|
||||
var
|
||||
SaveInitProc: Pointer = nil;
|
||||
OleAutHandle: Integer;
|
||||
|
||||
procedure InitComServer;
|
||||
begin
|
||||
if SaveInitProc <> nil then TProcedure(SaveInitProc);
|
||||
ComServer.FStartSuspended := (CoInitFlags <> -1) and
|
||||
Assigned(ComObj.CoInitializeEx) and Assigned(ComObj.CoResumeClassObjects);
|
||||
ComServer.Initialize;
|
||||
if ComServer.FStartSuspended then
|
||||
ComObj.CoResumeClassObjects;
|
||||
end;
|
||||
|
||||
function TComServer.GetStartSuspended: Boolean;
|
||||
begin
|
||||
Result := FStartSuspended;
|
||||
end;
|
||||
|
||||
procedure TComServer.SetHelpFileName(const Value: string);
|
||||
begin
|
||||
FHelpFileName := Value;
|
||||
end;
|
||||
{ older proc replaced by one below this
|
||||
procedure TComServer.Initialize;
|
||||
begin
|
||||
try
|
||||
UpdateRegistry(FStartMode <> smUnregServer);
|
||||
except
|
||||
on E: EOleRegistrationError do
|
||||
// User may not have write access to the registry.
|
||||
// Squelch the exception unless we were explicitly told to register.
|
||||
if FStartMode = smRegServer then raise;
|
||||
end;
|
||||
if FStartMode in [smRegServer, smUnregServer] then Halt;
|
||||
ComClassManager.ForEachFactory(Self, FactoryRegisterClassObject);
|
||||
end;
|
||||
}
|
||||
procedure TComServer.Initialize;
|
||||
begin
|
||||
try
|
||||
UpdateRegistry(FStartMode <> smUnregServer);
|
||||
except
|
||||
on E: EOleRegistrationError do
|
||||
// User may not have write access to the registry.
|
||||
// Squelch the exception unless we were explicitly told to register.
|
||||
if FStartMode = smRegServer then raise;
|
||||
on E: EOleSysError do
|
||||
if FStartMode = smRegServer then raise;
|
||||
end;
|
||||
if FStartMode in [smRegServer, smUnregServer] then Halt;
|
||||
ComClassManager.ForEachFactory(Self, FactoryRegisterClassObject);
|
||||
end;
|
||||
initialization
|
||||
begin
|
||||
OleAutHandle := SafeLoadLibrary('OLEAUT32.DLL');
|
||||
ComServer := TComServer.Create;
|
||||
if not ModuleIsLib then
|
||||
begin
|
||||
SaveInitProc := InitProc;
|
||||
InitProc := @InitComServer;
|
||||
AddTerminateProc(@AutomationTerminateProc);
|
||||
end;
|
||||
end;
|
||||
|
||||
finalization
|
||||
begin
|
||||
ComServer.Free;
|
||||
ComServer := nil;
|
||||
FreeLibrary(OleAutHandle);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
@ -1,100 +0,0 @@
|
|||
unit uDCSumm;
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, uConst;
|
||||
|
||||
type
|
||||
TEditDCSummRec = record
|
||||
Title: Integer;
|
||||
DocType: integer;
|
||||
Addend: integer;
|
||||
EditIEN: integer;
|
||||
AdmitDateTime: TFMDateTime;
|
||||
DischargeDateTime: TFMDateTime;
|
||||
TitleName: string;
|
||||
DictDateTime: TFMDateTime;
|
||||
Dictator: Int64;
|
||||
DictatorName: string;
|
||||
Cosigner: Int64;
|
||||
CosignerName: string;
|
||||
Transcriptionist: int64;
|
||||
TranscriptionistName: string;
|
||||
Attending: int64;
|
||||
AttendingName: string;
|
||||
Urgency: string;
|
||||
UrgencyName: string;
|
||||
Location: Integer;
|
||||
LocationName: string;
|
||||
VisitStr: string;
|
||||
NeedCPT: Boolean;
|
||||
Status: integer;
|
||||
LastCosigner: Int64;
|
||||
LastCosignerName: string;
|
||||
IDParent: integer;
|
||||
Lines: TStrings;
|
||||
end;
|
||||
|
||||
TDCSummRec = TEditDCSummRec;
|
||||
|
||||
TAdmitRec = record
|
||||
AdmitDateTime: TFMDateTime;
|
||||
Location: integer;
|
||||
LocationName: string;
|
||||
VisitStr: string;
|
||||
end;
|
||||
|
||||
TDCSummTitles = class
|
||||
DfltTitle: Integer;
|
||||
DfltTitleName: string;
|
||||
ShortList: TStringList;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TDCSummPrefs = class
|
||||
DfltLoc: Integer;
|
||||
DfltLocName: string;
|
||||
SortAscending: Boolean;
|
||||
AskCosigner: Boolean;
|
||||
DfltCosigner: Int64;
|
||||
DfltCosignerName: string;
|
||||
MaxSumms: Integer;
|
||||
end;
|
||||
|
||||
function MakeDCSummDisplayText(RawText: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
function MakeDCSummDisplayText(RawText: string): string;
|
||||
var
|
||||
x: string;
|
||||
begin
|
||||
x := RawText;
|
||||
if Copy(Piece(x, U, 9), 1, 4) = ' ' then SetPiece(x, U, 9, 'Dis: ');
|
||||
if Piece(x, U, 1)[1] in ['A', 'N', 'E'] then
|
||||
Result := Piece(x, U, 2)
|
||||
else
|
||||
Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3))) + ' ' +
|
||||
Piece(x, U, 2) + ', ' + Piece(x, U, 6) + ', ' + Piece(Piece(x, U, 5), ';', 2) +
|
||||
' (' + Piece(x,U,7) + '), ' + Piece(Piece(x, U, 8), ';', 1) + ', ' +
|
||||
Piece(Piece(x, U, 9), ';', 1);
|
||||
end;
|
||||
|
||||
{ Discharge Summary Titles -------------------------------------------------------------------- }
|
||||
|
||||
constructor TDCSummTitles.Create;
|
||||
{ creates an object to store Discharge Summary titles so only obtained from server once }
|
||||
begin
|
||||
inherited Create;
|
||||
ShortList := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TDCSummTitles.Destroy;
|
||||
{ frees the lists that were used to store the Discharge Summary titles }
|
||||
begin
|
||||
ShortList.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
@ -1,291 +0,0 @@
|
|||
unit uSpell;
|
||||
|
||||
{$O-}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Classes, Controls, Forms, ComObj, StdCtrls, ComCtrls,
|
||||
ORSystem, Word2000, ORFn, Variants, rCore, clipbrd;
|
||||
|
||||
type
|
||||
|
||||
TSpellCheckAvailable = record
|
||||
Evaluated: boolean;
|
||||
Available: boolean;
|
||||
end;
|
||||
|
||||
function SpellCheckAvailable: Boolean;
|
||||
function SpellCheckInProgress: Boolean;
|
||||
procedure KillSpellCheck;
|
||||
procedure SpellCheckForControl(AnEditControl: TCustomMemo);
|
||||
procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
TX_WINDOW_TITLE = 'CPRS-Chart Spell Checking #';
|
||||
TX_NO_SPELL_CHECK = 'Spell checking is unavailable.';
|
||||
TX_NO_GRAMMAR_CHECK = 'Grammar checking is unavailable.';
|
||||
TX_SPELL_COMPLETE = 'The spelling check is complete.';
|
||||
TX_GRAMMAR_COMPLETE = 'The grammar check is complete.';
|
||||
TX_SPELL_ABORT = 'The spelling check terminated abnormally.';
|
||||
TX_GRAMMAR_ABORT = 'The grammar check terminated abnormally.';
|
||||
TX_SPELL_CANCELLED = 'Spelling check was cancelled before completion.';
|
||||
TX_GRAMMAR_CANCELLED = 'Grammar check was cancelled before completion.';
|
||||
TX_NO_DETAILS = 'No further details are available.';
|
||||
TX_NO_CORRECTIONS = 'Corrections have NOT been applied.';
|
||||
CR_LF = #13#10;
|
||||
SPELL_CHECK = 'S';
|
||||
GRAMMAR_CHECK = 'G';
|
||||
|
||||
var
|
||||
WindowList: TList;
|
||||
OldList, NewList: TList;
|
||||
MSWord: OleVariant;
|
||||
uSpellCheckAvailable: TSpellCheckAvailable;
|
||||
|
||||
function SpellCheckInProgress: boolean;
|
||||
begin
|
||||
Result := not VarIsEmpty(MSWord);
|
||||
end;
|
||||
|
||||
procedure KillSpellCheck;
|
||||
begin
|
||||
if SpellCheckInProgress then
|
||||
begin
|
||||
MSWord.Quit(wdDoNotSaveChanges);
|
||||
VarClear(MSWord);
|
||||
end;
|
||||
end;
|
||||
|
||||
function SpellCheckTitle: string;
|
||||
begin
|
||||
Result := TX_WINDOW_TITLE + IntToStr(Application.Handle);
|
||||
end;
|
||||
|
||||
function GetWindows(Handle: HWND; Info: Pointer): BOOL; stdcall;
|
||||
begin
|
||||
Result := True;
|
||||
WindowList.Add(Pointer(Handle));
|
||||
end;
|
||||
|
||||
procedure GetWindowList(List: TList);
|
||||
begin
|
||||
WindowList := List;
|
||||
EnumWindows(@GetWindows, 0);
|
||||
end;
|
||||
|
||||
procedure BringWordToFront(OldList, NewList: TList);
|
||||
var
|
||||
i, NameLen: integer;
|
||||
WinName: array[0..160] of char;
|
||||
NewWinName: PChar;
|
||||
NewName: string;
|
||||
|
||||
begin
|
||||
NewName := SpellCheckTitle;
|
||||
NameLen := length(NewName);
|
||||
for i := 0 to NewList.Count-1 do
|
||||
begin
|
||||
if(OldList.IndexOf(NewList[i]) < 0) then
|
||||
begin
|
||||
GetWindowText(HWND(NewList[i]), WinName, sizeof(WinName) - 1);
|
||||
if Pos('CPRS', WinName) > 0 then
|
||||
NewWinName := PChar(Copy(WinName, Pos('CPRS', WinName), sizeof(WinName) - 1))
|
||||
else
|
||||
NewWinName := WinName;
|
||||
if StrLComp(NewWinName, pchar(NewName), NameLen)=0 then
|
||||
begin
|
||||
Application.ProcessMessages;
|
||||
SetForegroundWindow(HWND(NewList[i]));
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Spell Checking using Visual Basic for Applications script }
|
||||
|
||||
function SpellCheckAvailable: Boolean;
|
||||
//const
|
||||
// WORD_VBA_CLSID = 'CLSID\{000209FF-0000-0000-C000-000000000046}';
|
||||
begin
|
||||
// CHANGED FOR PT. SAFETY ISSUE RELEASE 19.16, PATCH OR*3*155 - ADDED NEXT 2 LINES:
|
||||
//result := false;
|
||||
//exit;
|
||||
// Reenabled in version 21.1, via parameter setting (RV)
|
||||
// Result := (GetUserParam('ORWOR SPELL CHECK ENABLED?') = '1');
|
||||
with uSpellCheckAvailable do // only want to call this once per session!!! v23.10+
|
||||
begin
|
||||
if not Evaluated then
|
||||
begin
|
||||
Available := (GetUserParam('ORWOR SPELL CHECK ENABLED?') = '1');
|
||||
Evaluated := True;
|
||||
end;
|
||||
Result := Available;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SpellAndGrammarCheckForControl(var AnotherEditControl: TCustomMemo; ACheck: Char);
|
||||
var
|
||||
NoLFText, LFText: string;
|
||||
OneChar: char;
|
||||
ErrMsg: string;
|
||||
FinishedChecking: boolean;
|
||||
OldSaveInterval, i: integer;
|
||||
MsgText: string;
|
||||
FirstLineBlank: boolean;
|
||||
OldLine0: string;
|
||||
begin
|
||||
if AnotherEditControl = nil then Exit;
|
||||
OldList := TList.Create;
|
||||
NewList := TList.Create;
|
||||
FinishedChecking := False;
|
||||
FirstLineBlank := False;
|
||||
NoLFText := '';
|
||||
OldLine0 := '';
|
||||
ClipBoard.Clear;
|
||||
try
|
||||
try
|
||||
GetWindowList(OldList);
|
||||
try
|
||||
Screen.Cursor := crHourGlass;
|
||||
MSWord := CreateOLEObject('Word.Application');
|
||||
except // MSWord not available, so exit now
|
||||
Screen.Cursor := crDefault;
|
||||
case ACheck of
|
||||
SPELL_CHECK : MsgText := TX_NO_SPELL_CHECK;
|
||||
GRAMMAR_CHECK: MsgText := TX_NO_GRAMMAR_CHECK;
|
||||
else MsgText := ''
|
||||
end;
|
||||
Application.MessageBox(PChar(MsgText), PChar(Application.Title), MB_ICONWARNING);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
GetWindowList(NewList);
|
||||
try
|
||||
MSWord.Application.Caption := SpellCheckTitle;
|
||||
// Position Word off screen to avoid having document visible...
|
||||
MSWord.WindowState := 0;
|
||||
MSWord.Top := -3000;
|
||||
OldSaveInterval := MSWord.Application.Options.SaveInterval;
|
||||
MSWord.Application.Options.SaveInterval := 0;
|
||||
MSWord.Application.Options.AutoFormatReplaceQuotes := False;
|
||||
MSWord.Application.Options.AutoFormatAsYouTypeReplaceQuotes := False;
|
||||
MSWord.ResetIgnoreAll;
|
||||
|
||||
MSWord.Documents.Add; // FileNew
|
||||
MSWord.ActiveDocument.TrackRevisions := False;
|
||||
with AnotherEditControl do
|
||||
if (Lines.Count > 0) and (not ContainsVisibleChar(Lines[0])) then
|
||||
begin
|
||||
FirstLineBlank := True; //MS bug when spell-checking document with blank first line (RV - v22.6)
|
||||
OldLine0 := Lines[0];
|
||||
Lines.Delete(0);
|
||||
end;
|
||||
MSWord.ActiveDocument.Content.Text := (AnotherEditControl.Text); // The Text property returns the plain, unformatted text of the selection or range.
|
||||
// When you set this property, the text of the range or selection is replaced.
|
||||
BringWordToFront(OldList, NewList);
|
||||
MSWord.ActiveDocument.Content.SpellingChecked := False;
|
||||
MSWord.ActiveDocument.Content.GrammarChecked := False;
|
||||
|
||||
case ACheck of
|
||||
SPELL_CHECK : begin
|
||||
MSWord.ActiveDocument.Content.CheckSpelling; // ToolsSpelling
|
||||
FinishedChecking := MSWord.ActiveDocument.Content.SpellingChecked;
|
||||
end;
|
||||
GRAMMAR_CHECK: begin
|
||||
MSWord.ActiveDocument.Content.CheckGrammar; // ToolsGrammar
|
||||
FinishedChecking := MSWord.ActiveDocument.Content.GrammarChecked;
|
||||
end;
|
||||
end;
|
||||
if FinishedChecking then // not cancelled?
|
||||
NoLFText := MSWord.ActiveDocument.Content.Text // EditSelectAll
|
||||
else
|
||||
NoLFText := '';
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
MSWord.Application.Options.SaveInterval := OldSaveInterval;
|
||||
case ACheck of
|
||||
SPELL_CHECK : FinishedChecking := MSWord.ActiveDocument.Content.SpellingChecked;
|
||||
GRAMMAR_CHECK: FinishedChecking := MSWord.ActiveDocument.Content.GrammarChecked;
|
||||
end;
|
||||
MSWord.Quit(wdDoNotSaveChanges);
|
||||
VarClear(MSWord);
|
||||
end;
|
||||
finally
|
||||
OldList.Free;
|
||||
NewList.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
ErrMsg := E.Message;
|
||||
FinishedChecking := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
Screen.Cursor := crDefault;
|
||||
Application.BringToFront;
|
||||
if FinishedChecking then
|
||||
begin
|
||||
if (Length(NoLFText) > 0) then
|
||||
begin
|
||||
LFText := '';
|
||||
for i := 1 to Length(NoLFText) do
|
||||
begin
|
||||
OneChar := NoLFText[i];
|
||||
LFText := LFText + OneChar;
|
||||
if OneChar = #13 then LFText := LFText + #10;
|
||||
end;
|
||||
with AnotherEditControl do if Lines.Count > 0 then
|
||||
begin
|
||||
Text := LFText;
|
||||
if FirstLineBlank then Text := OldLine0 + Text;
|
||||
end;
|
||||
case ACheck of
|
||||
SPELL_CHECK : MsgText := TX_SPELL_COMPLETE;
|
||||
GRAMMAR_CHECK: MsgText := TX_GRAMMAR_COMPLETE;
|
||||
else MsgText := ''
|
||||
end;
|
||||
Application.MessageBox(PChar(MsgText), PChar(Application.Title), MB_ICONINFORMATION);
|
||||
end
|
||||
else
|
||||
begin
|
||||
case ACheck of
|
||||
SPELL_CHECK : MsgText := TX_SPELL_CANCELLED;
|
||||
GRAMMAR_CHECK: MsgText := TX_GRAMMAR_CANCELLED;
|
||||
else MsgText := ''
|
||||
end;
|
||||
Application.MessageBox(PChar(MsgText + CR_LF + CR_LF + TX_NO_CORRECTIONS), PChar(Application.Title), MB_ICONINFORMATION);
|
||||
end;
|
||||
end
|
||||
else // error during spell or grammar check
|
||||
begin
|
||||
case ACheck of
|
||||
SPELL_CHECK : MsgText := TX_SPELL_ABORT;
|
||||
GRAMMAR_CHECK: MsgText := TX_GRAMMAR_ABORT;
|
||||
else MsgText := ''
|
||||
end;
|
||||
if ErrMsg = '' then ErrMsg := TX_NO_DETAILS;
|
||||
Application.MessageBox(PChar(MsgText + CR_LF + ErrMsg + CR_LF + CR_LF + TX_NO_CORRECTIONS), PChar(Application.Title), MB_ICONWARNING);
|
||||
end;
|
||||
SendMessage(TRichEdit(AnotherEditControl).Handle, WM_VSCROLL, SB_TOP, 0);
|
||||
AnotherEditControl.SetFocus;
|
||||
end;
|
||||
|
||||
procedure SpellCheckForControl(AnEditControl: TCustomMemo);
|
||||
begin
|
||||
if AnEditControl = nil then Exit;
|
||||
SpellAndGrammarCheckForControl(AnEditControl, SPELL_CHECK);
|
||||
end;
|
||||
|
||||
procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
|
||||
begin
|
||||
if AnEditControl = nil then Exit;
|
||||
SpellAndGrammarCheckForControl(AnEditControl, GRAMMAR_CHECK);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
|
@ -1,114 +0,0 @@
|
|||
unit uSurgery;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Windows, Messages, Controls, Classes, StdCtrls, ORfn, dialogs;
|
||||
|
||||
type
|
||||
TSurgeryTitles = class
|
||||
ClassName: string;
|
||||
DfltTitle: Integer;
|
||||
DfltTitleName: string;
|
||||
ShortList: TStringList;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
function MakeSurgeryCaseDisplayText(InputString: string): string;
|
||||
function MakeSurgeryReportDisplayText(RawText: string): string;
|
||||
//procedure DisplayOpTop(ANoteIEN: integer);
|
||||
|
||||
const
|
||||
(* SG_ALL = 1; // Case context - all cases
|
||||
SG_BY_SURGEON = 2; // Case context - all cases by surgeon
|
||||
SG_BY_DATE = 3; // Case context - all cases by date range*)
|
||||
|
||||
SG_TV_TEXT = 'Surgery Cases';
|
||||
|
||||
OP_TOP_NEVER_SHOW = 0;
|
||||
OP_TOP_ALWAYS_SHOW = 1;
|
||||
OP_TOP_ASK_TO_SHOW = 2;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uConst, rSurgery, fRptBox;
|
||||
|
||||
constructor TSurgeryTitles.Create;
|
||||
{ creates an object to store Surgery titles so only obtained from server once }
|
||||
begin
|
||||
inherited Create;
|
||||
ShortList := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TSurgeryTitles.Destroy;
|
||||
{ frees the lists that were used to store the Surgery titles }
|
||||
begin
|
||||
ShortList.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function MakeSurgeryCaseDisplayText(InputString: string): string;
|
||||
(*
|
||||
CASE #^Operative Procedure^Date/Time of Operation^Surgeon^^^^^^^^^+^Context
|
||||
*)
|
||||
var
|
||||
x: string;
|
||||
begin
|
||||
x := InputString;
|
||||
x := FormatFMDateTime('mmm dd yyyy', MakeFMDateTime(Piece(x, U, 3))) + ' ' + Piece(x, U, 2) +
|
||||
', ' + Piece(Piece(x, U, 4), ';', 2) + ', ' + 'Case #: ' + Piece(x, u, 1);
|
||||
Result := x;
|
||||
end;
|
||||
|
||||
function MakeSurgeryReportDisplayText(RawText: string): string;
|
||||
var
|
||||
x: string;
|
||||
begin
|
||||
x := RawText;
|
||||
x := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3))) + ' ' + Piece(x, U, 2) +
|
||||
' (#' + Piece(x, U, 1) + '), ' + Piece(x, U, 6) + ', ' + Piece(Piece(x, U, 5), ';', 2);
|
||||
Result := x;
|
||||
end;
|
||||
|
||||
(*procedure DisplayOpTop(ANoteIEN: integer);
|
||||
const
|
||||
{ TODO -oRich V. -cSurgery/TIU : What should be the text of the prompt for display OpTop on signature? }
|
||||
TX_OP_TOP_PROMPT = 'Would you like to first review the OpTop for this surgery report?';
|
||||
var
|
||||
AList: TStringList;
|
||||
ACaseIEN: integer;
|
||||
IsNonORProc: boolean;
|
||||
ShouldShowOpTop: integer;
|
||||
x: string;
|
||||
ShowReport: boolean;
|
||||
begin
|
||||
AList := TStringList.Create;
|
||||
try
|
||||
ShowReport := False;
|
||||
x := GetSurgCaseRefForNote(ANoteIEN);
|
||||
ACaseIEN := StrToIntDef(Piece(x, ';', 1), 0);
|
||||
ShouldShowOpTop := ShowOpTopOnSignature(ACaseIEN);
|
||||
case ShouldShowOpTop of
|
||||
OP_TOP_NEVER_SHOW : ; // do nothing
|
||||
OP_TOP_ALWAYS_SHOW : begin
|
||||
x := GetSingleCaseListItemWithoutDocs(ANoteIEN);
|
||||
IsNonORProc := IsNonORProcedure(ACaseIEN);
|
||||
LoadOpTop(AList, ACaseIEN, IsNonORProc, ShowReport);
|
||||
ReportBox(AList, MakeSurgeryCaseDisplayText(x), True);
|
||||
end;
|
||||
OP_TOP_ASK_TO_SHOW : if InfoBox(TX_OP_TOP_PROMPT, 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
|
||||
begin
|
||||
x := GetSingleCaseListItemWithoutDocs(ANoteIEN);
|
||||
IsNonORProc := IsNonORProcedure(ACaseIEN);
|
||||
LoadOpTop(AList, ACaseIEN, IsNonORProc, ShowReport);
|
||||
ReportBox(AList, MakeSurgeryCaseDisplayText(x), True);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
AList.Free;
|
||||
end;
|
||||
end;*)
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue