Procedure

BuildServiceTree

Module

uConsults

Last Modified

7/15/2014 3:26:36 PM

Comments

TmpNode: TORTreeNode;
  AllNodes: TStringList;
  List: TList;
  Lists: TObjectList;
  bad: boolean;
 Former code was only filtering out half the duplicates, depending on
 how they appeared in the tree.  Commented out code filters out all the duplicates,
 and still keeps the fast tree build.  However, CPRS Clinical Workgroup determined
 that no duplicates should be filtered out.  Code kept here in order to keep fast filter
 logic, in case duplicates are ever filtered out in the future.

  procedure FilterOutDuplicates;
  var
    j: integer;
  begin
    bad := false;
    if AllNodes.Find(MyID, Idx) then
    begin
      if AllNodes.Objects[Idx] is TORTreeNode then
      begin
        tmpNode := TORTreeNode(AllNodes.Objects[Idx]);
        bad := tmpNode.HasAsParent(ParentNode);
        if (not bad) and assigned(tmpNode.Parent) then
          bad := ParentNode.HasAsParent(tmpNode.Parent);
      end
      else
      begin
        bad := False;
        List := TList(AllNodes.Objects[Idx]);
        for j := 0 to List.Count - 1 do
        begin
          tmpNode := TORTreeNode(List[j]);
          bad := TORTreeNode(List[j]).HasAsParent(ParentNode);
          if (not bad) and assigned(tmpNode.Parent) then
            bad := ParentNode.HasAsParent(tmpNode.Parent);
          if bad then break;
        end;
      end;
    end;
  end;

  procedure AddNode;
  begin
    if AllNodes.Find(MyID, Idx) then
    begin
      if AllNodes.Objects[Idx] is TORTreeNode then
      begin
        List := TList.Create;
        Lists.Add(List);
        List.Add(AllNodes.Objects[Idx]);
        AllNodes.Objects[Idx] := List;
      end
      else
        List := TList(AllNodes.Objects[Idx]);
      List.Add(ChildNode);
    end
    else
      AllNodes.AddObject(MyId, ChildNode);
  end;

Scope

Interfaced

Declaration

procedure BuildServiceTree(Tree: TORTreeView; SvcList: TStrings; const Parent: string; Node: TORTreeNode);

Called-By Hierarchy


                                BuildServiceTree
                                 SelectService┤ 
                   TfrmConsults.mnuViewClick┘ │ 
               TfrmConsults.SetViewContext┘   │ 
                TfrmConsults.DisplayPage┤     │ 
TfrmConsults.mnuViewReturntoDefaultClick┘     │ 
                            SelectConsultsView┤ 
                TfrmConsults.mnuViewClick...┘ │ 
                TfrmConsultAction.SetupForward┤ 
                            SetActionContext┘ │ 
           TfrmConsults.mnuActConsultClick┘   │ 
                        TfrmODCslt.SetupDialog┘ 

Called-By

Name Declaration Comments
SelectConsultsView function SelectConsultsView(FontSize: Integer; CurrentContext: TSelectContext; var SelectContext: TSelectContext): boolean ; -
SelectService function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean; -
TfrmODCslt.SetupDialog procedure SetupDialog(OrderAction: Integer; const ID: string); override; -
TfrmConsultAction.SetupForward function SetupForward(IsProcedure: boolean; ProcIEN: integer): boolean; -


Source

261   procedure BuildServiceTree(Tree: TORTreeView; SvcList: TStrings; const Parent: string; Node: TORTreeNode);
262   var
263     MyID, MyParent, Name, item: string;
264     i, Idx: Integer;
265     ParentNode, ChildNode: TORTreeNode;
266   //  tmpNode: TORTreeNode;
267     HasChildren: Boolean;
268   //  AllNodes: TStringList;
269     ParentNodes: TStringList;
270   //  List: TList;
271   //  Lists: TObjectList;
272   //  bad: boolean;
273   
274   // Former code was only filtering out half the duplicates, depending on
275   // how they appeared in the tree.  Commented out code filters out all the duplicates,
276   // and still keeps the fast tree build.  However, CPRS Clinical Workgroup determined
277   // that no duplicates should be filtered out.  Code kept here in order to keep fast filter
278   // logic, in case duplicates are ever filtered out in the future.
279   
280   {
281     procedure FilterOutDuplicates;
282     var
283       j: integer;
284     begin
285       bad := false;
286       if AllNodes.Find(MyID, Idx) then
287       begin
288         if AllNodes.Objects[Idx] is TORTreeNode then
289         begin
290           tmpNode := TORTreeNode(AllNodes.Objects[Idx]);
291           bad := tmpNode.HasAsParent(ParentNode);
292           if (not bad) and assigned(tmpNode.Parent) then
293             bad := ParentNode.HasAsParent(tmpNode.Parent);
294         end
295         else
296         begin
297           bad := False;
298           List := TList(AllNodes.Objects[Idx]);
299           for j := 0 to List.Count - 1 do
300           begin
301             tmpNode := TORTreeNode(List[j]);
302             bad := TORTreeNode(List[j]).HasAsParent(ParentNode);
303             if (not bad) and assigned(tmpNode.Parent) then
304               bad := ParentNode.HasAsParent(tmpNode.Parent);
305             if bad then break;
306           end;
307         end;
308       end;
309     end;
310   
311     procedure AddNode;
312     begin
313       if AllNodes.Find(MyID, Idx) then
314       begin
315         if AllNodes.Objects[Idx] is TORTreeNode then
316         begin
317           List := TList.Create;
318           Lists.Add(List);
319           List.Add(AllNodes.Objects[Idx]);
320           AllNodes.Objects[Idx] := List;
321         end
322         else
323           List := TList(AllNodes.Objects[Idx]);
324         List.Add(ChildNode);
325       end
326       else
327         AllNodes.AddObject(MyId, ChildNode);
328     end;
329   }
330   
331   begin
332     Tree.Items.BeginUpdate;
333     ParentNodes := TStringList.Create;
334   //  AllNodes := TStringList.Create;
335   //  Lists := TObjectList.Create;
336     try
337       ParentNodes.Sorted := True;
338   //    AllNodes.Sorted := True;
339       for i := 0 to SvcList.Count - 1 do
340       begin
341         item := SvcList[i];
342         if Piece(item, U, 5) = 'S' then Continue; 
343         MyParent := Piece(item, U, 3);
344         MyID := Piece(item, U, 1);
345         if not ParentNodes.Find(MyParent, Idx) then
346           ParentNode := nil
347         else
348         begin
349           ParentNode := TORTreeNode(ParentNodes.Objects[Idx]);
350   //        FilterOutDuplicates;
351   //        if bad then Continue;
352         end;
353         Name := Piece(item, U, 2);
354         HasChildren := Piece(item, U, 4) = '+';
355         ChildNode := TORTreeNode(Tree.Items.AddChild(ParentNode, Name));
356         ChildNode.StringData := item;
357   //      AddNode;
358         if HasChildren then
359           ParentNodes.AddObject(MyID, ChildNode);
360       end;
361     finally
362       ParentNodes.Free;
363   //    AllNodes.Free;
364   //    Lists.Free;
365     end;
366     Tree.Items.EndUpdate;
367   end;