Module

fReports

Path

C:\CPRS\CPRS30\fReports.pas

Last Modified

7/15/2014 3:26:38 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmReports);

end.

Units Used in Interface

Name Comments
fBase508Form -
fHSplit -
rECS -
uConst -

Units Used in Implementation

Name Comments
dShared -
fFrame -
fGraphData -
fGraphs -
fReportsAdhocComponent1 -
fReportsPrint -
rCore -
rGraphs -
rReports -
uCore -
uReports -

Classes

Name Comments
TfrmReports -

Procedures

Name Owner Declaration Scope Comments
BlankWeb TfrmReports procedure BlankWeb; Private -
btnChangeViewClick TfrmReports procedure btnChangeViewClick(Sender: TObject); Public/Published -
btnGraphSelectionsClick TfrmReports procedure btnGraphSelectionsClick(Sender: TObject); Public/Published -
chkDualViewsClick TfrmReports procedure chkDualViewsClick(Sender: TObject); Public/Published -
chkMaxFreqClick TfrmReports procedure chkMaxFreqClick(Sender: TObject); Public/Published -
ClearPtData TfrmReports procedure ClearPtData; override; Public -
Copy1Click TfrmReports procedure Copy1Click(Sender: TObject); Public/Published -
Copy2Click TfrmReports procedure Copy2Click(Sender: TObject); Public/Published -
DisplayHeading TfrmReports procedure DisplayHeading(aRanges: string); Public/Published -
DisplayPage TfrmReports procedure DisplayPage; override; Public
OrigDateIEN: Int64;
  OrigDateItemID: Variant;
  OrigReportCat, OrigProcedure: TTreeNode;
FormCreate TfrmReports procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmReports procedure FormDestroy(Sender: TObject); Public/Published -
FormShow TfrmReports procedure FormShow(Sender: TObject); Public/Published -
FreezeText1Click TfrmReports procedure FreezeText1Click(Sender: TObject); Public/Published -
GoRemote TfrmReports procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string); Public/Published -
GotoBottom1Click TfrmReports procedure GotoBottom1Click(Sender: TObject); Public/Published -
GotoTop1Click TfrmReports procedure GotoTop1Click(Sender: TObject); Public/Published -
Graph TfrmReports procedure Graph(reportien: integer); Private -
GraphPanel TfrmReports procedure GraphPanel(active: boolean); Private -
LoadListView TfrmReports procedure LoadListView(aReportData: TStringList); Public/Published -
LoadProceduresTreeView TfrmReports procedure LoadProceduresTreeView(x: string; var CurrentParentNode: TTreeNode; var CurrentNode: TTreeNode); Public/Published -
LoadTreeView TfrmReports procedure LoadTreeView; Public/Published -
lstDateRangeClick TfrmReports procedure lstDateRangeClick(Sender: TObject); Public/Published -
lstHeadersClick TfrmReports procedure lstHeadersClick(Sender: TObject); Public/Published -
lstQualifierClick TfrmReports procedure lstQualifierClick(Sender: TObject); Public/Published -
lstQualifierDrawItem TfrmReports procedure lstQualifierDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
lvReportsColumnClick TfrmReports procedure lvReportsColumnClick(Sender: TObject; Column: TListColumn); Public/Published -
lvReportsCompare TfrmReports procedure lvReportsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); Public/Published -
lvReportsKeyUp TfrmReports procedure lvReportsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
lvReportsSelectItem TfrmReports procedure lvReportsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); Public/Published -
Memo1KeyUp TfrmReports procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
PopupMenu1Popup TfrmReports procedure PopupMenu1Popup(Sender: TObject); Public/Published -
Print1Click TfrmReports procedure Print1Click(Sender: TObject); Public/Published -
Print2Click TfrmReports procedure Print2Click(Sender: TObject); Public/Published -
ProcessNotifications TfrmReports procedure ProcessNotifications; Private -
RequestPrint TfrmReports procedure RequestPrint; override; Public -
SelectAll1Click TfrmReports procedure SelectAll1Click(Sender: TObject); Public/Published -
SelectAll2Click TfrmReports procedure SelectAll2Click(Sender: TObject); Public/Published -
SetFontSize TfrmReports procedure SetFontSize(NewFontSize: Integer); override; Public -
ShowTabControl TfrmReports procedure ShowTabControl; Private -
Splitter1CanResize TfrmReports procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); Public/Published -
sptHorzMoved TfrmReports procedure sptHorzMoved(Sender: TObject); Public/Published -
sptHorzRightCanResize TfrmReports procedure sptHorzRightCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); Public/Published -
TabControl1Change TfrmReports procedure TabControl1Change(Sender: TObject); Public/Published -
Timer1Timer TfrmReports procedure Timer1Timer(Sender: TObject); Public/Published -
tvProceduresChange TfrmReports procedure tvProceduresChange(Sender: TObject; Node: TTreeNode); Public/Published -
tvProceduresClick TfrmReports procedure tvProceduresClick(Sender: TObject); Public/Published -
tvProceduresCollapsing TfrmReports procedure tvProceduresCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); Public/Published -
tvProceduresExpanding TfrmReports procedure tvProceduresExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); Public/Published -
tvProceduresKeyDown TfrmReports procedure tvProceduresKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
tvReportsClick TfrmReports procedure tvReportsClick(Sender: TObject); Public/Published -
tvReportsCollapsing TfrmReports procedure tvReportsCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); Public/Published -
tvReportsExpanding TfrmReports procedure tvReportsExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); Public/Published -
tvReportsKeyDown TfrmReports procedure tvReportsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
UnFreezeText1Click TfrmReports procedure UnFreezeText1Click(Sender: TObject); Public/Published -
UpdateRemoteStatus TfrmReports procedure UpdateRemoteStatus(aSiteID, aStatus: string); Public/Published -
WebBrowser1DocumentComplete TfrmReports procedure WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); Public/Published -

Functions

Name Owner Declaration Scope Comments
AllowContextChange TfrmReports function AllowContextChange(var WhyNot: string): Boolean; override; Public -
CompareValues - function CompareValues(Col: Integer): integer; Local -
FindReport - function FindReport(ReportID: string; var AnIndex: integer): boolean; overload; Local -
FindReport - function FindReport(QualType: integer; var AnIndex: integer): boolean; overload; Local -

Global Variables

Name Type Declaration Comments
ColumnSortForward Boolean ColumnSortForward: Boolean; -
ColumnToSort Integer ColumnToSort: Integer; -
frmReports TfrmReports frmReports: TfrmReports; -
GraphForm TfrmGraphs GraphForm: TfrmGraphs; -
GraphFormActive Boolean GraphFormActive: boolean; -
uColChange UnicodeString uColChange: string; Determines when column widths have changed
uColumns TStringList uColumns: TStringList; -
uDirect UnicodeString uDirect: String; -
uECSReport TECSReport uECSReport: TECSReport; Event Capture Report, initiated in fFrame when Click Event Capture under Tools
uEmptyImageList TImageList uEmptyImageList: TImageList; -
uFirstSort Integer uFirstSort: Integer; -
uFrozen Boolean uFrozen: Boolean; -
uHSAll TStringList uHSAll: TStringList;
Segment^OccuranceLimit^TimeLimit^Header...
^(value of uComponents...)

List of all displayable Health Summaries
uHSComponents TStringList uHSComponents: TStringList; Components selected
uHState UnicodeString uHState: string; -
uHTMLDoc UnicodeString uHTMLDoc: string; -
uHTMLPatient AnsiString uHTMLPatient: ANSIstring; -
uListItem TListItem uListItem: TListItem; -
uListState Integer uListState: Integer; Checked state of list of Adhoc components Checked: Abbreviation, UnChecked: Name
uLocalReportData TStringList uLocalReportData: TStringList; Storage for Local report data
ulvSelectOn Boolean ulvSelectOn: boolean; Flag turned on when multiple items in lvReports control have been selected
uMaxOcc UnicodeString uMaxOcc: string; -
uNewColumn TListColumn uNewColumn: TListColumn; -
UpdatingLvReports Boolean UpdatingLvReports: Boolean; Currently updating lvReports
UpdatingTvProcedures Boolean UpdatingTvProcedures: Boolean; Currently updating tvProcedures
uQualifier UnicodeString uQualifier: string; -
uQualifierType Integer uQualifierType: Integer; -
uRemoteCount Integer uRemoteCount: Integer; -
uRemoteReportData TStringList uRemoteReportData: TStringList; Storage for status of Remote data
uReportInstruction UnicodeString uReportInstruction: String; User Instructions
uReportRPC UnicodeString uReportRPC: string; -
uReportType UnicodeString uReportType: string; -
uRptID UnicodeString uRptID: String; -
uSecondSort Integer uSecondSort: Integer; -
uSortOrder UnicodeString uSortOrder: string; -
uThirdSort Integer uThirdSort: Integer; -
uTreeStrings TStrings uTreeStrings: TStrings; -
uUpdateStat Boolean uUpdateStat: boolean; Flag turned on when remote status is being updated

Constants

Name Declaration Scope Comments
BlankWebPage 'about:blank' Global -
CT_REPORTS 10 Global ID for REPORTS tab used by frmFrame
HTML_POST CRLF + '</pre></body></html>' Global -
HTML_PRE '<html><head><style>' + CRLF + Global -
QT_DATERANGE 2 Global -
QT_HSCOMPONENT 5 Global -
QT_HSTYPE 1 Global -
QT_HSWPCOMPONENT 6 Global -
QT_IMAGING 3 Global -
QT_NUTR 4 Global -
QT_OTHER 0 Global -
QT_PROCEDURES 19 Global -
QT_SURGERY 28 Global -
TX_NOREPORT 'No report is currently selected.' Global -
TX_NOREPORT_CAP 'No Report Selected' Global -


Module Source

1     unit fReports;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fHSplit, StdCtrls, ExtCtrls, ORCtrls, ComCtrls, Menus, uConst, ORDtTmRng,
8       OleCtrls, SHDocVw, Buttons, ClipBrd, rECS, Variants, StrUtils, fBase508Form,
9       VA508AccessibilityManager, VA508ImageListLabeler;
10    
11    type
12      TfrmReports = class(TfrmHSplit)
13        PopupMenu1: TPopupMenu;
14        GotoTop1: TMenuItem;
15        GotoBottom1: TMenuItem;
16        FreezeText1: TMenuItem;
17        UnFreezeText1: TMenuItem;
18        calApptRng: TORDateRangeDlg;
19        Timer1: TTimer;
20        pnlLefTop: TPanel;
21        lblTypes: TOROffsetLabel;
22        Splitter1: TSplitter;
23        pnlLeftBottom: TPanel;
24        lblQualifier: TOROffsetLabel;
25        lblHeaders: TLabel;
26        lstHeaders: TORListBox;
27        lstQualifier: TORListBox;
28        pnlRightTop: TPanel;
29        pnlRightBottom: TPanel;
30        pnlRightMiddle: TPanel;
31        TabControl1: TTabControl;
32        lvReports: TCaptionListView;
33        Memo1: TMemo;
34        WebBrowser1: TWebBrowser;
35        memText: TRichEdit;
36        sptHorzRight: TSplitter;
37        tvReports: TORTreeView;
38        PopupMenu2: TPopupMenu;
39        Print1: TMenuItem;
40        Copy1: TMenuItem;
41        Print2: TMenuItem;
42        Copy2: TMenuItem;
43        SelectAll1: TMenuItem;
44        SelectAll2: TMenuItem;
45        pnlProcedures: TPanel;
46        lblProcedures: TOROffsetLabel;
47        tvProcedures: TORTreeView;
48        lblProcTypeMsg: TOROffsetLabel;
49        pnlViews: TORAutoPanel;
50        chkDualViews: TCheckBox;
51        btnChangeView: TORAlignButton;
52        btnGraphSelections: TORAlignButton;
53        lblDateRange: TLabel;
54        lstDateRange: TORListBox;
55        pnlTopViews: TPanel;
56        pnlTopRtLabel: TPanel;
57        lblTitle: TOROffsetLabel;
58        chkMaxFreq: TCheckBox;
59        imgLblImages: TVA508ImageListLabeler;
60        procedure lstQualifierClick(Sender: TObject);
61        procedure GotoTop1Click(Sender: TObject);
62        procedure GotoBottom1Click(Sender: TObject);
63        procedure FreezeText1Click(Sender: TObject);
64        procedure UnFreezeText1Click(Sender: TObject);
65        procedure PopupMenu1Popup(Sender: TObject);
66        procedure FormCreate(Sender: TObject);
67        procedure DisplayHeading(aRanges: string);
68        procedure FormShow(Sender: TObject);
69        procedure Timer1Timer(Sender: TObject);
70        procedure TabControl1Change(Sender: TObject);
71        procedure FormDestroy(Sender: TObject);
72        procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
73        procedure lstHeadersClick(Sender: TObject);
74        procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer;
75          var Accept: Boolean);
76        procedure WebBrowser1DocumentComplete(Sender: TObject;
77          const pDisp: IDispatch; var URL: OleVariant);
78        procedure sptHorzRightCanResize(Sender: TObject; var NewSize: Integer;
79          var Accept: Boolean);
80        procedure lstQualifierDrawItem(Control: TWinControl; Index: Integer;
81          Rect: TRect; State: TOwnerDrawState);
82        procedure tvReportsClick(Sender: TObject);
83        procedure lvReportsColumnClick(Sender: TObject; Column: TListColumn);
84        procedure lvReportsCompare(Sender: TObject; Item1, Item2: TListItem;
85          Data: Integer; var Compare: Integer);
86        procedure lvReportsSelectItem(Sender: TObject; Item: TListItem;
87          Selected: Boolean);
88        procedure LoadListView(aReportData: TStringList);
89        procedure LoadTreeView;
90        procedure tvReportsExpanding(Sender: TObject; Node: TTreeNode;
91          var AllowExpansion: Boolean);
92        procedure tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
93          var AllowCollapse: Boolean);
94        procedure Print1Click(Sender: TObject);
95        procedure Copy1Click(Sender: TObject);
96        procedure Copy2Click(Sender: TObject);
97        procedure Print2Click(Sender: TObject);
98        procedure UpdateRemoteStatus(aSiteID, aStatus: string);
99        procedure lvReportsKeyUp(Sender: TObject; var Key: Word;
100         Shift: TShiftState);
101       procedure SelectAll1Click(Sender: TObject);
102       procedure SelectAll2Click(Sender: TObject);
103       procedure tvReportsKeyDown(Sender: TObject; var Key: Word;
104         Shift: TShiftState);
105       procedure Memo1KeyUp(Sender: TObject; var Key: Word;
106         Shift: TShiftState);
107       procedure LoadProceduresTreeView(x: string; var CurrentParentNode: TTreeNode;       
108         var CurrentNode: TTreeNode);                                                      
109       procedure tvProceduresCollapsing(Sender: TObject; Node: TTreeNode;                  
110         var AllowCollapse: Boolean);                                                      
111       procedure tvProceduresExpanding(Sender: TObject; Node: TTreeNode;                   
112         var AllowExpansion: Boolean);
113       procedure tvProceduresClick(Sender: TObject);
114       procedure tvProceduresChange(Sender: TObject; Node: TTreeNode);
115       procedure tvProceduresKeyDown(Sender: TObject; var Key: Word;                       
116         Shift: TShiftState);
117       procedure chkDualViewsClick(Sender: TObject);
118       procedure btnChangeViewClick(Sender: TObject);
119       procedure btnGraphSelectionsClick(Sender: TObject);
120       procedure lstDateRangeClick(Sender: TObject);
121       procedure sptHorzMoved(Sender: TObject);
122       procedure chkMaxFreqClick(Sender: TObject);
123   
124     private
125       SortIdx1, SortIdx2, SortIdx3: Integer;
126       procedure ProcessNotifications;
127       procedure ShowTabControl;
128       procedure Graph(reportien: integer);
129       procedure GraphPanel(active: boolean);
130       procedure BlankWeb;
131     public
132       procedure ClearPtData; override;
133       function AllowContextChange(var WhyNot: string): Boolean; override;
134       procedure DisplayPage; override;
135       procedure SetFontSize(NewFontSize: Integer); override;
136       procedure RequestPrint; override;
137     end;
138   
139   var
140     frmReports: TfrmReports;
141     uHSComponents: TStringList;  //components selected
142                                  //segment^OccuranceLimit^TimeLimit^Header...
143                                  //^(value of uComponents...)
144     uHSAll: TStringList;  //List of all displayable Health Summaries
145     uLocalReportData: TStringList;  //Storage for Local report data
146     uRemoteReportData: TStringList; //Storage for status of Remote data
147     uReportInstruction: String;     //User Instructions
148     uNewColumn: TListColumn;
149     uListItem: TListItem;
150     uColumns: TStringList;
151     uTreeStrings: TStrings;
152     uMaxOcc: string;
153     uHState: string;
154     uQualifier: string;
155     uReportType: string;
156     uSortOrder: string;
157     uQualifierType: Integer;
158     uFirstSort: Integer;
159     uSecondSort: Integer;
160     uThirdSort: Integer;
161     uColChange: string;               //determines when column widths have changed
162     uUpdateStat: boolean;             //flag turned on when remote status is being updated
163     ulvSelectOn: boolean;             //flag turned on when multiple items in lvReports control have been selected
164     uListState: Integer;              //Checked state of list of Adhoc components Checked: Abbreviation, UnChecked: Name
165     uECSReport: TECSReport;           //Event Capture Report, initiated in fFrame when Click Event Capture under Tools
166     UpdatingLvReports: Boolean;       //Currently updating lvReports
167     UpdatingTvProcedures: Boolean;    //Currently updating tvProcedures       
168   
169   implementation
170   
171   {$R *.DFM}
172   
173   uses ORFn, rCore, rReports, fFrame, uCore, uReports, fReportsPrint,
174        fReportsAdhocComponent1, activex, mshtml, dShared, fGraphs, fGraphData, rGraphs,
175        VA508AccessibilityRouter, VAUtils;  
176   
177   const
178     CT_REPORTS    =10;        // ID for REPORTS tab used by frmFrame
179     QT_OTHER      = 0;
180     QT_HSTYPE     = 1;
181     QT_DATERANGE  = 2;
182     QT_IMAGING    = 3;
183     QT_NUTR       = 4;
184     QT_PROCEDURES = 19;
185     QT_SURGERY    = 28;
186     QT_HSCOMPONENT   = 5;
187     QT_HSWPCOMPONENT = 6;
188     TX_NOREPORT     = 'No report is currently selected.';
189     TX_NOREPORT_CAP = 'No Report Selected';
190     HTML_PRE  = '<html><head><style>' + CRLF +
191                 'PRE {font-size:8pt;font-family: "Courier New", "monospace"}' + CRLF +
192                 '</style></head><body><pre>';
193     HTML_POST = CRLF + '</pre></body></html>';
194     BlankWebPage = 'about:blank';
195   
196   var
197     uRemoteCount: Integer;
198     uFrozen: Boolean;
199     uHTMLDoc: string;
200     uReportRPC: string;
201     uHTMLPatient: ANSIstring;
202     uRptID: String;
203     uDirect: String;
204     uEmptyImageList: TImageList;
205     ColumnToSort: Integer;
206     ColumnSortForward: Boolean;
207     GraphForm: TfrmGraphs;
208     GraphFormActive: boolean;
209   
210   procedure TfrmReports.ClearPtData;
211   begin
212     inherited ClearPtData;
213     if Assigned(WebBrowser1) then
214     begin
215       uHTMLDoc := '';
216       BlankWeb;
217     end;
218     Timer1.Enabled := False;
219     memText.Clear;
220     tvProcedures.Items.Clear;
221     lblProcTypeMsg.Visible := FALSE;
222     lvReports.SmallImages := uEmptyImageList;
223     imgLblImages.ComponentImageListChanged;
224     lvReports.Items.Clear;
225     uLocalReportData.Clear;
226     uRemoteReportData.Clear;
227     TabControl1.Tabs.Clear;
228     TabControl1.Visible := false;
229     TabControl1.TabStop := false;
230     lstDateRange.Tag := 0; // used to reset date default on graph
231     if (GraphForm <> nil) and GraphFormActive then
232     with GraphForm do
233     begin
234       GraphForm.SendToBack;
235       Initialize;
236       DisplayData('top');
237       DisplayData('bottom');
238       //GtslCheck.Clear;
239       GraphFormActive := false;
240     end;
241     begin
242     end;
243   end;
244   
245   procedure TfrmReports.Graph(reportien: integer);
246   begin
247     if GraphForm = nil then
248     begin
249       GraphForm := TfrmGraphs.Create(self);
250       try
251         with GraphForm do
252         begin
253           if btnClose.Tag = 1 then
254             Exit;
255           Parent := pnlRight;
256           Align := alClient;
257           pnlFooter.Tag := 1;   //suppresses bottom of graph form
258           pnlBottom.Height := 1;
259           pnlMain.BevelInner := bvLowered;
260           pnlMain.BevelOuter := bvRaised;
261           pnlMain.Tag := reportien;
262           Initialize;
263           ResizeAnchoredFormToFont(GraphForm);
264           Show;
265           DisplayData('top');
266           DisplayData('bottom');
267           //GtslCheck.Clear;
268           GraphPanel(true);
269           frmGraphData.pnlData.Hint := Patient.DFN;
270           BringToFront;
271         end;
272       finally
273         if GraphForm.btnClose.Tag = 1 then
274         begin
275           GraphFormActive := false;
276           GraphForm.Free;
277           GraphForm := nil;
278         end
279         else
280           GraphFormActive := true;
281       end;
282     end
283     else if GraphForm.btnClose.Tag = 1 then
284       Exit
285     else if frmGraphData.pnlData.Hint = Patient.DFN then
286     begin   // displaying same patient
287       if Tag <> reportien then   // different report
288       with GraphForm do
289       begin  // new report
290         SendToBack;
291         GraphPanel(false);
292         pnlMain.Tag := reportien;
293         Initialize;
294         DisplayData('top');
295         DisplayData('bottom');
296         //GtslCheck.Clear;
297         GraphPanel(true);
298         BringToFront;
299         GraphFormActive := true;
300       end
301       else
302       begin   // bring back graph
303         GraphPanel(true);
304         BringToFront;
305         GraphFormActive := true;
306       end;
307     end
308     else
309     with GraphForm do
310     begin  // new patient
311       pnlMain.Tag := reportien;
312       Initialize;
313       DisplayData('top');
314       DisplayData('bottom');
315       //GtslCheck.Clear;
316       frmGraphData.pnlData.Hint := Patient.DFN;
317       GraphPanel(true);
318       BringToFront;
319       GraphFormActive := true;
320     end;
321   end;
322   
323   procedure TfrmReports.GraphPanel(active: boolean);
324   var
325     adddaterange: boolean;
326     i: integer;
327     aQualifier, aStartTime, aStopTime, aNewLine: string;
328   begin
329     if active then
330     begin
331       pnlLeftBottom.Height := pnlLeft.Height div 2;
332       pnlViews.Height := pnlLeftBottom.Height;
333       if pnlLeft.Height < 200 then
334         pnlTopViews.Height := 3
335       else
336         pnlTopViews.Height := 80;
337       lblQualifier.Visible := false;
338       lstQualifier.Visible := false;
339       pnlViews.Visible := true;
340       if lstDateRange.Tag = 0 then
341       begin
342         lstDateRange.Tag := 1;
343         aQualifier  :=  PReportTreeObject(tvReports.Selected.Data)^.Qualifier;
344         aStartTime  :=  Piece(aQualifier,';',1);
345         aStopTime   :=  Piece(aQualifier,';',2);
346         adddaterange := true;
347         aNewLine := '^' + aStartTime + ' to ' + aStopTime +'^^^' + aStartTime + ';' +  aStopTime +
348           '^' + floattostr(StrToFMDateTime(aStartTime)) + '^' + floattostr(StrToFMDateTime(aStopTime));
349         for i := 0 to GraphForm.cboDateRange.Items.Count - 1 do
350           if GraphForm.cboDateRange.Items[i] = aNewLine then
351           begin
352             adddaterange := false;
353             break;
354           end;
355         if adddaterange then GraphForm.cboDateRange.Items.Add(aNewLine);
356         lstDateRange.Items := GraphForm.cboDateRange.Items;
357         GraphForm.DateDefaults;
358         lstDateRange.ItemIndex := GraphForm.cboDateRange.ItemIndex;
359         //lstDateRange.ItemIndex := lstDateRange.Items.Count - 1;
360         //lstDateRange.ItemIndex := lstDateRange.Items.Count - 2;      //set to all results till fixed
361         lstDateRangeClick(self);
362       end;
363       pnlLeftBottom.Visible := true;
364       splitter1.Visible := true;
365     end
366     else
367     begin
368       lblQualifier.Visible := true;
369       lstQualifier.Visible := true;
370       pnlViews.Visible := false;
371       pnlLeftBottom.Height := lblHeaders.Height + lblQualifier.Height + 90;
372     end;
373   end;
374   
375   procedure TfrmReports.BlankWeb;
376   begin
377     try
378       WebBrowser1.Navigate(BlankWebPage);
379     except
380     end;
381   end;
382   
383   function TfrmReports.AllowContextChange(var WhyNot: string): Boolean;
384   var
385     i: integer;
386   begin
387     Result := inherited AllowContextChange(WhyNot);  // sets result = true
388     if Timer1.Enabled = true then
389       case BOOLCHAR[frmFrame.CCOWContextChanging] of
390         '1': begin
391                WhyNot := 'A remote data query in progress will be aborted.';
392                Result := False;
393              end;
394         '0': if WhyNot = 'COMMIT' then
395                begin
396                  with RemoteSites.SiteList do for i := 0 to Count - 1 do
397                    if TRemoteSite(Items[i]).Selected then
398                    if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then
399                      begin
400                        TRemoteSite(Items[i]).ReportClear;
401                        TRemoteSite(Items[i]).QueryStatus := '-1^Aborted';
402                        UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Query Aborted');
403                      end;
404                  Timer1.Enabled := false;
405                  Result := True;
406                end;
407       end;
408   end;
409   
410   procedure TfrmReports.RequestPrint;
411   begin
412     if uReportType = 'M' then
413       begin
414         InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK);
415         Exit;
416       end;
417     if (uReportType = 'V') and (length(piece(uHState,';',2)) > 0) then
418       begin
419         if lvReports.Items.Count < 1 then
420           begin
421             InfoBox('There are no items to be printed.', 'No Items to Print', MB_OK);
422             Exit;
423           end;
424         if lvReports.SelCount < 1 then
425           begin
426             InfoBox('Please select one or more items from the list to be printed.', 'No Items Selected', MB_OK);
427             Exit;
428           end;
429       end;
430     if (uReportType = 'G') and GraphFormActive then
431       with GraphForm do
432       begin
433         if (lvwItemsTop.SelCount < 1) and (lvwItemsBottom.SelCount < 1) then
434           begin
435             InfoBox('There are no items graphed.', 'No Items to Print', MB_OK);
436             Exit;
437           end
438         else
439           begin
440             mnuPopGraphPrintClick(mnuPopGraphPrint);
441             Exit;
442           end;
443       end;
444     if uQualifierType = QT_DATERANGE then
445       begin      //      = 2
446         if lstQualifier.ItemIndex < 0 then
447           begin
448             InfoBox('Please select from one of the Date Range items before printing', 'Incomplete Information', MB_OK);
449           end
450         else
451           PrintReports(uRptID, piece(uRemoteType,'^',4));
452       end
453     else
454       PrintReports(uRptID, piece(uRemoteType,'^',4));
455   end;
456   
457   procedure TfrmReports.DisplayPage;
458   var
459     i{, OrigSelection}: integer;
460     {OrigDateIEN: Int64;
461     OrigDateItemID: Variant;
462     OrigReportCat, OrigProcedure: TTreeNode; }
463   begin
464     inherited DisplayPage;
465     frmFrame.mnuFilePrint.Tag := CT_REPORTS;
466     frmFrame.mnuFilePrint.Enabled := True;
467     frmFrame.mnuFilePrintSetup.Enabled := True;
468     uUpdateStat := false;
469     ulvSelectOn := false;
470     uListState := GetAdhocLookup();
471     memText.SelStart := 0;
472     FormShow(self);
473     uHTMLPatient := '<DIV align left>'
474                     + '<TABLE width="75%" border="0" cellspacing="0" cellpadding="1">'
475                     + '<TR valign="bottom" align="left">'
476                     + '<TD nowrap><B>Patient: ' + Patient.Name + '</B></TD>'
477                     + '<TD nowrap><B>' + Patient.SSN + '</B></TD>'
478                     + '<TD nowrap><B>Age: ' + IntToStr(Patient.Age) + '</B></TD>'
479                     + '</TR></TABLE></DIV><HR>';
480                     //the preferred method would be to use headers and footers
481                     //so this is just an interim solution.
482     {if not GraphFormActive then
483       pnlLeftBottom.Visible := False;  } //This was keeping Date Range selection box from appearing when leaving and coming back to this Tab
484     if InitPage then
485       begin
486         Splitter1.Visible := false;
487         pnlLeftBottom.Visible := false;
488         uMaxOcc := '';
489         uColChange := '';
490         LoadTreeView;
491       end;
492     if InitPatient and not (CallingContext = CC_NOTIFICATION) then
493       begin
494         uColChange := '';
495         lstQualifier.Clear;
496         tvProcedures.Items.Clear;
497         lblProcTypeMsg.Visible := FALSE;
498         lvReports.SmallImages := uEmptyImageList;
499         imgLblImages.ComponentImageListChanged;
500         lvReports.Items.Clear;
501         lvReports.Columns.Clear;
502         lblTitle.Caption := '';
503         lvReports.Caption := '';
504         Splitter1.Visible := false;
505         pnlLeftBottom.Visible := false;
506         memText.Parent := pnlRightBottom;
507         memText.Align := alClient;
508         memText.Clear;
509         uReportInstruction := '';
510         uLocalReportData.Clear;
511         for i := 0 to RemoteSites.SiteList.Count - 1 do
512           TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
513         pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
514         StatusText('');
515         with tvReports do
516           if Items.Count > 0 then
517             begin
518               tvReports.Selected := tvReports.Items.GetFirstNode;
519               tvReportsClick(self);
520             end;
521       end;
522     case CallingContext of
523       CC_INIT_PATIENT:  if not InitPatient then
524                           begin
525                           uColChange := '';
526                           lstQualifier.Clear;
527                           tvProcedures.Items.Clear;
528                           lblProcTypeMsg.Visible := FALSE;      
529                           lvReports.SmallImages := uEmptyImageList;
530                           imgLblImages.ComponentImageListChanged;
531                           lvReports.Items.Clear;
532                           Splitter1.Visible := false;
533                           pnlLeftBottom.Visible := false;
534                           with tvReports do
535                             if Items.Count > 0 then
536                               begin
537                                 tvReports.Selected := tvReports.Items.GetFirstNode;
538                                 tvReportsClick(self);
539                               end;
540                           end;
541       CC_NOTIFICATION:  ProcessNotifications;
542       
543       //This corrects the reload of the reports when switching back to the tab.
544        {Remove this since it has already been corrected. Related code was also removed from fLabs.
545       CC_CLICK: if not InitPatient then
546         begin
547           //Clear our local variables
548           OrigReportCat := nil;
549           OrigDateIEN := -1;
550           OrigSelection := -1;
551           OrigDateItemID := '';
552           OrigProcedure := nil;
553   
554           //What was last selected before they switched tabs.
555           if tvReports.Selected <> nil then OrigReportCat := tvReports.Selected;
556           if lstDateRange.ItemIEN > 0 then OrigDateIEN := lstDateRange.ItemIEN;
557           if lvReports.Selected <> nil then OrigSelection := lvReports.Selected.Index;
558           if lstQualifier.ItemID <> '' then OrigDateItemID := lstQualifier.ItemID;
559           if tvProcedures.Selected <> nil then OrigProcedure := tvProcedures.Selected;
560   
561           //Load the tree and select the last selected
562           if OrigReportCat <> nil then begin
563            tvReports.Select(OrigReportCat);
564            tvReportsClick(self);
565           end;
566   
567           //Did they click on a date (lstDates box)
568           if OrigDateIEN > -1 then begin
569             lstDateRange.SelectByIEN(OrigDateIEN);
570             lstDateRangeClick(self);
571           end;
572   
573           //Did they click on a date (lstQualifier)
574            if OrigDateItemID <> '' then begin
575             lstQualifier.SelectByID(OrigDateItemID);
576             lstQualifierClick(self);
577           end;
578   
579           //Did they click on a procedure
580           if OrigProcedure <> nil then begin
581             tvProcedures.Select(OrigProcedure);
582             tvProceduresClick(tvProcedures);
583           end;
584   
585   
586           //Did they click on a report
587           if OrigSelection > -1 then begin
588            lvReports.Selected := lvReports.Items[OrigSelection];
589            lvReportsSelectItem(self, lvReports.Selected, true);
590           end;
591         end;  }
592     end;  
593   end;
594   
595   procedure TfrmReports.UpdateRemoteStatus(aSiteID, aStatus: string);
596   var
597     j: integer;
598     s: string;
599     c: boolean;
600   begin
601     if uUpdateStat = true then exit;                 //uUpdateStat also looked at in fFrame
602     uUpdateStat := true;
603     for j := 0 to frmFrame.lstCIRNLocations.Items.Count - 1 do
604       begin
605         s := frmFrame.lstCIRNLocations.Items[j];
606         c := frmFrame.lstCIRNLocations.checked[j];
607         if piece(s, '^', 1) = aSiteID then
608           begin
609             frmFrame.lstCIRNLocations.Items[j] := pieces(s, '^', 1, 3) + '^' + aStatus;
610             frmFrame.lstCIRNLocations.checked[j] := c;
611           end;
612       end;
613     uUpdateStat := false;
614   end;
615   
616   procedure TfrmReports.LoadTreeView;
617   var
618     i,j: integer;
619     currentNode, parentNode, grandParentNode, gtGrandParentNode: TTreeNode;
620     x: string;
621     addchild, addgrandchild, addgtgrandchild: boolean;
622   begin
623     tvReports.Items.Clear;
624     memText.Clear;
625     uHTMLDoc := '';
626     BlankWeb;
627     tvProcedures.Items.Clear;
628     lblProcTypeMsg.Visible := FALSE;
629     lvReports.SmallImages := uEmptyImageList;
630     imgLblImages.ComponentImageListChanged;
631     lvReports.Items.Clear;
632     uTreeStrings.Clear;
633     lblTitle.Caption := '';
634     lvReports.Caption := '';
635     ListReports(uTreeStrings);
636     addchild := false;
637     addgrandchild := false;
638     addgtgrandchild := false;
639     parentNode := nil;
640     grandParentNode := nil;
641     gtGrandParentNode := nil;
642     currentNode := nil;
643     for i := 0 to uTreeStrings.Count - 1 do
644       begin
645         x := uTreeStrings[i];
646         if UpperCase(Piece(x,'^',1))='[PARENT END]' then
647           begin
648             if addgtgrandchild = true then
649               begin
650                 currentNode := gtgrandParentNode;
651                 addgtgrandchild := false;
652               end
653             else
654               if addgrandchild = true then
655                 begin
656                   currentNode := grandParentNode;
657                   addgrandchild := false;
658                 end
659               else
660                 begin
661                   currentNode := parentNode;
662                   addchild := false;
663                 end;
664             continue;
665           end;
666         if UpperCase(Piece(x,'^',1))='[PARENT START]' then
667           begin
668             if addgtgrandchild = true then
669               currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)))
670             else
671               if addgrandchild = true then
672                 begin
673                   currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
674                   addgtgrandchild := true;
675                   gtgrandParentNode := currentNode;
676                 end
677               else
678                 if addchild = true then
679                   begin
680                     currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
681                     addgrandchild := true;
682                     grandParentNode := currentNode;
683                   end
684                 else
685                   begin
686                     currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21)));
687                     parentNode := currentNode;
688                     addchild := true;
689                   end;
690           end
691         else
692           if addchild = false then
693             begin
694               currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',2),MakeReportTreeObject(x));
695               parentNode := currentNode;
696             end
697           else
698             begin
699               if addgtgrandchild = true then
700                   currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
701               else
702                 if addgrandchild = true then
703                     currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',2),MakeReportTreeObject(x))
704                 else
705                     currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',2),MakeReportTreeObject(x));
706             end;
707       end;
708     for i := 0 to tvReports.Items.Count - 1 do
709       if Piece(PReportTreeObject(tvReports.Items[i].Data)^.Qualifier,';',4) = '1' then
710         begin
711           HealthSummaryCheck(uHSAll,'1');
712           for j := 0 to uHSAll.Count - 1 do
713             tvReports.Items.AddChildObject(tvReports.Items[i],Piece(uHSAll[j],'^',2),MakeReportTreeObject(uHSAll[j]));
714         end;
715     if tvReports.Items.Count > 0 then begin
716       tvReports.Selected := tvReports.Items.GetFirstNode;
717       tvReportsClick(self);
718     end;
719   end;
720   
721   procedure TfrmReports.SetFontSize(NewFontSize: Integer);
722   var
723     pnlRightMiddlePct: Real;
724     frmReportsHeight, pnlRightHeight: Integer;
725   
726   begin
727     pnlRightMiddlePct := (pnlRightMiddle.Height / (pnlRight.Height - (sptHorzRight.Height + pnlRightTop.Height)));
728     pnlRightMiddle.Constraints.MaxHeight := 20;
729     inherited SetFontSize(NewFontSize);
730     memText.Font.Size := NewFontSize;
731     frmReportsHeight := frmFrame.pnlPatientSelectedHeight - (frmFrame.pnlToolbar.Height + frmFrame.stsArea.Height + frmFrame.tabPage.Height + 2);
732     pnlRightHeight := frmReportsHeight - shpPageBottom.Height;
733     pnlRightMiddle.Constraints.MaxHeight := 0;
734     pnlRightMiddle.Height := (Round((pnlRightHeight - (sptHorzRight.Height + pnlRightTop.Height)) * pnlRightMiddlePct) - 14);
735     if frmFrame.Height <> frmFrame.frmFrameHeight then
736     begin
737       pnlRight.Height := pnlRightHeight;
738       frmReports.Height := frmReportsHeight;
739       frmFrame.Height := frmFrame.frmFrameHeight;
740     end;
741   end;
742   
743   procedure TfrmReports.LoadListView(aReportData: TStringList);
744   var
745     i,j,k,aErr: integer;
746     aTmpAray: TStringList;
747     aColCtr, aCurCol, aCurRow, aColID: integer;
748     x,y,z,c,aSite: string;
749     ListItem: TListItem;
750   begin
751     aSite := '';
752     aErr := 0;
753     ListItem := nil;
754     case uQualifierType of
755       QT_HSCOMPONENT:
756         begin      //      = 5
757           if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
758             begin
759               with lvReports do
760                 begin
761                   ViewStyle := vsReport;
762                   for j := 0 to aReportData.Count - 1 do
763                     begin
764                       if piece(aReportData[j],'^',1) = '-1' then  //error condition, most likely remote call
765                         continue;
766                       ListItem := Items.Add;
767                       aSite := piece(aReportData[j],'^',1);
768                       ListItem.Caption := piece(aSite,';',1);
769                       for k := 2 to uColumns.Count do
770                         begin
771                           ListItem.SubItems.Add(piece(aReportData[j],'^',k));
772                         end;
773                     end;
774                   if aReportData.Count = 0 then
775                     begin
776                       uReportInstruction := '<No Data Available>';
777                       memText.Lines.Clear;
778                       memText.Lines.Add(uReportInstruction);
779                     end
780                   else
781                     memText.Lines.Clear;
782                 end;
783             end;
784         end;
785       QT_HSWPCOMPONENT:
786         begin     //      = 6
787           if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
788             begin
789               aTmpAray := TStringList.Create;
790               aCurRow := 0;
791               aCurCol := 0;
792               aColCtr := 9;
793               aTmpAray.Clear;
794               with lvReports do
795                 begin
796                   for j := 0 to aReportData.Count - 1 do
797                     begin
798                       x := aReportData[j];
799                       aColID := StrToIntDef(piece(x,'^',1),-1);
800                       if aColID < 0 then    //this is an error condition most likely an incompatible remote call
801                         continue;
802                       if aColID > (uColumns.Count - 1) then
803                         begin
804                           aErr := 1;
805                           continue;           //extract is out of sync with columns defined in 101.24
806                         end;
807                       if aColID < aColCtr then
808                         begin
809                           if aTmpAray.Count > 0 then
810                             begin
811                               if aColCtr = 1 then
812                                 begin
813                                   ListItem := Items.Add;
814                                   aSite := piece(aTmpAray[j],'^',1);
815                                   ListItem.Caption := piece(aSite,';',1);
816                                   ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
817                                 end
818                               else
819                                 begin
820                                   c := aTmpAray[0];
821                                   if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
822                                     c := c + '...';
823                                   z := piece(c,'^',1);
824                                   y := copy(c, (pos('^', c)), 9999);
825                                   if pos('^',y) > 0 then
826                                     begin
827                                       while pos('^',y) > 0 do
828                                         begin
829                                           y := copy(y, (pos('^', y)+1), 9999);
830                                           z := z + '^' + y;
831                                         end;
832                                           ListItem.SubItems.Add(z);
833                                     end
834                                   else
835                                     begin
836                                       ListItem.SubItems.Add(y);
837                                     end;
838                                 end;
839                               RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
840                               aTmpAray.Clear;
841                             end;
842                           aColCtr := 0;
843                           aCurCol := aColID;
844                           aCurRow := aCurRow + 1;
845                         end
846                       else
847                         if aColID = aCurCol then
848                           begin
849                             z := '';
850                             y := piece(x,'^',2);
851                             if length(y) > 0 then z := y;
852                             y := copy(x, (pos('^', x)+1), 9999);
853                             if pos('^',y) > 0 then
854                               begin
855                                 while pos('^',y) > 0 do
856                                   begin
857                                     y := copy(y, (pos('^', y)+1), 9999);
858                                     z := z + '^' + y;
859                                   end;
860                                 aTmpAray.Add(z);
861                               end
862                             else
863                               begin
864                                 aTmpAray.Add(y);
865                               end;
866                             continue;
867                           end;
868                       if aTmpAray.Count > 0 then
869                         begin
870                           if aColCtr = 1 then
871                             begin
872                               ListItem := Items.Add;
873                               aSite := piece(aTmpAray[0],'^',1);
874                               ListItem.Caption := piece(aSite,';',1);
875                               ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
876                             end
877                           else
878                             begin
879                               c := aTmpAray[0];
880                               if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
881                                 c := c + '...';
882                               ListItem.SubItems.Add(c);
883                             end;
884                           RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
885                           aTmpAray.Clear;
886                         end;
887                       aCurCol := aColID;
888                       Inc(aColCtr);
889                       y := '';
890                       for k := 2 to 10 do
891                         if length(piece(x,'^',k)) > 0 then
892                           begin
893                             if length(y) > 0 then y := y + '^' + piece(x,'^',k)
894                             else y := y + piece(x,'^',k);
895                           end;
896                       aTmpAray.Add(y);
897                       if aColCtr > 0 then
898                         while aColCtr < aCurCol do
899                           begin
900                             ListItem.SubItems.Add('');
901                             Inc(aColCtr);
902                           end;
903                     end;
904                   if aTmpAray.Count > 0 then
905                     begin
906                       if aColCtr = 1 then
907                         begin
908                           ListItem := Items.Add;
909                           aSite := piece(aTmpAray[0],'^',1);
910                           ListItem.Caption := piece(aSite,';',1);
911                           ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol));
912                         end
913                       else
914                         begin
915                           c := aTmpAray[0];
916                           if piece(uColumns.Strings[aCurCol],'^',4) = '1' then
917                             c := c + '...';
918                           ListItem.SubItems.Add(c);
919                         end;
920                       RowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray);
921                       aTmpAray.Clear;
922                     end;
923                 end;
924               aTmpAray.Free;
925             end;
926           if uRptID = 'OR_R18:IMAGING' then with lvReports do  //set image indicator for "Imaging" report
927             begin
928               SmallImages := dmodShared.imgImages;
929               imgLblImages.ComponentImageListChanged;
930               for i := 0 to Items.Count - 1 do
931                 if (Items[i].SubItems.Count > 7) and (Items[i].SubItems[7] = 'Y') then
932                   Items[i].SubItemImages[1] := IMG_1_IMAGE
933                 else
934                   Items[i].SubItemImages[1] := IMG_NO_IMAGES;
935             end
936           else //lvReports.SmallImages := uEmptyImageList;
937           if uRptID = 'OR_PN:PROGRESS NOTES' then with lvReports do  //set image indicator for "Progress Notes" report
938             begin
939               SmallImages := dmodShared.imgImages;
940               imgLblImages.ComponentImageListChanged;
941               for i := 0 to Items.Count - 1 do
942                 if (Items[i].SubItems.Count > 7) and (StrToInt(Items[i].SubItems[7]) > 0) then
943                   Items[i].SubItemImages[2] := IMG_1_IMAGE
944                 else
945                   Items[i].SubItemImages[2] := IMG_NO_IMAGES;
946             end
947           else begin
948             lvReports.SmallImages := uEmptyImageList;
949             imgLblImages.ComponentImageListChanged;
950           end;
951         end;
952     end;
953     if aErr = 1 then
954       if User.HasKey('XUPROGMODE') then
955         ShowMsg('Programmer message: One or more Column ID''s in file 101.24 do not match ID''s coded in extract routine');
956   end;
957   
958   procedure TfrmReports.lstQualifierClick(Sender: TObject);
959   var
960     MoreID: String;  //Restores MaxOcc value
961     aRemote, aHDR, aFHIE, aMax: string;
962     i: integer;
963   begin
964     inherited;
965     if uFrozen = True then
966       begin
967         memo1.visible := False;
968         memo1.TabStop := False;
969       end;
970     MoreID := ';' + Piece(uQualifier,';',3);
971     if chkMaxFreq.checked = true then
972       begin
973         MoreID := '';
974         SetPiece(uQualifier,';',3,'');
975       end;
976     aMax := piece(uQualifier,';',3);
977     if (CharAt(lstQualifier.ItemID,1) = 'd')
978       and (length(aMax)>0)
979       and (StrToInt(aMax)<101) then
980         MoreID := ';101';
981     Timer1.Interval := 3000;
982     aRemote :=  piece(uRemoteType,'^',1);
983     aHDR := piece(uRemoteType,'^',7);
984     aFHIE := piece(uRemoteType,'^',8);
985     SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
986     uHSComponents.Clear;
987     uHSAll.Clear;
988     tvProcedures.Items.Clear;
989     lblProcTypeMsg.Visible := FALSE;
990     uHTMLDoc := '';
991     if uReportType = 'H' then
992       begin
993         WebBrowser1.Visible := true;
994         WebBrowser1.TabStop := true;
995         BlankWeb;
996         WebBrowser1.BringToFront;
997         memText.Visible := false;
998         memText.TabStop := false;
999       end
1000    else
1001      begin
1002        WebBrowser1.Visible := false;
1003        WebBrowser1.TabStop := false;
1004        memText.Visible := true;
1005        memText.TabStop := true;
1006        memText.BringToFront;
1007        RedrawActivate(memText.Handle);
1008      end;
1009    uLocalReportData.Clear;
1010    uRemoteReportData.Clear;
1011    for i := 0 to RemoteSites.SiteList.Count - 1 do
1012     TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
1013    uRemoteCount := 0;
1014    if aHDR = '1' then
1015      DisplayHeading(lstQualifier.ItemID)
1016    else
1017      DisplayHeading(lstQualifier.ItemID + MoreID);
1018    if lstQualifier.ItemID = 'ds' then
1019      begin
1020        with calApptRng do
1021         if Not (Execute) then
1022           begin
1023             lstQualifier.ItemIndex := -1;
1024             Exit;
1025           end
1026         else if (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
1027           begin
1028             if (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
1029               if abs(FMDateTimeToDateTime(FMDateStart) - FMDateTimeToDateTime(FMDateStop)) > StrToInt(piece(uRemoteType,'^',6)) then
1030                 begin
1031                   InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
1032                     + ' for this report.', 'No Report Generated',MB_OK);
1033                   lstQualifier.ItemIndex := -1;
1034                   exit;
1035                 end;
1036             lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
1037               ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1038             DisplayHeading(lstQualifier.ItemID + MoreID);
1039             SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
1040           end
1041         else
1042           begin
1043             lstQualifier.ItemIndex := -1;
1044             InfoBox('Invalid Date Range entered. Please try again','Invalid Date/time entry',MB_OK);
1045             if (Execute) and (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then
1046               begin
1047                 lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart +
1048                   ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
1049                 DisplayHeading(lstQualifier.ItemID + MoreID);
1050                 SetPiece(uRemoteType,'^',5,lstQualifier.ItemID);
1051               end
1052             else
1053               begin
1054                 lstQualifier.ItemIndex := -1;
1055                 InfoBox('No Report Generated!','Invalid Date/time entry',MB_OK);
1056                 exit;
1057               end;
1058           end;
1059      end;
1060    if (CharAt(lstQualifier.ItemID,1) = 'd') and (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then
1061      if ExtractInteger(lstQualifier.ItemID) > (StrToInt(piece(uRemoteType,'^',6))) then
1062        begin
1063          InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6)
1064            + ' for this report.', 'No Report Generated',MB_OK);
1065          lstQualifier.ItemIndex := -1;
1066          exit;
1067        end;
1068    StatusText('Retrieving ' + lblTitle.Caption + '...');
1069    Screen.Cursor := crHourGlass;
1070    uReportInstruction := #13#10 + 'Retrieving data...';
1071    memText.Lines.Add(uReportInstruction);
1072    if WebBrowser1.Visible = true then
1073    begin
1074      uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
1075      BlankWeb;
1076    end;
1077    case uQualifierType of
1078        QT_HSCOMPONENT:
1079          begin     //      = 5
1080            lvReports.SmallImages := uEmptyImageList;
1081            imgLblImages.ComponentImageListChanged;
1082            lvReports.Items.Clear;
1083            memText.Lines.Clear;
1084            RowObjects.Clear;
1085            if ((aRemote = '1') or (aRemote = '2')) then
1086              GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1087            if not(piece(uRemoteType, '^', 9) = '1') then
1088              if (length(piece(uHState,';',2)) > 0) then
1089                begin
1090                  if not(aRemote = '2') then
1091                    LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1092                  LoadListView(uLocalReportData);
1093                end
1094              else
1095                begin
1096                  if ((aRemote = '1') or (aRemote = '2')) then
1097                    ShowTabControl;
1098                  pnlRightMiddle.Visible := false;
1099                  LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1100                  if uLocalReportData.Count < 1 then
1101                    begin
1102                      uReportInstruction := '<No Report Available>';
1103                      memText.Lines.Add(uReportInstruction);
1104                    end
1105                  else
1106                    begin
1107                      QuickCopy(uLocalReportData,memText);
1108                      TabControl1.OnChange(nil);
1109                    end;
1110                end;
1111          end;
1112        QT_HSWPCOMPONENT:
1113          begin      //      = 6
1114            lvReports.SmallImages := uEmptyImageList;
1115            imgLblImages.ComponentImageListChanged;
1116            lvReports.Items.Clear;
1117            RowObjects.Clear;
1118            memText.Lines.Clear;
1119            if ((aRemote = '1') or (aRemote = '2'))  then
1120              begin
1121                Screen.Cursor := crDefault;
1122                GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1123              end;
1124            if not(piece(uRemoteType, '^', 9) = '1') then
1125              if (length(piece(uHState,';',2)) > 0) then
1126                begin
1127                  if not(aRemote = '2') then
1128                    LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1129                  LoadListView(uLocalReportData);
1130                end
1131              else
1132                begin
1133                  if ((aRemote = '1') or (aRemote = '2')) then
1134                    ShowTabControl;
1135                  pnlRightMiddle.Visible := false;
1136                  if not (aRemote = '2') then
1137                    begin
1138                      LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1139                      if uLocalReportData.Count < 1 then
1140                        begin
1141                          uReportInstruction := '<No Report Available>';
1142                          memText.Lines.Add(uReportInstruction);
1143                        end
1144                      else
1145                        QuickCopy(uLocalReportData,memText);
1146                    end;
1147                end;
1148          end
1149        else
1150          begin
1151            Screen.Cursor := crDefault;
1152            GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE);
1153            if Pos('ECS',Piece(uRptID,':',1))>0 then
1154            begin
1155              if Pos('OR_ECS1',uRptID)>0 then
1156                uECSReport.ReportHandle := 'ECPCER';
1157              if Pos('OR_ECS2',uRptID)>0 then
1158                uECSReport.ReportHandle := 'ECPAT';
1159              uECSReport.ReportType   := 'D';
1160              if uECSReport.ReportHandle = 'ECPAT' then
1161              begin
1162                if InfoBox('Would you like the procedure reason be included in the report?', 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
1163                  uECSReport.NeedReason := 'Y'
1164                else
1165                  uECSReport.NeedReason := 'N';
1166              end;
1167              FormatECSDate(lstQualifier.ItemID, uECSReport);
1168              LoadECSReportText(uLocalReportData, uECSReport);
1169            end else
1170              if not(piece(uRemoteType, '^', 9) = '1') then
1171                LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState);
1172            if not(piece(uRemoteType, '^', 9) = '1') then
1173              if TabControl1.TabIndex < 1 then
1174                QuickCopy(uLocalReportData,memText);
1175          end;
1176      end;
1177      Screen.Cursor := crDefault;
1178      StatusText('');
1179      memText.Lines.Insert(0,' ');
1180      memText.Lines.Delete(0);
1181      if WebBrowser1.Visible = true then
1182        begin
1183          if uReportType = 'R' then
1184            uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST
1185          else
1186            uHTMLDoc := uHTMLPatient + uLocalReportData.Text;
1187          BlankWeb;
1188        end;
1189  end;
1190  
1191  procedure TfrmReports.GotoTop1Click(Sender: TObject);
1192  begin
1193    inherited;
1194    SendMessage(memText.Handle, WM_VSCROLL, SB_TOP, 0);
1195    {GoToTop1.Enabled := false;
1196    GoToBottom1.Enabled := true;    }
1197  end;
1198  
1199  procedure TfrmReports.GotoBottom1Click(Sender: TObject);
1200  begin
1201    Inherited;
1202    SendMessage(memText.Handle, WM_VSCROLL, SB_BOTTOM, 0);
1203    {GoToTop1.Enabled := true;
1204    GoToBottom1.Enabled := false;    }
1205  end;
1206  
1207  procedure TfrmReports.FreezeText1Click(Sender: TObject);
1208  var
1209    Current, Desired : Longint;
1210    LineCount : Integer;
1211  begin
1212    Inherited;
1213    If memText.SelLength > 0 then begin
1214      Memo1.visible := true;
1215      Memo1.TabStop := true;
1216      Memo1.Text := memText.SelText;
1217      If Memo1.Lines.Count <6 then
1218        LineCount := Memo1.Lines.Count + 1
1219      Else
1220        LineCount := 5;
1221      Memo1.Height := LineCount * frmReports.Canvas.TextHeight(memText.SelText);
1222      Current := SendMessage(memText.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1223      Desired := SendMessage(memText.handle, EM_LINEFROMCHAR,
1224                 memText.SelStart + memText.SelLength ,0);
1225      SendMessage(memText.Handle,EM_LINESCROLL, 0, Desired - Current);
1226      uFrozen := True;
1227    end;
1228  end;
1229  
1230  procedure TfrmReports.UnFreezeText1Click(Sender: TObject);
1231  begin
1232    Inherited;
1233    If uFrozen = True Then begin
1234      uFrozen := False;
1235      UnFreezeText1.Enabled := False;
1236      Memo1.Visible := False;
1237      Memo1.TabStop := False;
1238      Memo1.Text := '';
1239    end;
1240  end;
1241  
1242  procedure TfrmReports.PopupMenu1Popup(Sender: TObject);
1243  begin
1244    inherited;
1245    If Screen.ActiveControl.Name <> memText.Name then
1246     begin
1247       memText.SetFocus;
1248       memText.SelStart := 0;
1249     end;
1250    If memText.SelLength > 0 Then
1251      FreezeText1.Enabled := True
1252    Else
1253      FreezeText1.Enabled := False;
1254    If Memo1.Visible Then
1255      UnFreezeText1.Enabled := True;
1256    {If memText.SelStart > 0 then
1257      GotoTop1.Enabled := True
1258    Else
1259      GotoTop1.Enabled := False;
1260    If SendMessage(memText.handle, EM_LINEFROMCHAR,
1261      memText.SelStart,0) < memText.Lines.Count then
1262      GotoBottom1.Enabled := True
1263    Else
1264      GotoBottom1.Enabled := False;   }
1265  end;
1266  
1267  procedure TfrmReports.FormCreate(Sender: TObject);
1268  begin
1269    inherited;
1270    PageID := CT_REPORTS;
1271    uFrozen := False;
1272    uHSComponents := TStringList.Create;
1273    uHSAll := TStringList.Create;
1274    uLocalReportData := TStringList.Create;
1275    uRemoteReportData := TStringList.Create;
1276    uColumns := TStringList.Create;
1277    uTreeStrings := TStringList.Create;
1278    uEmptyImageList := TImageList.Create(Self);
1279    uEmptyImageList.Width := 0;
1280    RowObjects := TRowObject.Create;
1281    uRemoteCount := 0;
1282    GraphFormActive := false;
1283  end;
1284  
1285  procedure TfrmReports.ProcessNotifications;
1286  var
1287    j, AnIndex, IDColumn: integer;
1288    SelectID: string;
1289    ListItem: TListItem;
1290    tmpRptID: string;
1291  
1292    function FindReport(QualType: integer; var AnIndex: integer): boolean; overload;
1293    var
1294      Found: boolean;
1295      i: integer;
1296    begin
1297      Found := False;
1298      with tvReports do
1299        begin
1300          for i := 0 to Items.Count -1 do
1301            if StrToIntDef(Piece(PReportTreeObject(tvReports.Items[i].Data)^.Qualifier,';',4),0) = QualType then
1302              begin
1303                Found := True;
1304                break;
1305              end;
1306        end;
1307      Result := Found ;
1308      AnIndex := i;
1309    end;
1310  
1311    function FindReport(ReportID: string; var AnIndex: integer): boolean; overload;
1312    var
1313      Found: boolean;
1314      i: integer;
1315    begin
1316      Found := False;
1317      with tvReports do
1318        begin
1319          for i := 0 to Items.Count -1 do
1320            if Piece(PReportTreeObject(tvReports.Items[i].Data)^.ID, ':', 1) = ReportID then
1321              begin
1322                Found := True;
1323                break;
1324              end;
1325        end;
1326      Result := Found ;
1327      AnIndex := i;
1328    end;
1329  
1330  begin
1331    IDColumn := 0;
1332    case Notifications.Followup of
1333      NF_IMAGING_RESULTS, NF_ABNORMAL_IMAGING_RESULTS, NF_IMAGING_RESULTS_AMENDED:
1334        begin
1335          if not FindReport(QT_IMAGING, AnIndex) then exit;
1336          tvReports.Selected := tvReports.Items[AnIndex];
1337          SelectID := 'i' + Piece(Notifications.AlertData, '~', 1) +
1338            '-' + Piece(Notifications.AlertData, '~', 2);
1339          IDColumn := 0;
1340          if tvReports.Selected <> tvReports.Items[AnIndex] then
1341            tvReports.Selected := tvReports.Items[AnIndex];
1342        end;
1343      NF_IMAGING_REQUEST_CHANGED:
1344        begin
1345          if not FindReport(QT_IMAGING, AnIndex) then exit;
1346          tvReports.Selected := tvReports.Items[AnIndex];
1347          SelectID := 'i' + Piece(Notifications.AlertData, '/', 2) +
1348            '-' + Piece(Notifications.AlertData, '/', 3);
1349          IDColumn := 0;
1350          if tvReports.Selected <> tvReports.Items[AnIndex] then
1351            tvReports.Selected := tvReports.Items[AnIndex];
1352        end;
1353      NF_STAT_RESULTS                  :
1354        begin
1355          if not FindReport(QT_IMAGING, AnIndex) then exit;
1356          tvReports.Selected := tvReports.Items[AnIndex];
1357          SelectID := 'i' + Piece(Notifications.AlertData, '~', 2) +
1358            '-' + Piece(Piece(Notifications.AlertData, '~', 3), '@', 1);
1359          IDColumn := 0;
1360          if tvReports.Selected <> tvReports.Items[AnIndex] then
1361            tvReports.Selected := tvReports.Items[AnIndex];
1362        end;
1363      NF_MAMMOGRAM_RESULTS            :
1364        begin
1365          if not FindReport('OR_R18', AnIndex) then exit;
1366          tvReports.Selected := tvReports.Items[AnIndex];
1367          SelectID := 'i' + Piece(Notifications.AlertData, '~', 1) +
1368            '-' + Piece(Notifications.AlertData, '~', 2);
1369          IDColumn := 8;
1370          if tvReports.Selected <> tvReports.Items[AnIndex] then
1371            tvReports.Selected := tvReports.Items[AnIndex];
1372        end;
1373      NF_ANATOMIC_PATHOLOGY_RESULTS    :
1374        //OR_SP^Surgical Pathology
1375        //OR_CY^Cytology
1376        //OR_EM^Electron Microscopy
1377        //OR_AU^Autopsy
1378        begin
1379          if Notifications.AlertData = '^1^^^0^0^0' then  //code snippet to handle the processing of v26 AP alerts in a v27 environment.
1380            begin
1381              if pnlRightMiddle.Visible then pnlRightMiddle.Visible := FALSE;
1382              InfoBox('This alert was generated in a v26 environment as an informational alert and'
1383              + CRLF + 'therefore cannot be processed as an action alert in a v27 environment.',
1384              'Unable to Process as Action Alert', MB_OK or MB_ICONWARNING);
1385              memText.Text := 'Unable to Process as an Action Alert. In order to view the associated Anatomic Pathology report, please manually'
1386              + CRLF + 'locate the appropriate report under the Anatomic Pathology section (also found under Laboratory, Clinical Reports).';
1387              Notifications.Delete;
1388              exit;
1389            end;
1390          tmpRptID := Piece(Notifications.AlertData, U, 1);
1391          //if tmpRptID = 'CY' then tmpRptID := 'APR';
1392          //if tmpRptID = 'EM' then tmpRptID := 'APR';
1393          //if tmpRptID = 'SP' then tmpRptID := 'APR';
1394          if not FindReport('OR_' + tmpRptID, AnIndex) then exit;
1395          tvReports.Selected := tvReports.Items[AnIndex];
1396          SelectID := Piece(Notifications.AlertData, U, 2);
1397          if (tmpRptID = 'CY') or (tmpRptID = 'EM') or (tmpRptID = 'SP') then
1398               IDColumn := 3;
1399          //if      tmpRptID = 'APR' then IDColumn := 3
1400          //else if tmpRptID = 'SP' then IDColumn := 3
1401          //else if tmpRptID = 'EM' then IDColumn := 3
1402          //else if tmpRptID = 'CY' then IDColumn := 3 ;
1403          if tvReports.Selected <> tvReports.Items[AnIndex] then
1404            tvReports.Selected := tvReports.Items[AnIndex];
1405        end;
1406      NF_PAP_SMEAR_RESULTS            :
1407        begin
1408          if not FindReport('OR_CY', AnIndex) then exit;
1409          tvReports.Selected := tvReports.Items[AnIndex];
1410          SelectID := Piece(Notifications.AlertData, U, 2);
1411          IDColumn := 3;
1412          if tvReports.Selected <> tvReports.Items[AnIndex] then
1413            tvReports.Selected := tvReports.Items[AnIndex];
1414        end;
1415      else with tvReports do if Items.Count > 0 then Selected := Items[0];
1416    end;
1417    if tvReports.Selected <> nil then
1418      begin
1419        tvReportsClick(Self);
1420        Application.ProcessMessages;
1421        for j := 0 to lvReports.Items.Count - 1 do
1422         begin
1423           ListItem := lvReports.Items[j];
1424           if ListItem.Subitems[IDColumn] = SelectID then
1425             begin
1426               lvReports.Selected := lvReports.Items[j];
1427               break;
1428             end;
1429         end;
1430        Notifications.Delete;
1431      end;
1432  end;
1433  
1434  procedure TfrmReports.DisplayHeading(aRanges: string);
1435  var
1436    x,x1,x2,y,z,DaysBack: string;
1437    d1,d2: TFMDateTime;
1438  begin
1439    with lblTitle do
1440    begin
1441      x := '';
1442      if tvReports.Selected = nil then
1443       tvReports.Selected := tvReports.Items.GetFirstNode;
1444      if tvReports.Selected.Parent <> nil then
1445        x := tvReports.Selected.Parent.Text + ' ' + tvReports.Selected.Text
1446      else
1447        x :=  tvReports.Selected.Text;
1448        x1 := '';
1449        x2 := '';
1450      if uReportType <> 'M' then
1451        begin
1452          if CharAt(aRanges, 1) = 'd' then
1453            begin
1454              if length(piece(aRanges,';',2)) > 0 then
1455                begin
1456                  x2 := '  Max/site:' + piece(aRanges,';',2);
1457                  aRanges := piece(aRanges,';',1);
1458                end;
1459              DaysBack := Copy(aRanges, 2, Length(aRanges));
1460              if DaysBack = '0' then
1461                aRanges := 'T' + ';T'
1462              else
1463                aRanges := 'T-' + DaysBack + ';T';
1464            end;
1465          if length(piece(aRanges,';',1)) > 0 then
1466            begin
1467              d1 := ValidDateTimeStr(piece(aRanges,';',1),'');
1468              d2 := ValidDateTimeStr(piece(aRanges,';',2),'');
1469              y := FormatFMDateTime('mmm dd,yyyy',d1);
1470              if Copy(y,8,2) = '18' then y := 'EARLIEST RESULT';
1471              z := FormatFMDateTime('mmm dd,yyyy',d2);
1472              x1 := ' [From: ' + y + ' to ' + z + ']';
1473            end;
1474          if length(piece(aRanges,';',3)) > 0 then
1475            x2 := '  Max/site:' + piece(aRanges,';',3);
1476          case uQualifierType of
1477            QT_DATERANGE:
1478                x := x + x1;
1479            QT_HSCOMPONENT:
1480                x := x + x1 + x2;
1481            QT_HSWPCOMPONENT:
1482                x := x + x1 + x2;
1483            QT_IMAGING:
1484                x := x + x1 + x2;
1485          end;
1486        end;
1487      if piece(uRemoteType, '^', 9) = '1' then x := x + ' <<ONLY REMOTE DATA INCLUDED IN REPORT>>';
1488      Caption := x;
1489    end;
1490    lvReports.Caption := x;
1491  end;
1492  
1493  procedure TfrmReports.FormShow(Sender: TObject);
1494  begin
1495    inherited;
1496    if RemoteSites.SiteList.Count > 0 then
1497    begin
1498      case uQualifierType of
1499        QT_HSWPCOMPONENT:;
1500        QT_HSCOMPONENT:;
1501        QT_IMAGING:;
1502        QT_PROCEDURES:;
1503        QT_NUTR:;
1504      else
1505        ShowTabControl;
1506      end;
1507    end;
1508  end;
1509  
1510  procedure TfrmReports.Timer1Timer(Sender: TObject);
1511  var
1512    i,j,fail,t: integer;
1513    r0,aSite: String;
1514    aHDR, aID, aRet: String;
1515  begin
1516    inherited;
1517    with RemoteSites.SiteList do
1518     begin
1519      for i := 0 to Count - 1 do
1520        if TRemoteSite(Items[i]).Selected then
1521         begin
1522          if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then
1523            begin
1524              r0 := GetRemoteStatus(TRemoteSite(Items[i]).RemoteHandle);
1525              aSite := TRemoteSite(Items[i]).SiteName;
1526              TRemoteSite(Items[i]).QueryStatus := r0; //r0='1^Done' if no errors
1527              UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, piece(r0,'^',2));
1528              if piece(r0,'^',1) = '1' then
1529                begin
1530                  aHDR := piece(TRemoteSite(Items[i]).CurrentReportQuery, '^', 13);
1531                  aID := piece(piece(TRemoteSite(Items[i]).CurrentReportQuery, '^', 2),':',1);
1532                  if aHDR = '1' then
1533                    begin
1534                      ModifyHDRData(aRet, TRemoteSite(Items[i]).RemoteHandle ,aID);
1535                    end;
1536                  GetRemoteData(TRemoteSite(Items[i]).Data, TRemoteSite(Items[i]).RemoteHandle,Items[i]);
1537                  RemoteReports.Add(TRemoteSite(Items[i]).CurrentReportQuery,
1538                    TRemoteSite(Items[i]).RemoteHandle);
1539                  TRemoteSite(Items[i]).RemoteHandle := '';
1540                  TabControl1.OnChange(nil);
1541                  if (length(piece(uHState,';',2)) > 0) then
1542                    begin
1543                      uRemoteReportData.Clear;
1544                      QuickCopy(TRemoteSite(Items[i]).Data,uRemoteReportData);
1545                      fail := 0;
1546                      if uRemoteReportData.Count > 0 then
1547                        begin
1548                          if uRemoteReportData[0] = 'Report not available at this time.' then
1549                            begin
1550                              fail := 1;
1551                              UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Report not available');
1552                            end;
1553                          if piece(uRemoteReportData[0],'^',1) = '-1' then
1554                            begin
1555                              fail := 1;
1556                              UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication failure');
1557                            end;
1558                          if fail = 0 then
1559                            LoadListView(uRemoteReportData);
1560                        end;
1561                    end;
1562                end
1563              else
1564                begin
1565                  uRemoteCount := uRemoteCount + 1;
1566                  if uRemoteCount > 90 then
1567                    begin
1568                      TRemoteSite(Items[i]).RemoteHandle := '';
1569                      TRemoteSite(Items[i]).QueryStatus := '-1^Timed out';
1570                      UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Timed out');
1571                      StatusText('');
1572                      TabControl1.OnChange(nil);
1573                    end
1574                  else
1575                    StatusText('Retrieving reports from '
1576                  + TRemoteSite(Items[i]).SiteName + '...');
1577                end;
1578              t := Timer1.Interval;
1579              if t < 5000 then
1580                begin
1581                  if t < 3001 then Timer1.Interval := 4000
1582                  else if t < 4001 then Timer1.Interval := 5000;
1583                end;
1584            end;
1585         end;
1586       if Timer1.Enabled = True then
1587         begin
1588           j := 0;
1589           for i := 0 to Count -1 do
1590             begin
1591               if Length(TRemoteSite(Items[i]).RemoteHandle) > 0 then
1592                 begin
1593                   j := 1;
1594                   break;
1595                 end;
1596             end;
1597           if j = 0 then  //Shutdown timer if all sites have been processed
1598             begin
1599               Timer1.Enabled := False;
1600               StatusText('');
1601             end;
1602           j := 0;
1603           for i := 0 to Count -1 do
1604             if TRemoteSite(Items[i]).Selected = true then
1605               begin
1606                 j := 1;
1607                 break;
1608               end;
1609           if j = 0 then  //Shutdown timer if user has de-selected all sites
1610             begin
1611               Timer1.Enabled := False;
1612               StatusText('');
1613               TabControl1.OnChange(nil);
1614             end;
1615         end;
1616     end;
1617  end;
1618  
1619  procedure TfrmReports.TabControl1Change(Sender: TObject);
1620  var
1621    aStatus,aSite: string;
1622    hook: Boolean;
1623    i: integer;
1624  begin
1625    inherited;
1626    if (uQualifiertype <> 6) or (length(piece(uHState,';',2)) < 1) then
1627      memText.Lines.Clear;
1628    lstHeaders.Items.Clear;
1629    uHTMLDoc := '';
1630    if WebBrowser1.visible = true then BlankWeb;
1631    if (length(piece(uHState,';',2)) = 0) then with TabControl1 do
1632      begin
1633        memText.Lines.BeginUpdate;
1634        if TabIndex > 0 then
1635          begin
1636            aStatus := TRemoteSite(Tabs.Objects[TabIndex]).QueryStatus;
1637            aSite := TRemoteSite(Tabs.Objects[TabIndex]).SiteName;
1638            if aStatus = '1^Done' then
1639              begin
1640                if Piece(TRemoteSite(Tabs.Objects[TabIndex]).Data[0],'^',1) = '[HIDDEN TEXT]' then
1641                  begin
1642                    lstHeaders.Clear;
1643                    hook := false;
1644                    for i := 1 to TRemoteSite(Tabs.Objects[TabIndex]).Data.Count - 1 do
1645                      if hook = true then
1646                          memText.Lines.Add(TRemoteSite(Tabs.Objects[TabIndex]).Data[i])
1647                      else
1648                        begin
1649                          lstHeaders.Items.Add(MixedCase(TRemoteSite(Tabs.Objects[TabIndex]).Data[i]));
1650                          if Piece(TRemoteSite(Tabs.Objects[TabIndex]).Data[i],'^',1) = '[REPORT TEXT]' then
1651                            hook := true;
1652                        end;
1653                  end
1654                else
1655                  QuickCopy(TRemoteSite(Tabs.Objects[TabIndex]).Data,memText);
1656                memText.Lines.Insert(0,' ');
1657                memText.Lines.Delete(0);
1658              end;
1659            if Piece(aStatus,'^',1) = '-1' then
1660              begin
1661                memText.Lines.Add('Remote data transmission error: ' + Piece(aStatus,'^',2));
1662              end;
1663            if Piece(aStatus,'^',1) = '0' then
1664              memText.Lines.Add('Retrieving data... ' + Piece(aStatus,'^',2));
1665            if Piece(aStatus,'^',1) = '' then
1666              memText.Lines.Add(uReportInstruction);
1667          end
1668        else
1669          if uLocalReportData.Count > 0 then
1670            begin
1671              if Piece(uLocalReportData[0],'^',1) = '[HIDDEN TEXT]' then
1672              begin
1673                lstHeaders.Clear;
1674                hook := false;
1675                for i := 1 to uLocalReportData.Count - 1 do
1676                  if hook = true then
1677                    memText.Lines.Add(uLocalReportData[i])
1678                  else
1679                    begin
1680                      lstHeaders.Items.Add(MixedCase(uLocalReportData[i]));
1681                      if Piece(uLocalReportData[i],'^',1) = '[REPORT TEXT]' then
1682                        hook := true;
1683                    end;
1684              end
1685                else
1686                  if tvReports.Selected.Text = 'Imaging (local only)' then
1687                     memText.Lines.clear
1688                  else
1689                     QuickCopy(uLocalReportData,memText);
1690              memText.Lines.Insert(0,' ');
1691              memText.Lines.Delete(0);
1692            end
1693          else
1694            memText.Lines.Add(uReportInstruction);
1695        if WebBrowser1.Visible = true then
1696          begin
1697            if uReportType = 'R' then
1698              uHTMLDoc := HTML_PRE + memText.Lines.Text + HTML_POST
1699            else
1700              uHTMLDoc := uHTMLPatient + memText.Lines.Text;
1701            BlankWeb;
1702          end;
1703        memText.Lines.EndUpdate;
1704      end;
1705  end;
1706  
1707  procedure TfrmReports.GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string);
1708  var
1709    i, j: integer;
1710    LocalHandle, Query, Report, Seq: string;
1711    HSType, DaysBack, ExamID, MaxOcc: string;
1712    Alpha, Omega, Trans: double;
1713  begin
1714    HSType := '';
1715    DaysBack := '';
1716    ExamID := '';
1717    Alpha := 0;
1718    Omega := 0;
1719    Seq := '';
1720    if AHDR = '1' then
1721      begin
1722        if HDRActive = '0' then
1723          begin
1724            InfoBox('The HDR is currently inactive in CPRS.' + CRLF + 'You must use VistaWeb to view this report.', 'Use VistaWeb for HDR data', MB_OK);
1725            Exit;
1726          end;
1727        //InfoBox('You must use VistaWeb to view this report.', 'Use VistaWeb for HDR data', MB_OK);
1728        if (Piece(AItem, ':', 1) = 'OR_VWAL') or (Piece(AItem, ':', 1) = 'OR_VWRX') then
1729          AQualifier := 'T-50000;T+50000;99999';
1730        if (Piece(AItem, ':', 1) = 'OR_VWVS') and (CharAt(AQualifier, 1) = ';') then
1731          AQualifier := 'T-50000;T+50000;99999';
1732      end;
1733    if CharAt(AQualifier, 1) = 'd' then
1734      begin
1735        DaysBack := Copy(AQualifier, 2, Length(AQualifier));
1736        AQualifier := ('T-' + Piece(DaysBack,';',1) + ';T;' + Pieces(AQualifier,';',2,3));
1737        DaysBack := '';
1738      end;
1739    if CharAt(AQualifier, 1) = 'T' then
1740      begin
1741        if Piece(AQualifier,';',1) = 'T-0' then SetPiece(AQualifier,';',1,'T');
1742        if (Piece(Aqualifier,';',1) = 'T') and (Piece(Aqualifier,';',2) = 'T')
1743          then SetPiece(AQualifier,';',2,'T+1');
1744        Alpha := StrToFMDateTime(Piece(AQualifier,';',1));
1745        Omega := StrToFMDateTime(Piece(AQualifier,';',2));
1746        if Alpha > Omega then
1747          begin
1748            Trans := Omega;
1749            Omega := Alpha;
1750            Alpha := Trans;
1751          end;
1752        MaxOcc := Piece(AQualifier,';',3);
1753        SetPiece(AHSTag,';',4,MaxOcc);
1754      end;
1755    if CharAt(AQualifier, 1) = 'h' then HSType   := Copy(AQualifier, 2, Length(AQualifier));
1756    if CharAt(AQualifier, 1) = 'i' then ExamID   := Copy(AQualifier, 2, Length(AQualifier));
1757    with RemoteSites.SiteList do for i := 0 to Count - 1 do
1758      begin
1759      if (AHDR='1') and (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
1760        begin
1761          //TRemoteSite(Items[i]).Selected := true;
1762          //frmFrame.lstCIRNLocations.Checked[i+1] := true;
1763        end;
1764      if TRemoteSite(Items[i]).Selected then
1765        begin
1766          TRemoteSite(Items[i]).ReportClear;
1767          if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') and not(AHDR = '1') then
1768            begin
1769              TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
1770              UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
1771              TRemoteSite(Items[i]).RemoteHandle := '';
1772              TRemoteSite(Items[i]).QueryStatus := '1^Done';
1773              if uQualifierType = 6 then seq := '1^';
1774              TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1775              if uQualifierType = 6 then seq := '2^';
1776              TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data Included> - Use "HDR Reports" menu for HDR Data.');
1777              TabControl1.OnChange(nil);
1778              if (length(piece(uHState,';',2)) > 0) then
1779                LoadListView(TRemoteSite(Items[i]).Data);
1780              continue;
1781            end;
1782          if (AHDR = '1') and not(LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
1783            begin
1784              TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
1785              UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
1786              TRemoteSite(Items[i]).RemoteHandle := '';
1787              TRemoteSite(Items[i]).QueryStatus := '1^Done';
1788              if uQualifierType = 6 then seq := '1^';
1789              TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1790              if uQualifierType = 6 then seq := '2^';
1791              TRemoteSite(Items[i]).Data.Add(seq + '<No HDR Data> This site is not a source for HDR Data.');
1792              TabControl1.OnChange(nil);
1793              if (length(piece(uHState,';',2)) > 0) then
1794                LoadListView(TRemoteSite(Items[i]).Data);
1795              continue;
1796            end;
1797          if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') and not(aFHIE = '1') then
1798            begin
1799              TRemoteSite(Items[i]).QueryStatus := '1^Not Included';
1800              UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
1801              TRemoteSite(Items[i]).RemoteHandle := '';
1802              TRemoteSite(Items[i]).QueryStatus := '1^Done';
1803              if uQualifierType = 6 then seq := '1^';
1804              TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1805              if uQualifierType = 6 then seq := '2^';
1806              TRemoteSite(Items[i]).Data.Add(seq + '<No DOD Data> - Use "Dept. of Defense Reports" Menu to retrieve data from DOD.');
1807              TabControl1.OnChange(nil);
1808              if (length(piece(uHState,';',2)) > 0) then
1809                LoadListView(TRemoteSite(Items[i]).Data);
1810              continue;
1811            end;
1812          TRemoteSite(Items[i]).CurrentReportQuery := 'Report' + Patient.DFN + ';'
1813            + Patient.ICN + '^' + AItem + '^^^' + ARpc + '^' + HSType +
1814            '^' + DaysBack + '^' + ExamID + '^' + FloatToStr(Alpha) + '^' +
1815            FloatToStr(Omega) + '^' + TRemoteSite(Items[i]).SiteID + '^' + AHSTag + '^' + AHDR;
1816          LocalHandle := '';
1817          Query := TRemoteSite(Items[i]).CurrentReportQuery;
1818          for j := 0 to RemoteReports.Count - 1 do
1819            begin
1820              Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
1821              if Report = Query then
1822                begin
1823                  LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle;
1824                  break;
1825                end;
1826            end;
1827          if Length(LocalHandle) > 1 then
1828            with RemoteSites.SiteList do
1829              begin
1830                GetRemoteData(TRemoteSite(Items[i]).Data,LocalHandle,Items[i]);
1831                TRemoteSite(Items[i]).RemoteHandle := '';
1832                TRemoteSite(Items[i]).QueryStatus := '1^Done';
1833                UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
1834                TabControl1.OnChange(nil);
1835                if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then
1836                  LoadListView(TRemoteSite(Items[i]).Data);
1837              end
1838          else
1839            begin
1840              if uDirect = '1' then
1841                begin
1842                  StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
1843                  TRemoteSite(Items[i]).QueryStatus := '1^Direct Call';
1844                  UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Direct Call');
1845                  DirectQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
1846                  if Copy(Dest[0],1,2) = '-1' then
1847                    begin
1848                      TRemoteSite(Items[i]).QueryStatus := '-1^Communication error';
1849                      UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
1850                      if uQualifierType = 6 then seq := '1^';
1851                      TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1852                      if uQualifierType = 6 then seq := '2^';
1853                      TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
1854                      TabControl1.OnChange(nil);
1855                      if (length(piece(uHState,';',2)) > 0) then
1856                        LoadListView(TRemoteSite(Items[i]).Data);
1857                    end
1858                  else
1859                    begin
1860                      QuickCopy(Dest,TRemoteSite(Items[i]).Data);
1861                      TRemoteSite(Items[i]).RemoteHandle := '';
1862                      TRemoteSite(Items[i]).QueryStatus := '1^Done';
1863                      UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
1864                      TabControl1.OnChange(nil);
1865                      if (length(piece(uHState,';',2)) > 0) then
1866                        LoadListView(TRemoteSite(Items[i]).Data);
1867                    end;
1868                  StatusText('');
1869                end
1870              else
1871                begin
1872                  RemoteQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag);
1873                  if Dest[0] = '' then
1874                    begin
1875                      TRemoteSite(Items[i]).QueryStatus := '-1^Communication error';
1876                      UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error');
1877                      if uQualifierType = 6 then seq := '1^';
1878                      TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName);
1879                      if uQualifierType = 6 then seq := '2^';
1880                      TRemoteSite(Items[i]).Data.Add(seq + '<ERROR>- Unable to communicate with Remote site');
1881                      TabControl1.OnChange(nil);
1882                      if (length(piece(uHState,';',2)) > 0) then
1883                        LoadListView(TRemoteSite(Items[i]).Data);
1884                    end
1885                  else
1886                    begin
1887                      TRemoteSite(Items[i]).RemoteHandle := Dest[0];
1888                      TRemoteSite(Items[i]).QueryStatus := '0^initialization...';
1889                      UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'initialization');
1890                      Timer1.Enabled := True;
1891                      StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...');
1892                    end;
1893                end;
1894            end;
1895        end;
1896      end;
1897  end;
1898  
1899  procedure TfrmReports.FormDestroy(Sender: TObject);
1900  var
1901    i: integer;
1902    aColChange: string;
1903  begin
1904    inherited;
1905    if length(uColChange) > 0 then
1906      begin
1907        aColChange := '';
1908        for i := 0 to lvReports.Columns.Count - 1 do
1909          aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
1910        if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
1911          SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
1912        uColChange := '';
1913      end;
1914    RemoteQueryAbortAll;
1915    RowObjects.Free;
1916    uHSComponents.Free;
1917    uHSAll.Free;
1918    uLocalReportData.Free;
1919    uRemoteReportData.Free;
1920    uColumns.Free;
1921    uTreeStrings.Free;
1922    uEmptyImageList.Free;
1923    uECSReport.Free;
1924    if GraphForm <> nil then GraphForm.Release;
1925  end;
1926  
1927  procedure TfrmReports.lstHeadersClick(Sender: TObject);
1928  var
1929    Current, Desired: integer;
1930  begin
1931    inherited;
1932    if uFrozen = True then
1933      begin
1934        memo1.visible := False;
1935        memo1.TabStop := False;
1936      end;
1937    Current := SendMessage(memText.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1938    Desired := lstHeaders.ItemIEN;
1939    SendMessage(memText.Handle, EM_LINESCROLL, 0, Desired - Current - 1);
1940  end;
1941  
1942  procedure TfrmReports.Splitter1CanResize(Sender: TObject;
1943    var NewSize: Integer; var Accept: Boolean);
1944  begin
1945    inherited;
1946    if NewSize < 50 then
1947      Newsize := 50;
1948  end;
1949  
1950  procedure TfrmReports.WebBrowser1DocumentComplete(Sender: TObject;
1951    const pDisp: IDispatch; var URL: OleVariant);
1952  var
1953    WebDoc: IHtmlDocument2;
1954    v: variant;
1955  begin
1956    inherited;
1957    if uHTMLDoc = '' then Exit;
1958    if not(uReportType = 'H') then Exit; //this can be removed if & when browser replaces memtext control
1959    if not Assigned(WebBrowser1.Document) then Exit;
1960    WebDoc := WebBrowser1.Document as IHtmlDocument2;
1961    v := VarArrayCreate([0, 0], varVariant);
1962    v[0] := uHTMLDoc;
1963    WebDoc.write(PSafeArray(TVarData(v).VArray));
1964    WebDoc.close;
1965    //uHTMLDoc := '';
1966  end;
1967  
1968  procedure TfrmReports.sptHorzRightCanResize(Sender: TObject;
1969    var NewSize: Integer; var Accept: Boolean);
1970  begin
1971    inherited;
1972      if NewSize < 50 then
1973      Newsize := 50;
1974  end;
1975  
1976  procedure TfrmReports.lstQualifierDrawItem(Control: TWinControl;
1977    Index: Integer; Rect: TRect; State: TOwnerDrawState);
1978  var
1979    x: string;
1980    AnImage: TBitMap;
1981  const
1982    STD_DATE = 'MMM DD,YY@HH:NN';
1983  begin
1984    inherited;
1985    AnImage := TBitMap.Create;
1986    try
1987      with (Control as TORListBox).Canvas do  { draw on control canvas, not on the form }
1988        begin
1989          x := (Control as TORListBox).Items[Index];
1990          FillRect(Rect);       { clear the rectangle }
1991          if uQualifierType = QT_IMAGING then   // moved position of assignment in all case branches
1992            begin
1993              AnImage.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1');
1994              if Piece(x, U, 4) = 'Y' then
1995                begin
1996                  BrushCopy(Bounds(Rect.Left, Rect.Top, AnImage.Width, AnImage.Height),
1997                    AnImage, Bounds(0, 0, AnImage.Width, AnImage.Height), clRed); {render ImageFlag}
1998                end;
1999              TextOut(Rect.Left + AnImage.Width, Rect.Top, Piece(x, U, 2));
2000              TextOut(Rect.Left + AnImage.Width + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3));
2001            end
2002          else
2003            begin
2004              TextOut(Rect.Left, Rect.Top, Piece(x, U, 2));
2005              TextOut(Rect.Left + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3));
2006            end;
2007        end;
2008    finally
2009      AnImage.Free;
2010    end;
2011  end;
2012  
2013  procedure TfrmReports.tvReportsClick(Sender: TObject);
2014  var
2015    i,j: integer;
2016    ListItem: TListItem;
2017    aHeading, aReportType, aRPC, aQualifier, aStartTime, aStopTime, aMax, aRptCode, aRemote, aCategory, aSortOrder, aDaysBack, x: string;
2018    aIFN: integer;
2019    aID, aHSTag, aRadParam, aColChange, aDirect, aHDR, aFHIE, aFHIEONLY, aQualifierID: string;
2020    CurrentParentNode, CurrentNode: TTreeNode;
2021  begin
2022    inherited;
2023    lvReports.Hint := 'To sort, click on column headers|';
2024    tvReports.TopItem := tvReports.Selected;
2025    uRemoteCount := 0;
2026    Timer1.Interval := 3000;
2027    uReportInstruction := '';
2028    aHeading    :=  PReportTreeObject(tvReports.Selected.Data)^.Heading;
2029    aRemote     :=  PReportTreeObject(tvReports.Selected.Data)^.Remote;
2030    aReportType :=  PReportTreeObject(tvReports.Selected.Data)^.RptType;
2031    aQualifier  :=  PReportTreeObject(tvReports.Selected.Data)^.Qualifier;
2032    aID         :=  PReportTreeObject(tvReports.Selected.Data)^.ID;
2033    aRPC        :=  PReportTreeObject(tvReports.Selected.Data)^.RPCName;
2034    aHSTag      :=  PReportTreeObject(tvReports.Selected.Data)^.HSTag;
2035    aCategory   :=  PReportTreeObject(tvReports.Selected.Data)^.Category;
2036    aSortOrder  :=  PReportTreeObject(tvReports.Selected.Data)^.SortOrder;
2037    aDaysBack   :=  PReportTreeObject(tvReports.Selected.Data)^.MaxDaysBack;
2038    aIFN        :=  StrToIntDef(PReportTreeObject(tvReports.Selected.Data)^.IFN,0);
2039    aDirect     :=  PReportTreeObject(tvReports.Selected.Data)^.Direct;
2040    aHDR        :=  PReportTreeObject(tvReports.Selected.Data)^.HDR;
2041    aFHIE       :=  PReportTreeObject(tvReports.Selected.Data)^.FHIE;
2042    aFHIEONLY   :=  PReportTreeObject(tvReports.Selected.Data)^.FHIEONLY;
2043    aStartTime  :=  Piece(aQualifier,';',1);
2044    aStopTime   :=  Piece(aQualifier,';',2);
2045    aMax        :=  Piece(aQualifier,';',3);
2046    aRptCode    :=  Piece(aQualifier,';',4);
2047    aQualifierID:= '';
2048    if length(uColChange) > 0 then
2049      begin
2050        aColChange := '';
2051        for i := 0 to lvReports.Columns.Count - 1 do
2052          aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ',';
2053        if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then
2054          SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange);
2055        uColChange := '';
2056      end;
2057    if (aReportType <> 'M') and (aRPC = '') and (CharAt(aID,1) = 'H') then
2058      begin
2059        aReportType :=  'R';
2060        aRptCode    :=  LowerCase(CharAt(aID,1)) + Copy(aID, 2, Length(aID));
2061        aID         :=  '1';
2062        aRPC        :=  'ORWRP REPORT TEXT';
2063        aHSTag      :=  '';
2064      end;
2065    if aReportType = '' then aReportType := 'R';
2066    uReportRPC := aRPC;
2067    uRptID := aID;
2068    uReportID := aID;
2069    uDirect := aDirect;
2070    uReportType := aReportType;
2071    uQualifier := aQualifier;
2072    uSortOrder := aSortOrder;
2073    uRemoteType := aRemote + '^' + aReportType + '^' + IntToStr(aIFN) + '^' + aHeading + '^' + aRptCode + '^' + aDaysBack + '^' + aHDR + '^' + aFHIE + '^' + aFHIEONLY;
2074    pnlRightTop.Height := lblTitle.Height;  // see below
2075    RedrawSuspend(tvReports.Handle);
2076    RedrawSuspend(memText.Handle);
2077    uHState := aHSTag;
2078    Timer1.Enabled := False;
2079    TabControl1.Visible := false;
2080    TabControl1.TabStop := false;
2081    sptHorzRight.Visible := false;
2082    lblProcTypeMsg.Visible := FALSE;
2083    pnlRightMiddle.Visible := false;
2084    pnlProcedures.Visible := FALSE;
2085    if (aRemote = '1') or (aRemote = '2') then
2086      if not(uReportType = 'V') then
2087        if TabControl1.Tabs.Count > 1 then
2088          begin
2089            TabControl1.Visible := true;
2090            TabControl1.TabStop := true;
2091            pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
2092          end;
2093    StatusText('');
2094    uHTMLDoc := '';
2095    BlankWeb;
2096    memText.Lines.Clear;
2097    memText.Parent := pnlRightBottom;
2098    memText.Align := alClient;
2099    UpdatingLvReports := TRUE;    {lw added}
2100    tvProcedures.Items.Clear;
2101    UpdatingLvReports := FALSE;   {lw added}
2102    lblProcTypeMsg.Visible := FALSE;
2103    lvReports.SmallImages := uEmptyImageList;
2104    imgLblImages.ComponentImageListChanged;
2105    lvReports.Items.Clear;
2106    lvReports.Columns.Clear;
2107    uHSComponents.Clear;
2108    DisplayHeading('');
2109    if uReportType = 'H' then
2110      begin
2111        pnlRightMiddle.Visible := false;
2112        pnlRightBottom.Visible := true;
2113        WebBrowser1.Visible := true;
2114        WebBrowser1.TabStop := true;
2115        BlankWeb;
2116        WebBrowser1.BringToFront;
2117        memText.Visible := false;
2118        memText.TabStop := false;
2119      end
2120    else
2121      if uReportType = 'V' then
2122        begin
2123          with lvReports do
2124            begin
2125              Columns.BeginUpdate;
2126              ViewStyle := vsReport;
2127              ColumnHeaders(uColumns, IntToStr(aIFN));
2128              for i := 0 to uColumns.Count -1 do
2129                begin
2130                  uNewColumn := Columns.Add;
2131                  uNewColumn.Caption := piece(uColumns.Strings[i],'^',1);
2132                  if length(uColChange) < 1 then uColChange := IntToStr(aIFN) + '^';
2133                  if piece(uColumns.Strings[i],'^',2) = '1' then
2134                    begin
2135                      uNewColumn.Width := 0;
2136                      uColChange := uColChange + '0,';
2137                    end
2138                  else
2139                    if length(piece(uColumns.Strings[i],'^',10)) > 0 then
2140                      begin
2141                        uColChange := uColChange + piece(uColumns.Strings[i],'^',10) + ',';
2142                        uNewColumn.Width := StrToInt(piece(uColumns.Strings[i],'^',10))
2143                      end
2144                    else
2145                      uNewColumn.Width := ColumnHeaderWidth;  //ColumnTextWidth for width of text
2146                  if (i = 0) and (((aRemote <> '2') and (aRemote <> '1')) or ((TabControl1.Tabs.Count < 2) and (not (aHDR = '1')))) then
2147                    uNewColumn.Width := 0;
2148                end;
2149              Columns.EndUpdate;
2150            end;
2151          pnlRightMiddle.Visible := true;
2152          sptHorzRight.Visible := true;
2153          WebBrowser1.Visible := false;
2154          WebBrowser1.TabStop := false;
2155          pnlRightBottom.Visible := true;
2156          memText.Visible := true;
2157          memText.TabStop := true;
2158          memText.BringToFront;
2159        end
2160      else
2161        begin
2162          pnlRightMiddle.Visible := false;
2163          sptHorzRight.Visible := false;
2164          WebBrowser1.Visible := false;
2165          WebBrowser1.TabStop := false;
2166          pnlRightBottom.Visible := True;
2167          memText.Visible := true;
2168          memText.TabStop := true;
2169          memText.BringToFront;
2170        end;
2171    uLocalReportData.Clear;
2172    RowObjects.Clear;
2173    uRemoteReportData.Clear;
2174    lstHeaders.Visible := false;
2175    lstHeaders.TabStop := false;
2176    lblHeaders.Visible := false;
2177    lstHeaders.Clear;
2178    for i := 0 to RemoteSites.SiteList.Count - 1 do
2179      TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear;
2180    if uFrozen = True then
2181      begin
2182        memo1.visible := False;
2183        memo1.TabStop := False;
2184      end;
2185    Screen.Cursor := crHourGlass;
2186    if (GraphForm <> nil) and (aReportType <> 'G') then
2187    begin
2188      GraphForm.SendToBack;
2189      GraphPanel(false);
2190      GraphFormActive := false;
2191    end;
2192    if aReportType = 'G' then
2193      Graph(aIFN)
2194    else
2195    if aReportType = 'M' then
2196      begin
2197        pnlLeftBottom.Visible := false;
2198        splitter1.Visible := false;
2199      end
2200    else
2201      begin
2202       uQualifierType := StrToIntDef(aRptCode,0);
2203        case uQualifierType of
2204          QT_OTHER:
2205            begin      //      = 0
2206              memText.Lines.Clear;
2207              If copy(aRptCode,1,2) = 'h0' then  //HS Adhoc
2208                begin
2209                  if TabControl1.TabIndex > 0 then
2210                    begin
2211                      InfoBox('Adhoc report is not available for remote sites',
2212                        'Information', MB_OK);
2213                      TabControl1.TabIndex := 0;
2214                    end;
2215                  with RemoteSites.SiteList do
2216                  for j := 0 to Count - 1 do
2217                    begin
2218                      TRemoteSite(RemoteSites.SiteList[j]).ReportClear;
2219                      TRemoteSite(RemoteSites.SiteList[j]).LabClear;
2220                    end;
2221                  uHTMLDoc := '';
2222                  if WebBrowser1.Visible = true then BlankWeb;
2223                  ExecuteAdhoc1;  //Calls Adhoc form
2224                  if uLocalReportData.Count < 1 then
2225                    uReportInstruction := '<No Report Available>'
2226                  else
2227                    begin
2228                      if TabControl1.TabIndex < 1 then
2229                        QuickCopy(uLocalReportData,memText);
2230                      if WebBrowser1.Visible = true then
2231                        begin
2232                          if uReportType = 'R' then
2233                            uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST
2234                          else
2235                            uHTMLDoc := uHTMLPatient + uLocalReportData.Text;
2236                          BlankWeb;
2237                        end;
2238                    end;
2239                  TabControl1.OnChange(nil);
2240                end
2241              else
2242                begin
2243                  pnlLeftBottom.Visible := false;
2244                  splitter1.Visible := false;
2245                  StatusText('Retrieving ' + tvReports.Selected.Text + '...');
2246                  GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
2247                  uReportInstruction := #13#10 + 'Retrieving data...';
2248                  TabControl1.OnChange(nil);
2249                  if not(piece(uRemoteType, '^', 9) = '1') then
2250                    begin
2251                      LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState);
2252                      QuickCopy(uLocalReportData, memText);
2253                    end;
2254                  if uLocalReportData.Count > 0 then
2255                      TabControl1.OnChange(nil);
2256                  StatusText('');
2257                end;
2258            end;
2259          QT_HSTYPE:
2260            begin      //      = 1
2261              pnlLeftBottom.Visible := false;
2262              splitter1.Visible := false;
2263            end;
2264          QT_DATERANGE:
2265            begin      //      = 2
2266  
2267              ListReportDateRanges(lstQualifier.Items);
2268                if lstQualifier.ItemID = '' then
2269                  begin
2270                    lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2271                    lvReports.SmallImages := uEmptyImageList;
2272                    imgLblImages.ComponentImageListChanged;
2273                    lvReports.Items.Clear;
2274                    lstQualifierClick(self);
2275                  end
2276                else
2277                  lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2278  
2279              lblQualifier.Caption := 'Date Range';
2280              pnlLeftBottom.Visible := true;
2281              splitter1.Visible := true;
2282            end;
2283          QT_IMAGING:
2284            begin      //      = 3
2285              pnlLeftBottom.Visible := false;
2286              splitter1.Visible := false;
2287              ListImagingExams(uLocalReportData);
2288              aRadParam := ImagingParams;
2289              uQualifier := StringReplace(aRadParam, '^', ';', [rfReplaceAll]);
2290              with lvReports do
2291                begin
2292                  Items.BeginUpdate;
2293                  ViewStyle := vsReport;
2294                  SmallImages := dmodShared.imgImages;
2295                  imgLblImages.ComponentImageListChanged;
2296                  CurrentParentNode := nil;
2297                  CurrentNode := nil;
2298                  for i := 0 to uLocalReportData.Count - 1 do
2299                    begin
2300                      ListItem := Items.Add;
2301                      ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
2302                      if uColumns.Count > 1 then
2303                        begin
2304                          for j := 2 to uColumns.Count do
2305                            ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
2306                            // if pieces are (added to/removed from) return string, PLEASE UPDATE THIS!!  (RV)
2307                            if Piece(uLocalReportData[i], U, 9) = 'Y' then
2308                              ListItem.SubItemImages[1] := IMG_1_IMAGE
2309                            else
2310                              ListItem.SubItemImages[1] := IMG_NO_IMAGES;
2311                        end;
2312                      LoadProceduresTreeView(uLocalReportData[i], CurrentParentNode, CurrentNode);
2313                      if CurrentNode <> nil then
2314                         PProcTreeObj(CurrentNode.Data)^.Associate := lvReports.Items.IndexOf(ListItem);
2315                    end;
2316                  if tvProcedures.Items.Count > 0 then
2317                     tvProcedures.Selected := tvProcedures.Items.GetFirstNode;
2318                  lblProcTypeMsg.Visible := TRUE;
2319                  pnlRightTop.Height := lblTitle.Height + lblProcTypeMsg.Height;
2320                  pnlLeftBottom.Visible := FALSE;
2321                  pnlProcedures.Visible := TRUE;
2322                  Splitter1.Visible := True;                                      
2323                  if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
2324                  Items.EndUpdate;
2325                  tvProcedures.TopItem := tvProcedures.Selected;
2326                end;
2327              if TabControl1.TabIndex > 0 then TabControl1.TabIndex := 0;
2328              if uLocalReportData.Count > 0
2329                then x := #13#10 + 'Select an imaging exam...'
2330                else x := #13#10 + 'No imaging reports found...';
2331              uReportInstruction := PChar(x);
2332              memText.Lines.Add(uReportInstruction);
2333              if WebBrowser1.Visible = true then
2334                begin
2335                  uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
2336                  BlankWeb;
2337                end;
2338            end;
2339          QT_NUTR:
2340            begin      //      = 4
2341              lblQualifier.Caption := 'Nutritional Assessments';
2342              pnlLeftBottom.Visible := false;
2343              splitter1.Visible := false;
2344              ListNutrAssessments(uLocalReportData);
2345              with lvReports do
2346                begin
2347                  Items.BeginUpdate;
2348                  ViewStyle := vsReport;
2349                  for i := 0 to uLocalReportData.Count - 1 do
2350                    begin
2351                      ListItem := Items.Add;
2352                      ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
2353                      if uColumns.Count > 1 then
2354                        for j := 2 to uColumns.Count do
2355                          ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
2356                    end;
2357                  if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
2358                  Items.EndUpdate;
2359                end;
2360              if TabControl1.TabIndex > 0 then TabControl1.TabIndex := 0;
2361              if uLocalReportData.Count > 0
2362                then x := #13#10 + 'Select an assessment date...'
2363                else x := #13#10 + 'No nutritional assessments found...';
2364              uReportInstruction := PChar(x);
2365              memText.Lines.Add(uReportInstruction);
2366              if WebBrowser1.Visible = true then
2367                begin
2368                  uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
2369                  BlankWeb;
2370                end;
2371            end;
2372          QT_HSCOMPONENT:
2373            begin      //      = 5
2374              if Notifications.AlertData <> '' then
2375                pnlRightMiddle.Height := 75
2376              else
2377                pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2);
2378              pnlLeftBottom.Visible := false;
2379              splitter1.Visible := false;
2380              StatusText('Retrieving ' + tvReports.Selected.Text + '...');
2381              uReportInstruction := #13#10 + 'Retrieving data...';
2382              lvReports.SmallImages := uEmptyImageList;
2383              imgLblImages.ComponentImageListChanged;
2384              lvReports.Items.Clear;
2385              RowObjects.Clear;
2386              memText.Lines.Clear;
2387              if (length(piece(aHSTag,';',2)) > 0) then
2388                begin
2389                  if aCategory <> '0' then
2390                    begin
2391                      ListReportDateRanges(lstQualifier.Items);
2392                      aQualifierID := lstQualifier.ItemID;
2393                      if aQualifierID = '' then
2394                        begin
2395                          if aHDR = '1' then
2396                            lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2397                          else
2398                            if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2399                          lstQualifierClick(self);
2400                        end
2401                      else
2402                        begin
2403                          GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2404                          if aHDR = '1' then
2405                            lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2406                          else
2407                            if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2408                          lstQualifierClick(self);
2409                        end;
2410                      lblQualifier.Caption := 'Date Range';
2411                      pnlLeftBottom.Visible := true;
2412                      splitter1.Visible := true;
2413                    end
2414                  else
2415                    begin
2416                      if not (aRemote = '2' ) then
2417                        GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2418                      if not(piece(uRemoteType, '^', 9) = '1') then
2419                        begin
2420                          LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
2421                          LoadListView(uLocalReportData);
2422                        end;
2423                    end;
2424                end
2425              else
2426                begin
2427                  if (aRemote = '1') or (aRemote = '2') then
2428                    if TabControl1.Tabs.Count > 1 then
2429                      ShowTabControl;
2430                  sptHorzRight.Visible := false;
2431                  pnlRightMiddle.Visible := false;
2432                  GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2433                  if not(piece(uRemoteType, '^', 9) = '1') then
2434                    LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
2435                  if uLocalReportData.Count < 1 then
2436                    uReportInstruction := '<No Report Available>'
2437                  else
2438                    begin
2439                      if TabControl1.TabIndex < 1 then
2440                        QuickCopy(uLocalReportData,memText);
2441                    end;
2442                  TabControl1.OnChange(nil);
2443                  if aCategory <> '0' then
2444                    begin
2445                      ListReportDateRanges(lstQualifier.Items);
2446                      if lstQualifier.ItemID = '' then
2447                        begin
2448                          lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2449                          lstQualifierClick(self);
2450                        end
2451                      else
2452                        lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2453  
2454                      lblQualifier.Caption := 'Date Range';
2455                      pnlLeftBottom.Visible := true;
2456                      splitter1.Visible := true;
2457                    end
2458                  else
2459                    begin
2460                      if uLocalReportData.Count < 1 then
2461                        begin
2462                          uReportInstruction := '<No Report Available>';
2463                          memText.Lines.Add(uReportInstruction);
2464                        end
2465                      else
2466                        begin
2467                          QuickCopy(uLocalReportData,memText);
2468                          TabControl1.OnChange(nil);
2469                        end;
2470                    end;
2471                end;
2472              StatusText('');
2473            end;
2474          QT_HSWPCOMPONENT:
2475            begin      //      = 6
2476              if Notifications.AlertData <> '' then
2477                pnlRightMiddle.Height := 75
2478              else
2479                pnlRightMiddle.Height := pnlRight.Height - (pnlRight.Height div 2);
2480              pnlLeftBottom.Visible := false;
2481              splitter1.Visible := false;
2482              StatusText('Retrieving ' + tvReports.Selected.Text + '...');
2483              uReportInstruction := #13#10 + 'Retrieving data...';
2484              TabControl1.OnChange(nil);
2485              RowObjects.Clear;
2486              memText.Lines.Clear;
2487              lvReports.SmallImages := uEmptyImageList;
2488              imgLblImages.ComponentImageListChanged;
2489              lvReports.Items.Clear;
2490              if (length(piece(aHSTag,';',2)) > 0) then
2491                begin
2492                  if aCategory <> '0' then
2493                    begin
2494                      ListReportDateRanges(lstQualifier.Items);
2495                      aQualifierID := lstQualifier.ItemID;
2496                      if aQualifierID = '' then
2497                        begin
2498                          if aHDR = '1' then
2499                            lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2500                          else
2501                            if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2502                          lstQualifierClick(self);
2503                        end
2504                      else
2505                        begin
2506                          GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2507                          if aHDR = '1' then
2508                            lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000')
2509                          else
2510                            if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2511                          lstQualifierClick(self);
2512                        end;
2513                      lblQualifier.Caption := 'Date Range';
2514                      pnlLeftBottom.Visible := true;
2515                      splitter1.Visible := true;
2516                    end
2517                  else
2518                    begin
2519                      GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2520                      if not (aRemote = '2' ) and (not(piece(uRemoteType, '^', 9) = '1')) then
2521                        begin
2522                          LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
2523                          LoadListView(uLocalReportData);
2524                        end;
2525                    end;
2526                end
2527              else
2528                begin
2529                  if (aRemote = '1') or (aRemote = '2') then
2530                    ShowTabControl;
2531                  sptHorzRight.Visible := false;
2532                  pnlRightMiddle.Visible := false;
2533                  GoRemote(uRemoteReportData, aID, aQualifier, aRPC, uHState, aHDR, aFHIE);
2534                  if not(piece(uRemoteType, '^', 9) = '1') then
2535                    LoadReportText(uLocalReportData, aID, aQualifier, aRPC, uHState);
2536                  if uLocalReportData.Count < 1 then
2537                    uReportInstruction := '<No Report Available>'
2538                  else
2539                    begin
2540                      if TabControl1.TabIndex < 1 then
2541                        QuickCopy(uLocalReportData,memText);
2542                    end;
2543                  TabControl1.OnChange(nil);
2544                  if aCategory <> '0' then
2545                    begin
2546  
2547                      ListReportDateRanges(lstQualifier.Items);
2548                      if lstQualifier.ItemID = '' then
2549                        begin
2550                          lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2551                          lstQualifierClick(self);
2552                        end
2553                      else
2554                        lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime);
2555  
2556                      lblQualifier.Caption := 'Date Range';
2557                      pnlLeftBottom.Visible := true;
2558                      splitter1.Visible := true;
2559                    end
2560                  else
2561                    begin
2562                      LoadListView(uLocalReportData);
2563                    end;
2564                end;
2565              StatusText('');
2566            end;
2567          QT_PROCEDURES:
2568            begin      //      = 19
2569              pnlLeftBottom.Visible := false;
2570              splitter1.Visible := false;
2571              ListProcedures(uLocalReportData);
2572              with lvReports do
2573                begin
2574                  Items.BeginUpdate;
2575                  ViewStyle := vsReport;
2576                  for i := 0 to uLocalReportData.Count - 1 do
2577                    begin
2578                      ListItem := Items.Add;
2579                      ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
2580                      if uColumns.Count > 1 then
2581                        for j := 2 to uColumns.Count do
2582                          ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
2583                    end;
2584                  if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
2585                  Items.EndUpdate;
2586                end;
2587              if uLocalReportData.Count > 0
2588                then x := #13#10 + 'Select a procedure...'
2589                else x := #13#10 + 'No procedures found...';
2590              uReportInstruction := PChar(x);
2591              if WebBrowser1.Visible = true then
2592                begin
2593                  uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
2594                  BlankWeb;
2595                end;
2596              if WebBrowser1.Visible = true then BlankWeb;
2597            end;
2598          QT_SURGERY:
2599            begin      //      = 28
2600              pnlLeftBottom.Visible := false;
2601              splitter1.Visible := false;
2602              ListSurgeryReports(uLocalReportData);
2603              with lvReports do
2604                begin
2605                  Items.BeginUpdate;
2606                  ViewStyle := vsReport;
2607                  for i := 0 to uLocalReportData.Count - 1 do
2608                    begin
2609                      ListItem := Items.Add;
2610                      ListItem.Caption := piece(piece(uLocalReportData[i],'^',1),';',1);
2611                      if uColumns.Count > 1 then
2612                        for j := 2 to uColumns.Count do
2613                          ListItem.SubItems.Add(piece(uLocalReportData[i],'^',j));
2614                    end;
2615                  if lvReports.Columns.Count > 0 then lvReports.Columns[1].Width := 0;
2616                  Items.EndUpdate;
2617                end;
2618              if uLocalReportData.Count > 0
2619                then x := #13#10 + 'Select a surgery case...'
2620                else x := #13#10 + 'No surgery cases found...';
2621              uReportInstruction := PChar(x);
2622              memText.Lines.Add(uReportInstruction);
2623              uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST;
2624             if WebBrowser1.Visible = true then BlankWeb;
2625            end;
2626          else
2627            begin      //      = ?
2628              uQualifierType := QT_OTHER;
2629              pnlLeftBottom.Visible := false;
2630              splitter1.Visible := false;
2631              StatusText('Retrieving ' + tvReports.Selected.Text + '...');
2632              GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE);
2633              uReportInstruction := #13#10 + 'Retrieving data...';
2634              TabControl1.OnChange(nil);
2635              //LoadReportText(uLocalReportData, aID, aRptCode, aRPC, uHState);
2636              if not(piece(uRemoteType, '^', 9) = '1') then
2637                LoadReportText(uLocalReportData, aID, '', aRPC, uHState);
2638              if uLocalReportData.Count < 1 then
2639                uReportInstruction := '<No Report Available>'
2640              else
2641                begin
2642                  if TabControl1.TabIndex < 1 then
2643                    QuickCopy(uLocalReportData,memText);
2644                end;
2645              TabControl1.OnChange(nil);
2646              StatusText('');
2647            end;
2648          lstQualifier.Caption := lblQualifier.Caption;
2649        end;
2650      end;
2651    if not (aHDR = '1') then
2652      if aCategory <> '0' then
2653          DisplayHeading(uQualifier)
2654      else
2655        DisplayHeading('');
2656  
2657    SendMessage(tvReports.Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
2658    RedrawActivate(tvReports.Handle);
2659    RedrawActivate(memText.Handle);
2660    if WebBrowser1.Visible = true then
2661      begin
2662        BlankWeb;
2663        WebBrowser1.BringToFront;
2664      end
2665    else if not GraphFormActive then
2666      begin
2667        memText.Visible := true;
2668        memText.TabStop := true;
2669        memText.BringToFront;
2670      end
2671    else
2672      begin
2673        GraphPanel(true);
2674        with GraphForm do
2675        begin
2676          lstDateRange.Items := cboDateRange.Items;
2677          lstDateRange.ItemIndex := cboDateRange.ItemIndex;
2678          ViewSelections;
2679          BringToFront;
2680        end;
2681      end;
2682    lvReports.Columns.BeginUpdate;
2683    lvReports.Columns.EndUpdate;
2684    Screen.Cursor := crDefault;
2685  end;
2686  
2687  procedure TfrmReports.lvReportsColumnClick(Sender: TObject;
2688    Column: TListColumn);
2689  var
2690    ClickedColumn: Integer;
2691    a1, a2: integer;
2692    s,s1,s2: string;
2693  begin
2694    inherited;
2695    a1 := StrToIntDef(piece(uSortOrder,':',1),0) - 1;
2696    a2 := StrToIntDef(piece(uSortOrder,':',2),0) - 1;
2697    ClickedColumn := Column.Index;
2698    ColumnToSort := Column.Index;
2699    SortIdx1 := StrToIntDef(piece(uColumns[ColumnToSort],'^',9),0);
2700    SortIdx2 := 0;
2701    SortIdx3 := 0;
2702    if a1 > -1 then SortIdx2 := StrToIntDef(piece(uColumns[a1],'^',9),0);
2703    if a2 > -1 then SortIdx3 := StrToIntDef(piece(uColumns[a2],'^',9),0);
2704    if a1 = ColumnToSort then
2705      begin
2706        SortIdx2 := SortIdx3;
2707        SortIdx3 := 0;
2708      end;
2709    if a2 = ColumnToSort then
2710        SortIdx3 := 0;
2711    if ClickedColumn = ColumnToSort then
2712      ColumnSortForward := not ColumnSortForward
2713    else
2714      ColumnSortForward := true;
2715    ColumnToSort := ClickedColumn;
2716    uFirstSort := ColumnToSort;
2717    uSecondSort := a1;
2718    uThirdSort := a2;
2719    lvReports.Hint := '';
2720    if ColumnSortForward = true then
2721      s := 'Sorted forward'
2722    else
2723      s := 'Sorted reverse';
2724    s1 := piece(uColumns[uFirstSort],'^',1);
2725    s2 := '';
2726    if length(piece(s1,' ',2)) > 0 then
2727      s2 := pieces(s1,' ',2,99);
2728    if length(s2) > 0 then s2 := StripSpace(s2);
2729    s := s + ' by ' + piece(s1,' ',1) + ' ' + s2;
2730    if (a1 <> uFirstSort) and (a1 > -1) then
2731      begin
2732        s1 :=  piece(uColumns[a1], '^', 1);
2733        s2 := '';
2734        if length(piece(s1,' ',2)) > 0 then
2735          s2 := pieces(s1,' ',2,99);
2736        if length(s2) > 0 then s2 := StripSpace(s2);
2737        s := s + ' then by ' +  piece(s1,' ',1) + ' ' + s2;
2738      end;
2739    if (a2 <> uFirstSort) and (a2 > -1) then
2740      begin
2741        s1 :=  piece(uColumns[a2], '^', 1);
2742        s2 := '';
2743        if length(piece(s1,' ',2)) > 0 then
2744          s2 := pieces(s1,' ',2,99);
2745        if length(s2) > 0 then s2 := StripSpace(s2);
2746        s := s + ' then by ' +  piece(s1,' ',1) + ' ' + s2;
2747      end;
2748    lvReports.Hint := s;
2749    lvReports.CustomSort(nil, 0);
2750  end;
2751  
2752  procedure TfrmReports.lvReportsCompare(Sender: TObject; Item1,
2753    Item2: TListItem; Data: Integer; var Compare: Integer);
2754  
2755    function CompareValues(Col: Integer): integer;
2756    var
2757      ix: Integer;
2758      s1, s2: string;
2759      v1, v2: extended;
2760      d1, d2: TFMDateTime;
2761    begin
2762      inherited;
2763      if ColumnToSort = 0 then
2764        Result := CompareText(Item1.Caption,Item2.Caption)
2765      else
2766        begin
2767          ix := ColumnToSort - 1;
2768          case Col of
2769            0:                        //strings
2770              begin
2771                if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
2772                  s1 := Item1.SubItems[ix]
2773                else
2774                  s1 := '0';
2775                if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
2776                  s2 := Item2.SubItems[ix]
2777                else
2778                  s2 := '0';
2779                Result := CompareText(s1,s2);
2780              end;
2781  
2782            1:                        //integers
2783              begin
2784                if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then
2785                  s1 := Item1.SubItems[ix]
2786                else
2787                  s1 := '0';
2788                if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then
2789                  s2 := Item2.SubItems[ix]
2790                else
2791                  s2 := '0';
2792                IsValidNumber(s1, v1);
2793                IsValidNumber(s2, v2);
2794                if v1 > v2 then
2795                  Result := 1
2796                else
2797                if v1 < v2 then
2798                  Result := -1
2799                else
2800                  Result := 0;
2801              end;
2802  
2803            2:                        //date/times
2804              begin
2805                if(Item1.SubItems.Count > 1) and (ix < Item1.SubItems.Count) then
2806                  s1 := Item1.SubItems[ix]
2807                else
2808                  s1 := '1/1/1700';
2809                if(Item2.SubItems.Count > 1) and (ix < Item2.SubItems.Count) then
2810                  s2 := Item2.SubItems[ix]
2811                else
2812                  s2 := '1/1/1700';
2813                d1 := StringToFMDateTime(s1);
2814                d2 := StringToFMDateTime(s2);
2815                if d1 > d2 then
2816                  Result := 1
2817                else
2818                if d1 < d2 then
2819                  Result := -1
2820                else
2821                  Result := 0;
2822              end;
2823            else
2824              Result := 0; // to make the compiler happy
2825          end;
2826        end;
2827    end;
2828  begin
2829    ColumnToSort := uFirstSort;
2830    Compare := CompareValues(SortIdx1);
2831    if Compare = 0 then
2832    begin
2833      if (uSecondSort > -1) and (uFirstSort <> uSecondSort) then
2834        begin
2835          ColumnToSort := uSecondSort;
2836          Compare := CompareValues(SortIdx2);
2837        end;
2838      if Compare = 0 then
2839        if (uThirdSort > -1) and (uFirstSort <> uThirdSort) and (uSecondSort <> uThirdSort) then
2840          begin
2841            ColumnToSort := uThirdSort;
2842            Compare := CompareValues(SortIdx3);
2843          end;
2844    end;
2845    if not ColumnSortForward then Compare := -Compare;
2846  end;
2847  
2848  procedure TfrmReports.lvReportsSelectItem(Sender: TObject; Item: TListItem;
2849    Selected: Boolean);
2850  var
2851    aID, aMoreID, aSID: string;
2852    i,j,k: integer;
2853    aBasket: TStringList;
2854    aWPFlag: Boolean;
2855    x, HasImages: string;
2856  
2857  begin
2858    inherited;
2859    if not selected then Exit;
2860    aBasket := TStringList.Create;
2861    uLocalReportData.Clear;
2862    aWPFlag := false;
2863    with lvReports do
2864      begin
2865        aID := Item.SubItems[0];
2866        case uQualifierType of
2867              QT_OTHER:
2868                begin      //      = 0
2869  
2870                end;
2871              QT_HSTYPE:
2872                begin      //      = 1
2873                  aMoreID := ';' +  Item.SubItems[2];
2874                end;
2875              QT_DATERANGE:
2876                begin      //      = 2
2877  
2878                end;
2879              QT_IMAGING:
2880                begin      //      = 3
2881                  if lvReports.SelCount = 1 then
2882                    begin
2883                      memText.Lines.Clear;
2884                      if not UpdatingTvProcedures then
2885                        begin
2886                        UpdatingLvReports := TRUE;
2887                        for i := 0 to (tvProcedures.Items.Count - 1) do
2888                          if PProcTreeObj(tvProcedures.Items[i].Data)^.ExamDtTm = Item.SubItems[0] then
2889                             if PProcTreeObj(tvProcedures.Items[i].Data)^.ProcedureName = Item.SubItems[2] then
2890                                begin
2891                                  if tvProcedures.Items[i].Parent <> nil then
2892                                     begin
2893                                       tvProcedures.Items[i].Parent.Expanded := True;
2894                                       if PProcTreeObj(tvProcedures.Items[i].Data)^.MemberOfSet = '1' then
2895                                          lblProcTypeMsg.Caption := 'Descendent Procedure'
2896                                       else if PProcTreeObj(tvProcedures.Items[i].Data)^.MemberOfSet = '2' then
2897                                               lblProcTypeMsg.Caption := 'Descendent Procedure with shared report';
2898                                     end
2899                                  else
2900                                     lblProcTypeMsg.Caption := 'Standalone (single) procedure';
2901                                  tvProcedures.Items[i].Selected := TRUE;
2902                                end;
2903                        UpdatingLvReports := False;
2904                        end;
2905                    end
2906                  else
2907                    if not UpdatingTvProcedures then
2908                       tvProcedures.Selected := nil;
2909  
2910                  if MemText.Lines.Count > 0 then
2911                    memText.Lines.Add('===============================================================================');
2912                  aMoreID := '#' + Item.SubItems[5];
2913                  SetPiece(uRemoteType,'^',5,aID + aMoreID);
2914                  if not(piece(uRemoteType, '^', 9) = '1') then
2915                    begin
2916                      LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
2917                      for i := 0 to uLocalReportData.Count - 1 do
2918                        MemText.Lines.Add(uLocalReportData[i]);
2919                      if Item.SubItems.Count > 5 then
2920                        x := 'RA^' + aID + U + Item.SubItems[5]
2921                      else
2922                        x := 'RA^' + aID;
2923                      HasImages := BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE];
2924                      SetPiece(x, U, 10, HasImages);
2925                      NotifyOtherApps(NAE_REPORT, x);
2926                    end;
2927                end;
2928              QT_NUTR:
2929                begin      //      = 4
2930                  if lvReports.SelCount = 1 then
2931                    memText.Lines.Clear;
2932                  if MemText.Lines.Count > 0 then
2933                    memText.Lines.Add('===============================================================================');
2934                  SetPiece(uRemoteType,'^',5,aID);
2935                  if not(piece(uRemoteType, '^', 9) = '1') then
2936                    begin
2937                      LoadReportText(uLocalReportData, uRptID, aID, uReportRPC, '');
2938                      for i := 0 to uLocalReportData.Count - 1 do
2939                        MemText.Lines.Add(uLocalReportData[i]);
2940                    end;
2941                end;
2942              QT_HSWPCOMPONENT:
2943                begin      //      = 6
2944                  if lvReports.SelCount < 3 then
2945                    begin
2946                      memText.Lines.Clear;
2947                      ulvSelectOn := false;
2948                    end;
2949                  aBasket.Clear;
2950                  if (SelCount = 2) and (ulvSelectOn = false) then
2951                    begin
2952                      ulvSelectOn := true;
2953                      for i := 0 to Items.Count - 1 do
2954                        if (Items[i].Selected) and (aID <> Items[i].SubItems[0]) then
2955                          begin
2956                            aSID := Items[i].SubItems[0];
2957                            for j := 0 to RowObjects.ColumnList.Count - 1 do
2958                              if piece(aSID,':',1) = piece(TCellObject(RowObjects.ColumnList[j]).Handle,':',1) then
2959                                if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[j]).Site,';',1)) then
2960                                  if (TCellObject(RowObjects.ColumnList[j]).Data.Count > 0) and
2961                                    (TCellObject(RowObjects.ColumnList[j]).Include = '1') then
2962                                    begin
2963                                      aWPFlag := true;
2964                                      MemText.Lines.Add(TCellObject(RowObjects.ColumnList[j]).Name);
2965                                      FastAssign(TCellObject(RowObjects.ColumnList[j]).Data, aBasket);
2966                                      for k := 0 to aBasket.Count - 1 do
2967                                        MemText.Lines.Add(' ' + aBasket[k]);
2968                                    end;
2969                            if aWPFlag = true then
2970                              begin
2971                                memText.Lines.Add('Facility: ' + Item.Caption);
2972                                memText.Lines.Add('===============================================================================');
2973                              end;
2974                          end;
2975                    end;
2976                  aBasket.Clear;
2977                  aWPFlag := false;
2978                  for i := 0 to RowObjects.ColumnList.Count - 1 do
2979                    if piece(aID,':',1) = piece(TCellObject(RowObjects.ColumnList[i]).Handle,':',1) then
2980                      if Item.Caption = (piece(TCellObject(RowObjects.ColumnList[i]).Site,';',1)) then
2981                        if (TCellObject(RowObjects.ColumnList[i]).Data.Count > 0) and
2982                          (TCellObject(RowObjects.ColumnList[i]).Include = '1') then
2983                          begin
2984                            aWPFlag := true;
2985                            MemText.Lines.Add(TCellObject(RowObjects.ColumnList[i]).Name);
2986                            FastAssign(TCellObject(RowObjects.ColumnList[i]).Data, aBasket);
2987                            for j := 0 to aBasket.Count - 1 do
2988                              MemText.Lines.Add(' ' + aBasket[j]);
2989                          end;
2990                  if aWPFlag = true then
2991                    begin
2992                      memText.Lines.Add('Facility: ' + Item.Caption);
2993                      memText.Lines.Add('===============================================================================');
2994                    end;
2995                  if uRptID = 'OR_R18:IMAGING' then
2996                  begin
2997                    if (Item.SubItems.Count > 8) then                                             //has id, may have case (?)
2998                    begin
2999                      x := 'RA^' + Item.SubItems[8] + U + Item.SubItems[4] + U + Item.Caption;
3000                      SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
3001                      NotifyOtherApps(NAE_REPORT, x);
3002                    end
3003                    else if (Item.SubItems.Count > 4) then
3004                    begin
3005                      x := 'RA^' + U + U + Item.SubItems[4] + U + Item.Caption;
3006                      SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]);
3007                      NotifyOtherApps(NAE_REPORT, x);
3008                    end
3009                    else if Item.SubItemImages[1] = IMG_1_IMAGE then
3010                    begin
3011                      memText.Lines.Insert(0,'<Imaging links not active at this site>');
3012                      memText.Lines.Insert(1,' ');
3013                    end;
3014                  end;
3015                  if uRptID = 'OR_PN:PROGRESS NOTES' then
3016                    if (Item.SubItems.Count > 7) then
3017                      begin
3018                        if StrToIntDef(Item.SubItems[7], 0) > 0 then HasImages := '1' else HasImages := '0';
3019                        x := 'PN^' + Item.SubItems[7] + U + Item.SubItems[1] + U + Item.Caption;
3020                        SetPiece(x, U, 10, HasImages);
3021                        NotifyOtherApps(NAE_REPORT, x);
3022                      end;
3023                end;
3024              QT_PROCEDURES:
3025                begin      //      = 19
3026                  if lvReports.SelCount = 1 then
3027                    memText.Lines.Clear;
3028                  if MemText.Lines.Count > 0 then
3029                    memText.Lines.Add('===============================================================================');
3030                  SetPiece(uRemoteType,'^',5,aID);
3031                  if not(piece(uRemoteType, '^', 9) = '1') then
3032                    begin
3033                      LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
3034                      for i := 0 to uLocalReportData.Count - 1 do
3035                        MemText.Lines.Add(uLocalReportData[i]);
3036                    end;
3037                end;
3038              QT_SURGERY:
3039                begin      //      = 28
3040                  if lvReports.SelCount = 1 then
3041                    memText.Lines.Clear;
3042                  if MemText.Lines.Count > 0 then
3043                    memText.Lines.Add('===============================================================================');
3044                  SetPiece(uRemoteType,'^',5,aID);
3045                  if not(piece(uRemoteType, '^', 9) = '1') then
3046                    begin
3047                      LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
3048                      for i := 0 to uLocalReportData.Count - 1 do
3049                        MemText.Lines.Add(uLocalReportData[i]);
3050                      NotifyOtherApps(NAE_REPORT, 'SUR^' + aID);
3051                    end;
3052                end;
3053        end;
3054        memText.Lines.Insert(0,' ');
3055        memText.Lines.Delete(0);
3056      end;
3057    aBasket.Free;
3058  end;
3059  
3060  procedure TfrmReports.tvReportsExpanding(Sender: TObject; Node: TTreeNode;
3061    var AllowExpansion: Boolean);
3062  begin
3063    inherited;
3064    tvReports.Selected := Node;
3065  end;
3066  
3067  procedure TfrmReports.tvReportsCollapsing(Sender: TObject; Node: TTreeNode;
3068    var AllowCollapse: Boolean);
3069  begin
3070    inherited;
3071    tvReports.Selected := Node;
3072  end;
3073  
3074  
3075  procedure TfrmReports.Print1Click(Sender: TObject);
3076  begin
3077    inherited;
3078    RequestPrint;
3079  end;
3080  
3081  procedure TfrmReports.Copy1Click(Sender: TObject);
3082  var
3083    i,j: integer;
3084    line: string;
3085    ListItem: TListItem;
3086    aText: String;
3087  begin
3088    inherited;
3089    ClipBoard;
3090    aText := '';
3091    for i := 0 to lvReports.Items.Count - 1 do
3092      if lvReports.Items[i].Selected then
3093      begin
3094        ListItem := lvReports.Items[i];
3095        line := '';
3096        for j := 1 to lvReports.Columns.Count - 1 do
3097          begin
3098            if (lvReports.Column[j].Width <> 0) and (j < (ListItem.SubItems.Count + 1)) then
3099              line := line + '  ' + ListItem.SubItems[j-1];
3100          end;
3101        if (length(line) > 0) and (lvReports.Column[0].Width <> 0) then
3102          line := ListItem.Caption + '  ' + line;
3103        if length(aText) > 0 then
3104          aText := aText + CRLF + line
3105        else aText := line;
3106      end;
3107    ClipBoard.Clear;
3108    ClipBoard.AsText := aText;
3109  end;
3110  
3111  procedure TfrmReports.Copy2Click(Sender: TObject);
3112  begin
3113    inherited;
3114    memText.CopyToClipboard;
3115  end;
3116  
3117  procedure TfrmReports.Print2Click(Sender: TObject);
3118  begin
3119    inherited;
3120    RequestPrint;
3121  end;
3122  
3123  procedure TfrmReports.lvReportsKeyUp(Sender: TObject; var Key: Word;
3124    Shift: TShiftState);
3125  begin
3126    inherited;
3127    if (Key = 67) and (ssCtrl in Shift) then
3128      Copy1Click(Self);
3129    if (Key = 65) and (ssCtrl in Shift) then
3130      SelectAll1Click(Self);
3131  end;
3132  
3133  procedure TfrmReports.SelectAll1Click(Sender: TObject);
3134  var
3135    i: integer;
3136  begin
3137    inherited;
3138      for i := 0 to lvReports.Items.Count - 1 do
3139         lvReports.Items[i].Selected := true;
3140  end;
3141  
3142  procedure TfrmReports.SelectAll2Click(Sender: TObject);
3143  begin
3144    inherited;
3145    memText.SelectAll;
3146  end;
3147  
3148     
3149  procedure TfrmReports.tvReportsKeyDown(Sender: TObject; var Key: Word;
3150    Shift: TShiftState);
3151  begin
3152    inherited;
3153    case Key of
3154      VK_LBUTTON, VK_RETURN, VK_SPACE:
3155      begin
3156        tvReportsClick(Sender);
3157        Key := 0;
3158      end;
3159    end;
3160  end;
3161  
3162  procedure TfrmReports.ShowTabControl;
3163  begin
3164    if TabControl1.Tabs.Count > 1 then
3165      begin
3166        TabControl1.Visible := true;
3167        TabControl1.TabStop := true;
3168        pnlRightTop.Height := lblTitle.Height + TabControl1.Height;
3169      end;
3170  end;
3171  
3172  procedure TfrmReports.Memo1KeyUp(Sender: TObject; var Key: Word;
3173    Shift: TShiftState);
3174  begin
3175    inherited;
3176    if (Key = VK_TAB) then
3177    begin
3178      if ssShift in Shift then
3179      begin
3180        FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3181        Key := 0;
3182      end
3183      else if ssCtrl	in Shift then
3184      begin
3185        FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
3186        Key := 0;
3187      end;
3188    end;
3189    if (key = VK_ESCAPE) then begin
3190      FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3191      key := 0;
3192    end;
3193  end;
3194  
3195  procedure TfrmReports.LoadProceduresTreeView(x: string; var CurrentParentNode: TTreeNode; var CurrentNode: TTreeNode);
3196  var
3197    PTO, PTO2: PProcTreeObj;
3198  
3199  begin
3200    PTO := MakeProcedureTreeObject(x);
3201    PTO2 := MakeProcedureTreeObject(x);
3202    PTO2.ProcedureName := '';
3203    if PTO^.ParentName = '' then
3204       begin // New stand-alone
3205         CurrentParentNode := tvProcedures.Items.AddObject(CurrentParentNode,PTO^.ProcedureName,PTO);
3206         CurrentNode := CurrentParentNode;
3207       end
3208    else
3209      if (CurrentParentNode <> nil) and (PTO^.ParentName = PProcTreeObj(CurrentParentNode.Data)^.ParentName) then
3210            // another child for same parent
3211         CurrentNode := tvProcedures.Items.AddChildObject(CurrentParentNode,PTO^.ProcedureName,PTO)
3212      else
3213         begin //New child and parent
3214           CurrentParentNode := tvProcedures.Items.AddObject(CurrentParentNode,PTO2^.ParentName,PTO2);
3215           CurrentNode := tvProcedures.Items.AddChildObjectFirst(CurrentParentNode,PTO^.ProcedureName,PTO);
3216          end;
3217  end;
3218  
3219  procedure TfrmReports.tvProceduresCollapsing(Sender: TObject;
3220    Node: TTreeNode; var AllowCollapse: Boolean);
3221  begin
3222    inherited;
3223    tvReports.Selected := Node;
3224  end;
3225  
3226  procedure TfrmReports.tvProceduresExpanding(Sender: TObject;
3227    Node: TTreeNode; var AllowExpansion: Boolean);
3228  begin
3229    inherited;
3230    tvReports.Selected := Node;
3231  end;
3232  
3233  procedure TfrmReports.tvProceduresClick(Sender: TObject);
3234  var
3235    Associate: Integer;
3236    SelNode: TTreeNode;
3237  begin
3238    inherited;
3239    SelNode := TTreeView(Sender).Selected;
3240    if not assigned(SelNode) then Exit;
3241    Associate := PProcTreeObj(SelNode.Data)^.Associate;
3242    lvReports.Selected := nil;
3243    if PProcTreeObj(SelNode.Data)^.ProcedureName <> '' then  //if it is a descendent or a stand-alone
3244       begin
3245         memText.Lines.Clear;
3246         lvReports.Selected := lvReports.Items[Associate];
3247         if PProcTreeObj(SelNode.Data)^.MemberOfSet = '1' then
3248            lblProcTypeMsg.Caption := 'Descendent Procedure'
3249         else
3250            if PProcTreeObj(SelNode.Data)^.MemberOfSet = '2' then
3251               lblProcTypeMsg.Caption := 'Descendent Procedure with shared report';
3252       end
3253    else         //if it is a parent with descendents
3254       if PProcTreeObj(SelNode.Data)^.MemberOfSet = '2' then  //printset = shared report
3255          lblProcTypeMsg.Caption := 'Descendent Procedures with shared report'
3256       else if PProcTreeObj(SelNode.Data)^.MemberOfSet = '1' then    //examset - individual reports
3257               begin
3258                 memText.Lines.Clear;
3259                 lblProcTypeMsg.Caption := 'Descendent Procedures - Select to view individual reports';
3260                 memText.Lines.Add('Descendent Procedures - Select to view individual reports...')
3261               end;
3262  end;
3263  
3264  procedure TfrmReports.tvProceduresChange(Sender: TObject; Node: TTreeNode);
3265  var
3266    Associate, i: Integer;
3267    FirstChild: TTreeNode;
3268    aID, aMoreID: string;
3269    x, HasImages: string;
3270  begin
3271    inherited;
3272    if UpdatingLvReports or not assigned(Node) then Exit;
3273      UpdatingTVProcedures := TRUE;
3274      Associate := PProcTreeObj(Node.Data)^.Associate;
3275      lvReports.Selected := nil;
3276      if PProcTreeObj(Node.Data)^.ProcedureName <> '' then  //if it is a descendent or a stand-alone
3277         if (Associate >= 0) and (Associate < (lvReports.Items.Count)) then // if valid associate in lvReports
3278            if lvReports.Items[Associate].Selected = FALSE then  // if not already selected
3279               begin
3280                 lvReports.Selected := lvReports.Items[Associate];
3281                 if PProcTreeObj(Node.Data)^.MemberOfSet = '1' then
3282                    begin
3283                      lblProcTypeMsg.Caption := 'Descendent Procedure';
3284                    end
3285                 else if PProcTreeObj(Node.Data)^.MemberOfSet = '2' then
3286                         lblProcTypeMsg.Caption := 'Descendent Procedures with shared report'
3287                      else if PProcTreeObj(Node.Data)^.MemberOfSet = '' then
3288                              lblProcTypeMsg.Caption := 'Standalone (single) procedure';
3289               end;
3290      UpdatingTvProcedures := FALSE;
3291  
3292      if PProcTreeObj(Node.Data)^.ProcedureName = '' then  //Parent with descendents
3293         if PProcTreeObj(Node.Data)^.MemberOfSet = '2' then  //printset = shared report
3294            begin
3295              lblProcTypeMsg.Caption := 'Descendent Procedures with shared report';
3296              FirstChild := Node.GetFirstChild;
3297              Associate := PProcTreeObj(FirstChild.Data)^.Associate;
3298              aID := lvReports.Items[Associate].SubItems[0];
3299              aMoreID := '#' + lvReports.Items[Associate].SubItems[5];
3300              SetPiece(uRemoteType,'^',5,aID + aMoreID);
3301              uLocalReportData.Clear;
3302              MemText.Lines.Clear;
3303              if not(piece(uRemoteType, '^', 9) = '1') then
3304                begin
3305                  LoadReportText(uLocalReportData, uRptID, aID + aMoreID, uReportRPC, '');
3306                  for i := 0 to uLocalReportData.Count - 1 do
3307                    MemText.Lines.Add(uLocalReportData[i]);
3308                  memText.SelStart := 0;
3309                  if lvReports.Items[Associate].SubItems.Count > 5 then
3310                    x := 'RA^' + aID + U + lvReports.Items[Associate].SubItems[5]
3311                  else
3312                    x := 'RA^' + aID;
3313                  HasImages := BOOLCHAR[lvReports.Items[Associate].SubItemImages[1] = IMG_1_IMAGE];
3314                  SetPiece(x, U, 10, HasImages);
3315                  NotifyOtherApps(NAE_REPORT, x);
3316                end;
3317            end
3318         else if PProcTreeObj(Node.Data)^.MemberOfSet = '1' then    //examset - individual reports
3319                 begin
3320                   memText.Lines.Clear;
3321                   lblProcTypeMsg.Caption := 'Descendent Procedures - Select to view individual reports';
3322                   memText.Lines.Add('Descendent Procedures - Select to view individual reports...');
3323                 end;
3324  end;
3325  
3326  procedure TfrmReports.tvProceduresKeyDown(Sender: TObject; var Key: Word;
3327    Shift: TShiftState);
3328  begin
3329    inherited;
3330    case Key of
3331      VK_LBUTTON, VK_RETURN, VK_SPACE:
3332      begin
3333        tvReportsClick(Sender);
3334        Key := 0;
3335      end;
3336    end;
3337  
3338  end;
3339  
3340  procedure TfrmReports.chkDualViewsClick(Sender: TObject);
3341  begin
3342    inherited;
3343    if (GraphForm <> nil) and GraphFormActive then
3344      GraphForm.chkDualViews.Checked := chkDualViews.Checked;
3345  end;
3346  
3347  procedure TfrmReports.chkMaxFreqClick(Sender: TObject);
3348  begin
3349    inherited;
3350    if chkMaxFreq.Checked = true then
3351      begin
3352        uMaxOcc := piece(uQualifier, ';', 3);
3353        SetPiece(uQualifier, ';', 3, '');
3354      end
3355      else
3356        begin
3357          SetPiece(uQualifier, ';', 3, uMaxOcc);
3358        end;
3359    tvReportsClick(self);
3360  end;
3361  
3362  procedure TfrmReports.btnChangeViewClick(Sender: TObject);
3363  begin
3364    inherited;
3365    if (GraphForm <> nil) and GraphFormActive then
3366    begin
3367      GraphForm.btnChangeSettingsClick(GraphForm);
3368      chkDualViews.Checked := GraphForm.chkDualViews.Checked;
3369    end;
3370  end;
3371  
3372  procedure TfrmReports.btnGraphSelectionsClick(Sender: TObject);
3373  begin
3374    inherited;
3375    if (GraphForm <> nil) and GraphFormActive then
3376    begin
3377      GraphForm.btnGraphSelectionsClick(GraphForm);
3378      chkDualViews.Checked := GraphForm.chkDualViews.Checked;
3379    end;
3380  end;
3381  
3382  procedure TfrmReports.lstDateRangeClick(Sender: TObject);
3383  begin
3384    inherited;
3385    if (GraphForm <> nil) then
3386    begin
3387      GraphForm.cboDateRange.ItemIndex := lstDateRange.ItemIndex;
3388      GraphForm.cboDateRangeChange(self);
3389      FastAssign(GraphForm.cboDateRange.Items, lstDateRange.Items);
3390      lstDateRange.ItemIndex := GraphForm.cboDateRange.ItemIndex;
3391      //Exit;
3392    end;
3393    Timer1.Interval := 3000;
3394  end;
3395  
3396  procedure TfrmReports.sptHorzMoved(Sender: TObject);
3397  begin
3398    inherited;
3399    pnlTopViews.Height := 80;
3400  end;
3401  
3402  initialization
3403    SpecifyFormIsNotADialog(TfrmReports);
3404  
3405  end.

Module Calls (2 levels)


fReports
 ├fHSplit
 │ └fPage
 ├uConst
 ├rECS
 │ ├rCore
 │ └uCore
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rCore...
 ├rReports
 │ ├uCore...
 │ ├rCore...
 │ └uReports
 ├fFrame
 │ ├fPage...
 │ ├uConst
 │ ├VERGENCECONTEXTORLib_TLB
 │ ├fBase508Form...
 │ ├XuDsigS
 │ ├rCore...
 │ ├fPtSelMsg
 │ ├fPtSel
 │ ├fCover
 │ ├fProbs
 │ ├fMeds
 │ ├fOrders
 │ ├rOrders
 │ ├fNotes
 │ ├fConsults
 │ ├fDCSumm
 │ ├rMisc
 │ ├fLabs
 │ ├fReports...
 │ ├rReports...
 │ ├fPtDemo
 │ ├fEncnt
 │ ├fPtCWAD
 │ ├uCore...
 │ ├fAbout
 │ ├fReview
 │ ├fxBroker
 │ ├fxLists
 │ ├fxServer
 │ ├fRptBox
 │ ├rODAllergy
 │ ├uInit
 │ ├fLabInfo
 │ ├uReminders
 │ ├fReminderTree
 │ ├fDeviceSelect
 │ ├fDrawers
 │ ├fReminderDialog
 │ ├fOptions
 │ ├fGraphs
 │ ├fGraphData
 │ ├rTemplates
 │ ├fSurgery
 │ ├rSurgery
 │ ├uEventHooks
 │ ├uSignItems
 │ ├rECS...
 │ ├fIconLegend
 │ ├uOrders
 │ ├uSpell
 │ ├uOrPtf
 │ ├fPatientFlagMulti
 │ ├fAlertForward
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOrdersSign
 │ ├uVitals
 │ ├fMHTest
 │ ├uFormMonitor
 │ ├fOtherSchedule
 │ ├uVA508CPRSCompatibility
 │ ├fIVRoutes
 │ ├fPrintLocation
 │ ├fTemplateEditor
 │ └fCombatVet
 ├uCore...
 ├uReports
 ├fReportsPrint
 │ ├rECS...
 │ ├fBase508Form...
 │ ├rCore...
 │ ├uCore...
 │ ├fReports...
 │ ├rReports...
 │ ├uReports
 │ └fFrame...
 ├fReportsAdhocComponent1
 │ ├fAutoSz
 │ ├fReportsAdhocSubItem1
 │ ├fReports...
 │ └rReports...
 ├dShared
 │ ├uTemplates
 │ ├fDrawers...
 │ ├rTemplates...
 │ ├uCore...
 │ ├uTemplateFields
 │ └uEventHooks...
 ├fGraphs...
 └fGraphData...

Module Called-By (2 levels)


                   fReports
                   fFrame┤ 
              CPRSChart┤ │ 
                  fPage┤ │ 
                uOrders┤ │ 
                fODBase┤ │ 
                UBACore┤ │ 
                fOrders┤ │ 
                   uPCE┤ │ 
      fBALocalDiagnoses┤ │ 
             fEncVitals┤ │ 
                fVitals┤ │ 
                 fCover┤ │ 
                 rCover┤ │ 
              fPtSelMsg┤ │ 
                 fPtSel┤ │ 
            fOrdersSign┤ │ 
         fPrintLocation┤ │ 
                  fMeds┤ │ 
                fRptBox┤ │ 
                 fNotes┤ │ 
            fReports...┤ │ 
                 fEncnt┤ │ 
                 fProbs┤ │ 
          fReportsPrint┤ │ 
                fGraphs┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
        fReminderDialog┤ │ 
                  fLabs┤ │ 
              fLabPrint┤ │ 
                fReview┤ │ 
            fIconLegend┤ │ 
           fOrdersPrint┤ │ 
               fSurgery┤ │ 
uVA508CPRSCompatibility┤ │ 
           fOrdersRenew┤ │ 
             fODConsult┤ │ 
                fODProc┤ │ 
                 fODRad┤ │ 
                 fODLab┤ │ 
                fODMeds┤ │ 
               fODMedIV┤ │ 
              fODVitals┤ │ 
                fODAuto┤ │ 
                 fOMSet┤ │ 
         fOrdersRelease┤ │ 
              fODMedNVA┤ │ 
         fOrdersOnChart┤ │ 
             fOCSession┤ │ 
              fODActive┤ │ 
               fPCEEdit┘ │ 
                fProbs...┤ 
         fReportsPrint...┤ 
  fReportsAdhocComponent1┤ 
            fReports...┤ │ 
  fReportsAdhocSubItem1┘ │ 
               fGraphs...┤ 
    fOptionsReportsCustom┤ 
               fOptions┘ │ 
   fOptionsReportsDefault┘ 
            fOptions...┘