Module

fLabs

Path

C:\CPRS\CPRS30\fLabs.pas

Last Modified

7/15/2014 3:26:38 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmLabs);

end.

Units Used in Interface

Name Comments
fBase508Form -
fHSplit -
fLabTest -
fLabTestGroups -
fLabTests -
uConst -

Units Used in Implementation

Name Comments
fFrame -
fLabPrint -
fReportsPrint -
fRptBox -
rCore -
rCover -
rGraphs -
rLabs -
rOrders -
rReports -
uCore -
uReports -

Classes

Name Comments
TfrmLabs -
TGrdLab508Manager -

Procedures

Name Owner Declaration Scope Comments
AlignList TfrmLabs procedure AlignList; Private -
BeginEndDates TfrmLabs procedure BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer); Public/Published -
BlankWeb TfrmLabs procedure BlankWeb; Private -
chk3DClick TfrmLabs procedure chk3DClick(Sender: TObject); Public/Published -
ChkBrowser TfrmLabs procedure ChkBrowser; Private -
chkGraph3DClick TfrmLabs procedure chkGraph3DClick(Sender: TObject); Public/Published -
chkGraphValuesClick TfrmLabs procedure chkGraphValuesClick(Sender: TObject); Public/Published -
chkGraphZoomClick TfrmLabs procedure chkGraphZoomClick(Sender: TObject); Public/Published -
chkMaxFreqClick TfrmLabs procedure chkMaxFreqClick(Sender: TObject); Public/Published -
chkValuesClick TfrmLabs procedure chkValuesClick(Sender: TObject); Public/Published -
chkZoomClick TfrmLabs procedure chkZoomClick(Sender: TObject); Public/Published -
chtChartClickLegend TfrmLabs procedure chtChartClickLegend(Sender: TCustomChart; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
chtChartClickSeries TfrmLabs procedure chtChartClickSeries(Sender: TCustomChart; Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
chtChartMouseDown TfrmLabs procedure chtChartMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
chtChartUndoZoom TfrmLabs procedure chtChartUndoZoom(Sender: TObject); Public/Published -
ClearPtData TfrmLabs procedure ClearPtData; override; Public -
cmdNextClick TfrmLabs procedure cmdNextClick(Sender: TObject); Public/Published -
cmdOldClick TfrmLabs procedure cmdOldClick(Sender: TObject); Public/Published -
cmdOtherTestsClick TfrmLabs procedure cmdOtherTestsClick(Sender: TObject); Public/Published -
cmdPrevClick TfrmLabs procedure cmdPrevClick(Sender: TObject); Public/Published -
cmdRecentClick TfrmLabs procedure cmdRecentClick(Sender: TObject); Public/Published -
CommonComponentVisible TfrmLabs procedure CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12: Boolean); Private -
Copy1Click TfrmLabs procedure Copy1Click(Sender: TObject); Public/Published -
Copy2Click TfrmLabs procedure Copy2Click(Sender: TObject); Public/Published -
DisplayHeading TfrmLabs procedure DisplayHeading(aRanges: string); Public/Published -
DisplayPage TfrmLabs procedure DisplayPage; override; Public -
FillComments TfrmLabs procedure FillComments(amemo: TRichEdit; aitems:TStrings); Private -
FillGrid TfrmLabs procedure FillGrid(agrid: TStringGrid; aitems: TStrings); Private -
FormCreate TfrmLabs procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmLabs procedure FormDestroy(Sender: TObject); Public/Published -
FormResize TfrmLabs procedure FormResize(Sender: TObject); Public/Published -
FreezeText1Click TfrmLabs procedure FreezeText1Click(Sender: TObject); Public/Published -
GetInterimGrid TfrmLabs procedure GetInterimGrid(adatetime: TFMDateTime; direction: integer); Private -
GetStartStop TfrmLabs procedure GetStartStop(var start, stop: string; aitems: TStrings); Private -
GoRemote TfrmLabs procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string); Private -
GoRemoteOld TfrmLabs procedure GoRemoteOld(Dest: TStringList; AItem, AReportID: Int64; AQualifier, ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime); Private -
GotoBottom1Click TfrmLabs procedure GotoBottom1Click(Sender: TObject); Public/Published -
GotoTop1Click TfrmLabs procedure GotoTop1Click(Sender: TObject); Public/Published -
GraphChart TfrmLabs procedure GraphChart(test: string; aitems: TStrings); Private -
GraphList TfrmLabs procedure GraphList(griddata: TStrings); Private -
grdLabClick TfrmLabs procedure grdLabClick(Sender: TObject); Public/Published -
grdLabMouseDown TfrmLabs procedure grdLabMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
grdLabMouseUp TfrmLabs procedure grdLabMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
grdLabMouseWheelDown TfrmLabs procedure grdLabMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); Public/Published -
grdLabTopLeftChanged TfrmLabs procedure grdLabTopLeftChanged(Sender: TObject); Public/Published -
GridComments TfrmLabs procedure GridComments(aitems: TStrings); Private -
HGrid TfrmLabs procedure HGrid(griddata: TStrings); Private -
HideTabControl TfrmLabs procedure HideTabControl; Private -
lblDateEnter TfrmLabs procedure lblDateEnter(Sender: TObject); Public/Published -
LoadListView TfrmLabs procedure LoadListView(aReportData: TStringList); Public/Published -
LoadTreeView TfrmLabs procedure LoadTreeView; Public/Published -
lstDatesClick TfrmLabs procedure lstDatesClick(Sender: TObject); Public/Published -
lstHeadersClick TfrmLabs procedure lstHeadersClick(Sender: TObject); Public/Published -
lstQualifierClick TfrmLabs procedure lstQualifierClick(Sender: TObject); Public/Published -
lstTestGraphClick TfrmLabs procedure lstTestGraphClick(Sender: TObject); Public/Published -
lvReportsColumnClick TfrmLabs procedure lvReportsColumnClick(Sender: TObject; Column: TListColumn); Public/Published -
lvReportsCompare TfrmLabs procedure lvReportsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); Public/Published -
lvReportsKeyUp TfrmLabs procedure lvReportsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
lvReportsSelectItem TfrmLabs procedure lvReportsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); Public/Published -
Memo1KeyUp TfrmLabs procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
pnlRightResize TfrmLabs procedure pnlRightResize(Sender: TObject); Public/Published -
pop3DClick TfrmLabs procedure pop3DClick(Sender: TObject); Public/Published -
popChartPopup TfrmLabs procedure popChartPopup(Sender: TObject); Public/Published -
popCopyClick TfrmLabs procedure popCopyClick(Sender: TObject); Public/Published -
popDetailsClick TfrmLabs procedure popDetailsClick(Sender: TObject); Public/Published -
popPrintClick TfrmLabs procedure popPrintClick(Sender: TObject); Public/Published -
PopupMenu3Popup TfrmLabs procedure PopupMenu3Popup(Sender: TObject); Public/Published -
popValuesClick TfrmLabs procedure popValuesClick(Sender: TObject); Public/Published -
popZoomBackClick TfrmLabs procedure popZoomBackClick(Sender: TObject); Public/Published -
popZoomClick TfrmLabs procedure popZoomClick(Sender: TObject); Public/Published -
Print1Click TfrmLabs procedure Print1Click(Sender: TObject); Public/Published -
Print2Click TfrmLabs procedure Print2Click(Sender: TObject); Public/Published -
PrintLabGraph TfrmLabs procedure PrintLabGraph; Private -
ProcessNotifications TfrmLabs procedure ProcessNotifications; Private -
ragCorGClick TfrmLabs procedure ragCorGClick(Sender: TObject); Public/Published -
ragHorVClick TfrmLabs procedure ragHorVClick(Sender: TObject); Public/Published -
RequestPrint TfrmLabs procedure RequestPrint; override; Public -
SelectAll1Click TfrmLabs procedure SelectAll1Click(Sender: TObject); Public/Published -
SelectAll2Click TfrmLabs procedure SelectAll2Click(Sender: TObject); Public/Published -
SetFontSize TfrmLabs procedure SetFontSize(NewFontSize: Integer); override; Public -
ShowTabControl TfrmLabs procedure ShowTabControl; Private -
Splitter1CanResize TfrmLabs procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); Public/Published -
sptHorzRightCanResize TfrmLabs procedure sptHorzRightCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); Public/Published -
TabControl1Change TfrmLabs procedure TabControl1Change(Sender: TObject); Public/Published -
Timer1Timer TfrmLabs procedure Timer1Timer(Sender: TObject); Public/Published -
tvReportsClick TfrmLabs procedure tvReportsClick(Sender: TObject); Public/Published -
tvReportsCollapsing TfrmLabs procedure tvReportsCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); Public/Published -
tvReportsExpanding TfrmLabs procedure tvReportsExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); Public/Published -
tvReportsKeyDown TfrmLabs procedure tvReportsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
UnfreezeText1Click TfrmLabs procedure UnfreezeText1Click(Sender: TObject); Public/Published -
UpdateRemoteStatus TfrmLabs procedure UpdateRemoteStatus(aSiteID, aStatus: string); Public/Published -
VGrid TfrmLabs procedure VGrid(griddata: TStrings); Private -
WebBrowser1DocumentComplete TfrmLabs procedure WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); Public/Published -
WorksheetChart TfrmLabs procedure WorksheetChart(test: string; aitems: TStrings); Private -

Functions

Name Owner Declaration Scope Comments
AllowContextChange TfrmLabs function AllowContextChange(var WhyNot: string): Boolean; override; Public -
CompareValues - function CompareValues(Col: Integer): integer; Local -
FMToDateTime TfrmLabs function FMToDateTime(FMDateTime: string): TDateTime; Public -
GetItem TGrdLab508Manager function GetItem(Component: TWinControl): TObject; override; Public -
GetTextToSpeak TGrdLab508Manager function GetTextToSpeak(sg: TCaptionStringGrid): String; Private -
GetValue TGrdLab508Manager function GetValue(Component: TWinControl): string; override; Public -
OkFloatValue - function OkFloatValue(value: string): boolean; Local -
ToBlankIfEmpty TGrdLab508Manager function ToBlankIfEmpty(aString : String) : String; Private -

Global Variables

Name Type Declaration Comments
ColumnSortForward Boolean ColumnSortForward: Boolean; -
ColumnToSort Integer ColumnToSort: Integer; -
frmLabs TfrmLabs frmLabs: TfrmLabs; -
tmpGrid TStringList tmpGrid: TStringList; -
uColChange UnicodeString uColChange: string; Determines when column widths have changed
uColumns TStringList uColumns: TStringList; -
uDate1 TDateTime uDate1, uDate2: Tdatetime; -
uDate2 TDateTime uDate1, uDate2: Tdatetime; -
uDirect UnicodeString uDirect: String; -
uEmptyImageList Simple (unknown) uEmptyImageList: TImageList; -
uFirstSort Integer uFirstSort: Integer; -
uFormat Integer uFormat: integer; -
uFrozen Boolean uFrozen: Boolean; -
uGraphingActivated Boolean uGraphingActivated: Boolean; -
uGraphTestClicked Boolean uGraphTestClicked: Boolean; Used to avoid mouse wheel selection
uHState UnicodeString uHState: string; -
uHTMLDoc UnicodeString uHTMLDoc: string; -
uHTMLPatient AnsiString uHTMLPatient: ANSIstring; -
uLabLocalReportData TStringList uLabLocalReportData: TStringList; Storage for Local report data
uLabRemoteReportData TStringList uLabRemoteReportData: TStringList; Storage for Remote lab query
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; -
uMostRecent TStringList uMostRecent: TStringList; -
uNewColumn TListColumn uNewColumn: TListColumn; -
UpdatingLvReports Boolean UpdatingLvReports: Boolean; Currently updating lvReports
uPrevReportNode TTreeNode uPrevReportNode: TTreeNode; -
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; -
uScreenSplitLoc Integer uScreenSplitLoc: Integer; Location of user changed split - sptHorzRight Bar
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_LABS 9 Global ID for Labs 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_HSWPCOMPONENT 6 Global -
QT_IMAGING 3 Global -
QT_MOSTRECENT 1 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 -
ZOOM_PERCENT 99 Global Padding for inflating margins


Module Source

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