close Warning: Can't use blame annotator: 
svn blame failed on cprs/trunk/CPRS-Chart/uCaseTree.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: cprs/trunk/CPRS-Chart/uCaseTree.pas@ 1464

Last change on this file since 1464 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27
File size: 16.7 KB
RevLine 
1unit uCaseTree;
2
3interface
4
5uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, uConst, ORCtrls, ComCtrls, uSurgery, rSurgery;
6
7
8type
9 PCaseTreeObject = ^TCaseTreeObject;
10 TCaseTreeObject = record
11 // used for both types of node
12 CaseID : string;
13 NodeText : string; //Title, Location, Author (depends on node type)
14 ImageCount : integer; //Number of images
15 DocHasChildren : string; //Has children (+)
16 DocParent : string; //Parent document, or context
17 // used for Case nodes only
18 OperativeProc : string;
19 IsNonORProc : boolean;
20 SurgeryDate : string;
21 Surgeon : string;
22 // used for document nodes only
23 DocID : string ; //Document IEN
24 DocDate : string; //Formatted date of document
25 DocTitle : string; //Document Title Text
26 VisitDate : string; //ADM/VIS: date;FMDate
27 DocFMDate : string; //FM date of document
28 Author : string; //DUZ;Author name
29 PkgRef : string; //IEN;Package
30 Location : string; //Location name
31 Status : string; //Status
32 Subject : string; //Subject
33 // not currently used
34 OrderID : string; //Order file IEN (consults only, for now)
35 OrderByTitle : boolean; //Within cases, order docs by title, not date
36 end;
37
38// Procedures for document treeviews/listviews
39procedure CreateListItemsForCaseTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
40 Ascending: boolean);
41procedure BuildCaseTree(CaseList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode;
42 CaseContext: TSurgCaseContext);
43procedure SetCaseTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TSurgCaseContext);
44procedure SetImageFlag(ANode: TORTreeNode);
45procedure ResetCaseTreeObjectStrings(AnObject: PCaseTreeObject);
46procedure KillCaseTreeObjects(TreeView: TORTreeView);
47procedure KillCaseTreeNode(ANode: TTreeNode);
48procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TSurgCaseContext);
49function MakeCaseTreeObject(x: string): PCaseTreeObject;
50
51implementation
52
53(*uses
54 fRptBox;*)
55
56{==============================================================
57RPC [SURGERY CASES BY CONTEXT] returns
58the following string '^' pieces:
59===============================================================
60CASE #^Operative Procedure^Date/Time of Operation^Surgeon^^^^^^^^^+^Context ***NEEDS TO BE FIXED***
61IEN NIR^TITLE^REF DATE/TIME^PT ID^AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
62IEN AR^TITLE^REF DATE/TIME^PT ID^AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
63IEN OS^TITLE^REF DATE/TIME^PT ID^AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
64IEN Addendum^TITLE^REF DATE/TIME^PT ID^AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^^IEN of Parent Document*)
65
66===============================================================}
67
68procedure CreateListItemsForCaseTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
69 Ascending: Boolean);
70const
71 NO_MATCHES = '^No Surgery Cases Found^^^^^^^^^^^%^0';
72var
73 i: Integer;
74 x, x1, x2, x3, MyParent, MyType: string;
75 AList, SrcList: TStringList;
76begin
77 AList := TStringList.Create;
78 SrcList := TStringList.Create;
79 try
80 //ReportBox(Source, '', True);
81 FastAssign(Source, SrcList);
82 with SrcList do
83 begin
84 if (Count = 1) and (Piece(SrcList[0], U, 1) = '-1') then
85 begin
86 Dest.Insert(0, IntToStr(Context) + NO_MATCHES);
87 Exit;
88 end;
89 for i := 0 to Count - 1 do
90 begin
91 x := Strings[i];
92 if Piece(x, U, 10) <> '' then // if item is a note, and is missing information
93 begin
94 if Piece(x, U, 2) = '' then
95 SetPiece(x, U, 2, '** No title **');
96 if Piece(x, U, 6) = '' then
97 SetPiece(x, U, 6, '** No location **');
98 if Piece(Piece(x, U, 5), ';', 3) = '' then
99 SetPiece(x, U, 5, '0;** No Author **;** No Author **');
100 end;
101 MyParent := Piece(x, U, 14);
102 if GroupBy <> '' then case GroupBy[1] of
103 'D': begin
104 x2 := Piece(x, U, 3); // Proc date (FM)
105 if x2 = '' then
106 begin
107 x2 := '** No Date **';
108 x1 := '** No Date **';
109 end
110 else
111 x1 := FormatFMDateTime('mmm dd,yyyy', StrToFloat(x2)); // Proc date
112 if MyParent = IntToStr(Context) then
113 SetPiece(x, U, 14, MyParent + x2);
114 x3 := x2 + U + MixedCase(x1) + U + IntToStr(Context);
115 if (AList.IndexOf(x3) = -1) then AList.Add(x3);
116 end;
117 'P': begin
118 x1 := Piece(x, U, 2);
119 if x1 = '' then x1 := '** No Procedure **';
120 if MyParent = IntToStr(Context) then
121 SetPiece(x, U, 14, MyParent + x1);
122 x3 := x1 + U + MixedCase(x1) + U + IntToStr(Context);
123 if (AList.IndexOf(x3) = -1) then AList.Add(x3);
124 end;
125 'S': begin
126 x1 := Piece(Piece(x, U, 4), ';', 2);
127 if x1 = '' then x1 := '** No Surgeon **';
128 if MyParent = IntToStr(Context) then
129 SetPiece(x, U, 14, MyParent + x1);
130 x3 := x1 + U + MixedCase(x1) + U + IntToStr(Context);
131 if (AList.IndexOf(x3) = -1) then AList.Add(x3);
132 end;
133 'T': begin
134 if MyParent = IntToStr(Context) then
135 begin
136 if Piece(x, U, 6) = '1' then
137 MyType := 'Non-OR Procedures'
138 else
139 MyType := 'Operations';
140 SetPiece(x, U, 14, MyParent + MyType);
141 x3 := MyType + U + MyType + U + IntToStr(Context);
142 if (AList.IndexOf(x3) = -1) then AList.Add(x3);
143 end;
144 end;
145 end;
146 Dest.Add(x);
147 end; {for}
148 SortByPiece(TStringList(Dest), U, 3);
149 if not Ascending then InvertStringList(TStringList(Dest));
150 Dest.Insert(0, IntToStr(Context) + '^' + SG_TV_TEXT + '^^^^^^^^^^^%^0');
151 Alist.Sort;
152 if Ascending or (CharAt(GroupBy, 1) = 'T') then InvertStringList(AList); // operations before non-OR procs
153 for i := 0 to AList.Count-1 do
154 Dest.Insert(0, IntToStr(Context) + Piece(AList[i], U, 1) + '^' + Piece(AList[i], U, 2) + '^^^^^^^^^^^%^' + Piece(AList[i], U, 3));
155 end;
156 //ReportBox(Dest, '', True);
157 finally
158 AList.Free;
159 SrcList.Free;
160 end;
161end;
162
163procedure BuildCaseTree(CaseList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode;
164 CaseContext: TSurgCaseContext);
165var
166 MyID, MyParent, Name: string;
167 i: Integer;
168 ChildNode, tmpNode: TORTreeNode;
169 CaseHasChildren: Boolean;
170 AnObject: PCaseTreeObject;
171begin
172 with CaseList do for i := 0 to Count - 1 do
173 begin
174 tmpNode := nil;
175 MyParent := Piece(Strings[i], U, 14);
176 if (MyParent = Parent) then
177 begin
178 MyID := Piece(Strings[i], U, 1);
179 if Piece(Strings[i], U, 13) = '%' then
180 Name := Piece(Strings[i], U, 2)
181 else if Piece(Strings[i], U, 10) = '' then
182 Name := MakeSurgeryCaseDisplayText(Strings[i])
183 else
184 Name := MakeSurgeryReportDisplayText(Strings[i]);
185 CaseHasChildren := (Piece(Strings[i], U, 13) <> '');
186 if Node <> nil then if Node.HasChildren then
187 tmpNode := Tree.FindPieceNode(MyID, 1, U, Node);
188 if (tmpNode <> nil) and tmpNode.HasAsParent(Node) then
189 Continue
190 else
191 begin
192 AnObject := MakeCaseTreeObject(Strings[i]);
193 ChildNode := TORTreeNode(Tree.Items.AddChildObject(TORTreeNode(Node), Name, AnObject));
194 ChildNode.StringData := Strings[i];
195 SetCaseTreeNodeImagesAndFormatting(ChildNode, CaseContext);
196 if CaseHasChildren then BuildCaseTree(CaseList, MyID, Tree, ChildNode, CaseContext);
197 end;
198 end;
199 end;
200end;
201
202procedure SetCaseTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TSurgCaseContext);
203var
204 CaseNode: TORTreeNode;
205 i: integer;
206(* IMG_SURG_BLANK = 0;
207 IMG_SURG_TOP_LEVEL = 1;
208 IMG_SURG_GROUP_SHUT = 2;
209 IMG_SURG_GROUP_OPEN = 3;
210 IMG_SURG_CASE_EMPTY = 4;
211 IMG_SURG_CASE_SHUT = 5;
212 IMG_SURG_CASE_OPEN = 6;
213 IMG_SURG_RPT_SINGLE = 7;
214 IMG_SURG_RPT_ADDM = 8;
215 IMG_SURG_ADDENDUM = 9;
216 IMG_SURG_NON_OR_CASE_EMPTY = 10;
217 IMG_SURG_NON_OR_CASE_SHUT = 11;
218 IMG_SURG_NON_OR_CASE_OPEN = 12;
219*)
220begin
221 with Node, PCaseTreeObject(Node.Data)^ do
222 begin
223 i := Pos('*', DocTitle);
224 if i > 0 then i := i + 1 else i := 0;
225 if (Copy(DocTitle, i + 1, 8) = 'Addendum') then
226 ImageIndex := IMG_SURG_ADDENDUM
227 else if (DocHasChildren = '') then
228 begin
229 if PkgRef = '' then
230 begin
231 if IsNonORProc then
232 ImageIndex := IMG_SURG_NON_OR_CASE_EMPTY
233 else
234 ImageIndex := IMG_SURG_CASE_EMPTY;
235 end
236 else
237 ImageIndex := IMG_SURG_RPT_SINGLE;
238 end
239 else if DocParent = '0' then
240 begin
241 ImageIndex := IMG_SURG_TOP_LEVEL;
242 SelectedIndex := IMG_SURG_TOP_LEVEL;
243 StateIndex := -1;
244 with CurrentContext, Node do
245 if GroupBy <> '' then
246 case GroupBy[1] of
247 'P': Text := SG_TV_TEXT + ' by Procedure';
248 'D': Text := SG_TV_TEXT + ' by Surgery Date';
249 'S': Text := SG_TV_TEXT + ' by Surgeon';
250 'T': Text := SG_TV_TEXT + ' by Type';
251 end
252 else Text := SG_TV_TEXT;
253 end
254 else
255 case DocHasChildren[1] of
256 '+': if PkgRef <> '' then
257 ImageIndex := IMG_SURG_RPT_ADDM
258 else
259 begin
260 if IsNonORProc then
261 ImageIndex := IMG_SURG_NON_OR_CASE_SHUT
262 else
263 ImageIndex := IMG_SURG_CASE_SHUT;
264 end;
265 '%': begin
266 StateIndex := -1;
267 ImageIndex := IMG_SURG_GROUP_SHUT;
268 SelectedIndex := IMG_SURG_GROUP_OPEN;
269 end;
270 end;
271 SelectedIndex := ImageIndex;
272 SetImageFlag(Node);
273 CaseNode := TORTreeView(Node.TreeView).FindPieceNode(CaseID, 1, U, nil);
274 if CaseNode <> nil then
275 begin
276 PCaseTreeObject(CaseNode.Data)^.ImageCount := PCaseTreeObject(CaseNode.Data)^.ImageCount + ImageCount;
277 SetImageFlag(CaseNode);
278 end;
279 end;
280end;
281
282procedure SetImageFlag(ANode: TORTreeNode);
283begin
284 with ANode, PCaseTreeObject(ANode.Data)^ do
285 begin
286 if (ImageIndex in [IMG_SURG_TOP_LEVEL, IMG_SURG_GROUP_OPEN, IMG_SURG_GROUP_SHUT]) then
287 StateIndex := IMG_NO_IMAGES
288 else
289 begin
290 if ImageCount > 0 then
291 StateIndex := IMG_1_IMAGE
292 else if ImageCount = 0 then
293 StateIndex := IMG_NO_IMAGES
294 else if ImageCount = -1 then
295 StateIndex := IMG_IMAGES_HIDDEN;
296 end;
297(* else
298 case ImageCount of
299 0: StateIndex := IMG_NO_IMAGES;
300 1: StateIndex := IMG_1_IMAGE;
301 2: StateIndex := IMG_2_IMAGES;
302 else
303 StateIndex := IMG_MANY_IMAGES;
304 end;*)
305 if (Parent <> nil) and
306 (Parent.ImageIndex in [IMG_SURG_CASE_SHUT, IMG_SURG_CASE_OPEN, IMG_SURG_RPT_ADDM,
307 IMG_SURG_NON_OR_CASE_SHUT, IMG_SURG_NON_OR_CASE_OPEN ]) and
308 (StateIndex in [IMG_1_IMAGE, IMG_IMAGES_HIDDEN]) then
309 begin
310 Parent.StateIndex := IMG_CHILD_HAS_IMAGES;
311 end;
312 end;
313end;
314
315procedure ResetCaseTreeObjectStrings(AnObject: PCaseTreeObject);
316begin
317 with AnObject^ do
318 begin
319 CaseID := '';
320 OperativeProc := '';
321 SurgeryDate := '';
322 Surgeon := '';
323 DocID := '';
324 DocDate := '';
325 DocTitle := '';
326 NodeText := '';
327 VisitDate := '';
328 DocFMDate := '';
329 DocHasChildren := '';
330 DocParent := '';
331 Author := '';
332 PkgRef := '';
333 Location := '';
334 Status := '';
335 Subject := '';
336 OrderID := '';
337 end;
338end;
339
340procedure KillCaseTreeObjects(TreeView: TORTreeView);
341var
342 i: integer;
343begin
344 with TreeView do
345 for i := 0 to Items.Count-1 do
346 begin
347 if(Assigned(Items[i].Data)) then
348 begin
349 ResetCaseTreeObjectStrings(PCaseTreeObject(Items[i].Data));
350 Dispose(PCaseTreeObject(Items[i].Data));
351 Items[i].Data := nil;
352 end;
353 end;
354end;
355
356procedure KillCaseTreeNode(ANode: TTreeNode);
357begin
358 if(Assigned(ANode.Data)) then
359 begin
360 ResetCaseTreeObjectStrings(PCaseTreeObject(ANode.Data));
361 Dispose(PCaseTreeObject(ANode.Data));
362 ANode.Data := nil;
363 end;
364 ANode.Owner.Delete(ANode);
365end;
366
367procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TSurgCaseContext);
368var
369 n: integer;
370begin
371 with Tree do
372 for n := Items.Count - 1 downto 0 do
373 if (Items[n].ImageIndex in [IMG_SURG_GROUP_SHUT, IMG_SURG_GROUP_OPEN]) then
374 begin
375 if (not Items[n].HasChildren) then
376 KillCaseTreeNode(Items[n]);
377 end;
378end;
379
380
381function MakeCaseTreeObject(x: string): PCaseTreeObject;
382var
383 AnObject: PCaseTreeObject;
384begin
385 New(AnObject);
386 with AnObject^ do
387 begin
388 if Piece(x, U, 10) = '' then
389 //CASE #^Operative Procedure^Date/Time of Operation^Surgeon^^^^^^^^^+^Context
390 begin
391 CaseID := Piece(x, U, 1);
392 OperativeProc := Piece(x, U, 2);
393 SurgeryDate := Piece(x, U, 3);
394 Surgeon := Piece(x, U, 4);
395 IsNonORProc := Piece(x, U, 6) = '1';
396 DocHasChildren := Piece(x, U, 13);
397 DocParent := Piece(x, U, 14);
398 ImageCount := StrToIntDef(Piece(x, U, 11), 0);
399 NodeText := MakeSurgeryCaseDisplayText(x);
400 end
401 else
402 //IEN NIR^TITLE^REF DATE/TIME^PT ID^AUTHORDUZ;AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
403 //IEN AR^TITLE^REF DATE/TIME^PT ID^AUTHORDUZ;AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
404 //IEN OS^TITLE^REF DATE/TIME^PT ID^AUTHORDUZ;AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^+ (if has addenda)^IEN of Parent Document
405 //IEN Addendum^TITLE^REF DATE/TIME^PT ID^AUTHORDUZ;AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^^IEN of Parent Document
406 begin
407 DocID := Piece(x, U, 1);
408 DocTitle := Piece(x, U, 2);
409 DocFMDate := Piece(x, U, 3);
410 DocDate := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(x, U, 3)));
411 Author := Piece(x, U, 5);
412 Location := Piece(x, U, 6);
413 Status := Piece(x, U, 7);
414 VisitDate := Piece(x, U, 8);
415 PkgRef := Piece(x, U, 10);
416 CaseID := Piece(Piece(x, U, 10), ';', 1);
417 ImageCount := StrToIntDef(Piece(x, U, 11), 0);
418 Subject := Piece(x, U, 12);
419 DocHasChildren := Piece(x, U, 13);
420 DocParent := Piece(x, U, 14);
421 NodeText := MakeSurgeryReportDisplayText(x);
422 end;
423 end;
424 Result := AnObject;
425end;
426
427
428end.
Note: See TracBrowser for help on using the repository browser.