source: cprs/trunk/CPRS-Chart/uDocTree.pas@ 773

Last change on this file since 773 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76
File size: 27.2 KB
RevLine 
[456]1unit uDocTree;
2
3interface
4
5uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, uConst, ORCtrls, ComCtrls, uTIU;
6
7
8type
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
30procedure CreateListItemsForDocumentTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
31 Ascending: boolean; TabIndex: integer);
32procedure BuildDocumentTree(DocList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode;
33 TIUContext: TTIUContext; TabIndex: integer);
34procedure SetTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TTIUContext; TabIndex: integer);
35procedure ResetDocTreeObjectStrings(AnObject: PDocTreeObject);
36procedure KillDocTreeObjects(TreeView: TORTreeView);
37procedure KillDocTreeNode(ANode: TTreeNode);
38function ContextMatch(ANode: TORTreeNode; AParentID: string; AContext: TTIUContext): Boolean;
39function TextFound(ANode: TORTreeNode; CurrentContext: TTIUContext): Boolean;
40procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TTIUContext);
41procedure TraverseTree(ATree: TTreeView; AListView: TListView; ANode: TTreeNode; MyNodeID: string;
42 AContext: TTIUContext);
43procedure AddListViewItem(ANode: TTreeNode; AListView: TListView);
44function MakeNoteTreeObject(x: string): PDocTreeObject;
45function MakeDCSummTreeObject(x: string): PDocTreeObject;
46function MakeConsultsNoteTreeObject(x: string): PDocTreeObject;
47
48implementation
49
50uses
51 rConsults, uDCSumm, uConsults;
52
53{==============================================================
54RPC [TIU DOCUMENTS BY CONTEXT] returns
55the 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
74procedure CreateListItemsForDocumentTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
75 Ascending: Boolean; TabIndex: integer);
76const
77 NO_MATCHES = '^No Matching Documents Found^^^^^^^^^^^%^0';
78var
79 i: Integer;
80 x, x1, x2, x3, MyParent, MyTitle, MyLocation, MySubject: string;
81 AList, SrcList: TStringList;
82begin
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;
194end;
195
196procedure BuildDocumentTree(DocList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode;
197 TIUContext: TTIUContext; TabIndex: integer);
198var
199 MyID, MyParent, Name: string;
200 i: Integer;
201 ChildNode, tmpNode: TORTreeNode;
202 DocHasChildren: Boolean;
203 AnObject: PDocTreeObject;
204begin
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;
241end;
242
243procedure SetTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TTIUContext; TabIndex: integer);
244var
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
272begin
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;
361end;
362
363procedure TraverseTree(ATree: TTreeView; AListView: TListView; ANode: TTreeNode; MyNodeID: string; AContext: TTIUContext);
364var
365 IncludeIt: Boolean;
366 x: string;
367begin
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);
403end;
404
405function ContextMatch(ANode: TORTreeNode; AParentID: string; AContext: TTIUContext): Boolean;
406var
407 Status: string;
408 Author: int64;
409begin
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;
450end;
451
452function TextFound(ANode: TORTreeNode; CurrentContext: TTIUContext): Boolean;
453var
454 MySearch: string;
455begin
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));
466end;
467
468procedure ResetDocTreeObjectStrings(AnObject: PDocTreeObject);
469begin
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;
487end;
488
489procedure KillDocTreeObjects(TreeView: TORTreeView);
490var
491 i: integer;
492begin
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;
503end;
504
505procedure KillDocTreeNode(ANode: TTreeNode);
506begin
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);
514end;
515
516procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TTIUContext);
517var
518 n: integer;
519begin
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;
529end;
530
531procedure AddListViewItem(ANode: TTreeNode; AListView: TListView);
532var
533 ListItem: TListItem;
534begin
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;
555end;
556
557function MakeNoteTreeObject(x: string): PDocTreeObject;
558var
559 AnObject: PDocTreeObject;
560begin
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;
583end;
584
585function MakeDCSummTreeObject(x: string): PDocTreeObject;
586var
587 AnObject: PDocTreeObject;
588begin
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;
612end;
613
614function MakeConsultsNoteTreeObject(x: string): PDocTreeObject;
615var
616 AnObject: PDocTreeObject;
617begin
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;
641end;
642
643
644end.
Note: See TracBrowser for help on using the repository browser.