Context Navigation

uTemplates.pas@ 1797

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

Line
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;
255	procedure UpdatePersonalObjects;
256	procedure SetTemplateDialogCanceled(value: Boolean);
257	function WasTemplateDialogCanceled: Boolean;
258	procedure SetTemplateBPHasObjects(value: Boolean);
259	function TemplateBPHasObjects: Boolean;
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;
285	uPersonalObjects: TStringList = nil; // -------- CQ #8665 - RV ------------
286
287	implementation
288
289	uses
290	Windows, rTemplates, uCore, dShared, fTemplateDialog, ActiveX, ComObj, uTemplateFields,
291	XMLUtils, fTemplateImport, uSpell, rCore, uConst, ORCtrls, uEventHooks,
292	fReminderDialog, rODBase
293	{$IFDEF VER140}
294	, Word97;
295	{$ELSE}
296	, WordXP, VAUtils;
297	{$ENDIF}
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;
324	uTemplateDialogCanceled: Boolean = FALSE;
325	uTemplateBPHasObjects: Boolean = FALSE;
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;
546	FastAssign(RPCBrokerV.Results, TmpSL);
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);
574	FastAssign(RPCBrokerV.Results, TmpSL);
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;
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 ------------
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
744	ShowMsg(Errors.text)
745	else
746	ShowMsg(SingleError);
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=@');
888	FastAddStrings(DescSL, TempSL)
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;
1196	{$IFDEF VER140}
1197	WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam));
1198	{$ELSE}
1199	WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam, EmptyParam, EmptyParam));
1200	{$ENDIF}
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);
1334	FastAddStrings(PendingAdd, Fields);
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])) + '">';
1423	FastAddStrings(Fields, Data);
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
1513	SetTemplateDialogCanceled(FALSE);
1514	SetTemplateBPHasObjects(FALSE);
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;
1907	if Pos('\|', TmpSL.Text) > 0 then SetTemplateBPHasObjects(TRUE);
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
2580	ShowMsg(Format(TemplateLockedText, [FPrintName]));
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
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
2942	initialization
2943
2944	finalization
2945	ReleaseTemplates;
2946	end.
2947

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

Context Navigation

source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Templates/uTemplates.pas@ 1797

Download in other formats: