iSharkFly-Open
/
VistA-cprs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Upgrading to version 27

This commit is contained in:
kdtop3 2010-07-07 21:16:19 +00:00
parent 308d89e9cf
commit b57df74f8f
6 changed files with 2471 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1749
CPRS-Chart/VERGENCECONTEXTORLib_TLB.pas Normal file
View File

File diff suppressed because it is too large Load Diff

150
CPRS-Chart/XuDigSigSC_TLB.pas Normal file
View File

@ -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.

67
CPRS-Chart/tfVType.dfm Normal file
View File

@ -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

100
CPRS-Chart/uDCSumm.pas Normal file
View File

@ -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.

291
CPRS-Chart/uSpell.pas Normal file
View File

@ -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.

114
CPRS-Chart/uSurgery.pas Normal file
View File

@ -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.