iSharkFly-Open
/
VistA-cprs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
VistA-cprs/CPRS-Chart/fLabs.pas

2348 lines
78 KiB
Plaintext
Raw Normal View History

Initial Upload of Official WV CPRS 1.0.26.76
2008-07-06 17:36:37 -04:00
unit fLabs;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
fHSplit, StdCtrls, ExtCtrls, ORCtrls, ComCtrls, Grids, Buttons, fLabTest,
fLabTests, fLabTestGroups, ORFn, TeeProcs, TeEngine, Chart, Series, Menus,
uConst, ORDtTmRng, OleCtrls, SHDocVw, Variants, StrUtils;
type
TfrmLabs = class(TfrmHSplit)
lblHeading: TOROffsetLabel;
lstReports: TORListBox;
lstHeaders: TORListBox;
lstDates: TORListBox;
pnlHeader: TORAutoPanel;
pnlFooter: TORAutoPanel;
grdLab: TCaptionStringGrid;
pnlChart: TPanel;
memLab: TRichEdit;
lblSpecimen: TLabel;
lblSingleTest: TLabel;
lstTests: TORListBox;
lblFooter: TOROffsetLabel;
lblReports: TOROffsetLabel;
lblDates: TOROffsetLabel;
lblHeaders: TOROffsetLabel;
bvlHeader: TBevel;
pnlButtons: TORAutoPanel;
cmdNext: TButton;
cmdPrev: TButton;
cmdRecent: TButton;
cmdOld: TButton;
lblDateFloat: TLabel;
lblOld: TOROffsetLabel;
lblPrev: TOROffsetLabel;
lblNext: TOROffsetLabel;
lblRecent: TOROffsetLabel;
pnlOtherTests: TORAutoPanel;
cmdOtherTests: TButton;
chtChart: TChart;
serHigh: TLineSeries;
serLow: TLineSeries;
serTest: TLineSeries;
bvlOtherTests: TBevel;
lblMostRecent: TLabel;
lblDate: TLabel;
lblCollection: TLabel;
pnlWorksheet: TORAutoPanel;
chkValues: TCheckBox;
chk3D: TCheckBox;
ragHorV: TRadioGroup;
chkAbnormals: TCheckBox;
ragCorG: TRadioGroup;
lstTestGraph: TORListBox;
pnlGraph: TORAutoPanel;
chkGraph3D: TCheckBox;
chkGraphValues: TCheckBox;
lblGraphInfo: TLabel;
chkGraphZoom: TCheckBox;
PopupMenu1: TPopupMenu;
GotoTop1: TMenuItem;
GotoBottom1: TMenuItem;
FreezeText1: TMenuItem;
UnfreezeText1: TMenuItem;
Memo1: TMemo;
chkZoom: TCheckBox;
popChart: TPopupMenu;
popValues: TMenuItem;
pop3D: TMenuItem;
popZoom: TMenuItem;
N1: TMenuItem;
popCopy: TMenuItem;
popZoomBack: TMenuItem;
popDetails: TMenuItem;
N2: TMenuItem;
calLabRange: TORDateRangeDlg;
dlgWinPrint: TPrintDialog;
N3: TMenuItem;
popPrint: TMenuItem;
Timer1: TTimer;
TabControl1: TTabControl;
WebBrowser1: TWebBrowser;
lblGraph: TLabel;
procedure FormCreate(Sender: TObject);
procedure DisplayHeading;
procedure lstReportsClick(Sender: TObject);
procedure lstHeadersClick(Sender: TObject);
procedure lstDatesClick(Sender: TObject);
procedure cmdOtherTestsClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure cmdNextClick(Sender: TObject);
procedure cmdPrevClick(Sender: TObject);
procedure cmdRecentClick(Sender: TObject);
procedure cmdOldClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure pnlRightResize(Sender: TObject);
procedure chkValuesClick(Sender: TObject);
procedure chk3DClick(Sender: TObject);
procedure ragHorVClick(Sender: TObject);
procedure ragCorGClick(Sender: TObject);
procedure lstTestGraphClick(Sender: TObject);
procedure chkGraphValuesClick(Sender: TObject);
procedure chkGraph3DClick(Sender: TObject);
procedure chkGraphZoomClick(Sender: TObject);
procedure GotoTop1Click(Sender: TObject);
procedure GotoBottom1Click(Sender: TObject);
procedure FreezeText1Click(Sender: TObject);
procedure UnfreezeText1Click(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure chkZoomClick(Sender: TObject);
procedure chtChartUndoZoom(Sender: TObject);
procedure popCopyClick(Sender: TObject);
procedure popChartPopup(Sender: TObject);
procedure popValuesClick(Sender: TObject);
procedure pop3DClick(Sender: TObject);
procedure popZoomClick(Sender: TObject);
procedure popZoomBackClick(Sender: TObject);
procedure chtChartMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure chtChartClickSeries(Sender: TCustomChart;
Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure chtChartClickLegend(Sender: TCustomChart;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure popDetailsClick(Sender: TObject);
procedure popPrintClick(Sender: TObject);
procedure BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
procedure Timer1Timer(Sender: TObject);
procedure TabControl1Change(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure UpdateRemoteStatus(aSiteID, aStatus: string);
private
{ Private declarations }
procedure AlignList;
procedure HGrid(griddata: TStrings);
procedure VGrid(griddata: TStrings);
procedure FillGrid(agrid: TStringGrid; aitems: TStrings);
procedure GridComments(aitems: TStrings);
procedure FillComments(amemo: TRichEdit; aitems:TStrings);
procedure GetInterimGrid(adatetime: TFMDateTime; direction: integer);
procedure WorksheetChart(test: string; aitems: TStrings);
procedure GetStartStop(var start, stop: string; aitems: TStrings);
procedure GraphChart(test: string; aitems: TStrings);
procedure GraphList(griddata: TStrings);
procedure ProcessNotifications;
procedure PrintLabGraph;
procedure GoRemote(Dest: TStringList; AItem, AReportID: Int64; AQualifier,
ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime);
procedure ChkBrowser;
procedure CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9: Boolean);
public
procedure ClearPtData; override;
function AllowContextChange(var WhyNot: string): Boolean; override;
procedure DisplayPage; override;
procedure SetFontSize(NewFontSize: Integer); override;
function FMToDateTime(FMDateTime: string): TDateTime;
procedure RequestPrint; override;
procedure ExtlstReportsClick(Sender: TObject; Ext: boolean);
end;
var
frmLabs: TfrmLabs;
uPrevReportIndex, uFormat: integer;
uDate1, uDate2: Tdatetime;
tmpGrid: TStringList;
uLabLocalReportData: TStringList; //Storage for Local report data
uLabRemoteReportData: TStringList; //Storage for Remote lab query
uUpdateStat: boolean; //flag turned on when remote status is being updated
implementation
uses uCore, rLabs, rCore, rCover, rOrders, fLabPrint, fFrame, fRptBox, Printers,
clipbrd, rReports, rGraphs, activex, mshtml, uAccessibleStringGrid;
const
CT_LABS = 9; // ID for Labs tab used by frmFrame
TX_NOREPORT = 'No report is currently selected.';
TX_NOREPORT_CAP = 'No Report Selected';
ZOOM_PERCENT = 99; // padding for inflating margins
HTML_PRE = '<html><head><style>' + CRLF +
'PRE {font-size:8pt;font-family: "Courier New", "monospace"}' + CRLF +
'</style></head><body><pre>';
HTML_POST = CRLF + '</pre></body></html>';
{$R *.DFM}
var
uFrozen: Boolean;
uGraphingActivated: Boolean;
uRemoteCount: Integer;
uHTMLDoc: string;
uReportType: string;
uReportRPC: string;
uHTMLPatient: ANSIstring;
procedure TfrmLabs.RequestPrint;
begin
with lstReports do
begin
if ItemIEN = 0 then InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK);
case ItemIen of
1: begin
InfoBox('Unable to print ''Most Recent'' report.', 'No Print Available', MB_OK);
end;
2: begin
PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
end;
3: begin
PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
end;
4: begin
PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
end;
5: begin
InfoBox('Unable to print ''Worksheet'' report.', 'No Print Available', MB_OK);
end;
6: begin
if chtChart.Visible then PrintLabGraph;
end;
8: begin
PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
end;
9: begin
PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
end;
10: begin
PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
end;
20: begin
PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
end;
21: begin
PrintLabs(ItemIEN, DisplayText[ItemIndex], lstDates.ItemIEN);
end;
end;
end;
end;
procedure TfrmLabs.FormCreate(Sender: TObject);
var
aList: TStrings;
begin
inherited;
PageID := CT_LABS;
grdLab.Color := ReadOnlyColor;
memLab.Color := ReadOnlyColor;
uFrozen := False;
aList := TStringList.Create;
FastAssign(rpcGetGraphSettings, aList);
uGraphingActivated := aList.Count > 0;
aList.Free;
uRemoteCount := 0;
tmpGrid := TStringList.Create;
uLabLocalReportData := TStringList.Create;
uLabRemoteReportData := TStringList.Create;
uPrevReportIndex := 0;
lstReports.ItemIndex := uPrevReportIndex;
if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
lblSingleTest.Caption := '';
lblSpecimen.Caption := '';
SerTest.GetHorizAxis.ExactDateTime := true;
SerTest.GetHorizAxis.Increment := DateTimeStep[dtOneMinute];
TAccessibleStringGrid.WrapControl(grdLab);
end;
procedure TfrmLabs.UpdateRemoteStatus(aSiteID, aStatus: string);
var
j: integer;
s: string;
c: boolean;
begin
if uUpdateStat = true then exit; //uUpdateStat also looked at in fFrame
uUpdateStat := true;
for j := 0 to frmFrame.lstCIRNLocations.Items.Count - 1 do
begin
s := frmFrame.lstCIRNLocations.Items[j];
c := frmFrame.lstCIRNLocations.checked[j];
if piece(s, '^', 1) = aSiteID then
begin
frmFrame.lstCIRNLocations.Items[j] := pieces(s, '^', 1, 3) + '^' + aStatus;
frmFrame.lstCIRNLocations.checked[j] := c;
end;
end;
uUpdateStat := false;
end;
function TfrmLabs.AllowContextChange(var WhyNot: string): Boolean;
var
i: integer;
begin
Result := inherited AllowContextChange(WhyNot); // sets result = true
if Timer1.Enabled = true then
case BOOLCHAR[frmFrame.CCOWContextChanging] of
'1': begin
WhyNot := 'A remote data query in progress will be aborted.';
Result := False;
end;
'0': if WhyNot = 'COMMIT' then
begin
with RemoteSites.SiteList do for i := 0 to Count - 1 do
if TRemoteSite(Items[i]).Selected then
if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
begin
TRemoteSite(Items[i]).ReportClear;
TRemoteSite(Items[i]).LabQueryStatus := '-1^Aborted';
TabControl1.OnChange(nil);
end;
Timer1.Enabled := false;
Result := True;
end;
end;
end;
procedure TfrmLabs.ClearPtData;
begin
inherited ClearPtData;
Timer1.Enabled := False;
memLab.Lines.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
TabControl1.Tabs.Clear;
TabControl1.Visible := false;
tmpGrid.Clear;
with grdLab do
begin
RowCount := 1;
ColCount := 1;
Cells[0, 0] := '';
end;
end;
procedure TfrmLabs.DisplayPage;
begin
inherited DisplayPage;
frmFrame.mnuFilePrint.Tag := CT_LABS;
frmFrame.mnuFilePrint.Enabled := True;
frmFrame.mnuFilePrintSetup.Enabled := True;
memLab.SelStart := 0;
uHTMLPatient := '<DIV align left>'
+ '<TABLE width="75%" border="0" cellspacing="0" cellpadding="1">'
+ '<TR valign="bottom" align="left">'
+ '<TD nowrap><B>Patient: ' + Patient.Name + '</B></TD>'
+ '<TD nowrap><B>' + Patient.SSN + '</B></TD>'
+ '<TD nowrap><B>Age: ' + IntToStr(Patient.Age) + '</B></TD>'
+ '</TR></TABLE></DIV><HR>';
//the preferred method would be to use headers and footers
//so this is just an interim solution.
if InitPage then
begin
ListLabReports(lstReports.Items);
end;
if InitPatient and not (CallingContext = CC_NOTIFICATION) then
begin
if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
lstReports.ItemIndex := 0;
lstReportsClick(self);
end;
case CallingContext of
CC_INIT_PATIENT: if not InitPatient then
begin
if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
lstReports.ItemIndex := 0;
lstReportsClick(self);
end;
CC_NOTIFICATION: ProcessNotifications;
end;
end;
procedure TfrmLabs.SetFontSize(NewFontSize: Integer);
begin
inherited SetFontSize(NewFontSize);
FormResize(self);
end;
procedure TfrmLabs.DisplayHeading;
begin
with lblHeading do
begin
Caption := 'Laboratory Results - ' + lstReports.DisplayText[lstReports.ItemIndex];
if lstDates.Visible then
Caption := Caption + ' - ' + lstDates.DisplayText[lstDates.ItemIndex];
end;
end;
procedure TfrmLabs.AlignList;
begin
lblReports.Top := 0;
lstReports.Top := lblReports.Height;
lstDates.Height := pnlLeft.Height div 3 - (lblDates.Height div 2);
lstDates.Top := pnlLeft.Height - lstDates.Height;
lblDates.Top := lstDates.Top - lblDates.Height;
pnlOtherTests.Top := lblDates.Top - pnlOtherTests.Height;
lstHeaders.Height := pnlLeft.Height div 3 - (lblHeaders.Height * 3);
lstHeaders.Top := lblDates.Top - lstHeaders.Height;
lblHeaders.Top := lstHeaders.Top - lblHeaders.Height;
lstReports.Repaint;
lstDates.Repaint;
lstHeaders.Repaint;
end;
procedure TfrmLabs.lstReportsClick(Sender: TObject);
begin
ExtlstReportsClick(Sender, false);
end;
procedure TfrmLabs.ExtlstReportsClick(Sender: TObject; Ext: boolean);
var
i,iCat: integer;
Rpt: string;
begin
inherited;
uRemoteCount := 0;
Timer1.Enabled := False;
Rpt := lstReports.Items[lstReports.ItemIndex];
uReportType := Piece(Rpt,'^',4);
uReportRPC := UpperCase(Piece(Rpt,'^',6));
if length(Piece(Rpt,'^',5)) > 0 then
iCat := StrToInt(Piece(Rpt,'^',5))
else
iCat := 0;
if uReportType = '' then uReportType := 'R';
StatusText('');
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
lstHeaders.Clear;
TabControl1.Visible := false;
if Piece(Rpt,'^',3) = '1' then
if TabControl1.Tabs.Count > 1 then
TabControl1.Visible := true;
for i := 0 to RemoteSites.SiteList.Count - 1 do
TRemoteSite(RemoteSites.SiteList.Items[i]).LabClear;
if uFrozen = True then memo1.visible := False;
case lstReports.ItemIEN of
1: begin // Most Recent
CommonComponentVisible(false,false,false,false,false,true,true,false,true);
pnlButtons.Visible := true;
pnlWorksheet.Visible := false;
pnlGraph.Visible := false;
memLab.Align := alBottom;
memLab.Height := pnlLeft.Height div 5;
grdLab.Align := alClient;
memLab.Clear;
if uReportType = 'H' then
begin
WebBrowser1.Navigate('about:blank');
WebBrowser1.Align := alBottom;
WebBrowser1.Height := pnlLeft.Height div 5;
WebBrowser1.Visible := true;
WebBrowser1.BringToFront;
memLab.Visible := false;
end
else
begin
WebBrowser1.Visible := false;
WebBrowser1.SendToBack;
memLab.Visible := true;
memLab.BringToFront;
end;
FormResize(self);
cmdRecentClick(self);
uPrevReportIndex := lstReports.ItemIndex;
end;
4: begin // Interim for Selected Tests
if uPrevReportIndex <> lstReports.ItemIndex then
begin
lstTests.Clear;
lblSpecimen.Caption := '';
end;
if not Ext then SelectTests(Font.Size);
if lstTests.Items.Count > 0 then
begin
CommonComponentVisible(false,false,true,true,true,false,false,false,true);
memLab.Clear;
chkBrowser;
FormResize(self);
RedrawActivate(memLab.Handle);
lstDatesClick(self);
if not Ext then cmdOtherTests.SetFocus;
cmdOtherTests.Default := true;
end
else lstReports.ItemIndex := uPrevReportIndex;
end;
5: begin // Worksheet
if uPrevReportIndex <> lstReports.ItemIndex then
begin
lstTests.Clear;
lblSpecimen.Caption := '';
end;
if not Ext then SelectTestGroups(Font.Size);
if lstTests.Items.Count > 0 then
begin
CommonComponentVisible(false,false,true,true,true,true,true,false,false);
chtChart.Visible := true;
memLab.Visible := false;
pnlButtons.Visible := false;
pnlWorksheet.Visible := true;
pnlGraph.Visible := false;
lstTestGraph.Width := 97;
ragCorG.ItemIndex := 0;
FormResize(self);
lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value, "**" = Comments on Specimen';
//chkZoom.Checked := false;
//chkZoomClick(self);
lstDatesClick(self);
if not Ext then cmdOtherTests.SetFocus;
cmdOtherTests.Default := true;
end
else lstReports.ItemIndex := uPrevReportIndex;
end;
6: begin // Graph
// do if graphing is activiated
if uGraphingActivated then
begin
memLab.Clear;
chkBrowser;
FormResize(self);
memLab.Align := alClient;
CommonComponentVisible(false,false,false,false,false,false,false,false,false);
RedrawActivate(memLab.Handle);
StatusText('');
memLab.Lines.Insert(0, ' ');
memLab.Lines.Insert(1, 'Graphing activated');
memLab.SelStart := 0;
frmFrame.mnuToolsGraphingClick(self); // make it just lab tests ??
//lstReports.ItemIndex := uPrevReportIndex;
end
else // otherwise, do lab graph
begin
if uPrevReportIndex <> lstReports.ItemIndex then
begin
lblSingleTest.Caption := '';
lblSpecimen.Caption := '';
end;
if not Ext then SelectTest(Font.Size);
if (length(lblSingleTest.Caption) > 2) and (length(lblSpecimen.Caption) > 2) then
begin
CommonComponentVisible(false,false,true,true,true,true,false,false,true);
pnlChart.Visible := true;
chtChart.Visible := true;
pnlButtons.Visible := false;
pnlWorksheet.Visible := false;
pnlGraph.Visible := true;
memLab.Height := pnlRight.Height div 5;
memLab.Clear;
if uReportType = 'H' then
begin
WebBrowser1.Visible := true;
WebBrowser1.Navigate('about:blank');
WebBrowser1.Height := pnlRight.Height div 5;
WebBrowser1.BringToFront;
memLab.Visible := false;
end
else
begin
WebBrowser1.Visible := false;
WebBrowser1.SendToBack;
memLab.Visible := true;
memLab.BringToFront;
end;
lstTestGraph.Items.Clear;
lstTestGraph.Width := 0;
FormResize(self);
RedrawActivate(memLab.Handle);
lblFooter.Caption := '';
chkGraphZoom.Checked := false;
chkGraphZoomClick(self);
chkGraph3DClick(self);
chkGraphValuesClick(self);
lstDatesClick(self);
if not Ext then cmdOtherTests.SetFocus;
cmdOtherTests.Default := true;
end
else
lstReports.ItemIndex := uPrevReportIndex;
end;
end
else // case
begin
//added to deal with other reports from file 101.24
memLab.Clear;
chkBrowser;
FormResize(self);
memLab.Align := alClient;
case iCat of
{Categories of reports:
0:Fixed
1:Fixed w/Dates
2:Fixed w/Headers
3:Fixed w/Dates & Headers
4:Specialized
5:Graphic}
0: begin
CommonComponentVisible(false,false,false,false,false,false,false,false,false);
StatusText('Retrieving data...');
GoRemote(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
TabControl1.OnChange(nil);
Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '0', '9999', '1', 0, 0, uReportRPC);
if TabControl1.TabIndex < 1 then
QuickCopy(uLabLocalReportData,memLab);
RedrawActivate(memLab.Handle);
StatusText('');
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
memLab.SelStart := 0;
if uReportType = 'R' then
uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
else
uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
end;
1: begin
CommonComponentVisible(false,false,false,true,true,false,false,false,false);
memLab.Repaint;
lstDatesClick(self);
end;
2: begin
CommonComponentVisible(true,true,false,false,false,false,false,false,false);
lstHeaders.Clear;
StatusText('Retrieving data...');
GoRemote(uLabRemoteReportData,lstReports.ItemIEN,1,'',uReportRPC,'0','9999','1',0,0);
TabControl1.OnChange(nil);
Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '0', '9999', '1', 0, 0, uReportRPC);
if uLabLocalReportData.Count > 0 then
begin
TabControl1.OnChange(nil);
if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
end;
RedrawActivate(memLab.Handle);
StatusText('');
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
if uReportType = 'R' then
uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
else
uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
if WebBrowser1.Visible = true then WebBrowser1.Navigate('about:blank');
end;
3: begin
CommonComponentVisible(true,true,false,true,true,false,false,false,true);
lstDatesClick(self);
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
end;
end;
end;
end;
uPrevReportIndex := lstReports.ItemIndex;
DisplayHeading;
end;
procedure TfrmLabs.lstHeadersClick(Sender: TObject);
var
Current, Desired: integer;
begin
inherited;
if uFrozen = True then memo1.visible := False;
Current := SendMessage(memLab.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
Desired := lstHeaders.ItemIEN;
SendMessage(memLab.Handle, EM_LINESCROLL, 0, Desired - Current - 1);
end;
procedure TfrmLabs.lstDatesClick(Sender: TObject);
var
tmpList: TStringList;
daysback: integer;
date1, date2: TFMDateTime;
today: TDateTime;
i: integer;
Rpt: string;
begin
inherited;
uRemoteCount := 0;
if uFrozen = True then memo1.visible := False;
Screen.Cursor := crHourGlass;
DisplayHeading;
uHTMLDoc := '';
Rpt := lstReports.Items[lstReports.ItemIndex];
uReportRPC := UpperCase(Piece(Rpt,'^',6));
chkBrowser;
if (lstDates.ItemID = 'S') then
begin
with calLabRange do
begin
if Execute then
if Length(TextOfStart) > 0 then
if Length(TextOfStop) > 0 then
begin
lstDates.ItemIndex := lstDates.Items.Add(RelativeStart + ';' +
RelativeStop + U + TextOfStart + ' to ' + TextOfStop);
DisplayHeading;
end
else
lstDates.ItemIndex := -1
else
lstDates.ItemIndex := -1
else
lstDates.ItemIndex := -1;
end;
end;
today := FMToDateTime(floattostr(FMToday));
if lstDates.ItemIEN > 0 then
begin
daysback := lstDates.ItemIEN;
date1 := FMToday;
If daysback = 1 then
date2 := DateTimeToFMDateTime(today)
Else
date2 := DateTimeToFMDateTime(today - daysback);
end
else
BeginEndDates(date1,date2,daysback);
date1 := date1 + 0.2359;
uHTMLDoc := '';
WebBrowser1.Navigate('about:blank');
case lstReports.ItemIEN of
21: begin // Cumulative
lstHeaders.Clear;
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
StatusText('Retrieving data for cumulative report...');
GoRemote(uLabRemoteReportData,0,2,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
TabControl1.OnChange(nil);
Cumulative(uLabLocalReportData, Patient.DFN, daysback, date1, date2, uReportRPC);
if uLabLocalReportData.Count > 0 then
begin
TabControl1.OnChange(nil);
if lstHeaders.Items.Count > 0 then lstHeaders.ItemIndex := 0;
end;
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
end;
3: begin // Interim
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
StatusText('Retrieving data for interim report...');
GoRemote(uLabRemoteReportData,0,3,'',uReportRPC,'','','',date1,date2);
TabControl1.OnChange(nil);
Interim(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
if uLabLocalReportData.Count < 1 then
uLabLocalReportData.Add('<No results for this date range.>');
if TabControl1.TabIndex < 1 then
QuickCopy(uLabLocalReportData,memLab);
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
memLab.SelStart := 0;
end;
4: begin // Interim for Selected Tests
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
try
StatusText('Retrieving data for selected tests...');
uLabLocalReportData.Assign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items));
if uLabLocalReportData.Count > 0 then
QuickCopy(uLabLocalReportData,memLab)
else
memLab.Lines.Add('<No results for selected tests in this date range.>');
memLab.SelStart := 0;
finally
//tmpList.Free;
end;
end;
5: begin // Worksheet
chtChart.BottomAxis.Automatic := true;
chkZoom.Checked := false;
//chkZoomClick(self);
chkAbnormals.Checked := false;
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
grdLab.Align := alClient;
StatusText('Retrieving data for worksheet...');
tmpGrid.Assign(Worksheet(Patient.DFN, date1, date2,
Piece(lblSpecimen.Caption, '^', 1), lstTests.Items));
if ragHorV.ItemIndex = 0 then
HGrid(tmpGrid)
else
VGrid(tmpGrid);
GraphList(tmpGrid);
GridComments(tmpGrid);
ragCorGClick(self);
end;
6: begin // Graph
if not uGraphingActivated then
begin
chtChart.BottomAxis.Automatic := true;
chkGraphZoom.Checked := false;
chkGraphZoomClick(self);
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
tmpList := TStringList.Create;
try
StatusText('Retrieving data for graph...');
tmpList.Assign(GetChart(Patient.DFN, date1, date2,
Piece(lblSpecimen.Caption, '^', 1),
Piece(lblSingleTest.Caption, '^', 1)));
if tmpList.Count > 1 then
begin
chtChart.Visible := true;
GraphChart(lblSingleTest.Caption, tmpList);
chtChart.ZoomPercent(ZOOM_PERCENT);
for i := strtoint(Piece(tmpList[0], '^', 1)) + 1 to tmpList.Count - 1
do memLab.Lines.Add(tmpList[i]);
if memLab.Lines.Count < 2 then
memLab.Lines.Add('<No comments on specimens.>');
memLab.SelStart := 0;
lblGraph.Visible := false;
end
else
begin
lblGraph.Left := chtChart.Left + ((chtChart.Width - lblGraph.Width) div 2);
lblGraph.Top := 2;
lblGraph.Visible := true;
if Piece(lblSpecimen.Caption, '^', 1) = '0' then
pnlChart.Caption := '<No results can be graphed for ' +
Piece(lblSingleTest.Caption, '^', 2) + ' in this date range.> '
+ 'Results may be available, but cannot be graphed. Please try an alternate view.'
else
pnlChart.Caption := '<No results can be graphed for ' +
Piece(lblSingleTest.Caption, '^', 2)
+ ' (' + Piece(lblSpecimen.Caption, '^', 2) +
') in this date range.> '
+ 'Results may be available, but cannot be graphed. Please try an alternate view.';
chtChart.Visible := false;
end;
finally
tmpList.Free;
end;
end;
end;
9: begin // Micro
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
StatusText('Retrieving microbiology data...');
GoRemote(uLabRemoteReportData,0,4,'',uReportRPC,'','','',date1,date2);
TabControl1.OnChange(nil);
Micro(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC);
if uLabLocalReportData.Count < 1 then
uLabLocalReportData.Add('<No microbiology results for this date range.>');
if TabControl1.TabIndex < 1 then
QuickCopy(uLabLocalReportData,memLab);
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
memLab.SelStart := 0;
end;
10: begin // Lab Status
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
StatusText('Retrieving lab status data...');
GoRemote(uLabRemoteReportData,9,1,'',uReportRPC,'',IntToStr(daysback),'',date1,date2);
TabControl1.OnChange(nil);
Reports(uLabLocalReportData,Patient.DFN, '9', '', IntToStr(daysback),'',
date1, date2, uReportRPC);
if uLabLocalReportData.Count < 1 then
uLabLocalReportData.Add('<No laboratory orders for this date range.>');
if TabControl1.TabIndex < 1 then
QuickCopy(uLabLocalReportData,memLab);
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
memLab.SelStart := 0;
end;
else begin //Anything Else
lstHeaders.Clear;
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
StatusText('Retrieving lab data...');
GoRemote(uLabRemoteReportData, StrToInt(Piece(Rpt,'^',1)), 1, '',
uReportRPC, '', IntToStr(daysback), '', date1, date2);
TabControl1.OnChange(nil);
Reports(uLabLocalReportData,Patient.DFN, Piece(Rpt,'^',1), '',
IntToStr(daysback), '', date1, date2, uReportRPC);
if uLabLocalReportData.Count < 1 then
uLabLocalReportData.Add('<No data for this date range.>');
if TabControl1.TabIndex < 1 then
QuickCopy(uLabLocalReportData,memLab);
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
memLab.SelStart := 0;
end;
end;
if uReportType = 'R' then
uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST
else
uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text;
Screen.Cursor := crDefault;
StatusText('');
end;
procedure TfrmLabs.cmdOtherTestsClick(Sender: TObject);
begin
inherited;
lstReportsClick(self);
end;
procedure TfrmLabs.GraphList(griddata: TStrings);
var
i, j: integer;
ok: boolean;
testname, testnum, testnum1, line: string;
begin
lstTestGraph.Clear;
for i := 0 to lstTests.Items.Count - 1 do
begin
testnum := Piece(lstTests.Items[i], '^', 1);
testname := Piece(lstTests.Items[i], '^', 2);
ok := false;
for j := strtoint(Piece(griddata[0], '^', 4)) + 1 to strtointdef(Piece(griddata[0], '^', 5), 0) do
begin
testnum1 := Piece(griddata[j - 1], '^', 1);
if testnum1 = testnum then
begin
ok := true;
line := testnum + '^' + testname + ' (' + MixedCase(Piece(griddata[j - 1], '^', 2)) + ')^';
line := line + Pieces(griddata[j - 1], '^', 3, 6);
lstTestGraph.Items.Add(line);
end;
end;
if not ok then lstTestGraph.Items.Add(lstTests.Items[i]);
end;
end;
procedure TfrmLabs.HGrid(griddata: TStrings);
var
testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer;
begin
offset := 0;
testcnt := strtoint(Piece(griddata[offset], '^', 1));
datecnt := strtoint(Piece(griddata[offset], '^', 2));
datacnt := strtoint(Piece(griddata[offset], '^', 3));
linecnt := testcnt + datecnt + datacnt;
if chkAbnormals.Checked and (linecnt > 0) then
begin
offset := linecnt + 1;
testcnt := strtoint(Piece(griddata[offset], '^', 1));
datecnt := strtoint(Piece(griddata[offset], '^', 2));
datacnt := strtoint(Piece(griddata[offset], '^', 3));
linecnt := testcnt + datecnt + datacnt;
end;
with grdLab do
begin
if testcnt = 0 then ColCount := 3 else ColCount := testcnt + 2;
if datecnt = 0 then RowCount := 2 else RowCount := datecnt + 1;
DefaultColWidth := ResizeWidth( BaseFont, MainFont, 60);
ColWidths[0] := ResizeWidth( BaseFont, MainFont, 80);
FixedCols := 2;
FixedRows := 1;
for y := 0 to RowCount - 1 do
for x := 0 to ColCount - 1 do
Cells[x, y] := '';
Cells[0, 0] := 'Date/Time';
Cells[1, 0] := 'Specimen';
for i := 1 to testcnt do
begin
Cells[i + 1, 0] := Piece(griddata[i + offset], '^', 3);
end;
if datecnt = 0 then
begin
Cells[0, 1] := 'no results';
for x := 1 to ColCount - 1 do
Cells[x, 1] := '';
end;
for i := testcnt + 1 to testcnt + datecnt do
begin
Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
Cells[1, i - testcnt] := MixedCase(Piece(griddata[i + offset], '^', 4)) + ' ' + Piece(griddata[i + offset], '^', 5);
end;
for i := testcnt + datecnt + 1 to linecnt do
begin
y := strtoint(Piece(griddata[i + offset], '^', 1));
x := strtoint(Piece(griddata[i + offset], '^', 2)) + 1;
Cells[x, y] := Piece(griddata[i + offset], '^', 3) + ' ' + Piece(griddata[i + offset], '^', 4);
end;
end;
end;
procedure TfrmLabs.VGrid(griddata: TStrings);
var
testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer;
begin
offset := 0;
testcnt := strtoint(Piece(griddata[offset], '^', 1));
datecnt := strtoint(Piece(griddata[offset], '^', 2));
datacnt := strtoint(Piece(griddata[offset], '^', 3));
linecnt := testcnt + datecnt + datacnt;
if chkAbnormals.Checked and (linecnt > 0) then
begin
offset := linecnt + 1;
testcnt := strtoint(Piece(griddata[offset], '^', 1));
datecnt := strtoint(Piece(griddata[offset], '^', 2));
datacnt := strtoint(Piece(griddata[offset], '^', 3));
linecnt := testcnt + datecnt + datacnt;
end;
with grdLab do
begin
if datecnt = 0 then ColCount := 2 else ColCount := datecnt + 1;
if testcnt = 0 then RowCount := 3 else RowCount := testcnt + 2;
DefaultColWidth := ResizeWidth( BaseFont, MainFont, 80);
ColWidths[0] := ResizeWidth( BaseFont, MainFont, 60);
FixedCols := 1;
FixedRows := 2;
for y := 0 to RowCount - 1 do
for x := 0 to ColCount - 1 do
Cells[x, y] := '';
Cells[0, 0] := 'Date/Time';
Cells[0, 1] := 'Specimen';
for i := 1 to testcnt do
begin
Cells[0, i + 1] := Piece(griddata[i + offset], '^', 3);
end;
if datecnt = 0 then
begin
Cells[1, 0] := 'no results';
for x := 1 to RowCount - 1 do
Cells[x, 1] := '';
end;
for i := testcnt + 1 to testcnt + datecnt do
begin
Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2)));
Cells[i - testcnt, 1] := MixedCase(Piece(griddata[i + offset], '^', 4));
end;
for i := testcnt + datecnt + 1 to linecnt do
begin
x := strtoint(Piece(griddata[i + offset], '^', 1));
y := strtoint(Piece(griddata[i + offset], '^', 2)) + 1;
Cells[x, y] := Piece(griddata[i + offset], '^', 3) + ' ' + Piece(griddata[i + offset], '^', 4);
end;
end;
end;
procedure TfrmLabs.GridComments(aitems: TStrings);
var
i, start: integer;
begin
start := strtointdef(Piece(aitems[0], '^', 5), 1);
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
for i := start to aitems.Count - 1 do
memLab.Lines.Add(aitems[i]);
if (memLab.Lines.Count = 0) and (aitems.Count > 1) then
memLab.Lines.Add('<No comments on specimens.>');
memLab.SelStart := 0;
end;
procedure TfrmLabs.FormDestroy(Sender: TObject);
begin
inherited;
tmpGrid.free;
uLabLocalReportData.Free;
uLabRemoteReportData.Free;
TAccessibleStringGrid.UnwrapControl(grdLab);
end;
procedure TfrmLabs.FillGrid(agrid: TStringGrid; aitems: TStrings);
var
testcnt, x, y, i: integer;
begin
testcnt := strtoint(Piece(aitems[0], '^', 1));
with agrid do
begin
if testcnt = 0 then RowCount := 3 else RowCount := testcnt + 1;
ColCount := 5;
DefaultColWidth := agrid.Width div ColCount - 2;
ColWidths[0] := agrid.Width div 4;
ColWidths[4] := agrid.Width div 4;
ColWidths[2] := agrid.Width div 9;
ColWidths[3] := agrid.Width div 6;
ColWidths[1] := agrid.Width - ColWidths[0] - ColWidths[2] - ColWidths[3] - ColWidths[4] - 8;
FixedCols := 0;
FixedRows := 1;
for y := 0 to RowCount - 1 do
for x := 0 to ColCount - 1 do
Cells[x, y] := '';
Cells[0, 0] := 'Test';
Cells[1, 0] := 'Result';
Cells[2, 0] := 'Flag';
Cells[3, 0] := 'Units';
Cells[4, 0] := 'Ref Range';
for i := 1 to testcnt do
begin
Cells[0, i] := Piece(aitems[i], '^', 2);
Cells[1, i] := Piece(aitems[i], '^', 3);
Cells[2, i] := Piece(aitems[i], '^', 4);
Cells[3, i] := Piece(aitems[i], '^', 5);
Cells[4, i] := Piece(aitems[i], '^', 6);
end;
end;
end;
procedure TfrmLabs.FillComments(amemo: TRichEdit; aitems:TStrings);
var
testcnt, i: integer;
specimen, accession, provider: string;
begin
amemo.Lines.Clear;
specimen := Piece(aitems[0], '^', 5);
accession := Piece(aitems[0], '^', 6);
provider := Piece(aitems[0], '^', 7);
amemo.Lines.Add('Specimen: ' + specimen + '; Accession: ' + accession + '; Provider: ' + provider);
testcnt := strtoint(Piece(aitems[0], '^', 1));
for i := testcnt + 1 to aitems.Count - 1 do
amemo.Lines.Add(aitems[i]);
amemo.SelStart := 0;
end;
procedure TfrmLabs.GetInterimGrid(adatetime: TFMDateTime; direction: integer);
var
tmpList: TStringList;
nexton, prevon: boolean;
newest, oldest: string;
begin
tmpList := TStringList.Create;
GetNewestOldest(Patient.DFN, newest, oldest); //****** PATCH
nexton := true;
prevon := true;
try
tmpList.Assign(InterimGrid(Patient.DFN, adatetime, direction, uFormat));
if tmpList.Count > 0 then
begin
lblDateFloat.Caption := Piece(tmpList[0], '^', 3);
uFormat := strtointdef(Piece(tmpList[0], '^', 9), 1);
if length(lblDateFloat.Caption) > 0 then
lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(lblDateFloat.Caption));
if length(lblDateFloat.Caption) < 1
then
begin
lblDateFloat.Caption := FloatToStr(adatetime);
nexton := false;
end
else
begin
nexton := lblDateFloat.Caption <> newest;
prevon := lblDateFloat.Caption <> oldest;
end;
if (not nexton) and (uFormat = 3) then
nexton := true;
if (not prevon) and (uFormat = 2) then
prevon := true;
end
else
begin
lblDateFloat.Caption := '';
lblDate.Caption := '';
end;
cmdNext.Enabled := nexton;
cmdRecent.Enabled := nexton;
lblNext.Enabled := nexton;
lblRecent.Enabled := nexton;
cmdPrev.Enabled := prevon;
cmdOld.Enabled := prevon;
lblPrev.Enabled := prevon;
lblOld.Enabled := prevon;
if cmdOld.Enabled and cmdRecent.Enabled then
lblMostRecent.Visible := false
else
begin
lblMostRecent.Visible := true;
if (not cmdOld.Enabled) and (not cmdRecent.Enabled) then
lblMostRecent.Caption := 'No Lab Results'
else if cmdOld.Enabled then
lblMostRecent.Caption := 'Most Recent Lab Result'
else
lblMostRecent.Caption := 'Oldest Lab Result';
end;
if tmpList.Count > 0 then
begin
if Piece(tmpList[0], '^', 2) = 'CH' then
begin
FillGrid(grdLab, tmpList);
FillComments(memLab, tmpList);
memLab.Align := alBottom;
memLab.Height := pnlLeft.Height div 5;
grdLab.Align := alClient;
grdLab.Visible := true;
memLab.Visible := true;
pnlFooter.Height := lblHeading.Height + 5;
pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
lblFooter.Align := alTop;
pnlFooter.Visible := true;
if (grdLab.VisibleRowCount + 1) < grdLab.RowCount then
grdLab.ColWidths[4] := grdLab.ColWidths[4] - 18;
memLab.Repaint;
end;
if Piece(tmpList[0], '^', 2) = 'MI' then
begin
tmpList.Delete(0);
memLab.Lines.Assign(tmpList);
memLab.SelStart := 0;
grdLab.Visible := false;
pnlFooter.Visible := false;
memLab.Align := alClient;
end;
end
else
begin
grdLab.Visible := false;
pnlFooter.Visible := false;
memLab.Align := alClient;
end;
finally
tmpList.Free;
end;
end;
procedure TfrmLabs.cmdNextClick(Sender: TObject);
var
HadFocus: boolean;
begin
inherited;
HadFocus := Screen.ActiveControl = cmdNext;
StatusText('Retrieving next lab data...');
if Length(lblDateFloat.Caption) > 0 then GetInterimGrid(strtofloat(lblDateFloat.Caption), -1);
StatusText('');
if HadFocus then begin
if cmdNext.Enabled then cmdNext.SetFocus
else if cmdPrev.Enabled then cmdPrev.SetFocus
else lstReports.SetFocus;
end;
end;
procedure TfrmLabs.cmdPrevClick(Sender: TObject);
var
HadFocus: boolean;
begin
inherited;
HadFocus := Screen.ActiveControl = cmdPrev;
StatusText('Retrieving previous lab data...');
if Length(lblDateFloat.Caption) > 0 then GetInterimGrid(strtofloat(lblDateFloat.Caption), 1);
StatusText('');
if HadFocus then begin
if cmdPrev.Enabled then cmdPrev.SetFocus
else if cmdNext.Enabled then cmdNext.SetFocus
else lstReports.SetFocus;
end;
end;
procedure TfrmLabs.WorksheetChart(test: string; aitems: TStrings);
function OkFloatValue(value: string): boolean;
var
i, j: integer;
first, second: string;
begin
Result := false;
i := strtointdef(value, -99999);
if i <> -99999 then Result := true
else if pos('.', Copy(Value, Pos('.', Value) + 1, Length(Value))) > 0 then Result := false
else
begin
first := Piece(value, '.', 1);
second := Piece(value, '.', 2);
if length(second) > 0 then
begin
i := strtointdef(first, -99999);
j := strtointdef(second, -99999);
if (i <> -99999) and (j <> -99999) then Result := true;
end
else
begin
i :=strtointdef(first, -99999);
if i <> -99999 then Result := true;
end;
end;
end;
var
datevalue, oldstart, oldend: TDateTime;
labvalue: double;
i, numtest, numcol, numvalues, valuecount: integer;
high, low, start, stop, numspec, value, testcheck, units, specimen, testnum, testorder: string;
begin
if chkZoom.Checked and chtChart.Visible then
begin
oldstart := chtChart.BottomAxis.Minimum;
oldend := chtChart.BottomAxis.Maximum;
chtChart.UndoZoom;
chtChart.BottomAxis.Automatic := false;
chtChart.BottomAxis.Minimum := oldstart;
chtChart.BottomAxis.Maximum := oldend;
end
else
begin
chtChart.BottomAxis.Automatic := true;
end;
chtChart.Visible := true;
valuecount := 0;
testnum := Piece(test, '^', 1);
specimen := Piece(test, '^', 3);
units := Piece(test, '^', 4);
low := Piece(test, '^', 5);
high := Piece(test, '^', 6);
numtest := strtoint(Piece(aitems[0], '^', 1));
numcol := strtoint(Piece(aitems[0], '^', 2));
numvalues := strtoint(Piece(aitems[0], '^', 3));
serHigh.Clear; serLow.Clear; serTest.Clear;
if numtest > 0 then
begin
for i := 1 to numtest do
if testnum = Piece(aitems[i], '^', 2) then
begin
testorder := inttostr(i);
break;
end;
GetStartStop(start, stop, aitems);
if OKFloatValue(high) then
begin
serHigh.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
serHigh.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
end;
if OKFloatValue(low) then
begin
serLow.AddXY(FMToDateTime(start), strtofloat(low), '',clTeeColor);
serLow.AddXY(FMToDateTime(stop), strtofloat(low), '',clTeeColor);
end;
numspec := Piece(specimen, '^', 1);
chtChart.Legend.Color := grdLab.Color;
chtChart.Title.Font.Size := MainFontSize;
chtChart.LeftAxis.Title.Caption := units;
serTest.Title := Piece(test, '^', 2);
serHigh.Title := 'Ref High ' + high;
serLow.Title := 'Ref Low ' + low;
testcheck := testorder;
for i := numtest + numcol + 1 to numtest + numcol + numvalues do
if Piece(aitems[i], '^', 2) = testcheck then
if Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 3) = numspec then
begin
value := Piece(aitems[i], '^', 3);
if OkFloatValue(value) then
begin
labvalue := strtofloat(value);
datevalue := FMToDateTime(Piece(aitems[numtest + strtoint(Piece(aitems[i], '^', 1))], '^', 2));
serTest.AddXY(datevalue, labvalue, '', clTeeColor);
inc(valuecount);
end;
end;
end;
if valuecount = 0 then
begin
lblGraph.Left := chtChart.Left + ((chtChart.Width - lblGraph.Width) div 2);
lblGraph.Top := 2;
lblGraph.Visible := true;
if length(Piece(specimen, '^', 2)) > 0 then
pnlChart.Caption := '<No results can be graphed for ' + serTest.Title + ' in this date range.> '
else
pnlChart.Caption := '<No results can be graphed for ' + Piece(test, '^', 2) + ' in this date range.>';
chtChart.Visible := false;
end
else
lblGraph.Visible := false;
if not chkZoom.Checked then
begin
chtChart.UndoZoom;
chtChart.ZoomPercent(ZOOM_PERCENT);
end;
end;
procedure TfrmLabs.GetStartStop(var start, stop: string; aitems: TStrings);
var
numtest, numcol: integer;
begin
numtest := strtoint(Piece(aitems[0], '^', 1));
numcol := strtoint(Piece(aitems[0], '^', 2));
start := Piece(aitems[numtest + 1], '^', 2);
stop := Piece(aitems[numtest + numcol], '^', 2);
end;
procedure TfrmLabs.cmdRecentClick(Sender: TObject);
var
HadFocus: boolean;
begin
inherited;
HadFocus := Screen.ActiveControl = cmdRecent;
StatusText('Retrieving most recent lab data...');
uFormat := 1;
GetInterimGrid(FMToday + 0.2359, 1);
StatusText('');
if HadFocus and cmdPrev.Enabled then cmdPrev.SetFocus;
end;
procedure TfrmLabs.cmdOldClick(Sender: TObject);
var
HadFocus: boolean;
begin
inherited;
HadFocus := Screen.ActiveControl = cmdOld;
StatusText('Retrieving oldest lab data...');
uFormat := 1;
GetInterimGrid(2700101, -1);
if HadFocus and cmdNext.Enabled then cmdNext.SetFocus;
StatusText('');
end;
procedure TfrmLabs.FormResize(Sender: TObject);
begin
inherited;
AlignList;
lblHeaders.Height := lblReports.Height;
lblDates.Height := lblReports.Height;
lblHeading.Height := lblReports.Height;
pnlFooter.Height := lblReports.Height + 5;
lblFooter.Height := lblReports.Height;
case lstReports.ItemIEN of
1: begin // Most Recent
pnlHeader.Align := alTop;
memLab.Height := pnlLeft.Height div 5;
memLab.Top := pnlLeft.Height - pnlFooter.Height - memLab.Height;
memLab.Align := alBottom;
grdLab.Align := alClient;
if tmpGrid.Count > 0 then HGrid(tmpGrid);
if (grdLab.VisibleRowCount + 1) < grdLab.RowCount then
grdLab.ColWidths[4] := grdLab.ColWidths[4] - 18;
pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
pnlFooter.Align := alBottom;
memLab.Repaint;
end;
2: begin // Cumulative
pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
pnlFooter.Align := alBottom;
lblFooter.Align := alTop;
memLab.Align := alClient;
memLab.Repaint;
end;
3: begin // Interim
pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
pnlFooter.Align := alBottom;
lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
lblFooter.Align := alTop;
memLab.Align := alClient;
memLab.Repaint;
end;
4: begin // Interim for Selected Tests
pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
pnlFooter.Align := alBottom;
lblFooter.Caption := ' KEY: "L" = Abnormal Low, "H" = Abnormal High, "*" = Critical Value';
lblFooter.Align := alTop;
memLab.Align := alClient;
memLab.Repaint;
end;
5: begin // Worksheet
pnlHeader.Align := alTop;
grdLab.Align := alClient;
ragCorGClick(self);
pnlFooter.Top := pnlLeft.Height - pnlFooter.Height;
pnlFooter.Align := alBottom;
end;
6: begin // Graph
if not uGraphingActivated then
begin
memLab.Height := pnlLeft.Height div 4;
memLab.Align := alBottom;
pnlChart.Top := pnlHeader.Height;
pnlChart.Align := alClient;
memLab.Height := pnlLeft.Height div 4;
memLab.Align := alBottom;
memLab.Repaint;
end;
end;
7: begin // Anatomic Path
memLab.Repaint;
end;
8: begin // Blood Bank
memLab.Repaint;
end;
9: begin // Microbiology
memLab.Repaint;
end;
10: begin // Lab Status
memLab.Repaint;
end;
end;
end;
procedure TfrmLabs.pnlRightResize(Sender: TObject);
begin
inherited;
pnlRight.Refresh;
lblFooter.Height := lblHeading.Height;
end;
function TfrmLabs.FMToDateTime(FMDateTime: string): TDateTime;
var
x, Year: string;
begin
{ Note: TDateTime cannot store month only or year only dates }
x := FMDateTime + '0000000';
if Length(x) > 12 then x := Copy(x, 1, 12);
if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359';
Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2);
x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2);
Result := StrToDateTime(x);
end;
procedure TfrmLabs.chkValuesClick(Sender: TObject);
begin
inherited;
serTest.Marks.Visible := chkValues.Checked;
end;
procedure TfrmLabs.chk3DClick(Sender: TObject);
begin
inherited;
chtChart.View3D := chk3D.Checked;
end;
procedure TfrmLabs.GraphChart(test: string; aitems: TStrings);
var
datevalue: TDateTime;
labvalue: double;
i, numvalues: integer;
high, low, start, stop, value, units, specimen: string;
begin
numvalues := strtoint(Piece(aitems[0], '^', 1));
specimen := Piece(aitems[0], '^', 2);
high := Piece(aitems[0], '^', 3);
low := Piece(aitems[0], '^', 4);
units := Piece(aitems[0], '^', 5);
if numvalues > 0 then
begin
start := Piece(aitems[1], '^', 1);
stop := Piece(aitems[numvalues], '^', 1);
chtChart.Legend.Color := grdLab.Color;
serHigh.Clear; serLow.Clear; serTest.Clear;
if high <> '' then
begin
serHigh.AddXY(FMToDateTime(start), strtofloat(high), '',clTeeColor);
serHigh.AddXY(FMToDateTime(stop), strtofloat(high), '',clTeeColor);
end;
if low <> '' then
begin
serLow.AddXY(FMToDateTime(start), strtofloat(low), '',clTeeColor);
serLow.AddXY(FMToDateTime(stop), strtofloat(low), '',clTeeColor);
end;
//chtChart.Title.Text.Strings[0] := Piece(test, '^', 2) + ' (' + MixedCase(specimen) + ')';
//chtChart.Title.Font.Size := 12;
chtChart.LeftAxis.Title.Caption := units;
serTest.Title := Piece(test, '^', 2) + ' (' + MixedCase(specimen) + ')';
serHigh.Title := 'Ref High ' + high;
serLow.Title := 'Ref Low ' + low;
for i := 1 to numvalues do
begin
value := Piece(aitems[i], '^', 2);
labvalue := strtofloat(value);
datevalue := FMToDateTime(Piece(aitems[i], '^', 1));
serTest.AddXY(datevalue, labvalue, '', clTeeColor);
end;
end;
end;
procedure TfrmLabs.ragHorVClick(Sender: TObject);
begin
inherited;
if ragHorV.ItemIndex = 0 then HGrid(tmpGrid) else VGrid(tmpGrid);
end;
procedure TfrmLabs.ragCorGClick(Sender: TObject);
begin
inherited;
if ragCorG.ItemIndex = 0 then // comments
begin
chkZoom.Enabled := false;
chk3D.Enabled := false;
chkValues.Enabled := false;
pnlChart.Visible:= false;
grdLab.Align := alNone;
memLab.Height := pnlRight.Height div 6;
memLab.Top := pnlRight.Height - pnlFooter.Height - memLab.Height;
memLab.Align := alBottom;
memLab.Visible := true;
grdLab.Align := alClient;
end
else // graph
begin
chkZoom.Enabled := true;
chk3D.Enabled := true;
chkValues.Enabled := true;
chk3DClick(self);
chkValuesClick(self);
memLab.Visible := false;
grdLab.Align := alNone;
//pnlChart.Height := pnlLeft.Height - pnlOtherTests.Top - pnlFooter.Height;
//pnlChart.Top := pnlOtherTests.Top;
pnlChart.Height := pnlRight.Height div 2;
pnlChart.Top := pnlRight.Height - pnlFooter.Height - pnlChart.Height;
pnlChart.Align := alBottom;
pnlChart.Visible := true;
grdLab.Align := alClient;
if lstTestGraph.Items.Count > 0 then
begin
if lstTestGraph.ItemIndex < 0 then
lstTestGraph.ItemIndex := 0;
lstTestGraphClick(self);
end;
end;
end;
procedure TfrmLabs.lstTestGraphClick(Sender: TObject);
begin
inherited;
WorksheetChart(lstTestGraph.Items[lstTestGraph.ItemIndex], tmpGrid);
end;
procedure TfrmLabs.chkGraphValuesClick(Sender: TObject);
begin
inherited;
serTest.Marks.Visible := chkGraphValues.Checked;
end;
procedure TfrmLabs.chkGraph3DClick(Sender: TObject);
begin
inherited;
chtChart.View3D := chkGraph3D.Checked;
end;
procedure TfrmLabs.chkGraphZoomClick(Sender: TObject);
begin
inherited;
chtChart.AllowZoom := chkGraphZoom.Checked;
chtChart.AnimatedZoom := chkGraphZoom.Checked;
lblGraphInfo.Caption := 'To Zoom, hold down the mouse button while dragging an area to be enlarged.';
if chkGraphZoom.Checked then
lblGraphInfo.Caption := lblGraphInfo.Caption + #13
+ 'To Zoom Back drag to the upper left. You can also use the actions on the right mouse button.';
lblGraphInfo.Visible := chkGraphZoom.Checked;
if not chkGraphZoom.Checked then chtChart.UndoZoom;
end;
procedure TfrmLabs.GotoTop1Click(Sender: TObject);
begin
inherited;
with memLab do
begin
SetFocus;
SelStart :=0;
SelLength :=0;
end;
end;
procedure TfrmLabs.GotoBottom1Click(Sender: TObject);
var
I,CharCount : Integer;
begin
Inherited;
CharCount :=0;
with memLab do
begin
for I := 0 to lines.count-1 do
CharCount := CharCount + Length(Lines[I]) + 2;
SetFocus;
SelStart := CharCount;
SelLength :=0;
end;
end;
procedure TfrmLabs.FreezeText1Click(Sender: TObject);
var
Current, Desired : Longint;
LineCount : Integer;
begin
Inherited;
If memLab.SelLength > 0 then begin
Memo1.visible := true;
Memo1.Text := memLab.SelText;
If Memo1.Lines.Count <6 then
LineCount := Memo1.Lines.Count + 1
Else
LineCount := 5;
Memo1.Height := LineCount * frmLabs.Canvas.TextHeight(memLab.SelText);
Current := SendMessage(memLab.handle, EM_GETFIRSTVISIBLELINE, 0, 0);
Desired := SendMessage(memLab.handle, EM_LINEFROMCHAR,
memLab.SelStart + memLab.SelLength ,0);
SendMessage(memLab.Handle,EM_LINESCROLL, 0, Desired - Current);
uFrozen := True;
end;
end;
procedure TfrmLabs.UnfreezeText1Click(Sender: TObject);
begin
Inherited;
If uFrozen = True Then begin
uFrozen := False;
UnFreezeText1.Enabled := False;
Memo1.Visible := False;
Memo1.Text := '';
end;
end;
procedure TfrmLabs.PopupMenu1Popup(Sender: TObject);
begin
inherited;
If Screen.ActiveControl.Name <> memLab.Name then
begin
memLab.SetFocus;
memLab.SelStart := 0;
end;
If memLab.SelLength > 0 Then
FreezeText1.Enabled := True
Else
FreezeText1.Enabled := False;
If Memo1.Visible Then
UnFreezeText1.Enabled := True;
If memLab.SelStart > 0 then
GotoTop1.Enabled := True
Else
GotoTop1.Enabled := False;
If SendMessage(memLab.handle, EM_LINEFROMCHAR,
memLab.SelStart,0) < memLab.Lines.Count then
GotoBottom1.Enabled := True
Else
GotoBottom1.Enabled := False;
case lstReports.ItemIEN of
1: FreezeText1.Enabled := False;
5: FreezeText1.Enabled := False;
6: FreezeText1.Enabled := False;
end;
end;
procedure TfrmLabs.ProcessNotifications;
var
//AlertDate, CurrentDate: TFMDateTime;
OrderIFN: string;
begin
{uNewest := '';
uOldest := '';
GetNewestOldest(Patient.DFN, uNewest, uOldest); }
{AlertDate := Trunc(StrToFMDateTime(Piece(Piece(Notifications.RecordID, U, 2), ';', 3)));
CurrentDate := FMToday;
lstReports.ItemIndex := 2;
if AlertDate = CurrentDate then
begin
lstDates.ItemIndex := 0;
lstReports.ItemIndex := 0;
end
else if CurrentDate - AlertDate < 7 then lstDates.ItemIndex := 2
else if CurrentDate - AlertDate < 14 then lstDates.ItemIndex := 3
else if CurrentDate - AlertDate < 28 then lstDates.ItemIndex := 4
else lstDates.ItemIndex := 5;
lstReportsClick(self); }
OrderIFN := Piece(Notifications.AlertData, '@', 1);
if StrToIntDef(OrderIFN,0) > 0 then
begin
lstDates.ItemIndex := -1;
lstReports.ItemIndex := -1;
Memo1.Visible := false;
lblHeaders.Visible := false;
lstHeaders.Visible := false;
pnlOtherTests.Visible := false;
lblDates.Visible := true;
lstDates.Visible := true;
pnlHeader.Visible := false;
grdLab.Visible := false;
pnlChart.Visible := false;
WebBrowser1.Visible := false;
WebBrowser1.SendToBack;
memLab.Visible := true;
memLab.BringToFront;
pnlFooter.Visible := true;
memLab.Clear;
uLabLocalReportData.Clear;
uLabRemoteReportData.Clear;
memLab.Align := alClient;
FormResize(self);
memLab.Lines.Assign(ResultOrder(OrderIFN));
memLab.SelStart := 0;
memLab.Repaint;
lblHeading.Caption := Notifications.Text;
end
else
begin
if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 5;
lstReports.ItemIndex := 0;
lstReportsClick(self);
end;
case Notifications.FollowUp of
NF_LAB_RESULTS : Notifications.Delete;
NF_ABNORMAL_LAB_RESULTS : Notifications.Delete;
NF_SITE_FLAGGED_RESULTS : Notifications.Delete;
NF_STAT_RESULTS : Notifications.Delete;
NF_CRITICAL_LAB_RESULTS : Notifications.Delete;
NF_LAB_THRESHOLD_EXCEEDED : Notifications.Delete;
end;
end;
procedure TfrmLabs.chkZoomClick(Sender: TObject);
begin
inherited;
chtChart.AllowZoom := chkZoom.Checked;
chtChart.AnimatedZoom := chkZoom.Checked;
if not chkZoom.Checked then
begin
chtChart.UndoZoom;
chtChart.ZoomPercent(ZOOM_PERCENT);
end;
end;
procedure TfrmLabs.chtChartUndoZoom(Sender: TObject);
begin
inherited;
chtChart.BottomAxis.Automatic := true;
end;
procedure TfrmLabs.popCopyClick(Sender: TObject);
begin
inherited;
chtChart.CopyToClipboardBitmap;
end;
procedure TfrmLabs.popChartPopup(Sender: TObject);
begin
inherited;
if pnlWorksheet.Visible then
begin
popValues.Checked := chkValues.Checked;
pop3D.Checked := chk3D.Checked;
popZoom.Checked := chkZoom.Checked;
end
else
begin
popValues.Checked := chkGraphValues.Checked;
pop3D.Checked := chkGraph3D.Checked;
popZoom.Checked := chkGraphZoom.Checked;
end;
popZoomBack.Enabled := popZoom.Checked and not chtChart.BottomAxis.Automatic;;
if chtChart.Hint <> '' then
begin
popDetails.Caption := chtChart.Hint;
popDetails.Enabled := true;
end
else
begin
popDetails.Caption := 'Details';
popDetails.Enabled := false;
end;
end;
procedure TfrmLabs.popValuesClick(Sender: TObject);
begin
inherited;
if pnlWorksheet.Visible then
begin
chkValues.Checked := not chkValues.Checked;
chkValuesClick(self);
end
else
begin
chkGraphValues.Checked := not chkGraphValues.Checked;
chkGraphValuesClick(self);
end;
end;
procedure TfrmLabs.pop3DClick(Sender: TObject);
begin
inherited;
if pnlWorksheet.Visible then
begin
chk3D.Checked := not chk3D.Checked;
chk3DClick(self);
end
else
begin
chkGraph3D.Checked := not chkGraph3D.Checked;
chkGraph3DClick(self);
end;
end;
procedure TfrmLabs.popZoomClick(Sender: TObject);
begin
inherited;
if pnlWorksheet.Visible then
begin
chkZoom.Checked := not chkZoom.Checked;
chkZoomClick(self);
end
else
begin
chkGraphZoom.Checked := not chkGraphZoom.Checked;
chkGraphZoomClick(self);
end;
end;
procedure TfrmLabs.popZoomBackClick(Sender: TObject);
begin
inherited;
chtChart.UndoZoom;
end;
procedure TfrmLabs.chtChartMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited;
chtChart.Hint := '';
chtChart.Tag := 0;
end;
procedure TfrmLabs.chtChartClickSeries(Sender: TCustomChart;
Series: TChartSeries; ValueIndex: Integer; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited;
if Series = serHigh then exit;
if Series = serLow then exit;
uDate1 := Series.XValue[ValueIndex];
uDate2 := uDate1;
chtChart.Hint := 'Details - Lab results for ' + FormatDateTime('dddd, mmmm d, yyyy', Series.XValue[ValueIndex]) + '...';
chtChart.Tag := ValueIndex + 1;
if Button <> mbRight then popDetailsClick(self);
end;
procedure TfrmLabs.chtChartClickLegend(Sender: TCustomChart;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
chtChart.Hint := 'Details - for ' + Piece(serTest.Title, '(', 1) + '...';
chtChart.Tag := 0;
if Button <> mbRight then popDetailsClick(self);
end;
procedure TfrmLabs.popDetailsClick(Sender: TObject);
var
tmpList: TStringList;
date1, date2: TFMDateTime;
strdate1, strdate2: string;
begin
inherited;
Screen.Cursor := crHourGlass;
if chtChart.Tag > 0 then
begin
tmpList := TStringList.Create;
try
strdate1 := FormatDateTime('mm/dd/yyyy', uDate1);
strdate2 := FormatDateTime('mm/dd/yyyy', uDate2);
uDate1 := StrToDateTime(strdate1);
uDate2 := StrToDateTime(strdate2);
date1 := DateTimeToFMDateTime(uDate1 + 1);
date2 := DateTimeToFMDateTime(uDate2);
StatusText('Retrieving data for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2) + '...');
Interim(tmpList, Patient.DFN, date1, date2,'ORWLRR INTERIM');
ReportBox(tmpList, 'Lab results on ' + Patient.Name + ' for ' + FormatDateTime('dddd, mmmm d, yyyy', uDate2), True);
finally
tmplist.Free;
end;
end
else
begin
date1 := DateTimeToFMDateTime(chtChart.BottomAxis.Maximum);
date2 := DateTimeToFMDateTime(chtChart.BottomAxis.Minimum);
tmpList := TStringList.Create;
try
if lstTestGraph.ItemIndex > -1 then
tmpList.Add(lstTestGraph.Items[lstTestGraph.ItemIndex])
else
tmpList.Add(Piece(lblSingleTest.Caption, '^', 1));
StatusText('Retrieving data for ' + serTest.Title + '...');
ReportBox(InterimSelect(Patient.DFN, date1, date2, tmpList), Piece(serTest.Title, '(', 1) + 'results on ' + Patient.Name, True);
finally
tmpList.Free;
end;
end;
Screen.Cursor := crDefault;
StatusText('');
end;
procedure TfrmLabs.popPrintClick(Sender: TObject);
begin
inherited;
if chtChart.Visible then PrintLabGraph;
end;
procedure TfrmLabs.PrintLabGraph;
var
GraphTitle: string;
begin
inherited;
GraphTitle := Piece(lblSingleTest.Caption, '^', 2);
if (Length(lblSpecimen.Caption) > 2) then GraphTitle := GraphTitle + ' (' + Piece(lblSpecimen.Caption, '^', 2) + ')';
GraphTitle := GraphTitle + ' - ' + lstDates.DisplayText[lstDates.ItemIndex];
if dlgWinPrint.Execute then PrintGraph(chtChart, GraphTitle);
end;
procedure TfrmLabs.BeginEndDates(var ADate1, ADate2: TFMDateTime; var ADaysBack: integer);
var
datetemp: TFMDateTime;
today, datetime1, datetime2: TDateTime;
relativedate: string;
begin
today := FMToDateTime(floattostr(FMToday));
relativedate := Piece(lstDates.ItemID, ';', 1);
relativedate := Piece(relativedate, '-', 2);
ADaysBack := strtointdef(relativedate, 0);
ADate1 := DateTimeToFMDateTime(today - ADaysBack);
relativedate := Piece(lstDates.ItemID, ';', 2);
if StrToIntDef(Piece(relativedate, '+', 2), 0) > 0 then
begin
relativedate := Piece(relativedate, '+', 2);
ADaysBack := strtointdef(relativedate, 0);
ADate2 := DateTimeToFMDateTime(today + ADaysBack + 1);
end
else
begin
relativedate := Piece(relativedate, '-', 2);
ADaysBack := strtointdef(relativedate, 0);
ADate2 := DateTimeToFMDateTime(today - ADaysBack);
end;
datetime1 := FMDateTimeToDateTime(ADate1);
datetime2 := FMDateTimeToDateTime(ADate2);
if datetime1 < datetime2 then // reorder dates, if needed
begin
datetemp := ADate1;
ADate1 := ADate2;
ADate2 := datetemp
end;
ADate1 := ADate1 + 0.2359;
end;
procedure TfrmLabs.Timer1Timer(Sender: TObject);
var
i,j: integer;
r0: String;
begin
inherited;
with RemoteSites.SiteList do
begin
for i := 0 to Count - 1 do
if TRemoteSite(Items[i]).Selected then
if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
begin
r0 := GetRemoteStatus(TRemoteSite(Items[i]).LabRemoteHandle);
TRemoteSite(Items[i]).LabQueryStatus := r0; //r0='1^Done' if no errors
if piece(r0,'^',1) = '1' then
begin
RemoteReports.Add(TRemoteSite(Items[i]).CurrentLabQuery,
TRemoteSite(Items[i]).LabRemoteHandle);
GetRemoteData(TRemoteSite(Items[i]).LabData,
TRemoteSite(Items[i]).LabRemoteHandle,Items[i]);
TRemoteSite(Items[i]).LabRemoteHandle := '';
TabControl1.OnChange(nil);
end
else
begin
uRemoteCount := uRemoteCount + 1;
if uRemoteCount > 60 then //5 minute limit
begin
Timer1.Enabled := False;
TRemoteSite(Items[i]).LabQueryStatus := '-1^Timed out';
UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Timed out');
StatusText('');
TabControl1.OnChange(nil);
end
else
StatusText('Retrieving Lab data from '
+ TRemoteSite(Items[i]).SiteName + '...');
end;
Timer1.Interval := 5000;
end;
if Timer1.Enabled = True then
begin
j := 0;
for i := 0 to Count -1 do
if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then
j := 1;
if j = 0 then //Shutdown timer if all sites have been processed
begin
Timer1.Enabled := False;
StatusText('');
end;
j := 0;
for i := 0 to Count -1 do
if TRemoteSite(Items[i]).Selected = true then
j := 1;
if j = 0 then //Shutdown timer if user has de-selected all sites
begin
Timer1.Enabled := False;
StatusText('');
TabControl1.OnChange(nil);
end;
end;
end;
end;
procedure TfrmLabs.GoRemote(Dest: TStringList; AItem, AReportID: Int64; AQualifier,
ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime);
var
i,j: integer;
LocalHandle, Report, Query: String;
begin
{ AReportID := 1 Generic report RemoteLabReports
2 Cumulative RemoteLabCumulative
3 Interim RemoteLabInterim
4 Microbioloby RemoteLabMicro }
with RemoteSites.SiteList do
for i := 0 to Count - 1 do
if TRemoteSite(Items[i]).Selected then
begin
TRemoteSite(Items[i]).LabClear;
if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then
begin
TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included';
UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED');
TabControl1.OnChange(nil);
continue;
end;
TRemoteSite(Items[i]).CurrentLabQuery := 'Lab' + Patient.DFN + ';' + Patient.ICN +
'^' + IntToStr(AItem) + '^' + IntToStr(AReportID) + '^^' + ARpc + '^' + AHSType +
'^' + ADaysBack + '^' + ASection + '^' + DateToStr(ADate1) + '^' + DateToStr(ADate2) + '^' +
TRemoteSite(Items[i]).SiteID;
LocalHandle := '';
for j := 0 to RemoteReports.Count - 1 do
begin
Query := TRemoteSite(Items[i]).CurrentLabQuery;
Report := TRemoteReport(RemoteReports.ReportList.Items[j]).Report;
if Report = Query then
begin
LocalHandle := TRemoteReport(RemoteReports.ReportList.Items[j]).Handle;
break;
end;
end;
if Length(LocalHandle) > 1 then
with RemoteSites.SiteList do
begin
GetRemoteData(TRemoteSite(Items[i]).LabData,LocalHandle,Items[i]);
TRemoteSite(Items[i]).LabRemoteHandle := '';
TRemoteSite(Items[i]).LabQueryStatus := '1^Done';
UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done');
TabControl1.OnChange(nil);
end
else
begin
case AReportID of
1: begin
RemoteLabReports(Dest, Patient.DFN + ';' + Patient.ICN, IntToStr(AItem),
AHSType, ADaysBack, ASection, ADate1, ADate2,
TRemoteSite(Items[i]).SiteID, ARpc);
end;
2: begin
RemoteLabCumulative(Dest, Patient.DFN + ';' + Patient.ICN,
StrToInt(Adaysback), Adate1, Adate2, TRemoteSite(Items[i]).SiteID,ARpc);
end;
3: begin
RemoteLabInterim(Dest, Patient.DFN + ';' + Patient.ICN, Adate1, Adate2,
TRemoteSite(Items[i]).SiteID, ARpc);
end;
4: begin
RemoteLabMicro(Dest, Patient.DFN + ';' + Patient.ICN, Adate1, Adate2,
TRemoteSite(Items[i]).SiteID, ARpc);
end;
else begin
RemoteLab(Dest, Patient.DFN + ';' + Patient.ICN, IntToStr(AItem),
AHSType, ADaysBack, ASection, ADate1, ADate2,
TRemoteSite(Items[i]).SiteID, ARpc);
end;
end;
if Dest[0] = '' then
begin
TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error';
UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Communication error');
end
else
begin
TRemoteSite(Items[i]).LabRemoteHandle := Dest[0];
TRemoteSite(Items[i]).LabQueryStatus := '0^initialization...';
UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Initialization');
Timer1.Enabled := True;
StatusText('Retrieving reports from '
+ TRemoteSite(Items[i]).SiteName + '...');
end;
end;
end;
end;
procedure TfrmLabs.TabControl1Change(Sender: TObject);
var
aStatus: string;
hook: Boolean;
i: integer;
begin
inherited;
memLab.Lines.Clear;
lstHeaders.Items.Clear;
with TabControl1 do
begin
memLab.Lines.BeginUpdate;
if TabIndex > 0 then
begin
aStatus := TRemoteSite(Tabs.Objects[TabIndex]).LabQueryStatus;
if aStatus = '1^Done' then
begin
if Piece(TRemoteSite(Tabs.Objects[TabIndex]).LabData[0],'^',1) = '[HIDDEN TEXT]' then
begin
lstHeaders.Clear;
hook := false;
for i := 1 to TRemoteSite(Tabs.Objects[TabIndex]).LabData.Count - 1 do
if hook = true then
memLab.Lines.Add(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i])
else
begin
lstHeaders.Items.Add(MixedCase(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i]));
if Piece(TRemoteSite(Tabs.Objects[TabIndex]).LabData[i],'^',1) = '[REPORT TEXT]' then
hook := true;
end;
end
else
QuickCopy(TRemoteSite(Tabs.Objects[TabIndex]).LabData,memLab);
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
end;
if Piece(aStatus,'^',1) = '-1' then
memLab.Lines.Add('Remote data transmission error: ' + Piece(aStatus,'^',2));
if Piece(aStatus,'^',1) = '0' then
memLab.Lines.Add('Transmission in progress: ' + Piece(aStatus,'^',2));
if Piece(aStatus,'^',1) = '' then
memLab.Lines.Add('Select a report...');
end
else
if uLabLocalReportData.Count > 0 then
begin
if Piece(uLabLocalReportData[0],'^',1) = '[HIDDEN TEXT]' then
begin
lstHeaders.Clear;
hook := false;
for i := 1 to uLabLocalReportData.Count - 1 do
if hook = true then
memLab.Lines.Add(uLabLocalReportData[i])
else
begin
lstHeaders.Items.Add(MixedCase(uLabLocalReportData[i]));
if Piece(uLabLocalReportData[i],'^',1) = '[REPORT TEXT]' then
hook := true;
end;
end
else
QuickCopy(uLabLocalReportData,memLab);
memLab.Lines.Insert(0,' ');
memLab.Lines.Delete(0);
end;
memLab.SelStart := 0;
memLab.Lines.EndUpdate;
end;
end;
procedure TfrmLabs.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
WebDoc: IHtmlDocument2;
v: variant;
begin
inherited;
if uHTMLDoc = '' then Exit;
if not(uReportType = 'H') then Exit; //this can be removed if & when browser replaces memtext control
if not Assigned(WebBrowser1.Document) then Exit;
WebDoc := WebBrowser1.Document as IHtmlDocument2;
v := VarArrayCreate([0, 0], varVariant);
v[0] := uHTMLDoc;
WebDoc.write(PSafeArray(TVarData(v).VArray));
WebDoc.close;
//uHTMLDoc := '';
end;
procedure TfrmLabs.ChkBrowser;
begin
if uReportType = 'H' then
begin
WebBrowser1.Visible := true;
WebBrowser1.Navigate('about:blank');
WebBrowser1.BringToFront;
memLab.Visible := false;
end
else
begin
WebBrowser1.Visible := false;
WebBrowser1.SendToBack;
memLab.Visible := true;
memLab.BringToFront;
end;
end;
procedure TfrmLabs.CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9: Boolean);
begin
lstDates.Visible := false; // turned off to realign correctly
lblDates.Visible := false;
pnlOtherTests.Visible := false;
lstHeaders.Visible := false;
lblHeaders.Visible := false;
lstDates.Visible := A5; // reordered to realign
lblDates.Visible := A4;
pnlOtherTests.Visible := A3;
lstHeaders.Visible := A2;
lblHeaders.Visible := A1;
pnlHeader.Visible := A6;
grdLab.Visible := A7;
pnlChart.Visible := A8;
pnlFooter.Visible := A9;
if A4 and A1 and (lblDates.Top < lblHeaders.Top) then
begin
lblDates.Caption := 'Headings'; // swithes captions if not aligned
lblHeaders.Caption := 'Date Range';
end
else
begin
lblDates.Caption := 'Date Range';
lblHeaders.Caption := 'Headings';
end;
lstDates.Caption := lblDates.Caption;
lstHeaders.Caption := lblHeaders.Caption;
end;
procedure TfrmLabs.Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
inherited;
if (Key = VK_TAB) then
begin
if ssShift in Shift then
begin
FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
Key := 0;
end
else if ssCtrl in Shift then
begin
FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
Key := 0;
end;
end;
if (key = VK_ESCAPE) then begin
FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
key := 0;
end;
end;
end.