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.
|
---|