Context Navigation

uTemplates.pas@ 1429

Last change on this file since 1429 was 829, checked in by Kevin Toppenberg, 14 years ago
Upgrade to version 27
File size: 89.4 KB

Rev	Line
[456]	1	unit uTemplates;
	2
	3	{$O-}
	4
	5	interface
	6	uses
	7	Classes, Controls, SysUtils, Forms, ORFn, ORNet, Dialogs, MSXML_TLB, uTIU, uDCSumm, Variants;
	8
	9	type
	10	TTemplateType = (ttNone, ttMyRoot, ttRoot, ttTitles, ttConsults, ttProcedures,
	11	ttClass, ttDoc, ttGroup, ttDocEx, ttGroupEx);
	12	TTemplateLinkTypes = ttTitles..ttProcedures;
	13
	14	const
	15	AllTemplateLinkTypes = [ttTitles..ttProcedures];
	16	AllTemplateRootTypes = [ttMyRoot, ttRoot, ttTitles, ttConsults, ttProcedures];
	17	AllTemplateTrueTypes = AllTemplateRootTypes + [ttNone, ttClass];
	18	AllTemplateFolderTypes = AllTemplateRootTypes + [ttGroup, ttClass];
	19
	20	type
	21	TTemplateChildren = (tcNone, tcActive, tcInactive, tcBoth);
	22	TTemplateAccess = (taAll, taReadOnly, taNone, taEditor);
	23	TTemplateLinkType = (ltNone, ltTitle, ltConsult, ltProcedure);
	24
	25	TTemplateBackup = record
	26	BPrintName: string;
	27	BGap: integer;
	28	BRealType: TTemplateType;
	29	BActive: boolean;
	30	BDisplayOnly: boolean;
	31	BFirstLine: boolean;
	32	BOneItemOnly: boolean;
	33	BHideDlgItems: boolean;
	34	BHideItems: boolean;
	35	BIndentItems: boolean;
	36	BExclude: boolean;
	37	BDialog: boolean;
	38	BPersonalOwner: Int64;
	39	BBoilerPlate: string;
	40	BItemIENs: string;
	41	BDescription: string;
	42	BReminderDialog: string;
	43	BLock: boolean;
	44	BCOMObject: integer;
	45	BCOMParam: string;
	46	BFileLink: string;
	47
	48	SavedPrintName: boolean;
	49	SavedGap: boolean;
	50	SavedRealType: boolean;
	51	SavedActive: boolean;
	52	SavedDisplayOnly: boolean;
	53	SavedFirstLine: boolean;
	54	SavedOneItemOnly: boolean;
	55	SavedHideDlgItems: boolean;
	56	SavedHideItems: boolean;
	57	SavedIndentItems: boolean;
	58	SavedExclude: boolean;
	59	SavedDialog: boolean;
	60	SavedPersonalOwner: boolean;
	61	SavedBoilerPlate: boolean;
	62	SavedItemIENs: boolean;
	63	SavedDescription: boolean;
	64	SavedReminderDialog: boolean;
	65	SavedLock: boolean;
	66	SavedCOMObject: boolean;
	67	SavedCOMParam: boolean;
	68	SavedFileLink: boolean;
	69	end;
	70
	71	TTemplate = class(TObject)
	72	private
	73	FDescriptionLoaded: boolean; // Template Notes Loaded Flag
	74	FDescription: string; // Template Notes
	75	FCreatingChildren: boolean; // Flag used to prevent infinite recursion
	76	FExclude: boolean; // Exclude from group boilerplate
	77	FActive: boolean;
	78	FDisplayOnly: boolean; // Suppresses checkbox in dialog - no PN text
	79	FFirstLine: boolean; // Display only the first line in a dialog box
	80	FOneItemOnly: boolean; // Allow only one Child Item to be selected in dialog
	81	FHideDlgItems: boolean; // Hide Child Items when not checked
	82	FHideItems: boolean; // Hide items in Templates Drawer Tree
	83	FIndentItems: boolean; // Indent Items in dialog only
	84	FLock: boolean; // Locks Shared Templates
	85	FDialog: boolean; // Determines if Group is a Dialog
	86	FBoilerPlateLoaded: boolean; // Boilerplate Loaded Flag
	87	FBoilerplate: string; // Boilerplate
	88	FID: string; // Template IEN
	89	FPrintName: string; // Template Name
	90	FItems: TList; // Holds pointers to children templates
	91	FNodes: TStringList; // Holds tree nodes that reference the template
	92	// string value is tmp index used for syncing
	93	FRealType: TTemplateType; // Real Template Type (from the template file)
	94	FGap: integer; // Number of blank lines to insert between items
	95	FChildren: TTemplateChildren; // flag indicating the active status of children
	96	FPersonalOwner: Int64; // owner DUZ
	97	FExpanded: boolean; // Indicates children have been read from server
	98	FTag: longint; // Used internally for syncing
	99	FLastTagIndex: longint; // Used internally for syncing
	100	FBkup: TTemplateBackup; // Backup values to determine what needs to be saved
	101	FLastDlgCnt: longint;
	102	FLastUniqueID: longint;
	103	FDialogAborted: boolean; // Flag indicating Cancel was pressed on the dialog
	104	FReminderDialog: string; // Reminder Dialog IEN ^ Reminder Dialog Name
	105	FIsReminderDialog: boolean; // Flag used internally for setting Type
	106	FIsCOMObject: boolean; // Flag used internally for setting Type
	107	FLocked: boolean; // Flag Indicating Template is locked
	108	FCOMObject: integer; // COM Object IEN
	109	FCOMParam: string; // Param to pass to COM Object
	110	FFileLink: string; // Used to link templates to Titles and Reasons for Request
	111	FLinkName: string;
	112	FCloning: boolean; // Flag used to prevent locking during the cloning process
	113	FPreviewMode: boolean; // Flag to prevent "Are you sure you want to cancel?" dialog when previewing
	114	protected
	115	function TrueClone: TTemplate;
	116	function GetItems: TList;
	117	function GetTemplateType: TTemplateType;
	118	function GetBoilerplate: string;
	119	function GetChildren: TTemplateChildren;
	120	procedure SetTemplateType(const Value: TTemplateType);
	121	procedure SetBoilerplate(Value: string);
	122	function GetText: string;
	123	procedure SetPersonalOwner(Value: Int64);
	124	procedure SetActive(const Value: boolean);
	125	procedure SetDisplayOnly(const Value: boolean);
	126	procedure SetFirstLine(const Value: boolean);
	127	procedure SetOneItemOnly(const Value: boolean);
	128	procedure SetHideDlgItems(const Value: boolean);
	129	procedure SetHideItems(const Value: boolean);
	130	procedure SetIndentItems(const Value: boolean);
	131	procedure SetLock(const Value: boolean);
	132	procedure SetExclude(const Value: boolean);
	133	procedure SetDialog(const Value: boolean);
	134	procedure SetGap(const Value: integer);
	135	procedure SetPrintName(const Value: string);
	136	procedure SetRealType(const Value: TTemplateType);
	137	procedure ClearBackup(ClearItemIENs: boolean = TRUE);
	138	procedure SetDescription(const Value: string);
	139	function GetDescription: string;
	140	function GetDialogAborted: boolean;
	141	procedure SetReminderDialog(const Value: string); // Reminder Dialog IEN
	142	procedure SetCOMObject(const Value: integer);
	143	procedure SetCOMParam(const Value: string);
	144	procedure AssignFileLink(const Value: string; Force: boolean);
	145	procedure SetFileLink(const Value: string);
	146	function ValidID: boolean;
	147	public
	148	constructor Create(DataString: string);
	149	class function CreateFromXML(Element: IXMLDOMNode; Owner: string): TTemplate;
	150	destructor Destroy; override;
	151	function CanModify: boolean;
	152	procedure Unlock;
	153	procedure AddNode(Node: Pointer);
	154	procedure RemoveNode(Node: Pointer);
	155	procedure AddChild(Child: TTemplate);
	156	procedure RemoveChild(Child: TTemplate);
	157	function Clone(Owner: Int64): TTemplate;
	158	function ItemBoilerplate: string;
	159	function FullBoilerplate: string;
	160	function ItemIENs: string;
	161	procedure BackupItems;
	162	procedure SortChildren;
	163	function Changed: boolean;
	164	function DialogProperties(Parent: TTemplate = nil): string;
	165	function DlgID: string;
	166	function IsDialog: boolean;
	167	function CanExportXML(Data, Fields: TStringList; IndentLevel: integer = 0): boolean;
	168	function ReminderDialogIEN: string;
	169	function ReminderDialogName: string;
	170	function ReminderWipe: string; //AGP Change 24.8
	171	function IsLocked: boolean;
	172	procedure UpdateImportedFieldNames(List: TStrings);
	173	//function COMObjectText(const DefText: string = ''; DocInfo: string = ''): string;
	174	function COMObjectText(DefText: string; var DocInfo: string): string;
	175	function AutoLock: boolean;
	176	function LinkType: TTemplateLinkType;
	177	function LinkIEN: string;
	178	function LinkName: string;
	179	procedure ExecuteReminderDialog(OwningForm: TForm);
	180	property Nodes: TStringList read FNodes;
	181	property ID: string read FID;
	182	property PrintName: string read FPrintName write SetPrintName;
	183	property RealType: TTemplateType read FRealType write SetRealType;
	184	property TemplateType: TTemplateType read GetTemplateType write SetTemplateType;
	185	property Active: boolean read FActive write SetActive;
	186	property DisplayOnly: boolean read FDisplayOnly write SetDisplayOnly;
	187	property FirstLine: boolean read FFirstLine write SetFirstLine;
	188	property OneItemOnly: boolean read FOneItemOnly write SetOneItemOnly;
	189	property HideDlgItems: boolean read FHideDlgItems write SetHideDlgItems;
	190	property HideItems: boolean read FHideItems write SetHideItems;
	191	property IndentItems: boolean read FIndentItems write SetIndentItems;
	192	property Lock: boolean read FLock write SetLock;
	193	property Exclude: boolean read FExclude write SetExclude;
	194	property Dialog: boolean read FDialog write SetDialog;
	195	property Boilerplate: string read GetBoilerplate write SetBoilerplate;
	196	property Children: TTemplateChildren read GetChildren;
	197	property Items: TList read GetItems;
	198	property Gap: integer read FGap write SetGap;
	199	property Description: string read GetDescription write SetDescription;
	200	property Text: string read GetText;
	201	property PersonalOwner: Int64 read FPersonalOwner write SetPersonalOwner;
	202	property Expanded: boolean read FExpanded write FExpanded;
	203	property Tag: longint read FTag write FTag;
	204	property LastTagIndex: longint read FLastTagIndex write FLastTagIndex;
	205	property DialogAborted: boolean read GetDialogAborted;
	206	property ReminderDialog: string read FReminderDialog write SetReminderDialog;
	207	property IsReminderDialog: boolean read FIsReminderDialog write FIsReminderDialog;
	208	property IsCOMObject: boolean read FIsCOMObject write FIsCOMObject;
	209	property Locked: boolean read FLocked;
	210	property COMObject: integer read FCOMObject write SetCOMObject;
	211	property COMParam: string read FCOMParam write SetCOMParam;
	212	property FileLink: string read FFileLink write SetFileLink;
	213	property TemplatePreviewMode: boolean read FPreviewMode write FPreviewMode;
	214	end;
	215
	216	function SearchMatch(const SubStr, Str: string; const WholeWordsOnly: boolean): boolean;
	217	function UserTemplateAccessLevel: TTemplateAccess;
	218	function AddTemplate(DataString: string; Owner: TTemplate = nil): TTemplate;
	219	procedure LoadTemplateData;
	220	procedure ExpandTemplate(tmpl: TTemplate);
	221	procedure ReleaseTemplates;
	222	procedure RemoveAllNodes;
	223	function CanEditLinkType(LinkType: TTemplateLinkTypes): boolean;
	224	function GetLinkedTemplate(IEN: string; LType: TTemplateLinkType): TTemplate;
	225	function ConvertFileLink(IEN: string; LType: TTemplateLinkType): string;
	226	function GetLinkName(IEN: string; LType: TTemplateLinkType): string;
	227
	228	function BackupDiffers: boolean;
	229	procedure SaveTemplate(Template: TTemplate; Idx: integer; ErrorList: TStrings = nil);
	230	function SaveAllTemplates: boolean;
	231	procedure ClearBackup;
	232	procedure MarkDeleted(Template: TTemplate);
	233	function BadTemplateName(Text: string): boolean;
	234	procedure WordImportError(msg: string);
	235	procedure XMLImportError(Result: HResult);
	236	procedure XMLImportCheck(Result: HResult);
	237	function GetXMLFromWord(const AFileName: string; Data: TStrings): boolean;
	238	function WordImportActive: boolean;
	239	procedure UnlockAllTemplates;
	240	function DisplayGroupToLinkType(DGroup: integer): TTemplateLinkType;
	241
	242	(*procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType;
	243	OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = ''); overload;
	244	procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType;
	245	OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = ''); overload;*)
	246	procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType;
	247	OwningForm: TForm; CaptionText: string; var DocInfo: string); overload;
	248	procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType;
	249	OwningForm: TForm; CaptionText: string; var DocInfo: string); overload;
	250
	251	procedure ExpandEmbeddedFields(flds: TStringList);
	252	function MakeXMLParamTIU(ANoteID: string; ANoteRec: TEditNoteRec): string; overload;
	253	function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string; overload;
	254	function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string;
[829]	255	procedure UpdatePersonalObjects;
	256	procedure SetTemplateDialogCanceled(value: Boolean);
	257	function WasTemplateDialogCanceled: Boolean;
	258	procedure SetTemplateBPHasObjects(value: Boolean);
	259	function TemplateBPHasObjects: Boolean;
[456]	260
	261	const
	262	EmptyNodeText = '<^Empty Node^>';
	263	NewTemplateName = 'New Template';
	264	FirstRealTemplateType = ttMyRoot;
	265	LastRealTemplateType = ttGroup;
	266	TemplateTypeCodes: array[FirstRealTemplateType..LastRealTemplateType] of string[2] =
	267	('P','R','TF','CF','OF','C','T','G');
	268	BadNameText = CRLF + CRLF + 'Valid Template names must start with an alphanumber '+
	269	'character, and be at least 3 characters in length.' + CRLF +
	270	'In addition, no template can be named "' + NewTemplateName+'".';
	271
	272	TemplateLockedText = 'Template %s is currently being edited by another user.';
	273
	274	XMLTemplateTag = 'TEMPLATE';
	275	XMLTemplateFieldsTag = 'TEMPLATE_FIELDS';
	276	XMLHeader = 'CPRS_TEMPLATE';
	277
	278	var
	279	Templates: TStringList = nil;
	280	RootTemplate: TTemplate = nil;
	281	MyTemplate: TTemplate = nil;
	282	TitlesTemplate: TTemplate = nil;
	283	ConsultsTemplate: TTemplate = nil;
	284	ProceduresTemplate: TTemplate = nil;
[829]	285	uPersonalObjects: TStringList = nil; // -------- CQ #8665 - RV ------------
[456]	286
	287	implementation
	288
	289	uses
	290	Windows, rTemplates, uCore, dShared, fTemplateDialog, ActiveX, ComObj, uTemplateFields,
[829]	291	XMLUtils, fTemplateImport, uSpell, rCore, uConst, ORCtrls, uEventHooks,
	292	fReminderDialog, rODBase
	293	{$IFDEF VER140}
	294	, Word97;
	295	{$ELSE}
	296	, WordXP, VAUtils;
	297	{$ENDIF}
[456]	298
	299	const
	300	MaxSeq = 999999;
	301	sLoading = 'Loading Template Information...';
	302
	303	type
	304	ETemplateError = class(Exception);
	305	ETemplateImportError = class(Exception);
	306	ETemplateXMLImportError = class(EOleSysError);
	307
	308	var
	309	TemplateAccessLevelChecked: boolean = FALSE;
	310	TemplateAccessLevelValue: TTemplateAccess;
	311	LastTemplateLocation: integer = 0;
	312	TempSL: TStringList = nil;
	313	Deleted: TStringList = nil;
	314	NodeCount: longint = 0; // Used by FNodes to prevent access violations in a Resync
	315
	316	GettingDialogText: boolean = FALSE;
	317	uIndentLevel: integer;
	318	uDlgCount: longint = 0; // Used for dialogs on unsaved templates
	319	uUniqueIDNum: longint = 0; // Used for dialogs on unsaved templates
	320	uCanEditLinkTypeResults: string = '';
	321	uTemplateDataLoaded: boolean = FALSE;
	322	uDGroupConsults: integer = 0;
	323	uDGroupProcedures: integer = 0;
[829]	324	uTemplateDialogCanceled: Boolean = FALSE;
	325	uTemplateBPHasObjects: Boolean = FALSE;
[456]	326
	327	type
	328	TTemplateExportField = (efName, efBlankLines, efType, efStatus, efExclude, efDialog,
	329	efDisplayOnly, efFirstLine, efOneItemOnly, efHideDialogItems,
	330	efHideTreeItems, efIndentItems, efBoilerplate, efDescription,
	331	efItems, efLock);
	332
	333	const
	334	TemplateActiveCode: array[boolean] of string[1] = ('I','A');
	335	TemplateExportTag: array[TTemplateExportField] of string = // From Field Names in File 8927
	336	{ efName } ('NAME',
	337	{ efBlankLines } 'BLANK_LINES',
	338	{ efType } 'TYPE',
	339	{ efStatus } 'STATUS',
	340	{ efExclude } 'EXCLUDE_FROM_GROUP_BOILERPLATE',
	341	{ efDialog } 'DIALOG',
	342	{ efDisplayOnly } 'DISPLAY_ONLY',
	343	{ efFirstLine } 'FIRST_LINE',
	344	{ efOneItemOnly } 'ONE_ITEM_ONLY',
	345	{ efHideDialogItems } 'HIDE_DIALOG_ITEMS',
	346	{ efHideTreeItems } 'HIDE_TREE_ITEMS',
	347	{ efIndentItems } 'INDENT_ITEMS',
	348	{ efBoilerplate } 'BOILERPLATE_TEXT',
	349	{ efDescription } 'DESCRIPTION',
	350	{ efItems } 'ITEMS',
	351	{ efLock } 'LOCK');
	352
	353	ExportPieces:array[TTemplateExportField] of integer =
	354	{ efName } (4,
	355	{ efBlankLines } 6,
	356	{ efType } 2,
	357	{ efStatus } 3,
	358	{ efExclude } 5,
	359	{ efDialog } 9,
	360	{ efDisplayOnly } 10,
	361	{ efFirstLine } 11,
	362	{ efOneItemOnly } 12,
	363	{ efHideDialogItems } 13,
	364	{ efHideTreeItems } 14,
	365	{ efIndentItems } 15,
	366	{ efBoilerplate } 0,
	367	{ efDescription } 0,
	368	{ efItems } 0,
	369	{ efLock } 18);
	370
	371	XMLErrorMessage = 'Error Importing Template. File does not contain Template ' +
	372	'information or may be corrupted.';
	373
	374	WordErrorMessage = 'Error Importing Word Document.';
	375
	376	type
	377	TTemplateFieldExportField = (tfName, tfType, tfLength, tfDefault, tfDefIdx, tfDesc,
	378	tfItems, tfDateType, tfTextLen, tfMinVal, tfMaxVal);
	379
	380	const
	381	TemplateFieldExportTag: array[TTemplateFieldExportField] of string = // From Field Names in File 8927.1
	382	{ tfName } ('NAME',
	383	{ tfType } 'TYPE',
	384	{ tfLength } 'LENGTH',
	385	{ tfDefault } 'DEFAULT_TEXT',
	386	{ tfDefIdx } 'DEFAULT_INDEX',
	387	{ tfDesc } 'DESCRIPTION',
	388	{ tfItems } 'ITEMS',
	389	{ tfDateType } 'DATE_TYPE',
	390	{ tfTextLen } 'MAX_LENGTH',
	391	{ tfMinVal } 'MIN_VALUE',
	392	{ tfMaxVal } 'MAX_VALUE');
	393
	394	XMLFieldTag = 'FIELD';
	395
	396	LinkGlobal: array[TTemplateLinkType] of string =
	397	{ ltNone } ('',
	398	{ ltTitle } ';TIU(8925.1,',
	399	{ ltConsult } ';GMR(123.5,',
	400	{ ltProcedure } ';GMR(123.3,');
	401
	402	LinkPassCode: array[TTemplateLinkType] of string =
	403	{ ltNone } ('',
	404	{ ltTitle } 'T',
	405	{ ltConsult } 'C',
	406	{ ltProcedure } 'P');
	407
	408	function DlgText(const txt: string; DlgProps: string): string;
	409	var
	410	i, j: integer;
	411
	412	begin
	413	Result := txt;
	414	if GettingDialogText then
	415	begin
	416	if (Result = '') then
	417	Result := NoTextMarker;
	418	i := pos(DlgPropMarker, Result);
	419	j := pos(ObjMarker, Result);
	420	if(i > 0) and (j > 0) then
	421	delete(Result, i, j - i + ObjMarkerLen)
	422	else
	423	i := length(Result) + 1;
	424	insert(DlgPropMarker + DlgProps + ObjMarker, Result, i);
	425	end;
	426	end;
	427
	428	function SearchMatch(const SubStr, Str: string; const WholeWordsOnly: boolean): boolean;
	429	const
	430	AlphaNumeric = ['A'..'Z','a'..'z','0'..'9'];
	431
	432	var
	433	i, j: integer;
	434
	435	begin
	436	i := pos(SubStr,Str);
	437	if(i > 0) then
	438	begin
	439	Result := TRUE;
	440	if(WholeWordsOnly) then
	441	begin
	442	if((i > 1) and (Str[i-1] in AlphaNumeric)) then
	443	Result := FALSE
	444	else
	445	begin
	446	j := length(SubStr);
	447	if((i+j) <= length(Str)) then
	448	Result := (not (Str[i+j] in AlphaNumeric));
	449	end;
	450	end;
	451	end
	452	else
	453	Result := FALSE;
	454	end;
	455
	456	function UserTemplateAccessLevel: TTemplateAccess;
	457	var
	458	i: integer;
	459
	460	begin
	461	if(TemplateAccessLevelChecked and
	462	(LastTemplateLocation = Encounter.Location)) then
	463	Result := TemplateAccessLevelValue
	464	else
	465	begin
	466	TemplateAccessLevelChecked := FALSE;
	467	LastTemplateLocation := 0;
	468	if(not assigned(RootTemplate)) then
	469	begin
	470	Result := taAll;
	471	GetTemplateRoots;
	472	for i := 0 to RPCBrokerV.Results.Count-1 do
	473	begin
	474	if(Piece(RPCBrokerV.Results[i],U,2)=TemplateTypeCodes[ttRoot]) then
	475	begin
	476	Result := TTemplateAccess(GetTemplateAccess(Piece(RPCBrokerV.Results[i],U,1)));
	477	LastTemplateLocation := Encounter.Location;
	478	TemplateAccessLevelChecked := TRUE;
	479	TemplateAccessLevelValue := Result;
	480	Break;
	481	end;
	482	end;
	483	end
	484	else
	485	begin
	486	Result := TTemplateAccess(GetTemplateAccess(RootTemplate.ID));
	487	LastTemplateLocation := Encounter.Location;
	488	TemplateAccessLevelChecked := TRUE;
	489	TemplateAccessLevelValue := Result;
	490	end;
	491	end;
	492	end;
	493
	494	function AddTemplate(DataString: string; Owner: TTemplate = nil): TTemplate;
	495	var
	496	idx: integer;
	497	id: string;
	498	tmpl: TTemplate;
	499
	500	begin
	501	id := Piece(DataString, U, 1);
	502	if(id = '') or (id = '0') then
	503	idx := -1
	504	else
	505	idx := Templates.IndexOf(id);
	506	if(idx < 0) then
	507	begin
	508	tmpl := TTemplate.Create(DataString);
	509	Templates.AddObject(id, tmpl);
	510	if(tmpl.Active) then
	511	begin
	512	if (tmpl.RealType = ttRoot) then
	513	RootTemplate := tmpl
	514	else if (tmpl.RealType = ttTitles) then
	515	TitlesTemplate := tmpl
	516	else if (tmpl.RealType = ttConsults) then
	517	ConsultsTemplate := tmpl
	518	else if (tmpl.RealType = ttProcedures) then
	519	ProceduresTemplate := tmpl
	520	else if(tmpl.RealType = ttMyRoot) then
	521	MyTemplate := tmpl;
	522	end;
	523	end
	524	else
	525	tmpl := TTemplate(Templates.Objects[idx]);
	526	if(assigned(Owner)) and (assigned(tmpl)) then
	527	Owner.AddChild(tmpl);
	528	Result := tmpl;
	529	end;
	530
	531	procedure LoadTemplateData;
	532	var
	533	i: integer;
	534	TmpSL: TStringList;
	535
	536	begin
	537	if(not uTemplateDataLoaded) then
	538	begin
	539	StatusText(sLoading);
	540	try
	541	if(not assigned(Templates)) then
	542	Templates := TStringList.Create;
	543	TmpSL := TStringList.Create;
	544	try
	545	GetTemplateRoots;
[829]	546	FastAssign(RPCBrokerV.Results, TmpSL);
[456]	547	for i := 0 to TmpSL.Count-1 do
	548	AddTemplate(TmpSL[i]);
	549	uTemplateDataLoaded := TRUE;
	550	finally
	551	TmpSL.Free;
	552	end;
	553	finally
	554	StatusText('');
	555	end;
	556	end;
	557	end;
	558
	559	procedure ExpandTemplate(tmpl: TTemplate);
	560	var
	561	i: integer;
	562	TmpSL: TStringList;
	563
	564	begin
	565	if(not tmpl.Expanded) then
	566	begin
	567	if(tmpl.Children <> tcNone) then
	568	begin
	569	StatusText(sLoading);
	570	try
	571	TmpSL := TStringList.Create;
	572	try
	573	GetTemplateChildren(tmpl.FID);
[829]	574	FastAssign(RPCBrokerV.Results, TmpSL);
[456]	575	for i := 0 to TmpSL.Count-1 do
	576	AddTemplate(TmpSL[i], tmpl);
	577	finally
	578	TmpSL.Free;
	579	end;
	580	finally
	581	StatusText('');
	582	end;
	583	end;
	584	tmpl.Expanded := TRUE;
	585	with tmpl,tmpl.FBkup do
	586	begin
	587	BItemIENs := ItemIENs;
	588	SavedItemIENs := TRUE;
	589	end;
	590	end;
	591	end;
	592
	593	procedure ReleaseTemplates;
	594	var
	595	i: integer;
	596
	597	begin
	598	if(assigned(Templates)) then
	599	begin
	600	for i := 0 to Templates.Count-1 do
	601	TTemplate(Templates.Objects[i]).Free;
	602	Templates.Free;
	603	Templates := nil;
	604	uTemplateDataLoaded := FALSE;
	605	end;
	606	ClearBackup;
	607	if(assigned(TempSL)) then
	608	begin
	609	TempSL.Free;
	610	TempSL := nil;
	611	end;
[829]	612	// -------- CQ #8665 - RV ------------
	613	if (assigned(uPersonalObjects)) then
	614	begin
	615	KillObj(@uPersonalObjects);
	616	uPersonalObjects.Free;
	617	uPersonalObjects := nil;
	618	end;
	619	// ------end CQ #8665 ------------
[456]	620	if(assigned(Deleted)) then
	621	begin
	622	Deleted.Clear;
	623	Deleted := nil;
	624	end;
	625	RootTemplate := nil;
	626	MyTemplate := nil;
	627	TitlesTemplate := nil;
	628	ConsultsTemplate := nil;
	629	ProceduresTemplate := nil;
	630	end;
	631
	632	procedure RemoveAllNodes;
	633	var
	634	i: integer;
	635
	636	begin
	637	if(assigned(Templates)) then
	638	begin
	639	for i := 0 to Templates.Count-1 do
	640	TTemplate(Templates.Objects[i]).FNodes.Clear;
	641	end;
	642	end;
	643
	644	function CanEditLinkType(LinkType: TTemplateLinkTypes): boolean;
	645
	646	function CanEditType(Template: TTemplate): boolean;
	647	begin
	648	if not assigned(Template) then
	649	Result := FALSE
	650	else
	651	if pos(Char(ord(LinkType)+ord('0')), uCanEditLinkTypeResults) > 0 then
	652	Result := (pos(Char(ord(LinkType)+ord('A')), uCanEditLinkTypeResults) > 0)
	653	else
	654	begin
	655	Result := IsUserTemplateEditor(Template.ID, User.DUZ);
	656	uCanEditLinkTypeResults := uCanEditLinkTypeResults + Char(ord(LinkType)+ord('0'));
	657	if Result then
	658	uCanEditLinkTypeResults := uCanEditLinkTypeResults + Char(ord(LinkType)+ord('A'));
	659	end;
	660	end;
	661
	662	begin
	663	case LinkType of
	664	ttTitles: Result := CanEditType(TitlesTemplate);
	665	ttConsults: Result := CanEditType(ConsultsTemplate);
	666	ttProcedures: Result := CanEditType(ProceduresTemplate);
	667	else Result := FALSE;
	668	end;
	669	end;
	670
	671	function GetLinkedTemplate(IEN: string; LType: TTemplateLinkType): TTemplate;
	672	var
	673	idx: integer;
	674	Data, ALink: string;
	675
	676	begin
	677	Result := nil;
	678	if LType <> ltNone then
	679	begin
	680	if(not assigned(Templates)) then
	681	Templates := TStringList.Create;
	682	ALink := IEN + LinkGlobal[LType];
	683	for idx := 0 to Templates.Count-1 do
	684	begin
	685	if ALink = TTemplate(Templates.Objects[idx]).FFileLink then
	686	begin
	687	Result := TTemplate(Templates.Objects[idx]);
	688	break;
	689	end;
	690	end;
	691	if not assigned(Result) then
	692	begin
	693	Data := GetLinkedTemplateData(ALink);
	694	if Data <> '' then
	695	Result := AddTemplate(Data);
	696	end;
	697	end;
	698	end;
	699
	700	function ConvertFileLink(IEN: string; LType: TTemplateLinkType): string;
	701	begin
	702	if(LType = ltNone) or (IEN = '') or (StrToIntDef(IEN,0) = 0) then
	703	Result := ''
	704	else
	705	Result := IEN + LinkGlobal[LType];
	706	end;
	707
	708	function GetLinkName(IEN: string; LType: TTemplateLinkType): string;
	709	var
	710	IEN64: Int64;
	711
	712	begin
	713	IEN64 := StrToInt64Def(IEN,0);
	714	case LType of
	715	ltTitle: Result := ExternalName(IEN64,8925.1);
	716	ltConsult: Result := ExternalName(IEN64,123.5);
	717	ltProcedure: Result := ExternalName(IEN64,123.3);
	718	else Result := '';
	719	end;
	720	end;
	721
	722	function BackupDiffers: boolean;
	723	var
	724	i: integer;
	725
	726	begin
	727	Result := FALSE;
	728	if(assigned(Templates)) then
	729	begin
	730	for i := 0 to Templates.Count-1 do
	731	begin
	732	if(TTemplate(Templates.Objects[i]).Changed) then
	733	begin
	734	Result := TRUE;
	735	exit;
	736	end;
	737	end;
	738	end;
	739	end;
	740
	741	procedure DisplayErrors(Errors: TStringList; SingleError: string = '');
	742	begin
	743	if(assigned(Errors)) then
[829]	744	ShowMsg(Errors.text)
[456]	745	else
[829]	746	ShowMsg(SingleError);
[456]	747	end;
	748
	749
	750	procedure SaveTemplate(Template: TTemplate; Idx: integer; ErrorList: TStrings = nil);
	751	var
	752	i: integer;
	753	ID, Tmp: string;
	754	NoCheck: boolean;
	755	DescSL: TStringList;
	756
	757	begin
	758	{ Removed because this may be a bug??? - what if it's hidden? -
	759	better to save and delete than miss it
	760	//Don't save new templates that have been deleted
	761	if(((Template.ID = '0') or (Template.ID = '')) and
	762	(Template.Nodes.Count = 0)) then exit;
	763	}
	764	if(not Template.Changed) then
	765	begin
	766	Template.Unlock;
	767	exit;
	768	end;
	769
	770	if(not assigned(TempSL)) then
	771	TempSL := TStringList.Create;
	772	TempSL.Clear;
	773	ID := Template.ID;
	774
	775	NoCheck := (ID = '0') or (ID = '');
	776
	777	with Template,Template.FBkup do
	778	begin
	779	if(NoCheck or (SavedBoilerplate and (BBoilerplate <> Boilerplate))) then
	780	begin
	781	TempSL.Text := BoilerPlate;
	782	if(TempSL.Count > 0) then
	783	begin
	784	for i := 0 to TempSL.Count-1 do
	785	TempSL[i] := '2,'+IntToStr(i+1)+',0='+TempSL[i];
	786	end
	787	else
	788	TempSL.Add('2,1=@');
	789	end;
	790
	791	if(NoCheck or (SavedPrintName and (BPrintName <> PrintName))) then
	792	TempSL.Add('.01='+PrintName);
	793
	794	if(NoCheck or (SavedGap and (BGap <> Gap))) then
	795	begin
	796	if Gap = 0 then
	797	TempSL.Add('.02=@')
	798	else
	799	TempSL.Add('.02='+IntToStr(Gap));
	800	end;
	801
	802	if(NoCheck or (SavedRealType and (BRealType <> RealType))) then
	803	TempSL.Add('.03='+TemplateTypeCodes[RealType]);
	804
	805	if(NoCheck or (SavedActive and (BActive <> Active))) then
	806	TempSL.Add('.04='+TemplateActiveCode[Active]);
	807
	808	if(NoCheck or (SavedExclude and (BExclude <> FExclude))) then
	809	TempSL.Add('.05='+BOOLCHAR[Exclude]);
	810
	811	if(NoCheck or (SavedDialog and (BDialog <> FDialog))) then
	812	TempSL.Add('.08='+BOOLCHAR[Dialog]);
	813
	814	if(NoCheck or (SavedDisplayOnly and (BDisplayOnly <> DisplayOnly))) then
	815	TempSL.Add('.09='+BOOLCHAR[DisplayOnly]);
	816
	817	if(NoCheck or (SavedFirstLine and (BFirstLine <> FirstLine))) then
	818	TempSL.Add('.1='+BOOLCHAR[FirstLine]);
	819
	820	if(NoCheck or (SavedOneItemOnly and (BOneItemOnly <> OneItemOnly))) then
	821	TempSL.Add('.11='+BOOLCHAR[OneItemOnly]);
	822
	823	if(NoCheck or (SavedHideDlgItems and (BHideDlgItems <> HideDlgItems))) then
	824	TempSL.Add('.12='+BOOLCHAR[HideDlgItems]);
	825
	826	if(NoCheck or (SavedHideItems and (BHideItems <> HideItems))) then
	827	TempSL.Add('.13='+BOOLCHAR[HideItems]);
	828
	829	if(NoCheck or (SavedIndentItems and (BIndentItems <> IndentItems))) then
	830	TempSL.Add('.14='+BOOLCHAR[IndentItems]);
	831
	832	if(NoCheck or (SavedReminderDialog and (BReminderDialog <> ReminderDialog))) then
	833	begin
	834	if ReminderDialogIEN = '' then
	835	TempSL.Add('.15=@')
	836	else
	837	TempSL.Add('.15='+ReminderDialogIEN);
	838	end;
	839
	840	if(NoCheck or (SavedLock and (BLock <> Lock))) then
	841	TempSL.Add('.16='+BOOLCHAR[Lock]);
	842
	843	if(NoCheck or (SavedCOMObject and (BCOMObject <> COMObject))) then
	844	begin
	845	if COMObject = 0 then
	846	TempSL.Add('.17=@')
	847	else
	848	TempSL.Add('.17='+IntToStr(COMObject));
	849	end;
	850
	851	if(NoCheck or (SavedCOMParam and (BCOMParam <> COMParam))) then
	852	begin
	853	if COMParam = '' then
	854	TempSL.Add('.18=@')
	855	else
	856	TempSL.Add('.18=' + COMParam);
	857	end;
	858
	859	if(NoCheck or (SavedFileLink and (BFileLink <> FileLink))) then
	860	begin
	861	if FileLink = '' then
	862	TempSL.Add('.19=@')
	863	else
	864	TempSL.Add('.19=' + FileLink);
	865	end;
	866
	867	if(NoCheck or (SavedPersonalOwner and (BPersonalOwner <> PersonalOwner))) then
	868	begin
	869	if(PersonalOwner = 0) then
	870	Tmp := ''
	871	else
	872	Tmp := IntToStr(PersonalOwner);
	873	TempSL.Add('.06='+Tmp);
	874	end;
	875
	876	if(NoCheck or (SavedDescription and (BDescription <> Description))) then
	877	begin
	878	DescSL := TStringList.Create;
	879	try
	880	DescSL.Text := Description;
	881	if(DescSL.Count > 0) then
	882	begin
	883	for i := 0 to DescSL.Count-1 do
	884	DescSL[i] := '5,'+IntToStr(i+1)+',0='+DescSL[i];
	885	end
	886	else
	887	DescSL.Add('5,1=@');
[829]	888	FastAddStrings(DescSL, TempSL)
[456]	889	finally
	890	DescSL.Free;
	891	end;
	892	end;
	893
	894	end;
	895
	896	if(TempSL.Count > 0) then
	897	begin
	898	Tmp := UpdateTemplate(ID, TempSL);
	899	if(Piece(Tmp,U,1) = '0') then
	900	begin
	901	Tmp := 'Error Saving ' + Template.PrintName + ' ' + ID + '=' + Tmp;
	902	if(Assigned(ErrorList)) then
	903	ErrorList.Add(Tmp)
	904	else
	905	DisplayErrors(nil, Tmp);
	906	end
	907	else
	908	begin
	909	if(((ID = '') or (ID = '0')) and (Tmp <> ID)) then
	910	begin
	911	if(idx < 0) then
	912	idx := Templates.IndexOfObject(Template);
	913	Template.FID := Tmp;
	914	Templates[idx] := Tmp;
	915	if assigned(Template.FNodes) then
	916	begin
	917	for i := 0 to Template.FNodes.Count-1 do
	918	TORTreeNode(Template.FNodes.Objects[i]).StringData := Template.ID + U + Template.PrintName;
	919	end;
	920	end;
	921	Template.ClearBackup(FALSE);
	922	if NoCheck then with Template.FBkup do
	923	begin
	924	BItemIENs := '';
	925	SavedItemIENs := TRUE;
	926	end;
	927	end;
	928	end;
	929	end;
	930
	931	function SaveAllTemplates: boolean;
	932	var
	933	i, k: integer;
	934	New: TTemplate;
	935	Errors: TStringList;
	936	First, ChildErr: boolean;
	937
	938	begin
	939	Errors := TStringList.Create;
	940	try
	941	if(assigned(Templates)) then
	942	begin
	943	if(not assigned(TempSL)) then
	944	TempSL := TStringList.Create;
	945	for i := 0 to Templates.Count-1 do
	946	SaveTemplate(TTemplate(Templates.Objects[i]), i, Errors);
	947	First := TRUE;
	948	if(Errors.Count > 0) then
	949	Errors.Insert(0,'Errors Encountered Saving Templates:');
	950	for i := 0 to Templates.Count-1 do
	951	begin
	952	New := TTemplate(Templates.Objects[i]);
	953	with New.FBkup do
	954	if(SavedItemIENs and (BItemIENs <> New.ItemIENs)) then
	955	begin
	956	TempSL.Clear;
	957	for k := 0 to New.Items.Count-1 do
	958	TempSL.Add(TTemplate(New.Items[k]).FID);
	959	UpdateChildren(New.ID, TempSL);
	960	ChildErr := FALSE;
	961	for k := 0 to RPCBrokerV.Results.Count-1 do
	962	begin
	963	if(RPCBrokerV.Results[k] <> IntToStr(k+1)) then
	964	begin
	965	if(First) then
	966	begin
	967	Errors.Add('Errors Encountered Saving Children:');
	968	First := FALSE;
	969	end;
	970	Errors.Add(New.ID+' Item #'+IntToStr(k+1)+'('+
	971	TTemplate(New.Items[k]).FID+')'+'='+RPCBrokerV.Results[k]);
	972	ChildErr := TRUE;
	973	end;
	974	end;
	975	if(not ChildErr) then
	976	BItemIENs := New.ItemIENs;
	977	end;
	978	New.Unlock;
	979	end;
	980	if(assigned(Deleted)) and (Deleted.Count > 0) then
	981	begin
	982	DeleteTemplates(Deleted);
	983	Deleted.Clear;
	984	end;
	985	if(Errors.Count > 0) then
	986	DisplayErrors(Errors);
	987	end;
	988	finally
	989	Result := (Errors.Count = 0);
	990	Errors.Free;
	991	end;
	992	end;
	993
	994	procedure ClearBackup;
	995	var
	996	i: integer;
	997
	998	begin
	999	if(assigned(Templates)) then
	1000	begin
	1001	for i := 0 to Templates.Count-1 do
	1002	TTemplate(Templates.Objects[i]).ClearBackup;
	1003	end;
	1004	end;
	1005
	1006	procedure MarkDeleted(Template: TTemplate);
	1007	var
	1008	i, idx: integer;
	1009
	1010	begin
	1011	if(Template.ValidID) then
	1012	begin
	1013	if(not assigned(Deleted)) then
	1014	Deleted := TStringList.Create;
	1015	idx := Deleted.IndexOf(Template.ID);
	1016	if(idx < 0) then
	1017	Deleted.Add(Template.ID);
	1018	end;
	1019	Template.FileLink := '';
	1020	Template.GetItems;
	1021	for i := 0 to Template.FItems.Count-1 do
	1022	MarkDeleted(TTemplate(Template.FItems[i]));
	1023	end;
	1024
	1025	function BadTemplateName(Text: string): boolean;
	1026	begin
	1027	Result := FALSE;
	1028	if(Text = NewTemplateName) or (length(Text) < 3) then
	1029	Result := TRUE
	1030	else
	1031	if(not (Text[1] in ['a'..'z','A'..'Z','0'..'9'])) then
	1032	Result := TRUE;
	1033	end;
	1034
	1035	procedure WordImportError(msg: string);
	1036	begin
	1037	raise ETemplateImportError.Create(WordErrorMessage + CRLF + msg);
	1038	end;
	1039
	1040	procedure XMLImportError(Result: HResult);
	1041	begin
	1042	raise ETemplateXMLImportError.Create(XMLErrorMessage, Result, 0);
	1043	end;
	1044
	1045	procedure XMLImportCheck(Result: HResult);
	1046	begin
	1047	if not Succeeded(Result) then
	1048	XMLImportError(Result);
	1049	end;
	1050
	1051	procedure AddXMLData(Data: TStrings; const Pad: string; FldType: TTemplateExportField; const Value, DefValue: string);
	1052	begin
	1053	if(Value <> '') and (Value <> DefValue) then
	1054	Data.Add(Pad + ' <' + TemplateExportTag[FldType] + '>' + Text2XML(Value) +
	1055	'</' + TemplateExportTag[FldType] + '>');
	1056	end;
	1057
	1058	procedure AddXMLBool(Data: TStrings; const Pad: string; FldType: TTemplateExportField; const Value: boolean);
	1059	begin
	1060	AddXMLData(Data, Pad, FldType, BOOLCHAR[Value], BOOLCHAR[FALSE]);
	1061	end;
	1062
	1063	procedure AddXMLList(Data, Fields: TStrings; const Pad: string; FldType: TTemplateExportField; Const Txt: string);
	1064	var
	1065	i: integer;
	1066	TmpSL: TStrings;
	1067
	1068	begin
	1069	if(Txt <> '') then
	1070	begin
	1071	TmpSL := TStringList.Create;
	1072	try
	1073	TmpSL.Text := Txt;
	1074	Data.Add(Pad + ' <' + TemplateExportTag[FldType] + '>');
	1075	for i := 0 to TmpSL.Count-1 do
	1076	Data.Add(Pad + ' <p>' + Text2XML(TmpSL[i]) + '</p>');
	1077	Data.Add(Pad + ' </' + TemplateExportTag[FldType] + '>');
	1078	finally
	1079	TmpSL.Free;
	1080	end;
	1081	if assigned(Fields) then
	1082	ListTemplateFields(Txt, Fields);
	1083	end;
	1084	end;
	1085
	1086	function GetXMLFromWord(const AFileName: string; Data: TStrings): boolean;
	1087	var
	1088	itmp, itmp2, itmp3, i, j: integer;
	1089	WDoc: TWordDocument;
	1090	WasVis: boolean;
	1091	WApp: TWordApplication;
	1092	Boiler: string;
	1093	FldCache, Fields, PendingAdd: TStringList;
	1094	OldCur: TCursor;
	1095	idx, TmpVar, RangeStart, RangeEnd: oleVariant;
	1096	ddTotal, ffTotal, ffStartCur, ffEndCur, ffEndLast : integer;
	1097	ffRange, textRange: Range;
	1098	tmp, TemplateName, fName: string;
	1099	tmpType, tfIdx: TTemplateFieldType;
	1100	tmpDate: TTmplFldDateType;
	1101
	1102	tfCount: array[TTemplateFieldType] of integer;
	1103
	1104	procedure AddBoiler(txt: string);
	1105	var
	1106	i: integer;
	1107	c: char;
	1108	tmp: string;
	1109
	1110	begin
	1111	tmp := '';
	1112	for i := 1 to length(txt) do
	1113	begin
	1114	c := txt[i];
	1115	if (c > #31) or (c = #13) or (c = #10) then
	1116	tmp := tmp + c;
	1117	end;
	1118	Boiler := Boiler + tmp;
	1119	end;
	1120
	1121	procedure AddField(Typ: TTemplateFieldExportField; Value: string; Pending: boolean = FALSE);
	1122	var
	1123	sl: TStringList;
	1124
	1125	begin
	1126	if Pending then
	1127	sl := PendingAdd
	1128	else
	1129	sl := Fields;
	1130	sl.Add('<' + TemplateFieldExportTag[Typ] + '>' + Text2XML(Value) +
	1131	'</' + TemplateFieldExportTag[Typ] + '>');
	1132	end;
	1133
	1134	procedure AddFieldHeader(FldType: TTemplateFieldType; First: boolean);
	1135	var
	1136	tmp: string;
	1137
	1138	begin
	1139	tmp := '<';
	1140	if not First then
	1141	tmp := tmp + '/';
	1142	tmp := tmp + XMLFieldTag;
	1143	if First then
	1144	begin
	1145	fname := 'WORDFLD_' + FldNames[FldType] + '_';
	1146	tfIdx := FldType;
	1147	tmp := tmp + ' ' + TemplateFieldExportTag[tfName] + '="' + Text2XML(fname);
	1148	end;
	1149	if not First then
	1150	tmp := tmp + '>';
	1151	Fields.Add(tmp);
	1152	if First then
	1153	AddField(tfType, TemplateFieldTypeCodes[FldType]);
	1154	end;
	1155
	1156	procedure WordWrap(var Str: string);
	1157	var
	1158	TmpSL: TStringList;
	1159	i: integer;
	1160
	1161	begin
	1162	TmpSL := TStringList.Create;
	1163	try
	1164	TmpSL.Text := Str;
	1165	Str := '';
	1166	for i := 0 to TmpSL.Count-1 do
	1167	begin
	1168	if Str <> '' then
	1169	Str := Str + CRLF;
	1170	Str := Str + WrapText(TmpSL[i], #13#10, [' ','-'], MAX_ENTRY_WIDTH);
	1171	end;
	1172	finally
	1173	TmpSL.Free;
	1174	end;
	1175	end;
	1176
	1177	begin
	1178	for tfIdx := low(TTemplateFieldType) to high(TTemplateFieldType) do
	1179	tfCount[tfIdx] := 1;
	1180	TemplateName := ExtractFileName(AFileName);
	1181	Result := TRUE;
	1182	try
	1183	OldCur := Screen.Cursor;
	1184	Screen.Cursor := crAppStart;
	1185	try
	1186	WApp := TWordApplication.Create(nil);
	1187	try
	1188	WasVis := WApp.Visible;
	1189	WApp.Visible := FALSE;
	1190	try
	1191	WDoc := TWordDocument.Create(nil);
	1192	try
	1193	try
	1194	WApp.Connect;
	1195	TmpVar := AFileName;
[829]	1196	{$IFDEF VER140}
[456]	1197	WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam));
[829]	1198	{$ELSE}
	1199	WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam, EmptyParam, EmptyParam));
	1200	{$ENDIF}
[456]	1201	ffTotal := WDoc.FormFields.Count;
	1202
	1203	if ffTotal > 3 then
	1204	StartImportMessage(TemplateName, ffTotal+1);
	1205
	1206	if WDoc.ProtectionType <> wdNoProtection then
	1207	WDoc.Unprotect;
	1208
	1209	Data.Add('<'+XMLHeader+'>');
	1210
	1211	tmp := ExtractFileExt(TemplateName);
	1212	if tmp <> '' then
	1213	begin
	1214	i := pos(tmp,TemplateName);
	1215	if i > 0 then
	1216	delete(TemplateName, i, length(tmp));
	1217	end;
	1218	TemplateName := copy(TemplateName, 1, 60);
	1219
	1220	if BadTemplateName(TemplateName) then
	1221	begin
	1222	tmp := copy('WordDoc ' + TemplateName, 1, 60);
	1223	if BadTemplateName(TemplateName) then
	1224	tmp := 'Imported Word Document'
	1225	else
	1226	tmp := TemplateName;
	1227	end
	1228	else
	1229	tmp := TemplateName;
	1230	Data.Add('<' + XMLTemplateTag + ' ' + TemplateExportTag[efName] + '="' + Text2XML(tmp) + '">');
	1231	AddXMLData(Data, '', efType, TemplateTypeCodes[ttDoc], '');
	1232	AddXMLData(Data, '', efStatus, TemplateActiveCode[TRUE], '');
	1233
	1234	Boiler := '';
	1235	Fields := TStringList.Create;
	1236	try
	1237	FldCache := TStringList.Create;
	1238	try
	1239	PendingAdd := TStringList.Create;
	1240	try
	1241	ffEndCur := 0;
	1242
	1243	for i := 1 to ffTotal do
	1244	begin
	1245	if UpdateImportMessage(i) then
	1246	begin
	1247	Result := FALSE;
	1248	Data.Clear;
	1249	break;
	1250	end;
	1251	idx := i;
	1252	ffEndLast := ffEndCur;
	1253	ffRange := WDoc.FormFields.Item(idx).Range;
	1254	ffStartCur := ffRange.Start;
	1255	ffEndCur := ffRange.End_;
	1256
	1257	// Assign working start range for text collection:
	1258	if i = 1 then
	1259	rangeStart := 0 // Before first FormField, use start of document.
	1260	else
	1261	rangeStart := ffEndLast; // Start of new range is end of the last FormField range.
	1262
	1263	// Assign working end range for text collection:
	1264	rangeEnd := ffStartCur; // End of new range is start of current FormField range.
	1265
	1266	// Collect text in the range:
	1267	textRange := WDoc.Range(rangeStart, rangeEnd);
	1268	textRange.Select;
	1269
	1270	AddBoiler(TextRange.text);
	1271	tfIdx := dftUnknown;
	1272	fname := '';
	1273	case WDoc.FormFields.Item(idx).type_ of
	1274	wdFieldFormTextInput:
	1275	begin
	1276	itmp3 := WDoc.FormFields.Item(idx).TextInput.Type_;
	1277	case itmp3 of
	1278	wdNumberText: tmpType := dftNumber;
	1279	wdDateText, wdCurrentDateText, wdCurrentTimeText: tmpType := dftDate;
	1280	else tmpType := dftEditBox;
	1281	end;
	1282	AddFieldHeader(tmpType, TRUE);
	1283	tmpDate := dtUnknown;
	1284	tmp := WDoc.FormFields.Item(idx).TextInput.Default;
	1285	case itmp3 of
	1286	wdNumberText:
	1287	begin
	1288	AddField(tfMinVal, IntToStr(-9999), TRUE);
	1289	AddField(tfMaxVal, IntToStr(9999), TRUE);
	1290	end;
	1291
	1292	wdDateText: tmpDate := dtDate;
	1293	wdCurrentDateText:
	1294	begin
	1295	tmpDate := dtDate;
	1296	if tmp = '' then
	1297	tmp := 'T';
	1298	end;
	1299	wdCurrentTimeText:
	1300	begin
	1301	tmpDate := dtDateTime;
	1302	if tmp = '' then
	1303	tmp := 'NOW';
	1304	end;
	1305	else
	1306	begin
	1307	itmp2 := WDoc.FormFields.Item(idx).TextInput.Width;
	1308	itmp := itmp2;
	1309	if (itmp < 1) then
	1310	begin
	1311	itmp := length(tmp);
	1312	if itmp < 10 then
	1313	itmp := 10
	1314	else
	1315	if itmp > 70 then
	1316	itmp := 70;
	1317	itmp2 := 240;
	1318	end
	1319	else
	1320	begin
	1321	if (itmp > 70) then
	1322	itmp := 70;
	1323	if (itmp2 > 240) then
	1324	itmp2 := 240;
	1325	end;
	1326	AddField(tfLength, IntToStr(itmp));
	1327	AddField(tfTextLen, IntToStr(itmp2), TRUE);
	1328	end;
	1329	end;
	1330	if tmpDate <> dtUnknown then
	1331	AddField(tfDateType, TemplateFieldDateCodes[tmpDate], TRUE);
	1332	if tmp <> '' then
	1333	AddField(tfDefault, tmp);
[829]	1334	FastAddStrings(PendingAdd, Fields);
[456]	1335	PendingAdd.Clear;
	1336	AddFieldHeader(tmpType, FALSE);
	1337	end;
	1338
	1339	wdFieldFormCheckBox:
	1340	begin
	1341	AddFieldHeader(dftButton, TRUE);
	1342	itmp := ord(boolean(WDoc.FormFields.Item(idx).CheckBox.Default))+1;
	1343	AddField(tfDefIdx, IntToStr(itmp));
	1344	Fields.Add('<' + TemplateFieldExportTag[tfItems] + '>');
	1345	Fields.Add('<p>' + Text2XML('[ ]') + '</p>');
	1346	Fields.Add('<p>' + Text2XML('[X]') + '</p>');
	1347	Fields.Add('</' + TemplateFieldExportTag[tfItems] + '>');
	1348	AddFieldHeader(dftButton, FALSE);
	1349	end;
	1350
	1351	wdFieldFormDropDown:
	1352	begin
	1353	ddTotal := WDoc.FormFields.Item(Idx).DropDown.ListEntries.Count;
	1354	if(ddTotal > 0)then
	1355	begin
	1356	AddFieldHeader(dftComboBox, TRUE);
	1357	itmp := WDoc.FormFields.Item(idx).DropDown.Default;
	1358	if itmp > 0 then
	1359	AddField(tfDefIdx, IntToStr(itmp));
	1360
	1361	Fields.Add('<' + TemplateFieldExportTag[tfItems] + '>');
	1362	for j := 1 to ddTotal do
	1363	begin
	1364	TmpVar := j;
	1365	tmp := WDoc.FormFields.Item(Idx).DropDown.ListEntries.Item(TmpVar).Name;
	1366	Fields.Add('<p>' + Text2XML(tmp) + '</p>');
	1367	end;
	1368	Fields.Add('</' + TemplateFieldExportTag[tfItems] + '>');
	1369	AddFieldHeader(dftComboBox, FALSE);
	1370	end;
	1371	end;
	1372	end;
	1373	if (Fields.Count > 0) then
	1374	begin
	1375	if tfIdx <> dftUnknown then
	1376	begin
	1377	tmp := Fields.CommaText;
	1378	j := FldCache.IndexOf(tmp);
	1379	if j < 0 then
	1380	begin
	1381	FldCache.AddObject(tmp, TObject(tfCount[tfIdx]));
	1382	j := tfCount[tfIdx];
	1383	inc(tfCount[tfIdx]);
	1384	end
	1385	else
	1386	j := Integer(FldCache.Objects[j]);
	1387	Boiler := Boiler + TemplateFieldBeginSignature + fname + IntToStr(j) + TemplateFieldEndSignature;
	1388	end;
	1389	Fields.Clear;
	1390	end;
	1391	end;
	1392	if Result then
	1393	begin
	1394	rangeStart := ffEndCur; // Start of new range is end of last FormField range.
	1395	rangeEnd := WDoc.Range.End_; // After last FormField, use end of document.
	1396
	1397	// Collect text in trailing range:
	1398	textRange := WDoc.Range(rangeStart, rangeEnd);
	1399	textRange.Select;
	1400
	1401	AddBoiler(TextRange.text);
	1402
	1403	WordWrap(Boiler);
	1404
	1405	AddXMLList(Data, nil, '', efBoilerplate, Boiler);
	1406
	1407	tmp := WrapText('Imported on ' + FormatFMDateTime('mmm dd yyyy hh:nn', FMNow) +
	1408	' from Word Document: ' + AFileName, #13#10, [' '], MAX_ENTRY_WIDTH);
	1409
	1410	AddXMLList(Data, nil, '', efDescription, tmp);
	1411
	1412	Data.Add('</' + XMLTemplateTag + '>');
	1413	if FldCache.Count > 0 then
	1414	begin
	1415	Data.Add('<' + XMLTemplateFieldsTag + '>');
	1416	for i := 0 to FldCache.Count-1 do
	1417	begin
	1418	Fields.Clear;
	1419	Fields.CommaText := FldCache[i];
	1420	if Fields.Count > 0 then
	1421	begin
	1422	Fields[0] := Fields[0] + IntToStr(Integer(FldCache.Objects[i])) + '">';
[829]	1423	FastAddStrings(Fields, Data);
[456]	1424	end;
	1425	end;
	1426	Data.Add('</' + XMLTemplateFieldsTag + '>');
	1427	end;
	1428
	1429	Data.Add('</'+XMLHeader+'>');
	1430	UpdateImportMessage(ffTotal+1);
	1431	end;
	1432	finally
	1433	PendingAdd.Free;
	1434	end;
	1435	finally
	1436	FldCache.Free;
	1437	end;
	1438	finally
	1439	Fields.Free;
	1440	end;
	1441
	1442	except
	1443	on E:Exception do
	1444	WordImportError(E.Message);
	1445	end;
	1446	finally
	1447	TmpVar := wdDoNotSaveChanges;
	1448	WDoc.Close(TmpVar);
	1449	WDoc.Free;
	1450	end;
	1451	finally
	1452	WApp.Visible := WasVis;
	1453	end;
	1454	finally
	1455	WApp.Disconnect;
	1456	WApp.Free;
	1457	end;
	1458	finally
	1459	Screen.Cursor := OldCur;
	1460	end;
	1461	finally
	1462	StopImportMessage;
	1463	end;
	1464	if not Result then
	1465	InfoBox('Importing Word Document Canceled.','Import Canceled', MB_OK);
	1466	end;
	1467
	1468	function WordImportActive: boolean;
	1469	begin
	1470	Result := True;
	1471	//Result := SpellCheckAvailable; spell check disabled in v19.16
	1472	end;
	1473
	1474	procedure UnlockAllTemplates;
	1475	var
	1476	i: integer;
	1477
	1478	begin
	1479	if(assigned(Templates)) then
	1480	begin
	1481	for i := 0 to Templates.Count-1 do
	1482	TTemplate(Templates.Objects[i]).Unlock;
	1483	end;
	1484	end;
	1485
	1486	function DisplayGroupToLinkType(DGroup: integer): TTemplateLinkType;
	1487	begin
	1488	Result := ltNone;
	1489	if DGroup <> 0 then
	1490	begin
	1491	if uDGroupConsults = 0 then
	1492	uDGroupConsults := DisplayGroupByName('CONSULTS');
	1493	if uDGroupProcedures = 0 then
	1494	uDGroupProcedures := DisplayGroupByName('PROCEDURES');
	1495	if DGroup = uDGroupConsults then
	1496	Result := ltConsult
	1497	else
	1498	if DGroup = uDGroupProcedures then
	1499	Result := ltProcedure;
	1500	end;
	1501	end;
	1502
	1503	(*procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType;
	1504	OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = '');*)
	1505	procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType;
	1506	OwningForm: TForm; CaptionText: string; var DocInfo: string);
	1507
	1508	var
	1509	Template: TTemplate;
	1510	txt: string;
	1511
	1512	begin
[829]	1513	SetTemplateDialogCanceled(FALSE);
	1514	SetTemplateBPHasObjects(FALSE);
[456]	1515	Template := GetLinkedTemplate(IntToStr(IEN), LType);
	1516	if assigned(Template) then
	1517	begin
	1518	if Template.IsReminderDialog then
	1519	begin
	1520	Template.ExecuteReminderDialog(OwningForm);
	1521	DocInfo := '';
	1522	end
	1523	else
	1524	begin
	1525	if Template.IsCOMObject then
	1526	txt := Template.COMObjectText(SL.Text, DocInfo)
	1527	else
	1528	begin
	1529	txt := Template.Text;
	1530	DocInfo := '';
	1531	end;
	1532	if(txt <> '') then
	1533	begin
	1534	CheckBoilerplate4Fields(txt, CaptionText);
	1535	SL.Text := txt;
	1536	end;
	1537	end;
	1538	end
	1539	else
	1540	begin
	1541	txt := SL.Text;
	1542	CheckBoilerplate4Fields(txt, CaptionText);
	1543	DocInfo := '';
	1544	SL.Text := txt;
	1545	end;
	1546	end;
	1547
	1548	(*procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType;
	1549	OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = '');*)
	1550	procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType;
	1551	OwningForm: TForm; CaptionText: string; var DocInfo: string);
	1552
	1553	var
	1554	tmp: TStringList;
	1555
	1556	begin
	1557	tmp := TStringList.Create;
	1558	try
	1559	tmp.text := AText;
	1560	ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, OwningForm, CaptionText, DocInfo);
	1561	AText := tmp.text;
	1562	finally
	1563	tmp.free;
	1564	end;
	1565	end;
	1566
	1567	{ TTemplate }
	1568
	1569	constructor TTemplate.Create(DataString: string);
	1570	var
	1571	i: TTemplateType;
	1572	Code: string[2];
	1573
	1574	begin
	1575	FCloning := TRUE;
	1576	try
	1577	FNodes := TStringList.Create;
	1578	FID := Piece(DataString, U, 1);
	1579	Code := Piece(DataString, U, 2);
	1580	FRealType := ttNone;
	1581	for i := FirstRealTemplateType to LastRealTemplateType do
	1582	begin
	1583	if(TemplateTypeCodes[i] = Code) then
	1584	begin
	1585	FRealType := i;
	1586	break;
	1587	end;
	1588	end;
	1589	if FRealType = ttNone then
	1590	raise ETemplateError.Create('Template has invalid Type Code of "' + Code + '"');
	1591	FActive := (Piece(DataString, U, 3) = TemplateActiveCode[TRUE]);
	1592	FPrintName := Piece(DataString, U, 4);
	1593	FExclude := (Piece(DataString, U, 5) = '1');
	1594	FDialog := (Piece(DataString, U, 9) = '1');
	1595	FDisplayOnly := (Piece(DataString, U, 10) = '1');
	1596	FFirstLine := (Piece(DataString, U, 11) = '1');
	1597	FOneItemOnly := (Piece(DataString, U, 12) = '1');
	1598	FHideDlgItems := (Piece(DataString, U, 13) = '1');
	1599	FHideItems := (Piece(DataString, U, 14) = '1');
	1600	FIndentItems := (Piece(DataString, U, 15) = '1');
	1601	FLock := (Piece(DataString, U, 18) = '1');
	1602	FReminderDialog := Pieces(DataString, U, 16, 17);
	1603	FReminderDialog := FReminderDialog + U + Piece(DataString, U, 25); //AGP CHANGE 24.8
	1604	FIsReminderDialog := (ReminderDialogIEN <> '');
	1605	FCOMObject := StrToIntDef(Piece(DataString, U, 19), 0);
	1606	FCOMParam := Piece(DataString, U, 20);
	1607	FFileLink := Piece(DataString, U, 21);
	1608	FIsCOMObject := (FCOMObject > 0);
	1609	FGap := StrToIntDef(Piece(DataString, U, 6),0);
	1610	FPersonalOwner := StrToInt64Def(Piece(DataString, U, 7),0);
	1611	case StrToIntDef(Piece(DataString, U, 8),0) of
	1612	1: FChildren := tcActive;
	1613	2: FChildren := tcInactive;
	1614	3: FChildren := tcBoth;
	1615	else FChildren := tcNone;
	1616	end;
	1617	FLocked := FALSE;
	1618	finally
	1619	FCloning := FALSE;
	1620	end;
	1621	end;
	1622
	1623	class function TTemplate.CreateFromXML(Element: IXMLDOMNode; Owner: string): TTemplate;
	1624	var
	1625	DataStr: string;
	1626	Children, Items: IXMLDOMNodeList;
	1627	Child, Item: IXMLDOMNode;
	1628	i, j, count, ItemCount: integer;
	1629	fld: TTemplateExportField;
	1630	ETag: string;
	1631
	1632	begin
	1633	DataStr := '0';
	1634	SetPiece(DataStr, U, 4, FindXMLAttributeValue(Element, TemplateExportTag[efName]));
	1635	SetPiece(DataStr, U, 7, Owner);
	1636	Children := Element.Get_childNodes;
	1637	try
	1638	if assigned(Children) then
	1639	begin
	1640	count := Children.Length;
	1641	for i := 0 to Count - 1 do
	1642	begin
	1643	Child := Children.Item[i];
	1644	ETag := Child.NodeName;
	1645	for fld := low(TTemplateExportField) to high(TTemplateExportField) do
	1646	begin
	1647	if(ExportPieces[fld] > 0) and (CompareText(ETag, TemplateExportTag[fld]) = 0) then
	1648	SetPiece(DataStr, U, ExportPieces[fld], Child.Get_Text);
	1649	end;
	1650	end;
	1651	end
	1652	else
	1653	Count := 0;
	1654	Result := Create(DataStr);
	1655	Result.FCloning := TRUE;
	1656	try
	1657	if assigned(Children) then
	1658	begin
	1659	for i := 0 to Count - 1 do
	1660	begin
	1661	Child := Children.Item[i];
	1662	ETag := Child.NodeName;
	1663	for fld := low(TTemplateExportField) to high(TTemplateExportField) do
	1664	begin
	1665	if(ExportPieces[fld] = 0) and (CompareText(ETag, TemplateExportTag[fld]) = 0) then
	1666	begin
	1667	case fld of
	1668	efBoilerplate: Result.SetBoilerplate(GetXMLWPText(Child));
	1669	efDescription: Result.SetDescription(GetXMLWPText(Child));
	1670	efItems:
	1671	begin
	1672	Result.GetItems;
	1673	Items := Child.Get_childNodes;
	1674	if assigned(Items) then
	1675	begin
	1676	ItemCount := Items.Length;
	1677	for j := 0 to ItemCount - 1 do
	1678	begin
	1679	Item := Items.Item[j];
	1680	if(CompareText(Item.NodeName, XMLTemplateTag) = 0) then
	1681	Result.FItems.Add(CreateFromXML(Item, Owner));
	1682	end;
	1683	end;
	1684	end;
	1685	end;
	1686	end;
	1687	end;
	1688	end;
	1689	end;
	1690	finally
	1691	Result.FCloning := FALSE;
	1692	end;
	1693	finally
	1694	Children := nil;
	1695	end;
	1696	Result.BackupItems;
	1697	Templates.AddObject(Result.ID, Result);
	1698	end;
	1699
	1700	destructor TTemplate.Destroy;
	1701	begin
	1702	Unlock;
	1703	FNodes.Free;
	1704	if(assigned(FItems)) then FItems.Free;
	1705	inherited;
	1706	end;
	1707
	1708	procedure TTemplate.AddChild(Child: TTemplate);
	1709	begin
	1710	GetItems;
	1711	if(FItems.IndexOf(Child) < 0) then
	1712	FItems.Add(Child);
	1713	end;
	1714
	1715	procedure TTemplate.RemoveChild(Child: TTemplate);
	1716	var
	1717	idx: integer;
	1718
	1719	begin
	1720	GetItems;
	1721	idx := FItems.IndexOf(Child);
	1722	if(idx >= 0) and CanModify then
	1723	FItems.delete(idx);
	1724	end;
	1725
	1726	function TTemplate.GetItems: TList;
	1727	begin
	1728	if(not assigned(FItems)) then
	1729	begin
	1730	FItems := TList.Create;
	1731	FCreatingChildren := TRUE;
	1732	try
	1733	ExpandTemplate(Self);
	1734	finally
	1735	FCreatingChildren := FALSE;
	1736	end;
	1737	end;
	1738	Result := FItems;
	1739	end;
	1740
	1741	function TTemplate.GetTemplateType: TTemplateType;
	1742	begin
	1743	Result := FRealType;
	1744	if(Result in [ttDoc, ttGroup]) and (FExclude) then
	1745	begin
	1746	case (Result) of
	1747	ttDoc: Result := ttDocEx;
	1748	ttGroup: Result := ttGroupEx;
	1749	end;
	1750	end;
	1751	end;
	1752
	1753	function TTemplate.GetChildren: TTemplateChildren;
	1754	var
	1755	i: integer;
	1756
	1757	begin
	1758	if((assigned(FItems)) and (not FCreatingChildren)) then
	1759	begin
	1760	Result := tcNone;
	1761	for i := 0 to FItems.Count-1 do
	1762	begin
	1763	if(TTemplate(FItems[i]).Active) then
	1764	Result := TTemplateChildren(ord(Result) or ord(tcActive))
	1765	else
	1766	Result := TTemplateChildren(ord(Result) or ord(tcInactive));
	1767	if(Result = tcBoth) then break;
	1768	end;
	1769	end
	1770	else
	1771	Result := FChildren;
	1772	end;
	1773
	1774	procedure TTemplate.SetTemplateType(const Value: TTemplateType);
	1775	begin
	1776	if(GetTemplateType <> Value) and CanModify then
	1777	begin
	1778	if(Value in AllTemplateTrueTypes) then
	1779	SetRealType(Value)
	1780	else
	1781	begin
	1782	case Value of
	1783	ttDoc: begin SetExclude(FALSE); SetRealType(ttDoc); end;
	1784	ttGroup: begin SetExclude(FALSE); SetRealType(ttGroup); end;
	1785	ttDocEx: begin SetExclude(TRUE); SetRealType(ttDoc); end;
	1786	ttGroupEx: begin SetExclude(TRUE); SetRealType(ttGroup); end;
	1787	end;
	1788	end;
	1789	end;
	1790	end;
	1791
	1792	function TTemplate.GetBoilerplate: string;
	1793	begin
	1794	Result := '';
	1795	if FIsReminderDialog or FIsCOMObject then exit;
	1796	if(RealType in [ttDoc, ttGroup]) then
	1797	begin
	1798	if(not FBoilerPlateLoaded) then
	1799	begin
	1800	StatusText('Loading Template Boilerplate...');
	1801	try
	1802	GetTemplateBoilerplate(FID);
	1803	FBoilerplate := RPCBrokerV.Results.Text;
	1804	FBoilerPlateLoaded := TRUE;
	1805	finally
	1806	StatusText('');
	1807	end;
	1808	end;
	1809	Result := FBoilerplate;
	1810	end;
	1811	end;
	1812
	1813	{ Returns the cumulative boilerplate of a groups items }
	1814	function TTemplate.ItemBoilerplate: string;
	1815	var
	1816	i, j: integer;
	1817	Template: TTemplate;
	1818	GapStr: string;
	1819
	1820	begin
	1821	Result := '';
	1822	if FIsReminderDialog or FIsCOMObject then exit;
	1823	if(RealType = ttGroup) then
	1824	begin
	1825	GetItems;
	1826	GapStr := '';
	1827	if(FGap > 0) then
	1828	begin
	1829	for j := 1 to FGap do
	1830	GapStr := GapStr + CRLF;
	1831	end;
	1832	if(IndentItems) then
	1833	inc(uIndentLevel);
	1834	try
	1835	for i := 0 to FItems.Count-1 do
	1836	begin
	1837	Template := TTemplate(FItems[i]);
	1838	if(Template.Active and (Template.TemplateType in [ttDoc, ttGroup])) then
	1839	begin
	1840	if i > 0 then
	1841	Result := Result + GapStr;
	1842	Result := Result + DlgText(TTemplate(FItems[i]).FullBoilerplate,
	1843	TTemplate(FItems[i]).DialogProperties(Self));
	1844	end;
	1845	end;
	1846	finally
	1847	if(IndentItems) then
	1848	dec(uIndentLevel);
	1849	end;
	1850	end;
	1851	end;
	1852
	1853	{returns the complete boilerplate, including a group's items }
	1854	function TTemplate.FullBoilerplate: string;
	1855	var
	1856	Itm: string;
	1857	begin
	1858	Result := GetBoilerplate;
	1859	if FIsReminderDialog or FIsCOMObject then exit;
	1860	Itm := ItemBoilerplate;
	1861	if(Result <> '') and (Itm <> '') and (copy(Result,length(Result)-1,2) <> CRLF) then
	1862	Result := Result + CRLF;
	1863	Result := DlgText(Result, DialogProperties) + Itm;
	1864	end;
	1865
	1866	{Sets the items boilerplate - does not affect children boilerplates of a group }
	1867	procedure TTemplate.SetBoilerplate(Value: string);
	1868	begin
	1869	if(FBoilerplate <> Value) and CanModify then
	1870	begin
	1871	with FBkup do
	1872	begin
	1873	if(FBoilerPlateLoaded and (not SavedBoilerplate) and ValidID) then
	1874	begin
	1875	BBoilerplate := FBoilerplate;
	1876	SavedBoilerplate := TRUE;
	1877	end;
	1878	end;
	1879	FBoilerplate := Value;
	1880	end;
	1881	FBoilerPlateLoaded := TRUE;
	1882	end;
	1883
	1884	{Gets the object-expanded boilerplated text}
	1885	function TTemplate.GetText: string;
	1886	var
	1887	OldGettingDialogText: boolean;
	1888	TmpSL: TStringList;
	1889
	1890	begin
	1891	Result := '';
	1892	if FIsReminderDialog or FIsCOMObject then exit;
	1893	TmpSL := TStringList.Create;
	1894	try
	1895	StatusText('Expanding Boilerplate Text...');
	1896	try
	1897	OldGettingDialogText := GettingDialogText;
	1898	if(IsDialog) then
	1899	begin
	1900	GettingDialogText := TRUE;
	1901	inc(uDlgCount);
	1902	if not OldGettingDialogText then
	1903	uIndentLevel := 0;
	1904	end;
	1905	try
	1906	TmpSL.Text := FullBoilerPlate;
[829]	1907	if Pos('\|', TmpSL.Text) > 0 then SetTemplateBPHasObjects(TRUE);
[456]	1908	finally
	1909	if(IsDialog) then
	1910	GettingDialogText := OldGettingDialogText;
	1911	end;
	1912	GetTemplateText(TmpSL);
	1913	if(IsDialog) then
	1914	FDialogAborted := DoTemplateDialog(TmpSL, 'Template: ' + FPrintName, TemplatePreviewMode);
	1915	Result := TmpSL.Text;
	1916	finally
	1917	StatusText('');
	1918	end;
	1919	finally
	1920	TmpSL.Free;
	1921	end;
	1922	end;
	1923
	1924	procedure TTemplate.SetPersonalOwner(Value: Int64);
	1925	var
	1926	i: integer;
	1927	ok: boolean;
	1928
	1929	begin
	1930	if(FPersonalOwner <> Value) then
	1931	begin
	1932	ok := CanModify;
	1933	if ok then
	1934	begin
	1935	with FBkup do
	1936	begin
	1937	if(not SavedPersonalOwner) and ValidID then
	1938	begin
	1939	BPersonalOwner := FPersonalOwner;
	1940	SavedPersonalOwner := TRUE;
	1941	end;
	1942	end;
	1943	FPersonalOwner := Value;
	1944	end;
	1945	end
	1946	else
	1947	ok := TRUE;
	1948	if ok and (Value = 0) then // No Shared Template can have personal items within it.
	1949	begin
	1950	GetItems;
	1951	for i := 0 to FItems.Count-1 do
	1952	TTemplate(FItems[i]).SetPersonalOwner(0);
	1953	end;
	1954	end;
	1955
	1956	procedure TTemplate.AddNode(Node: Pointer);
	1957	begin
	1958	if(dmodShared.InEditor) and (FNodes.IndexOfObject(Node) < 0) then
	1959	begin
	1960	inc(NodeCount);
	1961	FNodes.AddObject(IntToStr(NodeCount),Node);
	1962	end;
	1963	end;
	1964
	1965	procedure TTemplate.RemoveNode(Node: Pointer);
	1966	var
	1967	idx: integer;
	1968
	1969	begin
	1970	if(dmodShared.InEditor) then
	1971	begin
	1972	idx := FNodes.IndexOfObject(Node);
	1973	if(idx >= 0) then FNodes.Delete(idx);
	1974	end;
	1975	end;
	1976
	1977	{ Creates a new Template that looks like the old one, but with a new Owner }
	1978	{ - an example of where this is needed: when a shared template in a user's }
	1979	{ personal folder is modified, we need to create a copy of the shared }
	1980	{ template, make it a personal template, and make the changes to the copy }
	1981	function TTemplate.Clone(Owner: Int64): TTemplate;
	1982	var
	1983	i: integer;
	1984
	1985	begin
	1986	Result := Self;
	1987	if(FPersonalOwner <> Owner) and (RealType in [ttDoc, ttGroup, ttClass]) then
	1988	begin
	1989	Result := TrueClone;
	1990	Result.FCloning := TRUE;
	1991	try
	1992	Result.FID := '0';
	1993	GetItems;
	1994	Result.FPersonalOwner := Owner;
	1995	Result.Expanded := TRUE;
	1996	Result.GetItems;
	1997	for i := 0 to Items.Count-1 do
	1998	Result.Items.Add(Items[i]);
	1999	Result.BackupItems;
	2000	Templates.AddObject(Result.ID, Result);
	2001	finally
	2002	Result.FCloning := FALSE;
	2003	end;
	2004	end;
	2005	end;
	2006
	2007	{ Creates a duplicate Template - used for backups and comparrisons }
	2008	function TTemplate.TrueClone: TTemplate;
	2009	var
	2010	Code, DataStr: string;
	2011
	2012	begin
	2013	DataStr := ID+U+TemplateTypeCodes[RealType]+U+TemplateActiveCode[Active]+U+PrintName+U;
	2014	if(Exclude) then
	2015	DataStr := DataStr + '1'
	2016	else
	2017	DataStr := DataStr + '0';
	2018	case GetChildren of
	2019	tcActive: Code := '1';
	2020	tcInactive: Code := '2';
	2021	tcBoth: Code := '3';
	2022	else Code := '0';
	2023	end;
	2024	DataStr := DataStr + U + IntToStr(Gap) + U + IntToStr(PersonalOwner) + U + Code + U +
	2025	BOOLCHAR[Dialog] + U +
	2026	BOOLCHAR[DisplayOnly] + U +
	2027	BOOLCHAR[FirstLine] + U +
	2028	BOOLCHAR[OneItemOnly] + U +
	2029	BOOLCHAR[HideDlgItems] + U +
	2030	BOOLCHAR[HideItems] + U +
	2031	BOOLCHAR[IndentItems] + U +
	2032	FReminderDialog;
	2033	SetPiece(DataStr,U,18,BOOLCHAR[Lock]);
	2034	SetPiece(DataStr,U,19,IntToStr(COMObject));
	2035	SetPiece(DataStr,U,20,COMParam);
	2036	SetPiece(DataStr,U,21,FileLink);
	2037	Result := TTemplate.Create(DataStr);
	2038	Result.FCloning := TRUE;
	2039	try
	2040	Result.SetBoilerplate(GetBoilerplate);
	2041	Result.SetDescription(GetDescription);
	2042	finally
	2043	Result.FCloning := FALSE;
	2044	end;
	2045	end;
	2046
	2047	function TTemplate.ItemIENs: string;
	2048	var
	2049	i: integer;
	2050
	2051	begin
	2052	GetItems;
	2053	Result := '';
	2054	for i := 0 to FItems.Count-1 do
	2055	Result := Result + TTemplate(FItems[i]).FID+',';
	2056	end;
	2057
	2058	function TemplateChildrenCompare(Item1, Item2: Pointer): Integer;
	2059	begin
	2060	Result := CompareText(TTemplate(Item1).PrintName,TTemplate(Item2).PrintName);
	2061	end;
	2062
	2063	procedure TTemplate.SortChildren;
	2064	begin
	2065	GetItems;
	2066	if (FItems.Count > 1) and CanModify then
	2067	FItems.Sort(TemplateChildrenCompare);
	2068	end;
	2069
	2070	procedure TTemplate.BackupItems;
	2071	begin
	2072	with FBkup do
	2073	begin
	2074	if((not SavedItemIENs) and assigned(FItems)) then
	2075	begin
	2076	BItemIENs := ItemIENs;
	2077	SavedItemIENs := TRUE;
	2078	end;
	2079	end;
	2080	end;
	2081
	2082	procedure TTemplate.SetActive(const Value: boolean);
	2083	begin
	2084	if(FActive <> Value) and CanModify then
	2085	begin
	2086	with FBkup do
	2087	begin
	2088	if(not SavedActive) and ValidID then
	2089	begin
	2090	BActive := FActive;
	2091	SavedActive := TRUE;
	2092	end;
	2093	end;
	2094	FActive := Value;
	2095	end;
	2096	end;
	2097
	2098	procedure TTemplate.SetExclude(const Value: boolean);
	2099	begin
	2100	if(FExclude <> Value) and CanModify then
	2101	begin
	2102	with FBkup do
	2103	begin
	2104	if(not SavedExclude) and ValidID then
	2105	begin
	2106	BExclude := FExclude;
	2107	SavedExclude := TRUE;
	2108	end;
	2109	end;
	2110	FExclude := Value;
	2111	end;
	2112	end;
	2113
	2114	procedure TTemplate.SetDialog(const Value: boolean);
	2115	begin
	2116	if(FDialog <> Value) and CanModify then
	2117	begin
	2118	with FBkup do
	2119	begin
	2120	if(not SavedDialog) and ValidID then
	2121	begin
	2122	BDialog := FDialog;
	2123	SavedDialog := TRUE;
	2124	end;
	2125	end;
	2126	FDialog := Value;
	2127	end;
	2128	end;
	2129
	2130	procedure TTemplate.SetGap(const Value: integer);
	2131	begin
	2132	if(FGap <> Value) and CanModify then
	2133	begin
	2134	with FBkup do
	2135	begin
	2136	if(not SavedGap) and ValidID then
	2137	begin
	2138	BGap := FGap;
	2139	SavedGap := TRUE;
	2140	end;
	2141	end;
	2142	FGap := Value;
	2143	end;
	2144	end;
	2145
	2146	procedure TTemplate.SetPrintName(const Value: string);
	2147	begin
	2148	if(FPrintName <> Value) and CanModify then
	2149	begin
	2150	with FBkup do
	2151	begin
	2152	if(not SavedPrintName) and ValidID then
	2153	begin
	2154	BPrintName := FPrintName;
	2155	SavedPrintName := TRUE;
	2156	end;
	2157	end;
	2158	FPrintName := Value;
	2159	end;
	2160	end;
	2161
	2162	procedure TTemplate.SetRealType(const Value: TTemplateType);
	2163	begin
	2164	if(FRealType <> Value) and CanModify then
	2165	begin
	2166	with FBkup do
	2167	begin
	2168	if(not SavedRealType) and ValidID then
	2169	begin
	2170	BRealType := FRealType;
	2171	SavedRealType := TRUE;
	2172	end;
	2173	end;
	2174	FRealType := Value;
	2175	if(FFileLink <> '') and (not (FRealType in [ttDoc, ttGroup])) then
	2176	SetFileLink('');
	2177	end;
	2178	end;
	2179
	2180	procedure TTemplate.ClearBackup(ClearItemIENs: boolean = TRUE);
	2181	begin
	2182	with FBkup do
	2183	begin
	2184	SavedPrintName := FALSE;
	2185	SavedGap := FALSE;
	2186	SavedRealType := FALSE;
	2187	SavedActive := FALSE;
	2188	SavedDisplayOnly := FALSE;
	2189	SavedFirstLine := FALSE;
	2190	SavedOneItemOnly := FALSE;
	2191	SavedHideDlgItems := FALSE;
	2192	SavedHideItems := FALSE;
	2193	SavedIndentItems := FALSE;
	2194	SavedLock := FALSE;
	2195	SavedExclude := FALSE;
	2196	SavedDialog := FALSE;
	2197	SavedPersonalOwner := FALSE;
	2198	SavedBoilerPlate := FALSE;
	2199	SavedDescription := FALSE;
	2200	SavedReminderDialog := FALSE;
	2201	SavedCOMObject := FALSE;
	2202	SavedCOMParam := FALSE;
	2203	SavedFileLink := FALSE;
	2204	if(ClearItemIENs) then
	2205	begin
	2206	if(FExpanded) then
	2207	begin
	2208	BItemIENs := ItemIENs;
	2209	SavedItemIENs := TRUE;
	2210	end
	2211	else
	2212	SavedItemIENs := FALSE;
	2213	end;
	2214	end;
	2215	end;
	2216
	2217	function TTemplate.Changed: boolean;
	2218	begin
	2219	Result := not ValidID;
	2220	with FBkup do
	2221	begin
	2222	if(not Result) and (SavedPrintName) then Result := (BPrintName <> FPrintName);
	2223	if(not Result) and (SavedGap) then Result := (BGap <> FGap);
	2224	if(not Result) and (SavedRealType) then Result := (BRealType <> FRealType);
	2225	if(not Result) and (SavedActive) then Result := (BActive <> FActive);
	2226	if(not Result) and (SavedDisplayOnly) then Result := (BDisplayOnly <> FDisplayOnly);
	2227	if(not Result) and (SavedFirstLine) then Result := (BFirstLine <> FFirstLine);
	2228	if(not Result) and (SavedOneItemOnly) then Result := (BOneItemOnly <> FOneItemOnly);
	2229	if(not Result) and (SavedHideDlgItems) then Result := (BHideDlgItems <> FHideDlgItems);
	2230	if(not Result) and (SavedHideItems) then Result := (BHideItems <> FHideItems);
	2231	if(not Result) and (SavedIndentItems) then Result := (BIndentItems <> FIndentItems);
	2232	if(not Result) and (SavedLock) then Result := (BLock <> FLock);
	2233	if(not Result) and (SavedExclude) then Result := (BExclude <> FExclude);
	2234	if(not Result) and (SavedDialog) then Result := (BDialog <> FDialog);
	2235	if(not Result) and (SavedPersonalOwner) then Result := (BPersonalOwner <> FPersonalOwner);
	2236	if(not Result) and (SavedReminderDialog) then Result := (BReminderDialog <> FReminderDialog);
	2237	if(not Result) and (SavedCOMObject) then Result := (BCOMObject <> FCOMObject);
	2238	if(not Result) and (SavedCOMParam) then Result := (BCOMParam <> FCOMParam);
	2239	if(not Result) and (SavedFileLink) then Result := (BFileLink <> FFileLink);
	2240	if(not Result) and (SavedBoilerplate) then Result := (BBoilerplate <> FBoilerplate);
	2241	if(not Result) and (SavedDescription) then Result := (BDescription <> FDescription);
	2242	if(not Result) and (SavedItemIENs) then Result := (BItemIENs <> ItemIENs); // Keep last
	2243	end;
	2244	end;
	2245
	2246	procedure TTemplate.SetDescription(const Value: string);
	2247	begin
	2248	if(FDescription <> Value) and CanModify then
	2249	begin
	2250	with FBkup do
	2251	begin
	2252	if(FDescriptionLoaded and (not SavedDescription) and ValidID) then
	2253	begin
	2254	BDescription := FDescription;
	2255	SavedDescription := TRUE;
	2256	end;
	2257	end;
	2258	FDescription := Value;
	2259	end;
	2260	FDescriptionLoaded := TRUE;
	2261	end;
	2262
	2263	function TTemplate.GetDescription: string;
	2264	begin
	2265	if(not FDescriptionLoaded) then
	2266	begin
	2267	StatusText('Loading Template Boilerplate...');
	2268	try
	2269	LoadTemplateDescription(FID);
	2270	FDescription := RPCBrokerV.Results.Text;
	2271	finally
	2272	StatusText('');
	2273	end;
	2274	FDescriptionLoaded := TRUE;
	2275	end;
	2276	Result := FDescription;
	2277	end;
	2278
	2279	procedure TTemplate.SetDisplayOnly(const Value: boolean);
	2280	begin
	2281	if(FDisplayOnly <> Value) and CanModify then
	2282	begin
	2283	with FBkup do
	2284	begin
	2285	if(not SavedDisplayOnly) and ValidID then
	2286	begin
	2287	BDisplayOnly := FDisplayOnly;
	2288	SavedDisplayOnly := TRUE;
	2289	end;
	2290	end;
	2291	FDisplayOnly := Value;
	2292	end;
	2293	end;
	2294
	2295	procedure TTemplate.SetFirstLine(const Value: boolean);
	2296	begin
	2297	if(FFirstLine <> Value) and CanModify then
	2298	begin
	2299	with FBkup do
	2300	begin
	2301	if(not SavedFirstLine) and ValidID then
	2302	begin
	2303	BFirstLine := FFirstLine;
	2304	SavedFirstLine := TRUE;
	2305	end;
	2306	end;
	2307	FFirstLine := Value;
	2308	end;
	2309	end;
	2310
	2311	procedure TTemplate.SetHideItems(const Value: boolean);
	2312	begin
	2313	if(FHideItems <> Value) and CanModify then
	2314	begin
	2315	with FBkup do
	2316	begin
	2317	if(not SavedHideItems) and ValidID then
	2318	begin
	2319	BHideItems := FHideItems;
	2320	SavedHideItems := TRUE;
	2321	end;
	2322	end;
	2323	FHideItems := Value;
	2324	end;
	2325	end;
	2326
	2327	procedure TTemplate.SetIndentItems(const Value: boolean);
	2328	begin
	2329	if(FIndentItems <> Value) and CanModify then
	2330	begin
	2331	with FBkup do
	2332	begin
	2333	if(not SavedIndentItems) and ValidID then
	2334	begin
	2335	BIndentItems := FIndentItems;
	2336	SavedIndentItems := TRUE;
	2337	end;
	2338	end;
	2339	FIndentItems := Value;
	2340	end;
	2341	end;
	2342
	2343	procedure TTemplate.SetOneItemOnly(const Value: boolean);
	2344	begin
	2345	if(FOneItemOnly <> Value) and CanModify then
	2346	begin
	2347	with FBkup do
	2348	begin
	2349	if(not SavedOneItemOnly) and ValidID then
	2350	begin
	2351	BOneItemOnly := FOneItemOnly;
	2352	SavedOneItemOnly := TRUE;
	2353	end;
	2354	end;
	2355	FOneItemOnly := Value;
	2356	end;
	2357	end;
	2358
	2359	procedure TTemplate.SetHideDlgItems(const Value: boolean);
	2360	begin
	2361	if(FHideDlgItems <> Value) and CanModify then
	2362	begin
	2363	with FBkup do
	2364	begin
	2365	if(not SavedHideDlgItems) and ValidID then
	2366	begin
	2367	BHideDlgItems := FHideDlgItems;
	2368	SavedHideDlgItems := TRUE;
	2369	end;
	2370	end;
	2371	FHideDlgItems := Value;
	2372	end;
	2373	end;
	2374
	2375	function TTemplate.DlgID: string;
	2376	begin
	2377	Result := IntToStr(StrToIntDef(FID, 0));
	2378	if(Result = '0') then
	2379	begin
	2380	if(FLastDlgCnt <> uDlgCount) then
	2381	begin
	2382	FLastDlgCnt := uDlgCount;
	2383	inc(uUniqueIDNum);
	2384	FLastUniqueID := uUniqueIDNum;
	2385	end;
	2386	Result := '-' + inttostr(FLastUniqueID);
	2387	end;
	2388	end;
	2389
	2390	function TTemplate.DialogProperties(Parent: TTemplate = nil): string;
	2391	var
	2392	Show, ToggleItems: boolean;
	2393	bGap: integer;
	2394	GroupIdx: string;
	2395
	2396	begin
	2397	GroupIdx := '0';
	2398	bGap := 0;
	2399	if(assigned(parent)) then
	2400	begin
	2401	Show := ((not Parent.HideDlgItems) or (Parent.Boilerplate = ''));
	2402	// if(Parent.Boilerplate <> '') and (Parent.OneItemOnly) then
	2403	if(Parent.OneItemOnly) then
	2404	GroupIdx := Parent.DlgID;
	2405	if(Parent.RealType = ttGroup) then
	2406	bGap := Parent.Gap;
	2407	end
	2408	else
	2409	Show := TRUE;
	2410
	2411	ToggleItems := ((HideDlgItems) and (Boilerplate <> ''));
	2412
	2413	Result := BOOLCHAR[DisplayOnly] +
	2414	BOOLCHAR[FirstLine] +
	2415	BOOLCHAR[Show] +
	2416	BOOLCHAR[ToggleItems] +
	2417	IntToStr(bGap) + // Depends on Gap being 1 character in length
	2418	';' + GroupIdx + ';' + DlgID;
	2419	if(assigned(Parent)) then
	2420	SetPiece(Result, ';', 4, Parent.DlgID);
	2421	SetPiece(Result,';',5, inttostr(uIndentLevel));
	2422	end;
	2423
	2424	function TTemplate.GetDialogAborted: boolean;
	2425	begin
	2426	Result := FDialogAborted;
	2427	FDialogAborted := FALSE;
	2428	end;
	2429
	2430	function TTemplate.IsDialog: boolean;
	2431	begin
	2432	Result := (FDialog and (FRealType = ttGroup));
	2433	end;
	2434
	2435	function TTemplate.CanExportXML(Data, Fields: TStringList; IndentLevel: integer = 0): boolean;
	2436	var
	2437	Pad, Tmp: string;
	2438	i: integer;
	2439
	2440	begin
	2441	if BadTemplateName(PrintName) then
	2442	begin
	2443	InfoBox('Can not export template.' + CRLF + 'Template has an invalid name: ' +
	2444	PrintName + '.' + BadNameText, 'Error', MB_OK or MB_ICONERROR);
	2445	Result := FALSE;
	2446	exit;
	2447	end;
	2448	Result := TRUE;
	2449	Pad := StringOfChar(' ',IndentLevel);
	2450	Data.Add(Pad + '<' + XMLTemplateTag + ' ' + TemplateExportTag[efName] + '="' + Text2XML(PrintName) + '">');
	2451	AddXMLData(Data, Pad, efBlankLines, IntToStr(Gap), '0');
	2452	if(RealType in AllTemplateRootTypes) then
	2453	Tmp := TemplateTypeCodes[ttClass]
	2454	else
	2455	Tmp := TemplateTypeCodes[RealType];
	2456	AddXMLData(Data, Pad, efType, Tmp, '');
	2457	AddXMLData(Data, Pad, efStatus, TemplateActiveCode[Active], '');
	2458	AddXMLBool(Data, Pad, efExclude, Exclude);
	2459	AddXMLBool(Data, Pad, efDialog, Dialog);
	2460	AddXMLBool(Data, Pad, efDisplayOnly, DisplayOnly);
	2461	AddXMLBool(Data, Pad, efFirstLine, FirstLine);
	2462	AddXMLBool(Data, Pad, efOneItemOnly, OneItemOnly);
	2463	AddXMLBool(Data, Pad, efHideDialogItems, HideDlgItems);
	2464	AddXMLBool(Data, Pad, efHideTreeItems, HideItems);
	2465	AddXMLBool(Data, Pad, efIndentItems, IndentItems);
	2466	AddXMLBool(Data, Pad, efLock, Lock);
	2467	AddXMLList(Data, Fields, Pad, efBoilerplate, GetBoilerplate);
	2468	AddXMLList(Data, Fields, Pad, efDescription, GetDescription);
	2469	GetItems;
	2470	if(FItems.Count > 0) then
	2471	begin
	2472	Data.Add(Pad + ' <' + TemplateExportTag[efItems] + '>');
	2473	for i := 0 to FItems.Count-1 do
	2474	begin
	2475	Result := TTemplate(FItems[i]).CanExportXML(Data, Fields, IndentLevel + 4);
	2476	if(not Result) then exit;
	2477	end;
	2478	Data.Add(Pad + ' </' + TemplateExportTag[efItems] + '>');
	2479	end;
	2480	Data.Add(Pad + '</' + XMLTemplateTag + '>');
	2481	end;
	2482
	2483	procedure TTemplate.UpdateImportedFieldNames(List: TStrings);
	2484	const
	2485	SafeCode = #1 + '^@^' + #2;
	2486	SafeCodeLen = length(SafeCode);
	2487
	2488	var
	2489	i, p, l1: integer;
	2490	Tag1, Tag2, tmp: string;
	2491	First, ok: boolean;
	2492
	2493	begin
	2494	GetBoilerplate;
	2495	ok := TRUE;
	2496	First := TRUE;
	2497	for i := 0 to List.Count-1 do
	2498	begin
	2499	if(Piece(List[i],U,2) = '0') then
	2500	begin
	2501	Tag1 := TemplateFieldBeginSignature + Piece(List[i],U,1) + TemplateFieldEndSignature;
	2502	Tag2 := TemplateFieldBeginSignature + SafeCode + Piece(List[i],U,3) + TemplateFieldEndSignature;
	2503	l1 := length(Tag1);
	2504	repeat
	2505	p := pos(Tag1, FBoilerplate);
	2506	if(p > 0) then
	2507	begin
	2508	if First then
	2509	begin
	2510	ok := CanModify;
	2511	First := FALSE;
	2512	end;
	2513	if ok then
	2514	begin
	2515	tmp := copy(FBoilerplate,1,p-1) + Tag2 + copy(FBoilerplate,p+l1, MaxInt);
	2516	FBoilerplate := tmp;
	2517	end
	2518	else
	2519	p := 0;
	2520	end;
	2521	until (p = 0);
	2522	end;
	2523	if not ok then break;
	2524	end;
	2525	if ok then
	2526	begin
	2527	repeat
	2528	p := pos(SafeCode, FBoilerplate);
	2529	if(p > 0) then
	2530	delete(FBoilerplate, p, SafeCodeLen);
	2531	until (p = 0);
	2532	GetItems;
	2533	for i := 0 to FItems.Count-1 do
	2534	TTemplate(FItems[i]).UpdateImportedFieldNames(List);
	2535	end;
	2536	end;
	2537
	2538	procedure TTemplate.SetReminderDialog(const Value: string);
	2539	begin
	2540	if(FReminderDialog <> Value) and CanModify then
	2541	begin
	2542	with FBkup do
	2543	begin
	2544	if(not SavedReminderDialog) and ValidID then
	2545	begin
	2546	BReminderDialog := FReminderDialog;
	2547	SavedReminderDialog := TRUE;
	2548	end;
	2549	end;
	2550	FReminderDialog := Value;
	2551	FIsReminderDialog := (ReminderDialogIEN <> '');
	2552	if FIsReminderDialog and (not (LinkType in [ltNone, ltTitle])) then
	2553	SetFileLink('');
	2554	end;
	2555	end;
	2556
	2557	function TTemplate.ReminderDialogIEN: string;
	2558	begin
	2559	Result := Piece(FReminderDialog,U,1);
	2560	if Result = '0' then
	2561	Result := '';
	2562	end;
	2563
	2564	function TTemplate.ReminderDialogName: string;
	2565	begin
	2566	Result := Piece(FReminderDialog,U,2);
	2567	end;
	2568
	2569	function TTemplate.CanModify: boolean;
	2570	begin
	2571	if(not FLocked) and ValidID and (not FCloning) then
	2572	begin
	2573	FLocked := LockTemplate(FID);
	2574	Result := FLocked;
	2575	if(not FLocked) then
	2576	begin
	2577	if(assigned(dmodShared.OnTemplateLock)) then
	2578	dmodShared.OnTemplateLock(Self)
	2579	else
[829]	2580	ShowMsg(Format(TemplateLockedText, [FPrintName]));
[456]	2581	end;
	2582	end
	2583	else
	2584	Result := TRUE;
	2585	end;
	2586
	2587	function TTemplate.ValidID: boolean;
	2588	begin
	2589	Result := ((FID <> '0') and (FID <> ''));
	2590	end;
	2591
	2592	procedure TTemplate.Unlock;
	2593	begin
	2594	if FLocked and ValidID then
	2595	begin
	2596	UnlockTemplate(FID);
	2597	FLocked := FALSE;
	2598	end;
	2599	end;
	2600
	2601	procedure TTemplate.SetLock(const Value: boolean);
	2602	begin
	2603	if(FLock <> Value) and CanModify then
	2604	begin
	2605	with FBkup do
	2606	begin
	2607	if(not SavedLock) and ValidID then
	2608	begin
	2609	BLock := FLock;
	2610	SavedLock := TRUE;
	2611	end;
	2612	end;
	2613	FLock := Value;
	2614	end;
	2615	end;
	2616
	2617	function TTemplate.IsLocked: boolean;
	2618	begin
	2619	Result := (FLock and (FPersonalOwner = 0)) or AutoLock;
	2620	end;
	2621
	2622	procedure TTemplate.SetCOMObject(const Value: integer);
	2623	begin
	2624	if(FCOMObject <> Value) and CanModify then
	2625	begin
	2626	with FBkup do
	2627	begin
	2628	if(not SavedCOMObject) and ValidID then
	2629	begin
	2630	BCOMObject := FCOMObject;
	2631	SavedCOMObject := TRUE;
	2632	end;
	2633	end;
	2634	FCOMObject := Value;
	2635	FIsCOMObject := (FCOMObject > 0);
	2636	end;
	2637	end;
	2638
	2639	procedure TTemplate.SetCOMParam(const Value: string);
	2640	begin
	2641	if(FCOMParam <> Value) and CanModify then
	2642	begin
	2643	with FBkup do
	2644	begin
	2645	if(not SavedCOMParam) and ValidID then
	2646	begin
	2647	BCOMParam := FCOMParam;
	2648	SavedCOMParam := TRUE;
	2649	end;
	2650	end;
	2651	FCOMParam := Value;
	2652	end;
	2653	end;
	2654
	2655	procedure TTemplate.AssignFileLink(const Value: string; Force: boolean);
	2656	var
	2657	i: integer;
	2658	DoItems: boolean;
	2659
	2660	begin
	2661	DoItems := Force;
	2662	if(FFileLink <> Value) and CanModify then
	2663	begin
	2664	with FBkup do
	2665	begin
	2666	if(not SavedFileLink) and ValidID then
	2667	begin
	2668	BFileLink := FFileLink;
	2669	SavedFileLink := TRUE;
	2670	end;
	2671	end;
	2672	FFileLink := Value;
	2673	FLinkName := '';
	2674	if (not (LinkType in [ltNone, ltTitle])) then
	2675	SetReminderDialog('');
	2676	if not DoItems then
	2677	DoItems := (FFileLink <> '');
	2678	end;
	2679	if DoItems then
	2680	begin
	2681	GetItems;
	2682	for i := 0 to FItems.Count-1 do
	2683	TTemplate(FItems[i]).AssignFileLink('', TRUE);
	2684	end;
	2685	end;
	2686
	2687	procedure TTemplate.SetFileLink(const Value: string);
	2688	begin
	2689	AssignFileLink(Value, FALSE);
	2690	end;
	2691
	2692	//function TTemplate.COMObjectText(const DefText: string = ''; DocInfo: string = ''): string;
	2693	function TTemplate.COMObjectText(DefText: string; var DocInfo: string): string;
	2694	var
	2695	p2: string;
	2696
	2697	begin
	2698	Result := '';
	2699	if (FCOMObject > 0) then
	2700	begin
	2701	p2 := '';
	2702	if (LinkType <> ltNone) and (LinkIEN <> '') then
	2703	p2 := LinkPassCode[LinkType] + '=' + LinkIEN;
	2704	Result := DefText;
	2705	GetCOMObjectText(FCOMObject, p2, FCOMParam, Result, DocInfo);
	2706	end;
	2707	end;
	2708
	2709	function TTemplate.AutoLock: boolean;
	2710	begin
	2711	Result := FIsCOMObject;
	2712	if (not Result) and (not (RealType in AllTemplateLinkTypes)) and (LinkType <> ltNone) then
	2713	Result := TRUE;
	2714	end;
	2715
	2716	function TTemplate.LinkType: TTemplateLinkType;
	2717	var
	2718	idx: TTemplateLinkType;
	2719
	2720	begin
	2721	Result := ltNone;
	2722	case FRealType of
	2723	ttTitles: Result := ltTitle;
	2724	ttConsults: Result := ltConsult;
	2725	ttProcedures: Result := ltProcedure;
	2726	else
	2727	begin
	2728	for idx := succ(low(TTemplateLinkType)) to high(TTemplateLinkType) do
	2729	begin
	2730	if pos(LinkGlobal[idx], FFileLink) > 0 then
	2731	begin
	2732	Result := idx;
	2733	break;
	2734	end;
	2735	end;
	2736	end;
	2737	end;
	2738	end;
	2739
	2740	function TTemplate.LinkIEN: string;
	2741	begin
	2742	Result := piece(FFileLink,';',1);
	2743	end;
	2744
	2745	function TTemplate.LinkName: string;
	2746	begin
	2747	if FLinkName = '' then
	2748	FLinkName := GetLinkName(LinkIEN, LinkType);
	2749	Result := FLinkName;
	2750	end;
	2751
	2752	procedure TTemplate.ExecuteReminderDialog(OwningForm: TForm);
	2753	var
	2754	sts: integer;
	2755	txt: string;
	2756
	2757	begin
	2758	sts := IsRemDlgAllowed(ReminderDialogIEN);
	2759	txt := '';
	2760	if sts < 0 then
	2761	txt := 'Reminder Dialog has been Deleted or Deactivated.'
	2762	else
	2763	if sts = 0 then
	2764	txt := 'You are not Authorized to use this Reminder Dialog in a Template'
	2765	else
	2766	ViewRemDlgTemplateFromForm(OwningForm, Self, TRUE, TRUE);
	2767	if txt <> '' then
	2768	InfoBox(txt,'Can not use Reminder Dialog', MB_OK or MB_ICONERROR);
	2769	end;
	2770
	2771	procedure ExpandEmbeddedFields(flds: TStringList);
	2772	{07/26/01 S Monson Procedure to take a list of fields and expand it with any
	2773	embedded fields. Handles embedded field loops
	2774	(self referencing loops.)}
	2775	var
	2776	i,pos1,pos2: integer;
	2777	ifield: TTemplateField;
	2778	estring,next: string;
	2779	begin
	2780	if flds.count < 1 then
	2781	Exit;
	2782	i := 0;
	2783	repeat
	2784	ifield := GetTemplateField(flds[i],False);
	2785	if ifield <> nil then
	2786	begin
	2787	estring := '';
	2788	case ifield.FldType of
	2789	dftText,dftComboBox,dftButton,
	2790	dftCheckBoxes,dftRadioButtons: estring := ifield.items;
	2791	dftHyperlink: estring := ifield.EditDefault;
	2792	end;
	2793	while (estring <> '') do
	2794	begin
	2795	pos1 := pos(TemplateFieldBeginSignature,estring);
	2796	if pos1 > 0 then
	2797	begin
	2798	estring := copy(estring,(pos1 + length(TemplateFieldBeginSignature)),maxint);
	2799	pos2 := pos(TemplateFieldEndSignature,estring);
	2800	if pos2 > 0 then
	2801	begin
	2802	next := copy(estring,1,pos2-1);
	2803	delete(estring,1,pos2-1+length(TemplateFieldEndSignature));
	2804	if flds.IndexOf(next) < 0 then
	2805	flds.add(next);
	2806	end
	2807	else
	2808	estring := '';
	2809	end
	2810	else
	2811	estring := '';
	2812	end;
	2813	inc(i);
	2814	end
	2815	else
	2816	flds.Delete(i);
	2817	until (i > flds.count-1);
	2818	end;
	2819
	2820	function MakeXMLParamTIU(ANoteID: string; ANoteRec: TEditNoteRec): string;
	2821	var
	2822	tmpList: TStringList;
	2823	begin
	2824	tmpList := TStringList.Create;
	2825	try
	2826	tmpList.Add('<TIU_DOC>');
	2827	tmpList.Add(' <DOC_IEN>' + ANoteID + '</DOC_IEN>');
	2828	tmpList.Add(' <AUTHOR_IEN>' + IntToStr(ANoteRec.Author) + '</AUTHOR_IEN>');
	2829	tmpList.Add(' <AUTHOR_NAME>' + ExternalName(ANoteRec.Author, 200) + '</AUTHOR_NAME>');
	2830	tmpList.Add('</TIU_DOC>');
	2831	finally
	2832	Result := tmpList.Text;
	2833	tmpList.Free;
	2834	end;
	2835	end;
	2836
	2837	function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string;
	2838	var
	2839	tmpList: TStringList;
	2840	begin
	2841	tmpList := TStringList.Create;
	2842	try
	2843	tmpList.Add('<TIU_DOC>');
	2844	tmpList.Add(' <DOC_IEN>' + ADCSummID + '</DOC_IEN>');
	2845	tmpList.Add(' <AUTHOR_IEN>' + IntToStr(ADCSummRec.Dictator) + '</AUTHOR_IEN>');
	2846	tmpList.Add(' <AUTHOR_NAME>' + ExternalName(ADCSummRec.Dictator, 200) + '</AUTHOR_NAME>');
	2847	tmpList.Add('</TIU_DOC>');
	2848	finally
	2849	Result := tmpList.Text;
	2850	tmpList.Free;
	2851	end;
	2852	end;
	2853
	2854	function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string;
	2855	var
	2856	XMLDoc: IXMLDOMDocument;
	2857	RootElement: IXMLDOMElement;
	2858	TagElement: IXMLDOMNode;
	2859	const
	2860	NoIE5 = 'You must have Internet Explorer 5 or better installed to %s Templates';
	2861	NoIE5Header = 'Need Internet Explorer 5';
	2862	TIUHeader = 'TIU_DOC';
	2863	begin
	2864	// After ExecuteTemplateOrBoilerPlate, DocInfo parameter may contain return value of AUTHOR.
	2865	// Call this function at that point to get the value from the XML formatted parameter that's returned.
	2866	Result := '';
	2867	try
	2868	XMLDoc := CoDOMDocument.Create;
	2869	except
	2870	InfoBox(Format(NoIE5, ['use COM']), NoIE5Header, MB_OK);
	2871	exit;
	2872	end;
	2873	try
	2874	if assigned(XMLDoc) then
	2875	begin
	2876	XMLDoc.preserveWhiteSpace := TRUE;
	2877	if DocInfo <> '' then
	2878	XMLDoc.LoadXML(DocInfo);
	2879	RootElement := XMLDoc.DocumentElement;
	2880	if not assigned(RootElement) then exit;
	2881	try
	2882	if(RootElement.tagName <> TIUHeader) then exit
	2883	else
	2884	begin
	2885	TagElement := FindXMLElement(RootElement, ParamTag);
	2886	if assigned(TagElement) then
	2887	Result := TagElement.Text
	2888	else Result := '';
	2889	end;
	2890	finally
	2891	TagElement := nil;
	2892	RootElement := nil;
	2893	end;
	2894	end;
	2895	finally
	2896	XMLDoc := nil;
	2897	end;
	2898	end;
	2899
	2900	function TTemplate.ReminderWipe: string;
	2901	begin
	2902	Result := Piece(FReminderDialog,U,3);
	2903	end;
	2904
[829]	2905	// -------- CQ #8665 - RV ------------
	2906	procedure UpdatePersonalObjects;
	2907	var
	2908	i: integer;
	2909	begin
	2910	if not assigned(uPersonalObjects) then
	2911	begin
	2912	uPersonalObjects := TStringList.Create;
	2913	GetAllowedPersonalObjects;
	2914	for i := 0 to RPCBrokerV.Results.Count-1 do
	2915	uPersonalObjects.Add(Piece(RPCBrokerV.Results[i],U,1));
	2916	uPersonalObjects.Sorted := TRUE;
	2917	end;
	2918	end;
	2919	// -----end CQ #8665 ------------
	2920
	2921
	2922	procedure SetTemplateDialogCanceled(value: Boolean);
	2923	begin
	2924	uTemplateDialogCanceled := value;
	2925	end;
	2926
	2927	function WasTemplateDialogCanceled: Boolean;
	2928	begin
	2929	Result := uTemplateDialogCanceled;
	2930	end;
	2931
	2932	procedure SetTemplateBPHasObjects(value: Boolean);
	2933	begin
	2934	uTemplateBPHasObjects := value;
	2935	end;
	2936
	2937	function TemplateBPHasObjects: Boolean;
	2938	begin
	2939	Result := uTemplateBPHasObjects;
	2940	end;
	2941
[456]	2942	initialization
	2943
	2944	finalization
	2945	ReleaseTemplates;
[829]	2946	end.
[456]	2947

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: cprs/trunk/CPRS-Chart/Templates/uTemplates.pas@ 1429

Download in other formats: