Module

uCaseTree

Path

C:\CPRS\CPRS30\uCaseTree.pas

Last Modified

7/15/2014 3:26:44 PM

Units Used in Interface

Name Comments
rCore -
rSurgery -
uConst -
uCore -
uSurgery -

Procedures

Name Owner Declaration Scope Comments
BuildCaseTree - procedure BuildCaseTree(CaseList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode; CaseContext: TSurgCaseContext); Interfaced -
CreateListItemsForCaseTree - procedure CreateListItemsForCaseTree(Dest, Source: TStrings; Context: integer; GroupBy: string; Ascending: boolean); Interfaced
Procedures for document treeviews/listviews
==============================================================
RPC [SURGERY CASES BY CONTEXT] returns
the following string '^' pieces:
===============================================================
CASE #^Operative Procedure^Date/Time of Operation^Surgeon^^^^^^^^^+^Context         ***NEEDS TO BE FIXED***
IEN 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
IEN 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
IEN 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
IEN Addendum^TITLE^REF DATE/TIME^PT ID^AUTHOR^HOSP LOC^STATUS^Vis DT^Disch DT^CASE;SRF(^# Assoc Images^Subject^^IEN of Parent Document*)

===============================================================
KillCaseTreeNode - procedure KillCaseTreeNode(ANode: TTreeNode); Interfaced -
KillCaseTreeObjects - procedure KillCaseTreeObjects(TreeView: TORTreeView); Interfaced -
RemoveParentsWithNoChildren - procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TSurgCaseContext); Interfaced -
ResetCaseTreeObjectStrings - procedure ResetCaseTreeObjectStrings(AnObject: PCaseTreeObject); Interfaced -
SetCaseTreeNodeImagesAndFormatting - procedure SetCaseTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TSurgCaseContext); Interfaced
IMG_SURG_BLANK             = 0;
    IMG_SURG_TOP_LEVEL         = 1;
    IMG_SURG_GROUP_SHUT        = 2;
    IMG_SURG_GROUP_OPEN        = 3;
    IMG_SURG_CASE_EMPTY        = 4;
    IMG_SURG_CASE_SHUT         = 5;
    IMG_SURG_CASE_OPEN         = 6;
    IMG_SURG_RPT_SINGLE        = 7;
    IMG_SURG_RPT_ADDM          = 8;
    IMG_SURG_ADDENDUM          = 9;
    IMG_SURG_NON_OR_CASE_EMPTY = 10;
    IMG_SURG_NON_OR_CASE_SHUT  = 11;
    IMG_SURG_NON_OR_CASE_OPEN  = 12;
SetImageFlag - procedure SetImageFlag(ANode: TORTreeNode); Interfaced -

Functions

Name Owner Declaration Scope Comments
MakeCaseTreeObject - function MakeCaseTreeObject(x: string): PCaseTreeObject; Interfaced -


Module Source

1     unit uCaseTree;
2     
3     interface
4     
5     uses SysUtils, Classes, ORNet, ORFn, rCore, uCore, uConst, ORCtrls, ComCtrls, uSurgery, rSurgery;
6     
7     
8     type
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
39    procedure CreateListItemsForCaseTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
40              Ascending: boolean);
41    procedure BuildCaseTree(CaseList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode;
42              CaseContext: TSurgCaseContext);
43    procedure SetCaseTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TSurgCaseContext);
44    procedure SetImageFlag(ANode: TORTreeNode);
45    procedure ResetCaseTreeObjectStrings(AnObject: PCaseTreeObject);
46    procedure KillCaseTreeObjects(TreeView: TORTreeView);
47    procedure KillCaseTreeNode(ANode: TTreeNode);
48    procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TSurgCaseContext);
49    function  MakeCaseTreeObject(x: string): PCaseTreeObject;
50    
51    implementation
52    
53    (*uses
54      fRptBox;*)
55    
56    {==============================================================
57    RPC [SURGERY CASES BY CONTEXT] returns
58    the following string '^' pieces:
59    ===============================================================
60    CASE #^Operative Procedure^Date/Time of Operation^Surgeon^^^^^^^^^+^Context         ***NEEDS TO BE FIXED***
61    IEN 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
62    IEN 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
63    IEN 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
64    IEN 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    
68    procedure CreateListItemsForCaseTree(Dest, Source: TStrings; Context: integer; GroupBy: string;
69              Ascending: Boolean);
70    const
71      NO_MATCHES = '^No Surgery Cases Found^^^^^^^^^^^%^0';
72    var
73      i: Integer;
74      x, x1, x2, x3, MyParent, MyType: string;
75      AList, SrcList: TStringList;
76    begin
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;
161   end;
162   
163   procedure BuildCaseTree(CaseList: TStrings; const Parent: string; Tree: TORTreeView; Node: TORTreeNode;
164             CaseContext: TSurgCaseContext);
165   var
166     MyID, MyParent, Name: string;
167     i: Integer;
168     ChildNode, tmpNode: TORTreeNode;
169     CaseHasChildren: Boolean;
170     AnObject: PCaseTreeObject;
171   begin
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;
200   end;
201   
202   procedure SetCaseTreeNodeImagesAndFormatting(Node: TORTreeNode; CurrentContext: TSurgCaseContext);
203   var
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   *)
220   begin
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;
280   end;
281   
282   procedure SetImageFlag(ANode: TORTreeNode);
283   begin
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;
313   end;
314   
315   procedure ResetCaseTreeObjectStrings(AnObject: PCaseTreeObject);
316   begin
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;
338   end;
339   
340   procedure KillCaseTreeObjects(TreeView: TORTreeView);
341   var
342     i: integer;
343   begin
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;
354   end;
355   
356   procedure KillCaseTreeNode(ANode: TTreeNode);
357   begin
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);
365   end;
366   
367   procedure RemoveParentsWithNoChildren(Tree: TTreeView; Context: TSurgCaseContext);
368   var
369     n: integer;
370   begin
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;
378   end;
379   
380   
381   function MakeCaseTreeObject(x: string): PCaseTreeObject;
382   var
383     AnObject: PCaseTreeObject;
384   begin
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;
425   end;
426   
427   
428   end.

Module Calls (2 levels)


uCaseTree
 ├uConst
 ├uSurgery
 └rSurgery
   ├rCore
   ├uCore
   └uSurgery

Module Called-By (2 levels)


  uCaseTree
 fSurgery┘ 
 fFrame┤   
fReview┘