unit uCaseTree;

interface

uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, uConst, ORCtrls, ComCtrls, uSurgery, rSurgery;


type
  PCaseTreeObject = ^TCaseTreeObject;
  TCaseTreeObject = record
    // used for both types of node
    CaseID         : string;
    NodeText       : string;                  //Title, Location, Author (depends on node type)
    ImageCount     : integer;                 //Number of images
    DocHasChildren : string;                  //Has children  (+)
    DocParent      : string;                  //Parent document, or context
    // used for Case nodes only
    OperativeProc  : string;
    IsNonORProc    : boolean;
    SurgeryDate    : string;
    Surgeon        : string;
    // used for document nodes only
    DocID          : string ;                 //Document IEN
    DocDate        : string;                  //Formatted date of document
    DocTitle       : string;                  //Document Title Text
    VisitDate      : string;                  //ADM/VIS: date;FMDate
    DocFMDate      : string;                  //FM date of document
    Author         : string;                  //DUZ;Author name
    PkgRef         : string;                  //IEN;Package
    Location       : string;                  //Location name
    Status         : string;                  //Status
    Subject        : string;                  //Subject
    // not currently used
    OrderID        : string;                  //Order file IEN (consults only, for now)
    OrderByTitle   : boolean;                 //Within cases, order docs by title, not date
  end;

// Procedures for document treeviews/listviews
procedure CreateListItemsForCaseTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
          Ascending: boolean);
procedure BuildCaseTree(CaseList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode;
          CaseContext: TSurgCaseContext);
procedure SetCaseTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TSurgCaseContext);
procedure SetImageFlag(ANode: TORTreeNode);
procedure ResetCaseTreeObjectStrings(AnObject: PCaseTreeObject);
procedure KillCaseTreeObjects(TreeView: TORTreeView);
procedure KillCaseTreeNode(ANode: TTreeNode);
procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TSurgCaseContext);
function  MakeCaseTreeObject(x: string): PCaseTreeObject;

implementation

(*uses
  fRptBox;*)

{==============================================================
RPC [SURGERY CASES BY CONTEXT] returns
the following string '^' pieces:
===============================================================
CASE #^Operative Procedure^Date/Time of Operation^Surgeon^^^^^^^^^+^Context         ***NEEDS TO BE FIXED***
IEN NIR^TITLE^REF DATE/TIME^PT ID^AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
IEN AR^TITLE^REF DATE/TIME^PT ID^AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
IEN OS^TITLE^REF DATE/TIME^PT ID^AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
IEN Addendum^TITLE^REF DATE/TIME^PT ID^AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^^IEN of Parent Document*)

===============================================================}

procedure CreateListItemsForCaseTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
          Ascending: Boolean);
const
  NO_MATCHES = '^No Surgery Cases Found^^^^^^^^^^^%^0';
var
  i: Integer;
  x, x1, x2, x3, MyParent, MyType: string;
  AList, SrcList: TStringList;
begin
  AList := TStringList.Create;
  SrcList := TStringList.Create;
  try
    //ReportBox(Source, '', True);
    SrcList.Assign(Source);
    with SrcList do
      begin
        if (Count = 1) and (Piece(SrcList[0], U, 1) = '-1') then
          begin
            Dest.Insert(0, IntToStr(Context) + NO_MATCHES);
            Exit;
          end;
        for i := 0 to Count - 1 do
          begin
            x := Strings[i];
            if Piece(x, U, 10) <> '' then      // if item is a note, and is missing information
              begin
                if Piece(x, U, 2) = '' then
                  SetPiece(x, U, 2, '** No title **');
                if Piece(x, U, 6) = '' then
                  SetPiece(x, U, 6, '** No location **');
                if Piece(Piece(x, U, 5), ';', 3) = '' then
                  SetPiece(x, U, 5, '0;** No Author **;** No Author **');
              end;
            MyParent   := Piece(x, U, 14);
            if GroupBy <> '' then case GroupBy[1] of
              'D':  begin
                      x2 := Piece(x, U, 3);                          // Proc date (FM)
                      if x2 = '' then
                        begin
                          x2 := '** No Date **';
                          x1 := '** No Date **';
                        end
                      else
                        x1 := FormatFMDateTime('mmm dd,yyyy', StrToFloat(x2));  // Proc date
                      if MyParent = IntToStr(Context) then
                        SetPiece(x, U, 14, MyParent + x2);
                      x3 := x2 + U + MixedCase(x1) + U + IntToStr(Context);
                      if (AList.IndexOf(x3) = -1) then AList.Add(x3);
                    end;
              'P':  begin
                      x1 := Piece(x, U, 2);
                      if x1 = '' then x1 := '** No Procedure **';
                      if MyParent = IntToStr(Context) then
                        SetPiece(x, U, 14, MyParent + x1);
                      x3 := x1 + U + MixedCase(x1) + U + IntToStr(Context);
                      if (AList.IndexOf(x3) = -1) then AList.Add(x3);
                    end;
              'S':  begin
                      x1 := Piece(Piece(x, U, 4), ';', 2);
                      if x1 = '' then x1 := '** No Surgeon **';
                      if MyParent = IntToStr(Context) then
                        SetPiece(x, U, 14, MyParent + x1);
                      x3 := x1 + U + MixedCase(x1) + U + IntToStr(Context);
                      if (AList.IndexOf(x3) = -1) then AList.Add(x3);
                    end;
              'T':  begin
                      if MyParent = IntToStr(Context) then
                      begin
                        if Piece(x, U, 6) = '1' then
                          MyType := 'Non-OR Procedures'
                        else
                          MyType := 'Operations';
                        SetPiece(x, U, 14, MyParent + MyType);
                        x3 := MyType + U + MyType + U + IntToStr(Context);
                        if (AList.IndexOf(x3) = -1) then AList.Add(x3);
                      end;
                    end;
            end;
            Dest.Add(x);
          end; {for}
        SortByPiece(TStringList(Dest), U, 3);
        if not Ascending then InvertStringList(TStringList(Dest));
        Dest.Insert(0, IntToStr(Context) + '^' + SG_TV_TEXT + '^^^^^^^^^^^%^0');
        Alist.Sort;
        if Ascending or (CharAt(GroupBy, 1) = 'T') then InvertStringList(AList);   // operations before non-OR procs
        for i := 0 to AList.Count-1 do
          Dest.Insert(0, IntToStr(Context) + Piece(AList[i], U, 1) + '^' + Piece(AList[i], U, 2) + '^^^^^^^^^^^%^' + Piece(AList[i], U, 3));
      end;
      //ReportBox(Dest, '', True);
  finally
    AList.Free;
    SrcList.Free;
  end;
end;

procedure BuildCaseTree(CaseList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode;
          CaseContext: TSurgCaseContext);
var
  MyID, MyParent, Name: string;
  i: Integer;
  ChildNode, tmpNode: TORTreeNode;
  CaseHasChildren: Boolean;
  AnObject: PCaseTreeObject;
begin
  with CaseList do for i := 0 to Count - 1 do
    begin
      tmpNode := nil;
      MyParent := Piece(Strings[i], U, 14);
      if (MyParent = Parent) then
        begin
          MyID := Piece(Strings[i], U, 1);
          if Piece(Strings[i], U, 13) = '%' then
             Name := Piece(Strings[i], U, 2)
          else if Piece(Strings[i], U, 10) = '' then
             Name := MakeSurgeryCaseDisplayText(Strings[i])
          else
             Name := MakeSurgeryReportDisplayText(Strings[i]);
          CaseHasChildren := (Piece(Strings[i], U, 13) <> '');
          if Node <> nil then if Node.HasChildren then
            tmpNode := Tree.FindPieceNode(MyID, 1, U, Node);
          if (tmpNode <> nil) and tmpNode.HasAsParent(Node) then
            Continue
          else
            begin
              AnObject := MakeCaseTreeObject(Strings[i]);
              ChildNode := TORTreeNode(Tree.Items.AddChildObject(TORTreeNode(Node), Name, AnObject));
              ChildNode.StringData := Strings[i];
              SetCaseTreeNodeImagesAndFormatting(ChildNode, CaseContext);
              if CaseHasChildren then BuildCaseTree(CaseList, MyID, Tree, ChildNode, CaseContext);
            end;
        end;
    end;
end;

procedure SetCaseTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TSurgCaseContext);
var
  CaseNode: TORTreeNode;
  i: integer;
(*  IMG_SURG_BLANK             = 0;
    IMG_SURG_TOP_LEVEL         = 1;
    IMG_SURG_GROUP_SHUT        = 2;
    IMG_SURG_GROUP_OPEN        = 3;
    IMG_SURG_CASE_EMPTY        = 4;
    IMG_SURG_CASE_SHUT         = 5;
    IMG_SURG_CASE_OPEN         = 6;
    IMG_SURG_RPT_SINGLE        = 7;
    IMG_SURG_RPT_ADDM          = 8;
    IMG_SURG_ADDENDUM          = 9;
    IMG_SURG_NON_OR_CASE_EMPTY = 10;
    IMG_SURG_NON_OR_CASE_SHUT  = 11;
    IMG_SURG_NON_OR_CASE_OPEN  = 12;
*)
begin
  with Node, PCaseTreeObject(Node.Data)^ do
    begin
      i := Pos('*', DocTitle);
      if i > 0 then i := i + 1 else i := 0;
      if (Copy(DocTitle, i + 1, 8) = 'Addendum') then
        ImageIndex := IMG_SURG_ADDENDUM
      else if (DocHasChildren = '') then
        begin
          if PkgRef = '' then
            begin
              if IsNonORProc then
                ImageIndex := IMG_SURG_NON_OR_CASE_EMPTY
              else
                ImageIndex := IMG_SURG_CASE_EMPTY;
            end
          else
            ImageIndex := IMG_SURG_RPT_SINGLE;
        end
      else if DocParent = '0' then
        begin
          ImageIndex    := IMG_SURG_TOP_LEVEL;
          SelectedIndex := IMG_SURG_TOP_LEVEL;
          StateIndex := -1;
          with CurrentContext, Node do
            if GroupBy <> '' then
              case GroupBy[1] of
                'P': Text := SG_TV_TEXT + ' by Procedure';        
                'D': Text := SG_TV_TEXT + ' by Surgery Date';
                'S': Text := SG_TV_TEXT + ' by Surgeon';
                'T': Text := SG_TV_TEXT + ' by Type';
              end
            else Text := SG_TV_TEXT;
        end
      else
        case DocHasChildren[1] of
          '+': if PkgRef <> '' then
                 ImageIndex := IMG_SURG_RPT_ADDM
               else
                 begin
                   if IsNonORProc then
                     ImageIndex := IMG_SURG_NON_OR_CASE_SHUT
                   else
                     ImageIndex := IMG_SURG_CASE_SHUT;
                 end;
          '%': begin
                 StateIndex := -1;
                 ImageIndex    := IMG_SURG_GROUP_SHUT;
                 SelectedIndex := IMG_SURG_GROUP_OPEN;
               end;
        end;
      SelectedIndex := ImageIndex;
      SetImageFlag(Node);
      CaseNode := TORTreeView(Node.TreeView).FindPieceNode(CaseID, 1, U, nil);
      if CaseNode <> nil then
        begin
          PCaseTreeObject(CaseNode.Data)^.ImageCount := PCaseTreeObject(CaseNode.Data)^.ImageCount + ImageCount;
          SetImageFlag(CaseNode);
        end;
    end;
end;

procedure SetImageFlag(ANode: TORTreeNode);
begin
  with ANode, PCaseTreeObject(ANode.Data)^ do
    begin
      if (ImageIndex in [IMG_SURG_TOP_LEVEL, IMG_SURG_GROUP_OPEN, IMG_SURG_GROUP_SHUT]) then
        StateIndex := IMG_NO_IMAGES
      else
        begin
          if ImageCount > 0 then
            StateIndex := IMG_1_IMAGE
          else if ImageCount = 0 then
            StateIndex := IMG_NO_IMAGES
          else if ImageCount = -1 then
            StateIndex := IMG_IMAGES_HIDDEN;
        end;
(*      else
        case ImageCount of
          0: StateIndex := IMG_NO_IMAGES;
          1: StateIndex := IMG_1_IMAGE;
          2: StateIndex := IMG_2_IMAGES;
        else
          StateIndex := IMG_MANY_IMAGES;
        end;*)
      if (Parent <> nil) and
         (Parent.ImageIndex in [IMG_SURG_CASE_SHUT, IMG_SURG_CASE_OPEN, IMG_SURG_RPT_ADDM,
                                IMG_SURG_NON_OR_CASE_SHUT, IMG_SURG_NON_OR_CASE_OPEN ]) and
         (StateIndex in [IMG_1_IMAGE, IMG_IMAGES_HIDDEN]) then
         begin
           Parent.StateIndex := IMG_CHILD_HAS_IMAGES;
         end;
    end;
end;

procedure ResetCaseTreeObjectStrings(AnObject: PCaseTreeObject);
begin
  with AnObject^ do
    begin
      CaseID         := '';
      OperativeProc  := '';
      SurgeryDate    := '';
      Surgeon        := '';
      DocID          := '';
      DocDate        := '';
      DocTitle       := '';
      NodeText       := '';
      VisitDate      := '';
      DocFMDate      := '';
      DocHasChildren := '';
      DocParent      := '';
      Author         := '';
      PkgRef         := '';
      Location       := '';
      Status         := '';
      Subject        := '';
      OrderID        := '';
    end;
end;

procedure KillCaseTreeObjects(TreeView: TORTreeView);
var
  i: integer;
begin
  with TreeView do
    for i := 0 to Items.Count-1 do
    begin
      if(Assigned(Items[i].Data)) then
        begin
          ResetCaseTreeObjectStrings(PCaseTreeObject(Items[i].Data));
          Dispose(PCaseTreeObject(Items[i].Data));
          Items[i].Data := nil;
        end;
    end;
end;

procedure KillCaseTreeNode(ANode: TTreeNode);
begin
  if(Assigned(ANode.Data)) then
    begin
      ResetCaseTreeObjectStrings(PCaseTreeObject(ANode.Data));
      Dispose(PCaseTreeObject(ANode.Data));
      ANode.Data := nil;
    end;
  ANode.Owner.Delete(ANode);
end;

procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TSurgCaseContext);
var
  n: integer;
begin
  with Tree do
    for n := Items.Count - 1 downto 0 do
      if (Items[n].ImageIndex in  [IMG_SURG_GROUP_SHUT, IMG_SURG_GROUP_OPEN]) then
        begin
          if (not Items[n].HasChildren) then
             KillCaseTreeNode(Items[n]);
        end;
end;


function MakeCaseTreeObject(x: string): PCaseTreeObject;
var
  AnObject: PCaseTreeObject;
begin
  New(AnObject);
  with AnObject^ do
    begin
      if Piece(x, U, 10) = '' then
        //CASE #^Operative Procedure^Date/Time of Operation^Surgeon^^^^^^^^^+^Context   
        begin
          CaseID          := Piece(x, U, 1);
          OperativeProc   := Piece(x, U, 2);
          SurgeryDate     := Piece(x, U, 3);
          Surgeon         := Piece(x, U, 4);
          IsNonORProc     := Piece(x, U, 6) = '1';
          DocHasChildren  := Piece(x, U, 13);
          DocParent       := Piece(x, U, 14);
          ImageCount      := StrToIntDef(Piece(x, U, 11), 0);
          NodeText        := MakeSurgeryCaseDisplayText(x);
        end
      else
        //IEN NIR^TITLE^REF DATE/TIME^PT ID^AUTHORDUZ;AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
        //IEN AR^TITLE^REF DATE/TIME^PT ID^AUTHORDUZ;AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
        //IEN OS^TITLE^REF DATE/TIME^PT ID^AUTHORDUZ;AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
        //IEN Addendum^TITLE^REF DATE/TIME^PT ID^AUTHORDUZ;AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^^IEN of Parent Document
        begin
          DocID           := Piece(x, U, 1);
          DocTitle        := Piece(x, U, 2);
          DocFMDate       := Piece(x, U, 3);
          DocDate         := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3)));
          Author          := Piece(x, U, 5);
          Location        := Piece(x, U, 6);
          Status          := Piece(x, U, 7);
          VisitDate       := Piece(x, U, 8);
          PkgRef          := Piece(x, U, 10);
          CaseID          := Piece(Piece(x, U, 10), ';', 1);
          ImageCount      := StrToIntDef(Piece(x, U, 11), 0);
          Subject         := Piece(x, U, 12);
          DocHasChildren  := Piece(x, U, 13);
          DocParent       := Piece(x, U, 14);
          NodeText        := MakeSurgeryReportDisplayText(x);
        end;
    end;
  Result := AnObject;
end;


end.