Module

uReports

Path

C:\CPRS\CPRS30\uReports.pas

Last Modified

7/15/2014 3:26:44 PM

Classes

Name Comments
TCellObject Data Object for each Cell in ListView
TLabRowObject List of Row objects for Labs Tab ListView
TRowObject List of Row objects for ReportsTab ListView

Procedures

Name Owner Declaration Scope Comments
Add TCellObject procedure Add(ASite, AHandle, AColumnData: string; AData: TStringList); Public -
Add TLabRowObject procedure Add(ASite, AHandle, AColumnData: string; AData: TStringList); Public -
Add TRowObject procedure Add(ASite, AHandle, AColumnData: string; AData: TStringList); Public -
Clear TLabRowObject procedure Clear; Public -
Clear TRowObject procedure Clear; Public -
ReportTextFontChange - procedure ReportTextFontChange(Self, Sender: TObject); Interfaced Procedures & functions for Report Fonts

Functions

Name Owner Declaration Scope Comments
CreateReportTextComponent - function CreateReportTextComponent(ParentForm: TForm): TRichEdit; Interfaced CQ#70295
IsValidNumber - function IsValidNumber(S: string; var V: extended): boolean; Interfaced -
MakePrntProcTreeObject - function MakePrntProcTreeObject(x: string): PProcTreeObj; Interfaced -
MakeProcedureTreeObject - function MakeProcedureTreeObject(x: string): PProcTreeObj; Interfaced -
MakeReportTreeObject - function MakeReportTreeObject(x: string): PReportTreeObject; Interfaced Procedures & functions for Report Tree & ListView objects
ShortDateStrToDate - function ShortDateStrToDate(shortdate: string): string ; Interfaced Converts date in format 'mmm dd,yy' or 'mmm dd,yyyy' to standard 'mm/dd/yy'
StringToFMDateTime - function StringToFMDateTime(Str: string): TFMDateTime; Interfaced -
StripSpace - function StripSpace(str:string):string; Interfaced -

Global Variables

Name Type Declaration Comments
LabRowObjects TLabRowObject LabRowObjects: TLabRowObject; -
RowObjects TRowObject RowObjects: TRowObject; -

Constants

Name Declaration Scope Comments
Months array[1..12] of string[3] = ('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC') Global -


Module Source

1     unit uReports;
2     
3     interface
4     
5     uses sysutils, classes, ORFN, ComCtrls, Forms, Graphics;
6     
7     type
8     
9     TCellObject = class          //Data Object for each Cell in ListView
10      private
11        FName     : string;      //Column Name
12        FSite     : string;      //Site (#;name)
13        FInclude  : string;      //Set if data is to be included in detailed report
14        FTextType : string;      //Type of data (WP)
15        FVisible  : string;      //Set if column property is visible
16        FHandle   : string;      //Row:Col identifier
17        FDataType : string;      //Data Type of data in column (null or 0:freetext, 1:integer, 2:datetime)
18        FData     : TStringList; //Data for this field (could be WP)
19        FCount    : integer;
20    
21      public
22        constructor Create;
23        destructor Destroy; override;
24        procedure Add(ASite, AHandle, AColumnData: string; AData: TStringList);
25        property Name       :string read FName write FName;
26        property Site       :string read FSite write FSite;
27        property Include    :string read FInclude write FInclude;
28        property TextType   :string read FTextType write FTextType;
29        property Visible    :string read FVisible write FVisible;
30        property Handle     :string read FHandle write FHandle;
31        property DataType   :string read FDataType write FDatatype;
32        property Data       :TStringList read FData write FData;
33        property Count      :integer read FCount write FCount;
34      end;
35    
36    TRowObject = class           //List of Row objects for ReportsTab ListView
37      private
38        FCount     :integer;
39        FColumnList:TList;
40      public
41        constructor Create;
42        destructor  Destroy; override;
43        procedure   Add(ASite, AHandle, AColumnData: string; AData: TStringList);
44        procedure   Clear;
45        property    Count           :integer     read FCount;
46        property    ColumnList      :TList       read FColumnList;
47      end;
48    
49    TLabRowObject = class           //List of Row objects for Labs Tab ListView
50      private
51        FCount     :integer;
52        FColumnList:TList;
53      public
54        constructor Create;
55        destructor  Destroy; override;
56        procedure   Add(ASite, AHandle, AColumnData: string; AData: TStringList);
57        procedure   Clear;
58        property    Count           :integer     read FCount;
59        property    ColumnList      :TList       read FColumnList;
60      end;
61    
62    type
63      PReportTreeObject = ^TReportTreeObject;
64      TReportTreeObject = Record
65        ID         : String;         //Report ID           ID:Text => when passed to broker add: ;Remote~uHState
66        Heading    : String;         //Report Heading
67        Qualifier  : String;         //Report Qualifier
68        Remote     : String;         //Remote Data Capable
69        RptType    : String;         //Report Type
70        Category   : String;         //Report Category
71        RPCName    : String;         //Associated RPC
72        IFN        : String;         //IFN of report in file 101.24
73        HSTAG      : String;         //Report extract      tag;routine;component #
74        SortOrder  : String;         //#:# of columns to use in a multi-column sort
75        MaxDaysBack: String;         //Maximum number of Days allowed for report
76        Direct     : String;         //Direct Remote Call flag
77        HDR        : String;         //HDR is data source if = 1
78        FHIE       : String;         //FHIE is data source if = 1
79        FHIEONLY   : String;         //FHIEONLY if data is to only include FHIE
80    end;
81    
82    type
83      PProcTreeObj = ^TProcedureTreeObject;
84      TProcedureTreeObject = Record
85        ParentName   : String;      //Parent procedure name for exam/print sets
86        ProcedureName: String;      //Same as ParentName for stand-alone procedures
87        MemberOfSet  : String;      //1 = descendant procedures have individual reports
88                                    //2 = descendant procedures have one shared report
89        ExamDtTm   : String;        //Exam Date Time
90        Associate  : Integer;       //Index of the associated TListItem in the lvReports
91    end;
92    
93    var
94      RowObjects: TRowObject;
95      LabRowObjects: TLabRowObject;
96    
97    //procedures & functions for Report Tree & ListView objects
98    
99    function MakeReportTreeObject(x: string): PReportTreeObject;
100   function IsValidNumber(S: string; var V: extended): boolean;
101   function StringToFMDateTime(Str: string): TFMDateTime;
102   function ShortDateStrToDate(shortdate: string): string ;
103   function StripSpace(str:string):string;
104   function MakeProcedureTreeObject(x: string): PProcTreeObj;
105   function MakePrntProcTreeObject(x: string): PProcTreeObj;
106   
107   //procedures & functions for Report Fonts
108   
109   procedure ReportTextFontChange(Self, Sender: TObject);
110   function CreateReportTextComponent(ParentForm: TForm): TRichEdit;
111   
112   
113   implementation
114   
115   const
116     Months: array[1..12] of string[3] = ('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC');
117   
118   constructor TCellObject.Create;
119   
120   begin
121     FData := TStringList.Create;
122   end;
123   
124   destructor TCellObject.Destroy;
125   begin
126     FData.Free;
127   end;
128   
129   procedure TCellObject.Add(ASite, AHandle, AColumnData: string; AData: TStringList);
130   
131   begin
132     FName := piece(AColumnData,'^',1);
133     FSite := ASite;
134     FInclude := piece(AColumnData,'^',5);
135     FTextType := piece(AColumnData,'^',4);
136     FVisible := piece(AColumnData,'^',2);
137     FDataType := piece(AColumnData,'^',9);
138     FHandle := AHandle;
139     FCount := AData.Count;
140     FastAssign(AData, FData);
141   end;
142   
143   function MakeReportTreeObject(x: string): PReportTreeObject;
144   var
145     AnObject: PReportTreeObject;
146   begin
147     //x=id^Name^Qualifier^HSTag;Routine^Entry^Routine^Remote^Type^Category^RPC^ifn^SortOrder^MaxDaysBack^Direct^HDR^FHIE
148     New(AnObject);
149     with AnObject^ do
150       begin
151         ID              := UpperCase(Piece(x, U, 1)) + ':' + UpperCase(Piece(x, U, 2));
152         Heading         := Piece(x, U, 2);
153         Qualifier       := Piece(x, U, 3);
154         Remote          := Piece(x, U, 7);
155         RptType         := Piece(x, U, 8);
156         Category        := Piece(x, U, 9);
157         RPCName         := UpperCase(Piece(x, U, 10));
158         IFN             := Piece(x, U, 11);
159         HSTag           := UpperCase(Piece(x, U, 4));
160         SortOrder       := Piece(x, U, 12);
161         MaxDaysBack     := Piece(x, U, 13);
162         Direct          := Piece(x, U, 14);
163         HDR             := Piece(x, U, 15);
164         FHIE            := Piece(x, U, 16);
165         FHIEONLY        := Piece(x, U, 17);
166       end;
167     Result := AnObject;
168   end;
169   
170   constructor TRowObject.Create;
171   begin
172     FColumnList := TList.Create;
173     FCount := 0;
174   end;
175   
176   destructor TRowObject.Destroy;
177   begin
178     //Clear;
179     FColumnList.Free;
180     inherited Destroy;
181   end;
182   
183   procedure TRowObject.Add(ASite, AHandle, AColumnData: string; AData: TStringList);
184   var
185     ACell: TCellObject;
186   begin
187     ACell := TCellObject.Create;
188     ACell.Add(ASite,AHandle,AColumnData,AData);
189     FColumnList.Add(ACell);
190     FCount := FColumnList.Count;
191   end;
192   
193   procedure TRowObject.Clear;
194   var
195     i: Integer;
196   begin
197     with FColumnList do
198       for i := 0 to Count - 1 do
199         with TCellObject(Items[i]) do Free;
200     FColumnList.Clear;
201     FCount := 0;
202   end;
203   
204   constructor TLabRowObject.Create;
205   begin
206     FColumnList := TList.Create;
207     FCount := 0;
208   end;
209   
210   destructor TLabRowObject.Destroy;
211   begin
212     //Clear;
213     FColumnList.Free;
214     inherited Destroy;
215   end;
216   
217   procedure TLabRowObject.Add(ASite, AHandle, AColumnData: string; AData: TStringList);
218   var
219     ACell: TCellObject;
220   begin
221     ACell := TCellObject.Create;
222     ACell.Add(ASite,AHandle,AColumnData,AData);
223     FColumnList.Add(ACell);
224     FCount := FColumnList.Count;
225   end;
226   
227   procedure TLabRowObject.Clear;
228   var
229     i: Integer;
230   begin
231     with FColumnList do
232       for i := 0 to Count - 1 do
233         with TCellObject(Items[i]) do Free;
234     FColumnList.Clear;
235     FCount := 0;
236   end;
237   
238   function IsValidNumber(S: string; var V: extended): boolean;
239   var
240     NumCode: integer;
241     FirstSpace: integer;
242   begin
243     FirstSpace := Pos(' ', S);
244     if FirstSpace > 0 then
245       S := Copy(S, 1, FirstSpace - 1);
246     Val(S, V, NumCode);
247     Result := (NumCode = 0);
248     if not Result then
249     begin
250         // Remove thousands seperators
251       S := StringReplace(S, ThousandSeparator, '', [rfReplaceAll]);
252         // change DecimalSeperator to '.' because Val only recognizes that, not
253         // the locale specific decimal char... then try again.  Stupid Val.
254       S := StringReplace(S, DecimalSeparator, '.', [rfReplaceAll]);
255       Val(S, V, NumCode);
256       Result := (NumCode = 0);
257     end;
258   end;
259   
260   function StringToFMDateTime(Str: string): TFMDateTime;
261   var
262     mm,dd,yy,hh: integer;
263     day,time,hr,min: string;
264   begin
265     day := piece(str,' ',1);
266     time := piece(str,' ',2);
267     hh := 0;
268     if length(time) > 0 then
269       begin
270         hr := piece(time,':',1);
271         if Copy(hr,1,1) = '0' then hr := Copy(hr,2,1);
272         if Copy(hr,1,1) = '0' then hr := '';
273         min := piece(time,':',2);
274         if Copy(min,1,1) = '0' then min := Copy(min,2,1);
275         if Copy(min,1,1) = '0' then min := '';
276         hh := StrToIntDef(hr + min,0);
277       end;
278     mm := StrToIntDef(piece(day,'/',1),0);
279     dd := StrToIntDef(piece(day,'/',2),0);
280     yy := StrToIntDef(piece(day,'/',3),0) - 1700;
281     Result := (yy * 10000) + (mm * 100) + dd + (hh/10000);
282   end;
283   
284   function ShortDateStrToDate(shortdate: string): string ;
285   {Converts date in format 'mmm dd,yy' or 'mmm dd,yyyy' to standard 'mm/dd/yy'}
286   var
287     month,day,year: string ;
288     i: integer ;
289   begin
290     result := 'ERROR' ;
291     if (Pos(' ',shortdate) <> 4) or ((Pos(',',shortdate) <> 7) and (Pos(',',shortdate) <> 6)) then exit ;  {no spaces or comma}
292     for i := 1 to 12 do
293       if Months[i] = UpperCase(Copy(shortdate,1,3)) then month := IntToStr(i);
294     if month = '' then exit ;    {invalid month name}
295     if length(month) = 1 then month := '0' + month;
296     if Pos(',',shortdate) = 7 then
297       begin
298         day  := IntToStr(StrToInt(Copy(shortdate,5,2))) ;
299         year := IntToStr(StrToInt(Copy(shortdate,8,99))) ;
300       end;
301     if Pos(',',shortdate) = 6 then
302       begin
303         day  := '0' + IntToStr(StrToInt(Copy(shortdate,5,1))) ;
304         year := IntToStr(StrToInt(Copy(shortdate,7,99))) ;
305       end;
306     result := month+'/'+day+'/'+year ;
307   end ;
308   
309   function StripSpace(str: string): string;
310   var
311     i,j: integer;
312   begin
313     i := 1;
314     j := length(str);
315     while str[i] = #32 do inc(i);
316     while str[j] = #32 do dec(j);
317     result := copy(str, i, j-i+1);
318   end;
319   
320   function MakeProcedureTreeObject(x: string): PProcTreeObj;
321   var
322     AnObject: PProcTreeObj;
323   begin
324     New(AnObject);
325     with AnObject^ do
326       begin
327         ParentName := Piece(x, U, 11);
328         ProcedureName := Piece(x, U, 4);
329         MemberOfSet := Piece(x, U, 10);
330         ExamDtTm := Piece(x, U, 2);
331         Associate := -1;
332       end;
333     Result := AnObject;
334   end;
335   
336   function MakePrntProcTreeObject(x: string): PProcTreeObj;
337   var
338     AnObject: PProcTreeObj;
339   begin
340     New(AnObject);
341     with AnObject^ do
342       begin
343         ParentName := Piece(x, U, 11);
344         ExamDtTm := Piece(x, U, 2);
345         Associate := -1;
346       end;
347     Result := AnObject;
348   end;
349   
350   procedure ReportTextFontChange(Self, Sender: TObject);
351   begin
352     TFont(Sender).Size := 8;
353   end;
354   
355   // CQ#70295
356   function CreateReportTextComponent(ParentForm: TForm): TRichEdit;
357   var
358     m: TMethod;
359   begin
360     Result := TRichEdit.Create(ParentForm);
361     with Result do
362     begin
363       Parent := ParentForm;
364       Visible := False;
365       Width := 600;
366       Font.Name := 'Courier New';
367       Font.Size := 8;
368       m.Code := @ReportTextFontChange;
369       m.Data := ParentForm;
370       Font.OnChange := TNotifyEvent(m);
371     end;
372   end;
373   
374   end.

Module Calls (2 levels)

-

Module Called-By (2 levels)


                   uReports
                  fRptBox┤ 
                uOrders┤ │ 
                 fFrame┤ │ 
                fOrders┤ │ 
               fDrawers┤ │ 
        fTemplateDialog┤ │ 
             uReminders┤ │ 
                fVitals┤ │ 
                 fCover┤ │ 
                 fPtSel┤ │ 
            fOrdersSign┤ │ 
                  fMeds┤ │ 
              fAllgyBox┤ │ 
              fARTAllgy┤ │ 
                 fNotes┤ │ 
                 fProbs┤ │ 
                fGraphs┤ │ 
         fGraphProfiles┤ │ 
              fConsults┤ │ 
          fTemplateView┤ │ 
        fReminderDialog┤ │ 
                  fLabs┤ │ 
                fPtCWAD┤ │ 
                fReview┤ │ 
      fPatientFlagMulti┤ │ 
             fNoteProps┤ │ 
               fNotesBP┤ │ 
              fEditProc┤ │ 
           fEditConsult┤ │ 
           fConsMedRslt┤ │ 
                 fODLab┤ │ 
                fODMeds┤ │ 
         fOrdersRelease┤ │ 
              fODMedNVA┤ │ 
         fOrdersOnChart┤ │ 
        fODReleaseEvent┤ │ 
               uOptions┘ │ 
           fConsult513Prt┤ 
           fConsults...┘ │ 
                 rReports┤ 
              fFrame...┤ │ 
             fVitals...┤ │ 
             fRptBox...┤ │ 
      fConsult513Prt...┤ │ 
               fReports┤ │ 
          fReportsPrint┤ │ 
fReportsAdhocComponent1┤ │ 
  fReportsAdhocSubItem1┤ │ 
          fDeviceSelect┤ │ 
               fLabs...┤ │ 
              fLabPrint┤ │ 
                fPtDemo┤ │ 
               fNotePrt┤ │ 
                fPreReq┘ │ 
              fReports...┤ 
         fReportsPrint...┤ 
                 fLabs...┤ 
             fLabPrint...┤ 
               fPtDemo...┤ 
              fNotePrt...┤ 
               fPreReq...┘