Module

dShared

Path

C:\CPRS\CPRS30\dShared.pas

Last Modified

7/15/2014 3:26:36 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TdmodShared);

end.

Units Used in Interface

Name Comments
uTemplates -

Units Used in Implementation

Name Comments
fDrawers -
rTemplates -
uCore -
uEventHooks -
uTemplateFields -

Classes

Name Comments
TdmodShared -

Procedures

Name Owner Declaration Scope Comments
AddChildObject - procedure AddChildObject(Owner: TTreeNode); Local -
AddDrawerTree TdmodShared procedure AddDrawerTree(DrawerForm: TForm); Public -
AddErr - procedure AddErr(Amsg: string); Local -
AddTemplateNode TdmodShared procedure AddTemplateNode(Tree: TTreeView; var EmptyCount: integer; const tmpl: TTemplate; AllowInactive: boolean = FALSE; const Owner: TTreeNode = nil); Public -
BuildNodes - procedure BuildNodes(tmpl: TTemplate; Owner: TTreeNode); Local -
dmodSharedCreate TdmodShared procedure dmodSharedCreate(Sender: TObject); Public/Published -
dmodSharedDestroy TdmodShared procedure dmodSharedDestroy(Sender: TObject); Public/Published -
EncounterLocationChanged TdmodShared procedure EncounterLocationChanged(Sender: TObject); Protected -
ExpandTree TdmodShared procedure ExpandTree(Tree: TORTreeView; ExpandString: string; var EmptyCount: integer; AllowInactive: boolean = FALSE); Public -
FindRichEditText TdmodShared procedure FindRichEditText(AFindDialog: TFindDialog; ARichEdit: TRichEdit); Public -
LoadTIUObjects TdmodShared procedure LoadTIUObjects; Public -
Reload TdmodShared procedure Reload; Public -
RemoveDrawerTree TdmodShared procedure RemoveDrawerTree(DrawerForm: TForm); Public -
ReplaceRichEditText TdmodShared procedure ReplaceRichEditText(AReplaceDialog: TReplaceDialog; ARichEdit: TRichEdit); Public -
Resync TdmodShared procedure Resync(SyncNode: TTreeNode; AllowInactive: boolean; var EmptyCount: integer); Public SelNode,
SelectNode TdmodShared procedure SelectNode(Tree: TORTreeView; GotoNodeID: string; var EmptyCount: integer); Public -

Functions

Name Owner Declaration Scope Comments
BoilerplateOK TdmodShared function BoilerplateOK(const Txt, CRDelim: string; ObjList: TStringList; var Err: TStringList): boolean; Public -
ErrCount - function ErrCount: integer; Local -
ExpandNode TdmodShared function ExpandNode(Tree: TTreeView; Node: TTreeNode; var EmptyCount: integer; AllowInactive: boolean = FALSE): boolean; Public -
FindNode - function FindNode(StartNode: TORTreeNode): TORTreeNode; Local -
GetID - function GetID(Node: TTreeNode): string; Local -
GetNode - function GetNode(ID: string): TTreeNode; Local -
ImgIdx TdmodShared function ImgIdx(Node: TTreeNode): integer; Public -
InDialog TdmodShared function InDialog(Node: TTreeNode): boolean; Public -
InSyncNode - function InSyncNode(Node: TTreeNode): boolean; Local -
NeedsCollapsing TdmodShared function NeedsCollapsing(Tree: TTreeView): boolean; Public -
TemplateOK TdmodShared function TemplateOK(tmpl: TTemplate; Msg: string = ''): boolean; Public -

Global Variables

Name Type Declaration Comments
dmodShared TdmodShared dmodShared: TdmodShared; -

Constants

Name Declaration Scope Comments
COMObjIdx array[boolean] of integer = (29, 28) Global -
DialogConvMax 7 Global -
DialogImageXRef array[0..DialogConvMax, Boolean] of integer = Global -
DlgPropMarker '^@=' Interfaced -
DlgPropMarkerLen length(DlgPropMarker) Interfaced -
NoTextMarker '<@>' Interfaced -
ObjMarker '^@@^' Interfaced -
ObjMarkerLen length(ObjMarker) Interfaced -
RemDlgIdx array[boolean] of integer = (26, 27) Global -
TemplateImageIdx array[TTemplateType, Boolean, Boolean] of integer = Global -


Module Source

1     unit dShared;
2     interface
3     
4     uses
5       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
6       ComCtrls, ImgList, uTemplates, ORFn, ORNet, ExtCtrls, ORCtrls, Richedit,
7       VA508ImageListLabeler;
8     
9     type
10      TdmodShared = class(TDataModule)
11        imgTemplates: TImageList;
12        imgReminders: TImageList;
13        imgNotes: TImageList;
14        imgImages: TImageList;
15        imgReminders2: TImageList;
16        imgConsults: TImageList;
17        imgSurgery: TImageList;
18        imgLblReminders: TVA508ImageListLabeler;
19        imgLblHealthFactorLabels: TVA508ImageListLabeler;
20        imgLblNotes: TVA508ImageListLabeler;
21        imgLblImages: TVA508ImageListLabeler;
22        imgLblConsults: TVA508ImageListLabeler;
23        imgLblSurgery: TVA508ImageListLabeler;
24        imgLblReminders2: TVA508ImageListLabeler;
25        procedure dmodSharedCreate(Sender: TObject);
26        procedure dmodSharedDestroy(Sender: TObject);
27      private
28        FTIUObjects: TStringList;
29        FInEditor: boolean;
30        FOnTemplateLock: TNotifyEvent;
31        FTagIndex: longint;
32        FDrawerTrees: TList;
33        FRefreshObject: boolean;
34      protected
35        procedure EncounterLocationChanged(Sender: TObject);
36      public
37        function ImgIdx(Node: TTreeNode): integer;
38        procedure AddTemplateNode(Tree: TTreeView; var EmptyCount: integer;
39                                  const tmpl: TTemplate; AllowInactive: boolean = FALSE;
40                                  const Owner: TTreeNode = nil);
41        function ExpandNode(Tree: TTreeView; Node: TTreeNode;
42                  var EmptyCount: integer; AllowInactive: boolean = FALSE): boolean;
43        procedure Resync(SyncNode: TTreeNode; AllowInactive: boolean;
44                                    var EmptyCount: integer);
45        procedure AddDrawerTree(DrawerForm: TForm);
46        procedure RemoveDrawerTree(DrawerForm: TForm);
47        procedure Reload;
48        procedure LoadTIUObjects;
49        function BoilerplateOK(const Txt, CRDelim: string; ObjList: TStringList;
50                                                           var Err: TStringList): boolean;
51        function TemplateOK(tmpl: TTemplate; Msg: string = ''): boolean;
52        function NeedsCollapsing(Tree: TTreeView): boolean;
53        procedure SelectNode(Tree: TORTreeView; GotoNodeID: string; var EmptyCount: integer);
54        procedure ExpandTree(Tree: TORTreeView; ExpandString: string; var EmptyCount: integer;
55                             AllowInactive: boolean = FALSE);
56        function InDialog(Node: TTreeNode): boolean;
57        property InEditor: boolean read FInEditor write FInEditor;
58        property OnTemplateLock: TNotifyEvent read FOnTemplateLock write FOnTemplateLock;
59        property TIUObjects: TStringList read FTIUObjects;
60        property RefreshObject: boolean read FRefreshObject write FRefreshObject;
61        procedure FindRichEditText(AFindDialog: TFindDialog; ARichEdit: TRichEdit);
62        procedure ReplaceRichEditText(AReplaceDialog: TReplaceDialog; ARichEdit: TRichEdit);
63      end;
64    
65    var
66      dmodShared: TdmodShared;
67    
68    const
69      ObjMarker = '^@@^';
70      ObjMarkerLen = length(ObjMarker);
71      DlgPropMarker = '^@=';
72      DlgPropMarkerLen = length(DlgPropMarker);
73      NoTextMarker = '<@>';
74    
75    implementation
76    
77    uses fDrawers, rTemplates, uCore, uTemplateFields, uEventHooks, VA508AccessibilityRouter;
78    
79    {$R *.DFM}
80    
81    const
82      TemplateImageIdx: array[TTemplateType, Boolean, Boolean] of integer =
83                              //    Personal       Shared
84                              //  Closed  Open   Closed  Open
85                              (((    0,    0), (    0,    0)),  //  ttNone,
86                               ((    0,    1), (    0,    1)),  //  ttMyRoot
87                               ((    0,    1), (    0,    1)),  //  ttRoot
88                               ((    0,    1), (    0,    1)),  //  ttTitles
89                               ((    0,    1), (    0,    1)),  //  ttConsults
90                               ((    0,    1), (    0,    1)),  //  ttProcedures
91                               ((    2,    3), (   16,   17)),  //  ttClass
92                               ((    4,    4), (   10,   10)),  //  ttDoc
93                               ((    5,    6), (   11,   12)),  //  ttGroup
94                               ((    7,    7), (   13,   13)),  //  ttDocEx
95                               ((    8,    9), (   14,   15))); //  ttGroupEx
96    
97      DialogConvMax = 7;
98      DialogImageXRef: array[0..DialogConvMax, Boolean] of integer =
99                               ((5,18), (6,19),
100                               (8,20), (9,21),
101                               (11,22),(12,23),
102                               (14,24),(15,25));
103                               
104     RemDlgIdx: array[boolean] of integer = (26, 27);
105     COMObjIdx: array[boolean] of integer = (29, 28);
106   
107   function TdmodShared.ImgIdx(Node: TTreeNode): integer;
108   var
109     Typ: TTemplateType;
110     i: integer;
111   
112   begin
113     Result := -1;
114     if(assigned(Node.Data)) then
115     begin
116       with TTemplate(Node.Data) do
117       begin
118         if (RealType = ttDoc) and (IsReminderDialog) then
119           Result := RemDlgIdx[(PersonalOwner <= 0)]
120         else
121         if (RealType = ttDoc) and (IsCOMObject) then
122           Result := COMObjIdx[COMObjectOK(COMObject)]
123         else
124         begin
125           Typ := TemplateType;
126           if(Exclude and (Typ in [ttDocEx, ttGroupEx])) then
127           begin
128             if(not assigned(Node.Parent)) or (TTemplate(Node.Parent.Data).RealType <> ttGroup) then
129             begin
130               case Typ of
131                 ttDocEx: Typ := ttDoc;
132                 ttGroupEx: Typ := ttGroup;
133               end;
134             end;
135           end;
136           Result := TemplateImageIdx[Typ, (PersonalOwner <= 0),
137                     (Node.Expanded and Node.HasChildren)];
138           if(Dialog and (Typ in [ttGroup, ttGroupEx])) then
139           begin
140             for i := 0 to DialogConvMax do
141             begin
142               if(Result = DialogImageXRef[i, FALSE]) then
143               begin
144                 Result := DialogImageXRef[i, TRUE];
145                 break;
146               end;
147             end;
148           end;
149         end;
150       end;
151     end;
152   end;
153   
154   procedure TdmodShared.AddTemplateNode(Tree: TTreeView; var EmptyCount: integer;
155                                 const tmpl: TTemplate; AllowInactive: boolean = FALSE;
156                                 const Owner: TTreeNode = nil);
157   var
158     Cur, Next: TTreeNode;
159     Done: boolean;
160     NewNode: TTreeNode;
161   
162     procedure AddChildObject(Owner: TTreeNode);
163     begin
164       NewNode := Tree.Items.AddChildObject(Owner, tmpl.PrintName, tmpl);
165       TORTreeNode(NewNode).StringData := tmpl.ID + U + tmpl.PrintName;
166       NewNode.Cut := not tmpl.Active;
167       tmpl.AddNode(NewNode);
168       Done := TRUE;
169     end;
170   
171   begin
172     if((assigned(tmpl)) and ((tmpl.Active) or AllowInactive)) then
173     begin
174       Done := FALSE;
175       NewNode := nil;
176       if(assigned(Owner)) then
177       begin
178         Cur := Owner.GetFirstChild;
179         if(not assigned(Cur)) then
180           AddChildObject(Owner);
181       end
182       else
183       begin
184         Cur := Tree.Items.GetFirstNode;
185         if(not assigned(Cur)) then
186           AddChildObject(nil);
187       end;
188       if(not Done) then
189       begin
190         repeat
191           if(Cur.Data = tmpl) then
192             Done := TRUE
193           else
194           begin
195             Next := Cur.GetNextSibling;
196             if(assigned(Next)) then
197               Cur := Next
198             else
199               AddChildObject(Owner);
200           end;
201         until Done;
202       end;
203       if(assigned(NewNode) and (InEditor or (not tmpl.HideItems)) and 
204                                ((tmpl.Children in [tcActive, tcBoth]) or
205                                ((tmpl.Children <> tcNone) and AllowInactive))) then
206       begin
207         Tree.Items.AddChild(NewNode, EmptyNodeText);
208         inc(EmptyCount);
209       end;
210     end;
211   end;
212   
213   function TdmodShared.ExpandNode(Tree: TTreeView; Node: TTreeNode;
214                 var EmptyCount: integer; AllowInactive: boolean = FALSE): boolean;
215   
216   var
217     TmpNode: TTreeNode;
218     tmpl: TTemplate;
219     i :integer;
220   
221   begin
222     TmpNode := Node.GetFirstChild;
223     Result := TRUE;
224     if((assigned(TmpNode)) and (TmpNode.Text = EmptyNodeText)) then
225     begin
226       TmpNode.Delete;
227       dec(EmptyCount);
228       tmpl := TTemplate(Node.Data);
229       ExpandTemplate(tmpl);
230       for i := 0 to tmpl.Items.Count-1 do
231         AddTemplateNode(Tree, EmptyCount, TTemplate(tmpl.Items[i]),
232                         AllowInactive, Node);
233       if((tmpl.Children = tcNone) or ((not AllowInactive) and (tmpl.Children = tcInactive))) then
234         Result := FALSE;
235     end;
236   end;
237   
238   procedure TdmodShared.Resync(SyncNode: TTreeNode; AllowInactive: boolean;
239                                   var EmptyCount: integer);
240   var
241     FromGet: boolean;
242     IDCount, SyncLevel, i: integer;
243     SyncExpanded: boolean;
244     //SelNode,
245     Node: TTreeNode;
246     Template: TTemplate;
247     IDSort, CurExp: TStringList;
248     SelID, TopID: string;
249     DoSel, DoTop: boolean;
250     Tree: TTreeView;
251     First: boolean;
252     TagCount: longint;
253   
254     function InSyncNode(Node: TTreeNode): boolean;
255     var
256       TmpNode: TTreeNode;
257   
258     begin
259       Result := FALSE;
260       TmpNode := Node;
261       while((not Result) and assigned(TmpNode)) do
262       begin
263         if(TmpNode = SyncNode) then
264           Result := TRUE
265         else
266           TmpNode := TmpNode.Parent;
267       end;
268     end;
269   
270     function GetID(Node: TTreeNode): string;
271     var
272       tmpl: TTemplate;
273       IDX: string;
274       
275     begin
276       inc(IDCount);
277       Result := '';
278       if(assigned(Node) and assigned(Node.Data)) then
279       begin
280         tmpl := TTemplate(Node.Data);
281         if((tmpl.ID = '') or (tmpl.ID = '0')) then
282         begin
283           if(tmpl.LastTagIndex <> FTagIndex) then
284           begin
285             tmpl.LastTagIndex := FTagIndex;
286             inc(TagCount);
287             tmpl.tag := TagCount;
288           end;
289           IDX := '<'+IntToStr(tmpl.Tag)+'>';
290         end
291         else
292           IDX := tmpl.ID;
293         if(Node <> SyncNode) and (assigned(Node.Parent)) then
294           Result := U + GetID(Node.Parent);
295         Result := IDX + Result;
296       end;
297       dec(IDCount);
298       if((not FromGet) and (IDCount = 0) and (Result <> '')) then
299         Result := IntToStr(Node.AbsoluteIndex) + U + Result;
300     end;
301   
302     function GetNode(ID: string): TTreeNode;
303     var
304       idx, i :integer;
305       TrueID, TmpStr: string;
306       TmpNode: TTreeNode;
307   
308     begin
309       Result := nil;
310       if(ID <> '') then
311       begin
312         idx := StrToIntDef(Piece(ID,U,1),0);
313         i := pos(U,ID);
314         if(i > 0) then
315         begin
316           delete(ID,1,i);
317           FromGet := TRUE;
318           try
319             TmpNode := SyncNode.GetFirstChild;
320             while ((not assigned(Result)) and (assigned(TmpNode)) and
321                    (TmpNode.Level > SyncLevel)) do
322             begin
323               if(GetID(TmpNode) = ID) then
324                 Result := TmpNode
325               else
326                 TmpNode := TmpNode.GetNext;
327             end;
328             if(not assigned(Result)) then
329             begin
330               TrueID := piece(ID,U,1);
331               TmpNode := SyncNode.GetFirstChild;
332               while ((not assigned(Result)) and (assigned(TmpNode)) and
333                      (TmpNode.Level > SyncLevel)) do
334               begin
335                 if(assigned(TmpNode.Data) and (TTemplate(TmpNode.Data).ID = TrueID)) then
336                 begin
337                   TmpStr := IntToStr(abs(idx-TmpNode.AbsoluteIndex));
338                   TmpStr := copy('000000',1,7-length(TmpStr))+TmpStr;
339                   IDSort.AddObject(TmpStr,TmpNode);
340                 end;
341                 TmpNode := TmpNode.GetNext;
342               end;
343               if(IDSort.Count > 0) then
344               begin
345                 IDSort.Sort;
346                 Result := TTreeNode(IDSort.Objects[0]);
347                 IDSort.Clear;
348               end;
349             end;
350           finally
351             FromGet := FALSE;
352           end;
353         end;
354       end;
355     end;
356   
357     procedure BuildNodes(tmpl: TTemplate; Owner: TTreeNode);
358     var
359       i: integer;
360       TmpNode: TTreeNode;
361   
362     begin
363       if(tmpl.Active or AllowInactive) then
364       begin
365         if(First) then
366         begin
367           First := FALSE;
368           TmpNode := Owner;
369         end
370         else
371         begin
372           TmpNode := Tree.Items.AddChildObject(Owner, tmpl.PrintName, tmpl);
373           TORTreeNode(TmpNode).StringData := tmpl.ID + U + tmpl.PrintName;
374           TmpNode.Cut := not tmpl.Active;
375           tmpl.AddNode(TmpNode);
376         end;
377         if(tmpl.Expanded) then
378         begin
379           for i := 0 to tmpl.Items.Count-1 do
380             BuildNodes(TTemplate(tmpl.Items[i]), TmpNode);
381         end
382         else
383         if(InEditor or (not tmpl.HideItems)) and
384            ((tmpl.Children in [tcActive, tcBoth]) or
385            (AllowInactive and (tmpl.Children = tcInactive))) then
386         begin
387           Tree.Items.AddChild(TmpNode, EmptyNodeText);
388           inc(EmptyCount);
389         end;
390       end;
391     end;
392   
393   begin
394     if(assigned(SyncNode)) then
395     begin
396       TagCount := 0;
397       inc(FTagIndex);
398       Tree := TTreeView(SyncNode.TreeView);
399       Tree.Items.BeginUpdate;
400       try
401         SyncExpanded := SyncNode.Expanded;
402         Template := TTemplate(SyncNode.Data);
403         SyncLevel := SyncNode.Level;
404         FromGet := FALSE;
405         IDCount := 0;
406         IDSort := TStringList.Create;
407         try
408         {-- Get the Current State of the tree --}
409           CurExp := TStringList.Create;
410           try
411             Node := Tree.TopItem;
412             DoTop := InSyncNode(Node);
413             if(DoTop) then
414               TopID := GetID(Node);
415   
416             Node := Tree.Selected;
417             DoSel := InSyncNode(Node);
418             if(DoSel) then
419               SelID := GetID(Node);
420   
421             Node := SyncNode.GetFirstChild;
422             while ((assigned(Node)) and (Node.Level > SyncLevel)) do
423             begin
424               if(Node.Text = EmptyNodeText) then
425                 dec(EmptyCount)
426               else
427               if(Node.Expanded) then
428                 CurExp.Add(GetID(Node));
429               if(assigned(Node.Data)) then
430                 TTemplate(Node.Data).RemoveNode(Node);
431               Node := Node.GetNext;
432             end;
433   
434           {-- Recursively Rebuild the Tree --}
435             SyncNode.DeleteChildren;
436             First := TRUE;
437             BuildNodes(Template, SyncNode);
438   
439           {-- Attempt to restore Tree to it's former State --}
440             SyncNode.Expanded := SyncExpanded;
441             for i := 0 to CurExp.Count-1 do
442             begin
443               Node := GetNode(CurExp[i]);
444               if(assigned(Node)) then
445                 Node.Expand(FALSE);
446             end;
447   
448             if(DoTop) and (TopID <> '') then
449             begin
450               Node := GetNode(TopID);
451               if(assigned(Node)) then
452                 Tree.TopItem := Node;
453             end;
454   
455             if(DoSel) and (SelID <> '') then
456             begin
457               Node := GetNode(SelID);
458               if(assigned(Node)) then
459               begin
460                 Tree.Selected := Node;
461                 Node.MakeVisible;
462               end;
463             end;
464   
465           finally
466             CurExp.Free;
467           end;
468   
469         finally
470           IDSort.Free;
471         end;
472   
473       finally
474         Tree.Items.EndUpdate;
475       end;
476     end;
477   end;
478   
479   
480   procedure TdmodShared.dmodSharedCreate(Sender: TObject);
481   begin
482     FDrawerTrees := TList.Create;
483     imgReminders.Overlay(6,0);
484     imgReminders.Overlay(7,1);
485     imgReminders2.Overlay(4,0);
486   end;
487   
488   procedure TdmodShared.dmodSharedDestroy(Sender: TObject);
489   begin
490     KillObj(@FDrawerTrees);
491     KillObj(@FTIUObjects);
492   end;
493   
494   procedure TdmodShared.AddDrawerTree(DrawerForm: TForm);
495   begin
496     if(assigned(FDrawerTrees)) and (FDrawerTrees.IndexOf(DrawerForm) < 0) then
497       FDrawerTrees.Add(DrawerForm);
498     Encounter.Notifier.NotifyWhenChanged(EncounterLocationChanged);
499   end;
500   
501   procedure TdmodShared.RemoveDrawerTree(DrawerForm: TForm);
502   var
503     idx: integer;
504   
505   begin
506     if(assigned(FDrawerTrees)) then
507     begin
508       idx := FDrawerTrees.IndexOf(DrawerForm);
509       if(idx >= 0) then
510         FDrawerTrees.Delete(idx);
511     end;
512   end;
513   
514   procedure TdmodShared.Reload;
515   var
516     i: integer;
517   
518   begin
519     if(assigned(FDrawerTrees)) then
520     begin
521       ReleaseTemplates;
522       for i := 0 to FDrawerTrees.Count-1 do
523         TfrmDrawers(FDrawerTrees[i]).ExternalReloadTemplates;
524     end;
525   end;
526   
527   procedure TdmodShared.LoadTIUObjects;
528   var
529     i: integer;
530   
531   begin
532     if(not assigned(FTIUObjects)) or (FRefreshObject = true)  then
533     begin
534       if(not assigned(FTIUObjects)) then
535         FTIUObjects := TStringList.Create;
536       FTIUObjects.Clear;
537       GetObjectList;
538       for i := 0 to RPCBrokerV.Results.Count-1 do
539         FTIUObjects.Add(MixedCase(Piece(RPCBrokerV.Results[i],U,2))+U+RPCBrokerV.Results[i]);
540       FTIUObjects.Sort;
541       FRefreshObject := False;
542      end;
543   end;
544   
545   function TdmodShared.NeedsCollapsing(Tree: TTreeView): boolean;
546   var
547     Node: TTreeNode;
548   
549   begin
550     Result := FALSE;
551     if(assigned(Tree)) then
552     begin
553       Node := Tree.Items.GetFirstNode;
554       while((not Result) and assigned(Node)) do
555       begin
556         Result := Node.Expanded;
557         Node := Node.GetNextSibling;
558       end;
559     end;
560   end;
561   
562   function TdmodShared.BoilerplateOK(const Txt, CRDelim: string; ObjList: TStringList;
563                                                                  var Err: TStringList): boolean;
564   var
565     cnt, i, j, p: integer;
566     tmp,obj: string;
567     BadObj, ok: boolean;
568   
569     procedure AddErr(Amsg: string);
570     begin
571       if(not assigned(Err)) then
572         Err := TStringList.Create;
573       Err.Add(Amsg)
574     end;
575   
576     function ErrCount: integer;
577     begin
578       if(Assigned(Err)) then
579         Result := Err.Count
580       else
581         Result := 0;
582     end;
583   
584   begin
585     if(assigned(ObjList)) then
586       ObjList.Clear;
587     cnt := ErrCount;
588     tmp := Txt;
589     BadObj := FALSE;
590     repeat
591       i := pos('|',tmp);
592       if(i > 0) then
593       begin
594         delete(tmp,1,i);
595         j := pos('|',tmp);
596         if(j = 0) then
597         begin
598           AddErr('Unpaired "|" in Boilerplate');
599           continue;
600         end;
601         obj := copy(tmp,1,j-1);
602         delete(tmp,1,j);
603         if(obj = '') then
604         begin
605           AddErr('Brackets "||" are there, but there''s no name inside it.');
606           continue;
607         end;
608         j := pos(CRDelim, obj);
609         if(j > 0) then
610         begin
611           AddErr('Object "'+copy(obj,1,j-1)+'" split between lines');
612           continue;
613         end;
614         LoadTIUObjects;
615         ok := FALSE;
616         for j := 0 to FTIUObjects.Count-1 do
617         begin
618           for p := 3 to 5 do
619           begin
620             if(obj = piece(FTIUObjects[j],U,p)) then
621             begin
622               ok := TRUE;
623               if(assigned(ObjList)) and (ObjList.IndexOf(ObjMarker + obj) < 0) then
624               begin
625                 ObjList.Add(ObjMarker + obj);
626                 ObjList.Add('|' + obj + '|');
627               end;
628               break;
629             end;
630           end;
631           if(ok) then break;
632         end;
633         if(not ok) then
634         begin
635           AddErr('Object "'+obj+'" not found.');
636           BadObj := TRUE;
637         end;
638       end;
639     until(i=0);
640     Result := (cnt = ErrCount);
641     if(not Result) then
642     begin
643       Err.Insert(0,'Boilerplate Contains Errors:'); 
644       Err.Insert(1,'');
645       if(BadObj) then
646       begin
647         Err.Add('');
648         Err.Add('Use UPPERCASE and object''s exact NAME, PRINT NAME, or ABBREVIATION');
649         Err.Add('Any of these may have changed since an object was embedded.');
650       end;
651     end;
652     if(assigned(ObjList) and (ObjList.Count > 0)) then
653       ObjList.Add(ObjMarker);
654   end;
655   
656   function TdmodShared.TemplateOK(tmpl: TTemplate; Msg: string = ''): boolean;
657   var
658     Err: TStringList;
659     btns: TMsgDlgButtons;
660   
661   begin
662     Err := nil;
663     try
664       Result := BoilerplateOK(tmpl.FullBoilerplate, #13, nil, Err);
665       if(not Result) then
666       begin
667         if(Msg = 'OK') then
668           btns := [mbOK]
669         else
670         begin
671           btns := [mbAbort, mbIgnore];
672           Err.Add('');
673           if(Msg = '') then
674             Msg := 'template insertion';
675           Err.Add('Do you want to Abort '+Msg+', or Ignore the error and continue?');
676         end;
677         Result := (MessageDlg(Err.Text, mtError, btns, 0) = mrIgnore);
678       end;
679     finally
680       if(assigned(Err)) then
681         Err.Free;
682     end;
683     if Result then
684       Result := BoilerplateTemplateFieldsOK(tmpl.FullBoilerplate, Msg);
685   end;
686   
687   procedure TdmodShared.EncounterLocationChanged(Sender: TObject);
688   var
689     i: integer;
690   
691   begin
692     if(assigned(FDrawerTrees)) then
693     begin
694       for i:= 0 to FDrawerTrees.count-1 do
695         TfrmDrawers(FDrawerTrees[i]).UpdatePersonalTemplates;
696     end;
697   end;
698   
699   procedure TdmodShared.SelectNode(Tree: TORTreeView; GotoNodeID: string; var EmptyCount: integer);
700   var
701     i, j: integer;
702     IEN, PIEN: string;
703     Node: TORTreeNode;
704   
705     function FindNode(StartNode: TORTreeNode): TORTreeNode;
706     begin
707       Result := nil;
708       while assigned(StartNode) do
709       begin
710         if(Piece(StartNode.StringData, U ,1) = IEN) then
711         begin
712           Result := StartNode;
713           exit;
714         end;
715         StartNode := TORTreeNode(StartNode.GetNextSibling);
716       end;
717     end;
718   
719   begin
720     if(GotoNodeID <> '') then
721     begin
722       i := 1;
723       for j := 1 to length(GotoNodeID) do
724         if(GotoNodeID[j] = ';') then inc(i);
725       PIEN := '';
726       Node := TORTreeNode(Tree.Items.GetFirstNode);
727       repeat
728         IEN := piece(GotoNodeID, ';', i);
729         if(IEN <> '') then
730         begin
731           Node := FindNode(Node);
732           if(assigned(Node)) then
733           begin
734             if(PIEN <> '') then
735               PIEN := ';' + PIEN;
736             PIEN := IEN + PIEN;
737             if(PIEN = GotoNodeID) then
738             begin
739               Node.EnsureVisible;
740               Tree.Selected := Node;
741               IEN := '';
742             end
743             else
744             begin
745               dmodShared.ExpandNode(Tree, Node, EmptyCount);
746               Node := TORTreeNode(Node.GetFirstChild);
747               if(assigned(Node)) then
748                 dec(i)
749               else
750                 IEN := '';
751             end;
752           end
753           else
754             IEN := '';
755         end;
756       until (i < 1) or (IEN = '');
757     end;
758   end;
759   
760   function TdmodShared.InDialog(Node: TTreeNode): boolean;
761   begin
762     Result := FALSE;
763     while assigned(Node) and (not Result) do
764     begin
765       if TTemplate(Node.Data).IsDialog then
766         Result := TRUE
767       else
768         Node := Node.Parent;
769     end;
770   end;
771   
772   procedure TdmodShared.ExpandTree(Tree: TORTreeView; ExpandString: string;
773     var EmptyCount: integer; AllowInactive: boolean = FALSE);
774   
775   var
776     NStr: string;
777     i: integer;
778     Node: TTreeNode;
779   
780   begin
781     Tree.Items.BeginUpdate;
782     try
783       i := 1;
784       repeat
785         NStr := piece(ExpandString,U,i);
786         if(NStr <> '') then
787         begin
788           inc(i);
789           Node := Tree.FindPieceNode(NStr, 1, ';');
790           if assigned(Node) then
791           begin
792             ExpandNode(Tree, Node, EmptyCount, AllowInactive);
793             Node.Expand(False);
794           end;
795         end;
796       until(NStr = '');
797     finally
798       Tree.Items.EndUpdate;
799     end;
800   end;
801   
802   procedure TdmodShared.FindRichEditText(AFindDialog: TFindDialog; ARichEdit: TRichEdit);
803   const
804     TX_NOMATCH = 'The text was not found';
805     TC_NOMATCH = 'No more matches';
806   var
807     FoundAt, FoundLine, TopLine, BottomLine: LongInt;
808     StartPos, ToEnd, CharPos: Integer;
809     SearchOpts: TSearchTypes;
810   begin
811     SearchOpts := [];
812     with ARichEdit do
813     begin
814       SetFocus;
815       { begin the search after the current selection if there is one }
816       { otherwise, begin at the start of the text }
817       if SelStart <> 0 then
818         StartPos := SelStart + SelLength
819       else
820         StartPos := 0;
821       { ToEnd is the length from StartPos to the end of the text in the rich edit control }
822       ToEnd := Length(Text) - StartPos;
823       if frMatchCase in AFindDialog.Options then Include(SearchOpts, stMatchCase);
824       if frWholeWord in AFindDialog.Options then Include(SearchOpts, stWholeWord);
825       FoundAt := FindText(AFindDialog.FindText, StartPos, ToEnd, SearchOpts);
826       if FoundAt <> -1 then
827       begin
828         SetFocus;
829         TopLine := SendMessage(Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
830         BottomLine := TopLine + (Height div FontHeightPixel(Font.Handle));
831         FoundLine := SendMessage(Handle, EM_EXLINEFROMCHAR, 0, FoundAt);
832         if (FoundLine + 10) > BottomLine then
833           SendMessage(Handle, EM_LINESCROLL, 0, FoundLine - BottomLine + 10);
834         CharPos := Pos(AFindDialog.FindText, Lines[FoundLine]);
835         SendMessage(ARichEdit.Handle, EM_LINESCROLL, CharPos, 0);
836         SelStart := FoundAt;
837         SelLength := Length(AFindDialog.FindText);
838       end
839       else
840       begin
841         if not (frReplaceAll in AFindDialog.Options) then InfoBox(TX_NOMATCH, TC_NOMATCH, MB_OK);
842         SelStart := 0;
843         SelLength := 0;
844         Windows.SetFocus(AFindDialog.Handle);
845         //AFindDialog.CloseDialog;
846       end;
847     end;
848   end;
849   
850   procedure TdmodShared.ReplaceRichEditText(AReplaceDialog: TReplaceDialog; ARichEdit: TRichEdit);
851   const
852     TC_COMPLETE  = 'Replacement Complete';
853     TX_COMPLETE1 = 'CPRS has finished searching the document.  ' + CRLF;
854     TX_COMPLETE2 = ' replacements were made.';
855   var
856     Replacements: integer;
857     NewStart: integer;
858   begin
859     Replacements := 0;
860     if (frReplace in AReplaceDialog.Options) then
861       begin
862         if ARichEdit.SelLength > 0 then
863           begin
864             NewStart := ARichEdit.SelStart + Length(AReplaceDialog.ReplaceText);
865             ARichEdit.SelText := AReplaceDialog.ReplaceText;
866             ARichEdit.SelStart := NewStart;
867             //Replacements := Replacements + 1;
868           end;
869         FindRichEditText(AReplaceDialog, ARichEdit);
870       end
871     else if (frReplaceAll in AReplaceDialog.Options) then
872       begin
873         repeat
874           if ARichEdit.SelLength > 0 then
875             begin
876               NewStart := ARichEdit.SelStart + Length(AReplaceDialog.ReplaceText);
877               ARichEdit.SelText := AReplaceDialog.ReplaceText;
878               ARichEdit.SelStart := NewStart;
879               Replacements := Replacements + 1;
880             end;
881           FindRichEditText(AReplaceDialog, ARichEdit);
882         until ARichEdit.SelLength = 0;
883         InfoBox(TX_COMPLETE1 + IntToStr(Replacements) + TX_COMPLETE2, TC_COMPLETE, MB_OK);
884       end
885     else
886       FindRichEditText(AReplaceDialog, ARichEdit);
887   end;
888   
889   initialization
890     SpecifyFormIsNotADialog(TdmodShared);
891   
892   end.

Module Calls (2 levels)


dShared
 ├uTemplates
 │ ├uTIU
 │ ├uDCSumm
 │ ├rTemplates
 │ ├uCore
 │ ├dShared...
 │ ├fTemplateDialog
 │ ├uTemplateFields
 │ ├fTemplateImport
 │ ├rCore
 │ ├uConst
 │ ├uEventHooks
 │ ├fReminderDialog
 │ └rODBase
 ├fDrawers
 │ ├uTemplates...
 │ ├fBase508Form
 │ ├fTemplateView
 │ ├rTemplates...
 │ ├fTemplateEditor
 │ ├dShared...
 │ ├uReminders
 │ ├fReminderDialog...
 │ ├fRptBox
 │ ├fTemplateDialog...
 │ ├fIconLegend
 │ ├uVA508CPRSCompatibility
 │ └fFindingTemplates
 ├rTemplates...
 ├uCore...
 ├uTemplateFields...
 └uEventHooks...

Module Called-By (2 levels)


                    dShared
                CPRSChart┤ 
                  uODBase┤ 
                uOrders┤ │ 
                fODBase┤ │ 
                rODBase┤ │ 
                fOrders┤ │ 
           fOrdersRenew┤ │ 
                fODDiet┤ │ 
             fODConsult┤ │ 
                fODProc┤ │ 
                fODAuto┤ │ 
                fOMNavA┤ │ 
              fOMVerify┤ │ 
                 fOMSet┘ │ 
               uTemplates┤ 
             fODBase...┤ │ 
             dShared...┤ │ 
               fDrawers┤ │ 
        fTemplateDialog┤ │ 
                 fNotes┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
        fTemplateEditor┤ │ 
        fReminderDialog┤ │ 
               fSurgery┤ │ 
          fODConsult...┤ │ 
             fODProc...┤ │ 
             fODAuto...┤ │ 
      fFindingTemplates┤ │ 
       fTemplateObjects┤ │ 
       fTemplateAutoGen┘ │ 
              fDrawers...┤ 
       fTemplateDialog...┤ 
               uReminders┤ 
                 fFrame┤ │ 
            fDrawers...┤ │ 
                 fCover┤ │ 
                 rCover┤ │ 
              fNotes...┤ │ 
           fConsults...┤ │ 
     fTemplateEditor...┤ │ 
     fReminderDialog...┤ │ 
          fReminderTree┤ │ 
             rReminders┤ │ 
            fSurgery...┤ │ 
         fRemCoverSheet┘ │ 
                fNotes...┤ 
                 fReports┤ 
              fFrame...┤ │ 
                 fProbs┤ │ 
          fReportsPrint┤ │ 
fReportsAdhocComponent1┤ │ 
                fGraphs┤ │ 
  fOptionsReportsCustom┤ │ 
 fOptionsReportsDefault┘ │ 
             fConsults...┤ 
               fDCSumm...┤ 
       fTemplateEditor...┤ 
              fSurgery...┤ 
      fTemplateObjects...┤ 
      fTemplateAutoGen...┘