Upgrading to version 27
This commit is contained in:
kdtop3
parent
308d89e9cf
commit
b57df74f8f
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,150 @@
|
|||
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.
|
||||
|
|
@ -0,0 +1,67 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
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.
|
||||
|
|
@ -0,0 +1,291 @@
|
|||
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.
|
||||
|
|
@ -0,0 +1,114 @@
|
|||
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