| 1 | unit uDocTree; | 
|---|
| 2 |  | 
|---|
| 3 | interface | 
|---|
| 4 |  | 
|---|
| 5 | uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, uConst, ORCtrls, ComCtrls, uTIU; | 
|---|
| 6 |  | 
|---|
| 7 |  | 
|---|
| 8 | type | 
|---|
| 9 | PDocTreeObject = ^TDocTreeObject; | 
|---|
| 10 | TDocTreeObject = record | 
|---|
| 11 | DocID          : string ;                 //Document IEN | 
|---|
| 12 | DocDate        : string;                  //Formatted date of document | 
|---|
| 13 | DocTitle       : string;                  //Document Title Text | 
|---|
| 14 | NodeText       : string;                  //Title, Location, Author  (depends on tab) | 
|---|
| 15 | ImageCount     : integer;                 //Number of images | 
|---|
| 16 | VisitDate      : string;                  //ADM/VIS: date;FMDate | 
|---|
| 17 | DocFMDate      : string;                  //FM date of document | 
|---|
| 18 | DocHasChildren : string;                  //Has children  (+,>,<) | 
|---|
| 19 | DocParent      : string;                  //Parent document, or context | 
|---|
| 20 | Author         : string;                  //DUZ;Author name | 
|---|
| 21 | PkgRef         : string;                  //IEN;Package    (consults only, for now) | 
|---|
| 22 | Location       : string;                  //Location name | 
|---|
| 23 | Status         : string;                  //Status | 
|---|
| 24 | Subject        : string;                  //Subject | 
|---|
| 25 | OrderID        : string;                  //Order file IEN (consults only, for now) | 
|---|
| 26 | OrderByTitle   : boolean;                 //Within ID Parents, order children by title, not date | 
|---|
| 27 | end; | 
|---|
| 28 |  | 
|---|
| 29 | // Procedures for document treeviews/listviews | 
|---|
| 30 | procedure CreateListItemsForDocumentTree(Dest, Source: TStrings; Context: integer; GroupBy: string; | 
|---|
| 31 | Ascending: boolean; TabIndex: integer); | 
|---|
| 32 | procedure BuildDocumentTree(DocList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode; | 
|---|
| 33 | TIUContext: TTIUContext; TabIndex: integer); | 
|---|
| 34 | procedure SetTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TTIUContext; TabIndex: integer); | 
|---|
| 35 | procedure ResetDocTreeObjectStrings(AnObject: PDocTreeObject); | 
|---|
| 36 | procedure KillDocTreeObjects(TreeView: TORTreeView); | 
|---|
| 37 | procedure KillDocTreeNode(ANode: TTreeNode); | 
|---|
| 38 | function  ContextMatch(ANode: TORTreeNode; AParentID: string; AContext: TTIUContext): Boolean; | 
|---|
| 39 | function  TextFound(ANode: TORTreeNode; CurrentContext: TTIUContext): Boolean; | 
|---|
| 40 | procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TTIUContext); | 
|---|
| 41 | procedure TraverseTree(ATree: TTreeView; AListView: TListView; ANode: TTreeNode; MyNodeID: string; | 
|---|
| 42 | AContext: TTIUContext); | 
|---|
| 43 | procedure AddListViewItem(ANode: TTreeNode; AListView: TListView); | 
|---|
| 44 | function  MakeNoteTreeObject(x: string): PDocTreeObject; | 
|---|
| 45 | function  MakeDCSummTreeObject(x: string): PDocTreeObject; | 
|---|
| 46 | function  MakeConsultsNoteTreeObject(x: string): PDocTreeObject; | 
|---|
| 47 |  | 
|---|
| 48 | implementation | 
|---|
| 49 |  | 
|---|
| 50 | uses | 
|---|
| 51 | rConsults, uDCSumm, uConsults; | 
|---|
| 52 |  | 
|---|
| 53 | {============================================================== | 
|---|
| 54 | RPC [TIU DOCUMENTS BY CONTEXT] returns | 
|---|
| 55 | the following string '^' pieces: | 
|---|
| 56 | =============================================================== | 
|---|
| 57 | 1 -  Document IEN | 
|---|
| 58 | 2 -  Document Title | 
|---|
| 59 | 3 -  FM date of document | 
|---|
| 60 | 4 -  Patient Name | 
|---|
| 61 | 5 -  DUZ;Author name | 
|---|
| 62 | 6 -  Location | 
|---|
| 63 | 7 -  Status | 
|---|
| 64 | 8 -  ADM/VIS: date;FMDate | 
|---|
| 65 | 9 -  Discharge Date;FMDate | 
|---|
| 66 | 10 - Package variable pointer | 
|---|
| 67 | 11 - Number of images | 
|---|
| 68 | 12 - Subject | 
|---|
| 69 | 13 - Has children | 
|---|
| 70 | 14 - Parent document | 
|---|
| 71 | 15 - Order children of ID Note by title rather than date | 
|---|
| 72 | ===============================================================} | 
|---|
| 73 |  | 
|---|
| 74 | procedure CreateListItemsForDocumentTree(Dest, Source: TStrings; Context: integer; GroupBy: string; | 
|---|
| 75 | Ascending: Boolean; TabIndex: integer); | 
|---|
| 76 | const | 
|---|
| 77 | NO_MATCHES = '^No Matching Documents Found^^^^^^^^^^^%^0'; | 
|---|
| 78 | var | 
|---|
| 79 | i: Integer; | 
|---|
| 80 | x, x1, x2, x3, MyParent, MyTitle, MyLocation, MySubject: string; | 
|---|
| 81 | AList, SrcList: TStringList; | 
|---|
| 82 | begin | 
|---|
| 83 | AList := TStringList.Create; | 
|---|
| 84 | SrcList := TStringList.Create; | 
|---|
| 85 | try | 
|---|
| 86 | SrcList.Assign(Source); | 
|---|
| 87 | with SrcList do | 
|---|
| 88 | begin | 
|---|
| 89 | if (Count = 0) then | 
|---|
| 90 | begin | 
|---|
| 91 | Dest.Insert(0, IntToStr(Context) + NO_MATCHES); | 
|---|
| 92 | Exit; | 
|---|
| 93 | end; | 
|---|
| 94 | for i := 0 to Count - 1 do | 
|---|
| 95 | begin | 
|---|
| 96 | x := Strings[i]; | 
|---|
| 97 | MyParent   := Piece(x, U, 14); | 
|---|
| 98 | MyTitle    := Piece(x, U, 2); | 
|---|
| 99 | if Length(Trim(MyTitle)) = 0 then | 
|---|
| 100 | begin | 
|---|
| 101 | MyTitle := '** No Title **'; | 
|---|
| 102 | SetPiece(x, U, 2, MyTitle); | 
|---|
| 103 | end; | 
|---|
| 104 | MyLocation := Piece(x, U, 6); | 
|---|
| 105 | if Length(Trim(MyLocation)) = 0 then | 
|---|
| 106 | begin | 
|---|
| 107 | MyLocation := '** No Location **'; | 
|---|
| 108 | SetPiece(x, U, 6, MyLocation); | 
|---|
| 109 | end; | 
|---|
| 110 | MySubject  := Piece(x, U, 12); | 
|---|
| 111 | (*            case TIUContext.SearchField[1] of | 
|---|
| 112 | 'T': if ((TextFound(MyTitle)) then continue; | 
|---|
| 113 | 'S': if (not TextFound(MySubject)) then continue; | 
|---|
| 114 | 'B': if not ((TextFound(MyTitle)) or (TextFound(MySubject))) then continue; | 
|---|
| 115 | end;*) | 
|---|
| 116 | if GroupBy <> '' then case GroupBy[1] of | 
|---|
| 117 | 'D':  begin | 
|---|
| 118 | x1 := Piece(Piece(x, U, 8), ';', 1);                    // Visit date | 
|---|
| 119 | x2 := Piece(Piece(Piece(x, U, 8), ';', 2), '.', 1);     // Visit date (FM)   no time - v15.4 | 
|---|
| 120 | if x2 = '' then | 
|---|
| 121 | begin | 
|---|
| 122 | x2 := 'No Visit'; | 
|---|
| 123 | x1 := Piece(x1, ':', 1) + ':  No Visit'; | 
|---|
| 124 | end; | 
|---|
| 125 | (*else | 
|---|
| 126 | x1 := Piece(x1, ':', 1) + ':  ' + FormatFMDateTimeStr('mmm dd,yy@hh:nn',x2)*) //removed v15.4 | 
|---|
| 127 | if MyParent = IntToStr(Context) then | 
|---|
| 128 | SetPiece(x, U, 14, MyParent + x2 + Copy(x1, 1, 3));    // '2980324Adm' | 
|---|
| 129 | x3 := x2 + Copy(x1, 1, 3) + U + MixedCase(x1) + U + IntToStr(Context) + MixedCase(Copy(x1, 1, 3)); | 
|---|
| 130 | if (Copy(MyTitle, 1, 8) <> 'Addendum') and (AList.IndexOf(x3) = -1) then | 
|---|
| 131 | AList.Add(x3);   // '2980324Adm^Mar 24,98' | 
|---|
| 132 | end; | 
|---|
| 133 | 'L':  begin | 
|---|
| 134 | if MyParent = IntToStr(Context) then                  // keep ID notes together, or | 
|---|
| 135 | SetPiece(x, U, 14, MyParent + MyLocation); | 
|---|
| 136 | (*                        if (Copy(MyTitle, 1, 8) <> 'Addendum') then       // split ID Notes by location? | 
|---|
| 137 | SetPiece(x, U, 14, IntToStr(Context) + MyLocation);*) | 
|---|
| 138 | x3 := MyLocation + U + MixedCase(MyLocation) + U + IntToStr(Context); | 
|---|
| 139 | if (Copy(MyTitle, 1, 8) <> 'Addendum') and (AList.IndexOf(x3) = -1) then | 
|---|
| 140 | AList.Add(x3); | 
|---|
| 141 | end; | 
|---|
| 142 | 'T':  begin | 
|---|
| 143 | if MyParent = IntToStr(Context) then                  // keep ID notes together, or | 
|---|
| 144 | SetPiece(x, U, 14, MyParent + MyTitle); | 
|---|
| 145 | (*                        if (Copy(MyTitle, 1, 8) <> 'Addendum') then       // split ID Notes by title? | 
|---|
| 146 | SetPiece(x, U, 14, IntToStr(Context) + MyTitle);*) | 
|---|
| 147 | x3 := MyTitle + U + MixedCase(MyTitle) + U + IntToStr(Context); | 
|---|
| 148 | if (Copy(MyTitle, 1, 8) <> 'Addendum') and (AList.IndexOf(x3) = -1) then | 
|---|
| 149 | AList.Add(x3); | 
|---|
| 150 | end; | 
|---|
| 151 | 'A':  begin | 
|---|
| 152 | x1 := Piece(Piece(x, U, 5), ';', 3); | 
|---|
| 153 | if x1 = '' then x1 := '** No Author **'; | 
|---|
| 154 | if MyParent = IntToStr(Context) then                  // keep ID notes together, or | 
|---|
| 155 | SetPiece(x, U, 14, MyParent + x1); | 
|---|
| 156 | //if (Copy(MyTitle, 1, 8) <> 'Addendum') then         // split ID Notes by author? | 
|---|
| 157 | //  SetPiece(x, U, 14, IntToStr(Context) + x1); | 
|---|
| 158 | x3 := x1 + U + MixedCase(x1) + U + IntToStr(Context); | 
|---|
| 159 | if (Copy(MyTitle, 1, 8) <> 'Addendum') and(AList.IndexOf(x3) = -1) then | 
|---|
| 160 | AList.Add(x3); | 
|---|
| 161 | end; | 
|---|
| 162 | (*              'A':  begin                                                 // Makes note appear both places in tree, | 
|---|
| 163 | x1 := Piece(Piece(x, U, 5), ';', 3);                  // but also appears TWICE in lstNotes. | 
|---|
| 164 | if x1 = '' then x1 := '** No Author **';              // IS THIS REALLY A PROBLEM?? | 
|---|
| 165 | if MyParent = IntToStr(Context) then                  // Impact on EditingIndex? | 
|---|
| 166 | SetPiece(x, U, 14, MyParent + x1);                  // Careful when deleting note being edited!!! | 
|---|
| 167 | Dest.Add(x);                                          // Need to find and delete ALL occurrences! | 
|---|
| 168 | SetPiece(x, U, 14, IntToStr(Context) + x1); | 
|---|
| 169 | x3 := x1 + U + MixedCase(x1) + U + IntToStr(Context); | 
|---|
| 170 | if (AList.IndexOf(x3) = -1) then AList.Add(x3); | 
|---|
| 171 | end;*) | 
|---|
| 172 | end; | 
|---|
| 173 | Dest.Add(x); | 
|---|
| 174 | end; {for} | 
|---|
| 175 | SortByPiece(TStringList(Dest), U, 3); | 
|---|
| 176 | if not Ascending then InvertStringList(TStringList(Dest)); | 
|---|
| 177 | if GroupBy <> '' then if GroupBy[1] ='D' then | 
|---|
| 178 | begin | 
|---|
| 179 | AList.Add('Adm^Inpatient Notes' + U + IntToStr(Context)); | 
|---|
| 180 | AList.Add('Vis^Outpatient Notes' + U + IntToStr(Context)); | 
|---|
| 181 | end; | 
|---|
| 182 | Dest.Insert(0, IntToStr(Context) + '^' + NC_TV_TEXT[TabIndex, Context] + '^^^^^^^^^^^%^0'); | 
|---|
| 183 | Alist.Sort; | 
|---|
| 184 | InvertStringList(AList); | 
|---|
| 185 | if GroupBy <> '' then if GroupBy[1] ='D' then | 
|---|
| 186 | if (not Ascending) then InvertStringList(AList); | 
|---|
| 187 | for i := 0 to AList.Count-1 do | 
|---|
| 188 | Dest.Insert(0, IntToStr(Context) + Piece(AList[i], U, 1) + '^' + Piece(AList[i], U, 2) + '^^^^^^^^^^^%^' + Piece(AList[i], U, 3)); | 
|---|
| 189 | end; | 
|---|
| 190 | finally | 
|---|
| 191 | AList.Free; | 
|---|
| 192 | SrcList.Free; | 
|---|
| 193 | end; | 
|---|
| 194 | end; | 
|---|
| 195 |  | 
|---|
| 196 | procedure BuildDocumentTree(DocList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode; | 
|---|
| 197 | TIUContext: TTIUContext; TabIndex: integer); | 
|---|
| 198 | var | 
|---|
| 199 | MyID, MyParent, Name: string; | 
|---|
| 200 | i: Integer; | 
|---|
| 201 | ChildNode, tmpNode: TORTreeNode; | 
|---|
| 202 | DocHasChildren: Boolean; | 
|---|
| 203 | AnObject: PDocTreeObject; | 
|---|
| 204 | begin | 
|---|
| 205 | with DocList do for i := 0 to Count - 1 do | 
|---|
| 206 | begin | 
|---|
| 207 | tmpNode := nil; | 
|---|
| 208 | MyParent := Piece(Strings[i], U, 14); | 
|---|
| 209 | if (MyParent = Parent) then | 
|---|
| 210 | begin | 
|---|
| 211 | MyID := Piece(Strings[i], U, 1); | 
|---|
| 212 | if Piece(Strings[i], U, 13) <> '%' then | 
|---|
| 213 | case TabIndex of | 
|---|
| 214 | CT_NOTES:    Name := MakeNoteDisplayText(Strings[i]); | 
|---|
| 215 | CT_CONSULTS: Name := MakeConsultNoteDisplayText(Strings[i]); | 
|---|
| 216 | CT_DCSUMM:   Name := MakeDCSummDisplayText(Strings[i]); | 
|---|
| 217 | end | 
|---|
| 218 | else | 
|---|
| 219 | Name := Piece(Strings[i], U, 2); | 
|---|
| 220 | DocHasChildren := (Piece(Strings[i], U, 13) <> ''); | 
|---|
| 221 | if Node <> nil then if Node.HasChildren then | 
|---|
| 222 | tmpNode := Tree.FindPieceNode(MyID, 1, U, Node); | 
|---|
| 223 | if (tmpNode <> nil) and tmpNode.HasAsParent(Node) then | 
|---|
| 224 | Continue | 
|---|
| 225 | else | 
|---|
| 226 | begin | 
|---|
| 227 | case TabIndex of | 
|---|
| 228 | CT_NOTES:    AnObject := MakeNoteTreeObject(Strings[i]); | 
|---|
| 229 | CT_CONSULTS: AnObject := MakeConsultsNoteTreeObject(Strings[i]); | 
|---|
| 230 | CT_DCSUMM:   AnObject := MakeDCSummTreeObject(Strings[i]); | 
|---|
| 231 | else | 
|---|
| 232 | AnObject := nil; | 
|---|
| 233 | end; | 
|---|
| 234 | ChildNode := TORTreeNode(Tree.Items.AddChildObject(TORTreeNode(Node), Name, AnObject)); | 
|---|
| 235 | ChildNode.StringData := Strings[i]; | 
|---|
| 236 | SetTreeNodeImagesAndFormatting(ChildNode, TIUContext, TabIndex); | 
|---|
| 237 | if DocHasChildren then BuildDocumentTree(DocList, MyID, Tree, ChildNode, TIUContext, TabIndex); | 
|---|
| 238 | end; | 
|---|
| 239 | end; | 
|---|
| 240 | end; | 
|---|
| 241 | end; | 
|---|
| 242 |  | 
|---|
| 243 | procedure SetTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TTIUContext; TabIndex: integer); | 
|---|
| 244 | var | 
|---|
| 245 | tmpAuthor: int64; | 
|---|
| 246 | i: integer; | 
|---|
| 247 |  | 
|---|
| 248 | procedure MakeBold(ANode: TORTreeNode); | 
|---|
| 249 | var | 
|---|
| 250 | LookingForAddenda: boolean; | 
|---|
| 251 | begin | 
|---|
| 252 | LookingForAddenda := (Pos('ADDENDUM', UpperCase(CurrentContext.Keyword)) > 0); | 
|---|
| 253 | with ANode do | 
|---|
| 254 | begin | 
|---|
| 255 | Bold := True; | 
|---|
| 256 | if Parent <> nil then | 
|---|
| 257 | begin | 
|---|
| 258 | if (ImageIndex <> IMG_ADDENDUM) or ((ImageIndex = IMG_ADDENDUM) and LookingForAddenda) then | 
|---|
| 259 | Parent.Expand(False); | 
|---|
| 260 | if Parent.Parent <> nil then | 
|---|
| 261 | begin | 
|---|
| 262 | if (Parent.ImageIndex <> IMG_ADDENDUM) or ((Parent.ImageIndex = IMG_ADDENDUM) and LookingForAddenda) then | 
|---|
| 263 | Parent.Parent.Expand(False); | 
|---|
| 264 | if Parent.Parent.Parent <> nil then | 
|---|
| 265 | if (Parent.Parent.ImageIndex <> IMG_ADDENDUM) or ((Parent.Parent.ImageIndex = IMG_ADDENDUM) and LookingForAddenda) then | 
|---|
| 266 | Parent.Parent.Parent.Expand(False); | 
|---|
| 267 | end; | 
|---|
| 268 | end; | 
|---|
| 269 | end; | 
|---|
| 270 | end; | 
|---|
| 271 |  | 
|---|
| 272 | begin | 
|---|
| 273 | with Node, PDocTreeObject(Node.Data)^ do | 
|---|
| 274 | begin | 
|---|
| 275 | i := Pos('*', DocTitle); | 
|---|
| 276 | if i > 0 then i := i + 1 else i := 0; | 
|---|
| 277 | if (Copy(DocTitle, i + 1, 8) = 'Addendum') then | 
|---|
| 278 | ImageIndex := IMG_ADDENDUM | 
|---|
| 279 | else if (DocHasChildren = '') then | 
|---|
| 280 | ImageIndex := IMG_SINGLE | 
|---|
| 281 | else if Pos('+>', DocHasChildren) > 0 then | 
|---|
| 282 | ImageIndex := IMG_ID_CHILD_ADD | 
|---|
| 283 | else if (DocHasChildren = '>') then | 
|---|
| 284 | ImageIndex := IMG_ID_CHILD | 
|---|
| 285 | else if Pos('+<', DocHasChildren) > 0 then | 
|---|
| 286 | ImageIndex := IMG_IDPAR_ADDENDA_SHUT | 
|---|
| 287 | else if DocParent = '0' then | 
|---|
| 288 | begin | 
|---|
| 289 | ImageIndex    := IMG_TOP_LEVEL; | 
|---|
| 290 | SelectedIndex := IMG_TOP_LEVEL; | 
|---|
| 291 | StateIndex := -1; | 
|---|
| 292 | with CurrentContext, Node do | 
|---|
| 293 | begin | 
|---|
| 294 | if  Node.HasChildren and (GroupBy <> '') then case GroupBy[1] of | 
|---|
| 295 | 'T': Text := NC_TV_TEXT[TabIndex, StrToInt(DocID)] + ' by title'; | 
|---|
| 296 | 'D': Text := NC_TV_TEXT[TabIndex, StrToInt(DocID)] + ' by visit date'; | 
|---|
| 297 | 'L': Text := NC_TV_TEXT[TabIndex, StrToInt(DocID)] + ' by location'; | 
|---|
| 298 | 'A': Text := NC_TV_TEXT[TabIndex, StrToInt(DocID)] + ' by author'; | 
|---|
| 299 | end; | 
|---|
| 300 | if TabIndex <> CT_CONSULTS then | 
|---|
| 301 | begin | 
|---|
| 302 | if (DocID = '2') or (DocID ='3') then | 
|---|
| 303 | begin | 
|---|
| 304 | if StrToIntDef(Status, 0) in [NC_UNSIGNED, NC_UNCOSIGNED] then | 
|---|
| 305 | begin | 
|---|
| 306 | if Author = 0 then tmpAuthor := User.DUZ else tmpAuthor := Author; | 
|---|
| 307 | Text := Text + ' for ' + ExternalName(tmpAuthor, 200); | 
|---|
| 308 | end | 
|---|
| 309 | else | 
|---|
| 310 | Text := Text + ' for ' + User.Name; | 
|---|
| 311 | end; | 
|---|
| 312 | if DocID = '4' then | 
|---|
| 313 | Text := Text + ' for ' + ExternalName(Author, 200); | 
|---|
| 314 | end; | 
|---|
| 315 | end; | 
|---|
| 316 | end | 
|---|
| 317 | else | 
|---|
| 318 | case DocHasChildren[1] of | 
|---|
| 319 | '<': ImageIndex := IMG_IDNOTE_SHUT; | 
|---|
| 320 | '+': ImageIndex := IMG_PARENT; | 
|---|
| 321 | '%': begin | 
|---|
| 322 | StateIndex := -1; | 
|---|
| 323 | ImageIndex    := IMG_GROUP_SHUT; | 
|---|
| 324 | SelectedIndex := IMG_GROUP_OPEN; | 
|---|
| 325 | end; | 
|---|
| 326 | end; | 
|---|
| 327 | SelectedIndex := ImageIndex; | 
|---|
| 328 | if (ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then | 
|---|
| 329 | StateIndex := IMG_NONE | 
|---|
| 330 | else | 
|---|
| 331 | begin | 
|---|
| 332 | if ImageCount > 0 then | 
|---|
| 333 | StateIndex := IMG_1_IMAGE | 
|---|
| 334 | else if ImageCount = 0 then | 
|---|
| 335 | StateIndex := IMG_NO_IMAGES | 
|---|
| 336 | else if ImageCount = -1 then | 
|---|
| 337 | StateIndex := IMG_IMAGES_HIDDEN; | 
|---|
| 338 | end; | 
|---|
| 339 | if (Parent <> nil) and | 
|---|
| 340 | (Parent.ImageIndex in [IMG_PARENT, IMG_IDNOTE_SHUT, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_SHUT, IMG_IDPAR_ADDENDA_OPEN]) and | 
|---|
| 341 | (StateIndex in [IMG_1_IMAGE, IMG_IMAGES_HIDDEN]) then | 
|---|
| 342 | begin | 
|---|
| 343 | Parent.StateIndex := IMG_CHILD_HAS_IMAGES; | 
|---|
| 344 | end; | 
|---|
| 345 | (*        case ImageCount of | 
|---|
| 346 | 0: StateIndex := IMG_NO_IMAGES; | 
|---|
| 347 | 1: StateIndex := IMG_1_IMAGE; | 
|---|
| 348 | 2: StateIndex := IMG_2_IMAGES; | 
|---|
| 349 | else | 
|---|
| 350 | StateIndex := IMG_MANY_IMAGES; | 
|---|
| 351 | end;*) | 
|---|
| 352 | if Node.Parent <> nil then | 
|---|
| 353 | if not CurrentContext.Filtered then | 
|---|
| 354 | //don't bother to BOLD every entry | 
|---|
| 355 | else | 
|---|
| 356 | begin | 
|---|
| 357 | if (*ContextMatch(Node) then | 
|---|
| 358 | if (CurrentContext.KeyWord = '') or *)TextFound(Node, CurrentContext) then MakeBold(Node); | 
|---|
| 359 | end; | 
|---|
| 360 | end; | 
|---|
| 361 | end; | 
|---|
| 362 |  | 
|---|
| 363 | procedure TraverseTree(ATree: TTreeView; AListView: TListView; ANode: TTreeNode; MyNodeID: string; AContext: TTIUContext); | 
|---|
| 364 | var | 
|---|
| 365 | IncludeIt: Boolean; | 
|---|
| 366 | x: string; | 
|---|
| 367 | begin | 
|---|
| 368 | if ANode = nil then Exit; | 
|---|
| 369 | IncludeIt := False; | 
|---|
| 370 | if (ContextMatch(TORTreeNode(ANode), MyNodeID, AContext) and TextFound(TORTreeNode(ANode), AContext)) then | 
|---|
| 371 | with PDocTreeObject(ANode.Data)^ do | 
|---|
| 372 | begin | 
|---|
| 373 | if (AContext.GroupBy <> '') and | 
|---|
| 374 | (ATree.Selected.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then | 
|---|
| 375 | begin | 
|---|
| 376 | case AContext.GroupBy[1] of | 
|---|
| 377 | 'T': if (UpperCase(DocTitle) = UpperCase(PDocTreeObject(ATree.Selected.Data)^.DocTitle)) or | 
|---|
| 378 | (UpperCase(DocTitle) = UpperCase('Addendum to ' + PDocTreeObject(ATree.Selected.Data)^.DocTitle)) or | 
|---|
| 379 | (AContext.Filtered and TextFound(TORTreeNode(ANode), AContext)) then | 
|---|
| 380 | IncludeIt := True; | 
|---|
| 381 | 'D': begin | 
|---|
| 382 | x := PDocTreeObject(ATree.Selected.Data)^.DocID; | 
|---|
| 383 | if (Copy(x, 2, 3) = 'Vis') or (Copy(x, 2, 3) = 'Adm') then | 
|---|
| 384 | begin | 
|---|
| 385 | if Copy(VisitDate, 1, 3) = Copy(x, 2, 3) then | 
|---|
| 386 | IncludeIt := True; | 
|---|
| 387 | end | 
|---|
| 388 | else if Piece(Piece(VisitDate, ';', 2), '.', 1) = Copy(x, 2, Length(x) - 4) then | 
|---|
| 389 | IncludeIt := True; | 
|---|
| 390 | end; | 
|---|
| 391 | 'L': if MyNodeID + Location = PDocTreeObject(ATree.Selected.Data)^.DocID then | 
|---|
| 392 | IncludeIt := True; | 
|---|
| 393 | 'A': if MyNodeID + Piece(Author, ';', 2) = PDocTreeObject(ATree.Selected.Data)^.DocID then | 
|---|
| 394 | IncludeIt := True; | 
|---|
| 395 | end; | 
|---|
| 396 | end | 
|---|
| 397 | else | 
|---|
| 398 | IncludeIt := True; | 
|---|
| 399 | end; | 
|---|
| 400 | if IncludeIt then AddListViewItem(ANode, AListView); | 
|---|
| 401 | if ANode.HasChildren then TraverseTree(ATree, AListView, ANode.GetFirstChild, MyNodeID, AContext); | 
|---|
| 402 | TraverseTree(ATree, AListView, ANode.GetNextSibling, MyNodeID, AContext); | 
|---|
| 403 | end; | 
|---|
| 404 |  | 
|---|
| 405 | function ContextMatch(ANode: TORTreeNode; AParentID: string; AContext: TTIUContext): Boolean; | 
|---|
| 406 | var | 
|---|
| 407 | Status: string; | 
|---|
| 408 | Author: int64; | 
|---|
| 409 | begin | 
|---|
| 410 | Result := True; | 
|---|
| 411 | if not Assigned(ANode.Data) then Exit; | 
|---|
| 412 | Status := PDocTreeObject(ANode.Data)^.Status; | 
|---|
| 413 |  | 
|---|
| 414 | if (AContext.Status <> AParentID[1]) or (AContext.Author = 0) then | 
|---|
| 415 | Author := User.DUZ | 
|---|
| 416 | else | 
|---|
| 417 | Author := AContext.Author; | 
|---|
| 418 |  | 
|---|
| 419 | if Length(Trim(Status)) = 0 then exit; | 
|---|
| 420 | (*if PDocTreeObject(ANode.Data)^.DocHasChildren = '%' then Result := False else Result := True; | 
|---|
| 421 | Result := False;*) | 
|---|
| 422 | case AParentID[1] of | 
|---|
| 423 | '1':  Result := (Status = 'completed') or | 
|---|
| 424 | (Status = 'deleted')   or | 
|---|
| 425 | (Status = 'amended')   or | 
|---|
| 426 | (Status = 'uncosigned') or | 
|---|
| 427 | (Status = 'retracted'); | 
|---|
| 428 | '2':  Result := ((Status = 'unsigned')   or | 
|---|
| 429 | (Status = 'unreleased') or | 
|---|
| 430 | (Status = 'deleted')   or | 
|---|
| 431 | (Status = 'retracted') or | 
|---|
| 432 | (Status = 'unverified')) and | 
|---|
| 433 | (Piece(PDocTreeObject(ANode.Data)^.Author, ';', 1) = IntToStr(Author)); | 
|---|
| 434 | '3':  Result := ((Status = 'uncosigned') or | 
|---|
| 435 | (Status = 'unsigned')   or | 
|---|
| 436 | (Status = 'unreleased') or | 
|---|
| 437 | (Status = 'deleted')   or | 
|---|
| 438 | (Status = 'retracted') or | 
|---|
| 439 | (Status = 'unverified')) ;//and | 
|---|
| 440 | { TODO -oRich V. -cSort/Search : Uncosigned notes - need to check cosigner, not author, but don't have it } | 
|---|
| 441 | //(Piece(PDocTreeObject(ANode.Data)^.Author, ';', 1) = IntToStr(Author)); | 
|---|
| 442 | '4':  Result := (Piece(PDocTreeObject(ANode.Data)^.Author, ';', 1) = IntToStr(Author)); | 
|---|
| 443 | '5':  if PDocTreeObject(ANode.Data)^.DocHasChildren = '%' then Result := False | 
|---|
| 444 | else Result := (StrToFloat(PDocTreeObject(ANode.Data)^.DocFMDate) >= AContext.FMBeginDate) and | 
|---|
| 445 | (Trunc(StrToFloat(PDocTreeObject(ANode.Data)^.DocFMDate)) <= AContext.FMEndDate); | 
|---|
| 446 | 'N':  Result := True;     // NEW NOTE | 
|---|
| 447 | 'E':  Result := True;     // EDITING NOTE | 
|---|
| 448 | 'A':  Result := True;     // NEW ADDENDUM or processing alert | 
|---|
| 449 | end; | 
|---|
| 450 | end; | 
|---|
| 451 |  | 
|---|
| 452 | function TextFound(ANode: TORTreeNode; CurrentContext: TTIUContext): Boolean; | 
|---|
| 453 | var | 
|---|
| 454 | MySearch: string; | 
|---|
| 455 | begin | 
|---|
| 456 | Result := False; | 
|---|
| 457 | if not Assigned(ANode.Data) then Exit; | 
|---|
| 458 | if CurrentContext.SearchField <> '' then | 
|---|
| 459 | case CurrentContext.SearchField[1] of | 
|---|
| 460 | 'T': MySearch := PDocTreeObject(ANode.Data)^.DocTitle; | 
|---|
| 461 | 'S': MySearch := PDocTreeObject(ANode.Data)^.Subject; | 
|---|
| 462 | 'B': MySearch := PDocTreeObject(ANode.Data)^.DocTitle + ' ' + PDocTreeObject(ANode.Data)^.Subject; | 
|---|
| 463 | end; | 
|---|
| 464 | Result := (not CurrentContext.Filtered) or | 
|---|
| 465 | ((CurrentContext.Filtered) and (Pos(UpperCase(CurrentContext.KeyWord), UpperCase(MySearch)) > 0)); | 
|---|
| 466 | end; | 
|---|
| 467 |  | 
|---|
| 468 | procedure ResetDocTreeObjectStrings(AnObject: PDocTreeObject); | 
|---|
| 469 | begin | 
|---|
| 470 | with AnObject^ do | 
|---|
| 471 | begin | 
|---|
| 472 | DocID          := ''; | 
|---|
| 473 | DocDate        := ''; | 
|---|
| 474 | DocTitle       := ''; | 
|---|
| 475 | NodeText       := ''; | 
|---|
| 476 | VisitDate      := ''; | 
|---|
| 477 | DocFMDate      := ''; | 
|---|
| 478 | DocHasChildren := ''; | 
|---|
| 479 | DocParent      := ''; | 
|---|
| 480 | Author         := ''; | 
|---|
| 481 | PkgRef         := ''; | 
|---|
| 482 | Location       := ''; | 
|---|
| 483 | Status         := ''; | 
|---|
| 484 | Subject        := ''; | 
|---|
| 485 | OrderID        := ''; | 
|---|
| 486 | end; | 
|---|
| 487 | end; | 
|---|
| 488 |  | 
|---|
| 489 | procedure KillDocTreeObjects(TreeView: TORTreeView); | 
|---|
| 490 | var | 
|---|
| 491 | i: integer; | 
|---|
| 492 | begin | 
|---|
| 493 | with TreeView do | 
|---|
| 494 | for i := 0 to Items.Count-1 do | 
|---|
| 495 | begin | 
|---|
| 496 | if(Assigned(Items[i].Data)) then | 
|---|
| 497 | begin | 
|---|
| 498 | ResetDocTreeObjectStrings(PDocTreeObject(Items[i].Data)); | 
|---|
| 499 | Dispose(PDocTreeObject(Items[i].Data)); | 
|---|
| 500 | Items[i].Data := nil; | 
|---|
| 501 | end; | 
|---|
| 502 | end; | 
|---|
| 503 | end; | 
|---|
| 504 |  | 
|---|
| 505 | procedure KillDocTreeNode(ANode: TTreeNode); | 
|---|
| 506 | begin | 
|---|
| 507 | if(Assigned(ANode.Data)) then | 
|---|
| 508 | begin | 
|---|
| 509 | ResetDocTreeObjectStrings(PDocTreeObject(ANode.Data)); | 
|---|
| 510 | Dispose(PDocTreeObject(ANode.Data)); | 
|---|
| 511 | ANode.Data := nil; | 
|---|
| 512 | end; | 
|---|
| 513 | ANode.Owner.Delete(ANode); | 
|---|
| 514 | end; | 
|---|
| 515 |  | 
|---|
| 516 | procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TTIUContext); | 
|---|
| 517 | var | 
|---|
| 518 | n: integer; | 
|---|
| 519 | begin | 
|---|
| 520 | with Tree do | 
|---|
| 521 | for n := Items.Count - 1 downto 0 do | 
|---|
| 522 | if ((Items[n].ImageIndex = IMG_GROUP_SHUT)) then | 
|---|
| 523 | begin | 
|---|
| 524 | if (not Items[n].HasChildren) then | 
|---|
| 525 | KillDocTreeNode(Items[n]) | 
|---|
| 526 | else if Context.Filtered then   // if any hits, would be IMG_GROUP_OPEN | 
|---|
| 527 | KillDocTreeNode(Items[n]); | 
|---|
| 528 | end; | 
|---|
| 529 | end; | 
|---|
| 530 |  | 
|---|
| 531 | procedure AddListViewItem(ANode: TTreeNode; AListView: TListView); | 
|---|
| 532 | var | 
|---|
| 533 | ListItem: TListItem; | 
|---|
| 534 | begin | 
|---|
| 535 | if not Assigned(ANode.Data) then Exit; | 
|---|
| 536 | with Anode, PDocTreeObject(ANode.Data)^, AListView do | 
|---|
| 537 | begin | 
|---|
| 538 | (*      if (FCurrentContext.Status = '1') and | 
|---|
| 539 | (Copy(DocTitle, 1 , 8) = 'Addendum') then Exit;*) | 
|---|
| 540 | if ANode.ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT] then Exit; | 
|---|
| 541 | ListItem := Items.Add; | 
|---|
| 542 | ListItem.Caption := DocDate;                     // date | 
|---|
| 543 | ListItem.StateIndex := ANode.StateIndex; | 
|---|
| 544 | ListItem.ImageIndex := ANode.ImageIndex; | 
|---|
| 545 | with ListItem.SubItems do | 
|---|
| 546 | begin | 
|---|
| 547 | Add(DocTitle);                               //  title | 
|---|
| 548 | Add(Subject);                                //  subject | 
|---|
| 549 | Add(MixedCase(Piece(Author, ';', 2)));       //  author | 
|---|
| 550 | Add(Location);                               //  location | 
|---|
| 551 | Add(DocFMDate);                              //  reference date (FM) | 
|---|
| 552 | Add(DocID);                                  //  TIUDA | 
|---|
| 553 | end; | 
|---|
| 554 | end; | 
|---|
| 555 | end; | 
|---|
| 556 |  | 
|---|
| 557 | function MakeNoteTreeObject(x: string): PDocTreeObject; | 
|---|
| 558 | var | 
|---|
| 559 | AnObject: PDocTreeObject; | 
|---|
| 560 | begin | 
|---|
| 561 | New(AnObject); | 
|---|
| 562 | with AnObject^ do | 
|---|
| 563 | begin | 
|---|
| 564 | DocID           := Piece(x, U, 1); | 
|---|
| 565 | DocDate         := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3))); | 
|---|
| 566 | DocTitle        := Piece(x, U, 2); | 
|---|
| 567 | Location        := Piece(x, U, 6); | 
|---|
| 568 | NodeText        := MakeNoteDisplayText(x); | 
|---|
| 569 | ImageCount      := StrToIntDef(Piece(x, U, 11), 0); | 
|---|
| 570 | VisitDate       := Piece(x, U, 8); | 
|---|
| 571 | DocFMDate       := Piece(x, U, 3); | 
|---|
| 572 | DocHasChildren  := Piece(x, U, 13); | 
|---|
| 573 | if Copy(DocHasChildren, 1, 1) = '*' then | 
|---|
| 574 | DocHasChildren := Copy(DocHasChildren, 2, 5); | 
|---|
| 575 | DocParent       := Piece(x, U, 14); | 
|---|
| 576 | Author          := Piece(Piece(x, U, 5), ';', 1) + ';' + Piece(Piece(x, U, 5), ';', 3); | 
|---|
| 577 | PkgRef          := Piece(x, U, 10); | 
|---|
| 578 | Status          := Piece(x, U, 7); | 
|---|
| 579 | Subject         := Piece(x, U, 12); | 
|---|
| 580 | OrderByTitle    := Piece(x, U, 15) = '1'; | 
|---|
| 581 | end; | 
|---|
| 582 | Result := AnObject; | 
|---|
| 583 | end; | 
|---|
| 584 |  | 
|---|
| 585 | function MakeDCSummTreeObject(x: string): PDocTreeObject; | 
|---|
| 586 | var | 
|---|
| 587 | AnObject: PDocTreeObject; | 
|---|
| 588 | begin | 
|---|
| 589 | New(AnObject); | 
|---|
| 590 | if Copy(Piece(x, U, 9), 1, 4) = '    ' then SetPiece(x, U, 9, 'Dis: '); | 
|---|
| 591 | with AnObject^ do | 
|---|
| 592 | begin | 
|---|
| 593 | DocID            := Piece(x, U, 1); | 
|---|
| 594 | DocDate          := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3))); | 
|---|
| 595 | DocTitle         := Piece(x, U, 2); | 
|---|
| 596 | Location         := Piece(x, U, 6); | 
|---|
| 597 | NodeText         := MakeDCSummDisplayText(x); | 
|---|
| 598 | DocFMDate        := Piece(x, U, 3); | 
|---|
| 599 | ImageCount       := StrToIntDef(Piece(x, U, 11), 0); | 
|---|
| 600 | DocHasChildren   := Piece(x, U, 13); | 
|---|
| 601 | if Copy(DocHasChildren, 1, 1) = '*' then | 
|---|
| 602 | DocHasChildren := Copy(DocHasChildren, 2, 5); | 
|---|
| 603 | DocParent        := Piece(x, U, 14); | 
|---|
| 604 | Author           := Piece(Piece(x, U, 5), ';', 1) + ';' + Piece(Piece(x, U, 5), ';', 3); | 
|---|
| 605 | PkgRef           := Piece(x, U, 10); | 
|---|
| 606 | Status           := Piece(x, U, 7); | 
|---|
| 607 | Subject          := Piece(x, U, 12); | 
|---|
| 608 | VisitDate        := Piece(x, U, 8); | 
|---|
| 609 | OrderByTitle    := Piece(x, U, 15) = '1'; | 
|---|
| 610 | end; | 
|---|
| 611 | Result := AnObject; | 
|---|
| 612 | end; | 
|---|
| 613 |  | 
|---|
| 614 | function MakeConsultsNoteTreeObject(x: string): PDocTreeObject; | 
|---|
| 615 | var | 
|---|
| 616 | AnObject: PDocTreeObject; | 
|---|
| 617 | begin | 
|---|
| 618 | New(AnObject); | 
|---|
| 619 | with AnObject^ do | 
|---|
| 620 | begin | 
|---|
| 621 | DocID           := Piece(x, U, 1); | 
|---|
| 622 | DocDate         := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3))); | 
|---|
| 623 | DocTitle        := Piece(x, U, 2); | 
|---|
| 624 | Location        := Piece(x, U, 6); | 
|---|
| 625 | NodeText        := MakeConsultNoteDisplayText(x); | 
|---|
| 626 | DocFMDate       := Piece(x, U, 3); | 
|---|
| 627 | Status          := Piece(x, U, 7); | 
|---|
| 628 | Author          := Piece(Piece(x, U, 5), ';', 1) + ';' + Piece(Piece(x, U, 5), ';', 3); | 
|---|
| 629 | PkgRef          := Piece(x, U, 10); | 
|---|
| 630 | if Piece(PkgRef, ';', 2) = PKG_CONSULTS then | 
|---|
| 631 | OrderID       := GetConsultOrderIEN(StrToIntDef(Piece(PkgRef, ';', 1), 0)); | 
|---|
| 632 | ImageCount      := StrToIntDef(Piece(x, U, 11), 0); | 
|---|
| 633 | VisitDate       := Piece(x, U, 8); | 
|---|
| 634 | DocHasChildren  := Piece(x, U, 13); | 
|---|
| 635 | if Copy(DocHasChildren, 1, 1) = '*' then | 
|---|
| 636 | DocHasChildren := Copy(DocHasChildren, 2, 5); | 
|---|
| 637 | DocParent       := Piece(x, U, 14); | 
|---|
| 638 | OrderByTitle    := Piece(x, U, 15) = '1'; | 
|---|
| 639 | end; | 
|---|
| 640 | Result := AnObject; | 
|---|
| 641 | end; | 
|---|
| 642 |  | 
|---|
| 643 |  | 
|---|
| 644 | end. | 
|---|