source: cprs/branches/tmg-cprs/CPRS-Chart/uCaseTree.pas@ 1430

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

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