source: cprs/branches/tmg-cprs/CPRS-Chart/uDocTree.pas@ 1545

Last change on this file since 1545 was 453, checked in by Kevin Toppenberg, 17 years ago

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