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, fBase508Form, VA508AccessibilityManager; type TGrdLab508Manager = class(TVA508ComponentManager) private function GetTextToSpeak(sg: TCaptionStringGrid): String; function ToBlankIfEmpty(aString : String) : String; public constructor Create; override; function GetValue(Component: TWinControl): string; override; function GetItem(Component: TWinControl): TObject; override; end; TfrmLabs = class(TfrmHSplit) 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; pnlRightBottom: TPanel; Memo1: TMemo; memLab: TRichEdit; pnlRightTop: TPanel; bvlHeader: TBevel; pnlHeader: TORAutoPanel; lblDateFloat: TLabel; pnlWorksheet: TORAutoPanel; chkValues: TCheckBox; chk3D: TCheckBox; ragHorV: TRadioGroup; chkAbnormals: TCheckBox; ragCorG: TRadioGroup; chkZoom: TCheckBox; pnlGraph: TORAutoPanel; lblGraphInfo: TLabel; chkGraph3D: TCheckBox; chkGraphValues: TCheckBox; chkGraphZoom: TCheckBox; pnlButtons: TORAutoPanel; lblMostRecent: TLabel; lblDate: TVA508StaticText; cmdNext: TButton; cmdPrev: TButton; cmdRecent: TButton; cmdOld: TButton; grdLab: TCaptionStringGrid; pnlChart: TPanel; lblGraph: TLabel; lstTestGraph: TORListBox; chtChart: TChart; serHigh: TLineSeries; serLow: TLineSeries; serTest: TLineSeries; pnlRightTopHeader: TPanel; PopupMenu2: TPopupMenu; Print1: TMenuItem; Copy1: TMenuItem; SelectAll1: TMenuItem; PopupMenu3: TPopupMenu; Print2: TMenuItem; Copy2: TMenuItem; SelectAll2: TMenuItem; GoToTop1: TMenuItem; GoToBottom1: TMenuItem; FreezeText1: TMenuItem; UnFreezeText1: TMenuItem; sptHorzRight: TSplitter; pnlFooter: TORAutoPanel; lblSpecimen: TLabel; lblSingleTest: TLabel; lblFooter: TOROffsetLabel; lstTests: TORListBox; lvReports: TCaptionListView; pnlLefTop: TPanel; lblReports: TOROffsetLabel; tvReports: TORTreeView; pnlLeftBottom: TPanel; lstQualifier: TORListBox; lblQualifier: TOROffsetLabel; lblHeaders: TOROffsetLabel; lstHeaders: TORListBox; lblDates: TOROffsetLabel; lstDates: TORListBox; Splitter1: TSplitter; pnlOtherTests: TORAutoPanel; bvlOtherTests: TBevel; cmdOtherTests: TButton; TabControl1: TTabControl; pnlRightTopHeaderTop: TPanel; lblHeading: TOROffsetLabel; chkMaxFreq: TCheckBox; lblTitle: TOROffsetLabel; Label1: TLabel; lblSample: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); procedure DisplayHeading(aRanges: string); //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 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); procedure lblDateEnter(Sender: TObject); procedure LoadTreeView; procedure LoadListView(aReportData: TStringList); procedure tvReportsClick(Sender: TObject); procedure lstQualifierClick(Sender: TObject); procedure tvReportsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure tvReportsCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); procedure tvReportsExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); procedure lvReportsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SelectAll1Click(Sender: TObject); procedure Print1Click(Sender: TObject); procedure Copy1Click(Sender: TObject); procedure Copy2Click(Sender: TObject); procedure Print2Click(Sender: TObject); procedure lvReportsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); procedure lvReportsColumnClick(Sender: TObject; Column: TListColumn); procedure lvReportsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure sptHorzRightCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure SelectAll2Click(Sender: TObject); procedure chkMaxFreqClick(Sender: TObject); procedure PopupMenu3Popup(Sender: TObject); procedure grdLabTopLeftChanged(Sender: TObject); private { Private declarations } SortIdx1, SortIdx2, SortIdx3: Integer; grdLab508Manager : TGrdLab508Manager; 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 GoRemoteOld(Dest: TStringList; AItem, AReportID: Int64; AQualifier, ARpc, AHSType, ADaysBack, ASection: string; ADate1, ADate2: TFMDateTime); procedure GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string); procedure ShowTabControl; procedure HideTabControl; procedure ChkBrowser; procedure CommonComponentVisible(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12: 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; uFormat: integer; uPrevReportNode: TTreeNode; 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 uScreenSplitLoc: Integer; //location of user changed split - sptHorzRight Bar uTreeStrings: TStrings; uReportInstruction: String; //User Instructions uColChange: string; //determines when column widths have changed uQualifier: string; uReportType: string; uSortOrder: string; uMaxOcc: string; UpdatingLvReports: Boolean; //Currently updating lvReports uColumns: TStringList; uNewColumn: TListColumn; uLocalReportData: TStringList; //Storage for Local report data uRemoteReportData: TStringList; //Storage for status of Remote data uQualifierType: Integer; uHState: string; uFirstSort: Integer; uSecondSort: Integer; uThirdSort: Integer; ulvSelectOn: boolean; //flag turned on when multiple items in lvReports control have been selected implementation uses uCore, rLabs, rCore, rCover, rOrders, fLabPrint, fFrame, fRptBox, Printers, fReportsPrint, clipbrd, rReports, rGraphs, activex, mshtml, VA508AccessibilityRouter, uReports, VAUtils; const QT_OTHER = 0; QT_MOSTRECENT = 1; QT_DATERANGE = 2; QT_IMAGING = 3; QT_NUTR = 4; QT_PROCEDURES = 19; QT_SURGERY = 28; QT_HSCOMPONENT = 5; QT_HSWPCOMPONENT = 6; 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_POST = CRLF + '
'; {$R *.DFM} var uFrozen: Boolean; uGraphingActivated: Boolean; uRemoteCount: Integer; uHTMLDoc: string; uReportRPC: string; uHTMLPatient: ANSIstring; uEmptyImageList: TImageList; uRptID: String; uDirect: String; ColumnToSort: Integer; ColumnSortForward: Boolean; procedure TfrmLabs.RequestPrint; var aID : integer; begin aID := 0; if CharAt(uRPTID,2) =':' then aID := strToInt(piece(uRPTID,':',1)); if (aID = 0) and (CharAt(uRPTID,3) =':') then aID := StrToInt(piece(uRptID,':',1)); if uReportType = 'M' then begin InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK); Exit; end; if (uReportType = 'V') and (length(piece(uHState,';',2)) > 0) then begin if lvReports.Items.Count < 1 then begin InfoBox('There are no items to be printed.', 'No Items to Print', MB_OK); Exit; end; if lvReports.SelCount < 1 then begin InfoBox('Please select one or more items from the list to be printed.', 'No Items Selected', MB_OK); Exit; end; end; {if (uReportType = 'G') and GraphFormActive then with GraphForm do begin if (lvwItemsTop.SelCount < 1) and (lvwItemsBottom.SelCount < 1) then begin InfoBox('There are no items graphed.', 'No Items to Print', MB_OK); Exit; end else begin mnuPopGraphPrintClick(mnuPopGraphPrint); Exit; end; end; } if uQualifierType = QT_DATERANGE then begin // = 2 if lstQualifier.ItemIndex < 0 then begin InfoBox('Please select from one of the Date Range items before printing', 'Incomplete Information', MB_OK); end else PrintReports(uRptID, piece(uRemoteType,'^',4)); end else if uQualifierType = 0 then begin if aID = 0 then InfoBox(TX_NOREPORT, TX_NOREPORT_CAP, MB_OK); case aID of 1: begin InfoBox('Unable to print ''Most Recent'' report.', 'No Print Available', MB_OK); end; 2: begin PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN); end; 3: begin PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN); end; 4: begin PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), 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(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN); end; 9: begin PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN); end; 10: begin PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN); end; 20: begin PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN); end; 21: begin PrintLabs(IntToStr(aID), piece(uRemoteType,'^',4), lstDates.ItemIEN); end; end; end else PrintLabs(uRptID, piece(uRemoteType,'^',4), lstDates.ItemIEN); end; procedure TfrmLabs.FormCreate(Sender: TObject); var aList: TStrings; begin inherited; LabRowObjects := TLabRowObject.Create; PageID := CT_LABS; 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; uColumns := TStringList.Create; uTreeStrings := TStringList.Create; uEmptyImageList := TImageList.Create(Self); uEmptyImageList.Width := 0; uLocalReportData := TStringList.Create; uRemoteReportData := TStringList.Create; uPrevReportNode := tvReports.Items.GetFirstNode; tvReports.Selected := uPrevReportNode; if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4; lblSingleTest.Caption := ''; lblSpecimen.Caption := ''; SerTest.GetHorizAxis.ExactDateTime := true; SerTest.GetHorizAxis.Increment := DateTimeStep[dtOneMinute]; grdLab508Manager := TGrdLab508Manager.Create; amgrMain.ComponentManager[grdLab] := grdLab508Manager; memo1.Visible := false; 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; HideTabControl; tmpGrid.Clear; lvReports.SmallImages := uEmptyImageList; uLocalReportData.Clear; uRemoteReportData.Clear; with grdLab do begin RowCount := 1; ColCount := 1; Cells[0, 0] := ''; end; end; procedure TfrmLabs.DisplayPage; var i: integer; {OrigSelection: integer; OrigDateIEN: Int64; OrigDateItemID: Variant; OrigReportCat: TTreeNode; } begin inherited DisplayPage; frmFrame.mnuFilePrint.Tag := CT_LABS; frmFrame.mnuFilePrint.Enabled := True; frmFrame.mnuFilePrintSetup.Enabled := True; memLab.SelStart := 0; uHTMLPatient := '
' + '' + '' + '' + '' + '' + '
Patient: ' + Patient.Name + '' + Patient.SSN + 'Age: ' + IntToStr(Patient.Age) + '
'; //the preferred method would be to use headers and footers //so this is just an interim solution. if InitPage then begin Splitter1.Visible := false; pnlLeftBottom.Visible := false; uColChange := ''; uMaxOcc := ''; LoadTreeView; end; if InitPatient and not (CallingContext = CC_NOTIFICATION) then begin uColChange := ''; if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4; tvReports.Selected := tvReports.Items.GetFirstNode; tvReportsClick(self); end; if InitPatient and not (CallingContext = CC_NOTIFICATION) then begin uColChange := ''; lstQualifier.Clear; //tvProcedures.Items.Clear; //lblProcTypeMsg.Visible := FALSE; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; lvReports.Columns.Clear; lblTitle.Caption := ''; lvReports.Caption := ''; Splitter1.Visible := false; pnlLeftBottom.Visible := false; memLab.Parent := pnlRightBottom; memLab.Align := alClient; memLab.Clear; uReportInstruction := ''; uLocalReportData.Clear; for i := 0 to RemoteSites.SiteList.Count - 1 do TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear; //pnlRightTop.Height := lblTitle.Height + TabControl1.Height; StatusText(''); with tvReports do if Items.Count > 0 then begin tvReports.Selected := tvReports.Items.GetFirstNode; tvReportsClick(self); end; end; case CallingContext of CC_INIT_PATIENT: if not InitPatient then begin if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4; tvReports.Selected := tvReports.Items.GetFirstNode; tvReportsClick(self); lvReports.SmallImages := uEmptyImageList; lstQualifier.Clear; //tvProcedures.Items.Clear; //lblProcTypeMsg.Visible := FALSE; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; Splitter1.Visible := false; pnlLeftBottom.Visible := false; with tvReports do if Items.Count > 0 then begin tvReports.Selected := tvReports.Items.GetFirstNode; tvReportsClick(self); end; end; CC_NOTIFICATION: ProcessNotifications; //This corrects the reload of the labs when switching back to the tab. {This code was causing the processing of Lab notifications to display the wrong set of labs for a given notification the 1st notification after selecting/switching patients. Upon checking the problem that this code was trying to solve, we found that the problem no longer exists, which may be a result of subsequent changes for similar issues found during development/testing of V28 (CQ 18267, 18268) CC_CLICK: if not InitPatient then begin //Clear our local variables OrigReportCat := nil; OrigDateIEN := -1; OrigSelection := -1; OrigDateItemID := ''; //What was last selected before they switched tabs. if tvReports.Selected <> nil then OrigReportCat := tvReports.Selected; if lstDates.ItemIEN > 0 then OrigDateIEN := lstDates.ItemIEN; if lvReports.Selected <> nil then OrigSelection := lvReports.Selected.Index; if lstQualifier.ItemID <> '' then OrigDateItemID := lstQualifier.ItemID; //Load the tree and select the last selected if OrigReportCat <> nil then begin tvReports.Select(OrigReportCat); tvReportsClick(self); end; //Did they click on a date (lstDates box) if OrigDateIEN > -1 then begin lstDates.SelectByIEN(OrigDateIEN); lstDatesClick(self); end; //Did they click on a date (lstQualifier) if OrigDateItemID <> '' then begin lstQualifier.SelectByID(OrigDateItemID); lstQualifierClick(self); end; //Did they click on a lab if OrigSelection > -1 then begin lvReports.Selected := lvReports.Items[OrigSelection]; lvReportsSelectItem(self, lvReports.Selected, true); end; end; } end; end; procedure TfrmLabs.SetFontSize(NewFontSize: Integer); begin inherited SetFontSize(NewFontSize); FormResize(self); end; procedure TfrmLabs.LoadListView(aReportData: TStringList); var j,k,aErr: integer; aTmpAray: TStringList; aColCtr, aCurCol, aCurRow, aColID: integer; x,y,z,c,aSite: string; ListItem: TListItem; begin aSite := ''; aErr := 0; ListItem := nil; case uQualifierType of QT_HSCOMPONENT: begin // = 5 if (length(piece(uHState,';',2)) > 0) then begin with lvReports do begin ViewStyle := vsReport; for j := 0 to aReportData.Count - 1 do begin if piece(aReportData[j],'^',1) = '-1' then //error condition, most likely remote call continue; ListItem := Items.Add; aSite := piece(aReportData[j],'^',1); ListItem.Caption := piece(aSite,';',1); for k := 2 to uColumns.Count do begin ListItem.SubItems.Add(piece(aReportData[j],'^',k)); end; end; if aReportData.Count = 0 then begin uReportInstruction := ''; memLab.Lines.Clear; memLab.Lines.Add(uReportInstruction); end else memLab.Lines.Clear; end; end; end; QT_HSWPCOMPONENT: begin // = 6 if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then begin aTmpAray := TStringList.Create; aCurRow := 0; aCurCol := 0; aColCtr := 9; aTmpAray.Clear; with lvReports do begin for j := 0 to aReportData.Count - 1 do begin x := aReportData[j]; aColID := StrToIntDef(piece(x,'^',1),-1); if aColID < 0 then //this is an error condition most likely an incompatible remote call continue; if aColID > (uColumns.Count - 1) then begin aErr := 1; continue; //extract is out of sync with columns defined in 101.24 end; if aColID < aColCtr then begin if aTmpAray.Count > 0 then begin if aColCtr = 1 then begin ListItem := Items.Add; aSite := piece(aTmpAray[j],'^',1); ListItem.Caption := piece(aSite,';',1); ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol)); end else begin c := aTmpAray[0]; if piece(uColumns.Strings[aCurCol],'^',4) = '1' then c := c + '...'; z := piece(c,'^',1); y := copy(c, (pos('^', c)), 9999); if pos('^',y) > 0 then begin while pos('^',y) > 0 do begin y := copy(y, (pos('^', y)+1), 9999); z := z + '^' + y; end; ListItem.SubItems.Add(z); end else begin ListItem.SubItems.Add(y); end; end; LabRowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray); aTmpAray.Clear; end; aColCtr := 0; aCurCol := aColID; aCurRow := aCurRow + 1; end else if aColID = aCurCol then begin z := ''; y := piece(x,'^',2); if length(y) > 0 then z := y; y := copy(x, (pos('^', x)+1), 9999); if pos('^',y) > 0 then begin while pos('^',y) > 0 do begin y := copy(y, (pos('^', y)+1), 9999); z := z + '^' + y; end; aTmpAray.Add(z); end else begin aTmpAray.Add(y); end; continue; end; if aTmpAray.Count > 0 then begin if aColCtr = 1 then begin ListItem := Items.Add; aSite := piece(aTmpAray[0],'^',1); ListItem.Caption := piece(aSite,';',1); ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol)); end else begin c := aTmpAray[0]; if piece(uColumns.Strings[aCurCol],'^',4) = '1' then c := c + '...'; ListItem.SubItems.Add(c); end; LabRowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray); aTmpAray.Clear; end; aCurCol := aColID; Inc(aColCtr); y := ''; for k := 2 to 10 do if length(piece(x,'^',k)) > 0 then begin if length(y) > 0 then y := y + '^' + piece(x,'^',k) else y := y + piece(x,'^',k); end; aTmpAray.Add(y); if aColCtr > 0 then while aColCtr < aCurCol do begin ListItem.SubItems.Add(''); Inc(aColCtr); end; end; if aTmpAray.Count > 0 then begin if aColCtr = 1 then begin ListItem := Items.Add; aSite := piece(aTmpAray[0],'^',1); ListItem.Caption := piece(aSite,';',1); ListItem.SubItems.Add(IntToStr(aCurRow) + ':' + IntToStr(aCurCol)); end else begin c := aTmpAray[0]; if piece(uColumns.Strings[aCurCol],'^',4) = '1' then c := c + '...'; ListItem.SubItems.Add(c); end; LabRowObjects.Add(aSite, IntToStr(aCurRow) + ':' + IntToStr(aCurCol), uColumns.Strings[aCurCol], aTmpAray); aTmpAray.Clear; end; end; aTmpAray.Free; end; end; end; if aErr = 1 then if User.HasKey('XUPROGMODE') then ShowMsg('Programmer message: One or more Column ID''s in file 101.24 do not match ID''s coded in extract routine'); end; procedure TfrmLabs.DisplayHeading(aRanges: string); var x,x1,x2,y,z,DaysBack: string; d1,d2: TFMDateTime; begin with lblTitle do begin x := ''; if tvReports.Selected = nil then tvReports.Selected := tvReports.Items.GetFirstNode; if tvReports.Selected.Parent <> nil then x := tvReports.Selected.Parent.Text + ' ' + tvReports.Selected.Text else x := tvReports.Selected.Text; x1 := ''; x2 := ''; if (uReportType <> 'M') and (not(uRptID = '1:MOST RECENT')) then begin if CharAt(aRanges, 1) = 'd' then begin if length(piece(aRanges,';',2)) > 0 then begin x2 := ' Max/site:' + piece(aRanges,';',2); aRanges := piece(aRanges,';',1); end; DaysBack := Copy(aRanges, 2, Length(aRanges)); if DaysBack = '' then DaysBack := '7'; if DaysBack = '0' then aRanges := 'T' + ';T' else if Copy(aRanges, 2, 1) = 'T' then aRanges := DaysBack + ';T' else aRanges := 'T-' + DaysBack + ';T'; end; if length(piece(aRanges,';',1)) > 0 then begin d1 := ValidDateTimeStr(piece(aRanges,';',1),''); d2 := ValidDateTimeStr(piece(aRanges,';',2),''); y := FormatFMDateTime('mmm dd,yyyy',d1); if Copy(y,8,2) = '18' then y := 'EARLIEST RESULT'; z := FormatFMDateTime('mmm dd,yyyy',d2); x1 := ' [From: ' + y + ' to ' + z + ']'; end; if length(piece(aRanges,';',3)) > 0 then x2 := ' Max/site:' + piece(aRanges,';',3); case uQualifierType of QT_DATERANGE: x := x + x1; QT_HSCOMPONENT: x := x + x1 + x2; QT_HSWPCOMPONENT: x := x + x1 + x2; QT_IMAGING: x := x + x1 + x2; 0: x := x + x1; end; end; if piece(uRemoteType, '^', 9) = '1' then x := x + ' <>'; Caption := x; end; lvReports.Caption := x; end; procedure TfrmLabs.AlignList; begin lblReports.Top := 0; lstDates.Height := pnlLeft.Height div 3 - (lblDates.Height div 2); lstDates.Top := pnlLeft.Height - lstDates.Height; lblDates.Top := lstDates.Top - lblDates.Height; lstQualifier.Height := pnlLeft.Height div 3 - (lblQualifier.Height div 2); lstQualifier.Top := pnlLeft.Height - lstQualifier.Height; lblQualifier.Top := lstQualifier.Top - lblQualifier.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; lstDates.Repaint; lstHeaders.Repaint; lstQualifier.Repaint; end; procedure TfrmLabs.LoadTreeView; var i: integer; currentNode, parentNode, grandParentNode, gtGrandParentNode: TTreeNode; x: string; addchild, addgrandchild, addgtgrandchild: boolean; begin tvReports.Items.Clear; memLab.Clear; uHTMLDoc := ''; //WebBrowser1.Navigate('about:blank'); **Browser Remove** //tvProcedures.Items.Clear; //lblProcTypeMsg.Visible := FALSE; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; uTreeStrings.Clear; //lblTitle.Caption := ''; lvReports.Caption := ''; ListLabReports(uTreeStrings); addchild := false; addgrandchild := false; addgtgrandchild := false; parentNode := nil; grandParentNode := nil; gtGrandParentNode := nil; currentNode := nil; for i := 0 to uTreeStrings.Count - 1 do begin x := uTreeStrings[i]; if UpperCase(Piece(x,'^',1))='[PARENT END]' then begin if addgtgrandchild = true then begin currentNode := gtgrandParentNode; addgtgrandchild := false; end else if addgrandchild = true then begin currentNode := grandParentNode; addgrandchild := false; end else begin currentNode := parentNode; addchild := false; end; continue; end; if UpperCase(Piece(x,'^',1))='[PARENT START]' then begin if addgtgrandchild = true then currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21))) else if addgrandchild = true then begin currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21))); addgtgrandchild := true; gtgrandParentNode := currentNode; end else if addchild = true then begin currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21))); addgrandchild := true; grandParentNode := currentNode; end else begin currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',3),MakeReportTreeObject(Pieces(x,'^',2,21))); parentNode := currentNode; addchild := true; end; end else if addchild = false then begin currentNode := tvReports.Items.AddObject(currentNode,Piece(x,'^',2),MakeReportTreeObject(x)); parentNode := currentNode; end else begin if addgtgrandchild = true then currentNode := tvReports.Items.AddChildObject(gtGrandParentNode,Piece(x,'^',2),MakeReportTreeObject(x)) else if addgrandchild = true then currentNode := tvReports.Items.AddChildObject(grandParentNode,Piece(x,'^',2),MakeReportTreeObject(x)) else currentNode := tvReports.Items.AddChildObject(parentNode,Piece(x,'^',2),MakeReportTreeObject(x)); end; end; if tvReports.Items.Count > 0 then begin tvReports.Selected := tvReports.Items.GetFirstNode; tvReportsClick(self); end; 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,false,false,false); 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 **Browser Remove** //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,false,false,false); memLab.Clear; chkBrowser; FormResize(self); RedrawActivate(memLab.Handle); lstDatesClick(self); //lstQualifierClick(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,false,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); lstQualifierClick(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,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,false,false,false); 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 **Browser Remove** //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); lstQualifierClick(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,false,false,false); StatusText('Retrieving data...'); GoRemoteOld(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'); **Browser Remove** end; 1: begin CommonComponentVisible(false,false,false,true,true,false,false,false,false,false,false,false); memLab.Repaint; //lstDatesClick(self); lstQualifierClick(self); end; 2: begin CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false); lstHeaders.Clear; StatusText('Retrieving data...'); GoRemoteOld(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'); **Browser Remove** end; 3: begin CommonComponentVisible(true,true,false,true,true,false,false,false,true,false,false,false); //lstDatesClick(self); lstQualifierClick(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.lstQualifierClick(Sender: TObject); var MoreID: String; //Restores MaxOcc value aRemote, aHDR, aFHIE, aMax: string; i: integer; tmpList: TStringList; daysback: integer; date1, date2: TFMDateTime; today: TDateTime; begin inherited; if uFrozen = True then begin memo1.visible := False; memo1.TabStop := False; end; 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; MoreID := ';' + Piece(uQualifier,';',3); if chkMaxFreq.checked = true then begin MoreID := ''; SetPiece(uQualifier,';',3,''); end; aMax := piece(uQualifier,';',3); if (CharAt(lstQualifier.ItemID,1) = 'd') and (length(aMax)>0) and (StrToInt(aMax)<101) then MoreID := ';101'; aRemote := piece(uRemoteType,'^',1); aHDR := piece(uRemoteType,'^',7); aFHIE := piece(uRemoteType,'^',8); SetPiece(uRemoteType,'^',5,lstQualifier.ItemID); //tvProcedures.Items.Clear; //lblProcTypeMsg.Visible := FALSE; uHTMLDoc := ''; {if uReportType = 'H' then **Browser Remove** begin WebBrowser1.Visible := true; WebBrowser1.TabStop := true; WebBrowser1.Navigate('about:blank'); WebBrowser1.BringToFront; memLab.Visible := false; memLab.TabStop := false; end else begin WebBrowser1.Visible := false; WebBrowser1.TabStop := false; } memLab.Visible := true; memLab.TabStop := true; memLab.BringToFront; RedrawActivate(memLab.Handle); //end; } uLocalReportData.Clear; uRemoteReportData.Clear; for i := 0 to RemoteSites.SiteList.Count - 1 do TRemoteSite(RemoteSites.SiteList.Items[i]).ReportClear; uRemoteCount := 0; if aHDR = '1' then DisplayHeading(lstQualifier.ItemID) else DisplayHeading(lstQualifier.ItemID + MoreID); if lstQualifier.ItemID = 'ds' then begin with calLabRange do if Not (Execute) then begin lstQualifier.ItemIndex := -1; Exit; end else if (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then begin if (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then if abs(FMDateTimeToDateTime(FMDateStart) - FMDateTimeToDateTime(FMDateStop)) > StrToInt(piece(uRemoteType,'^',6)) then begin InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6) + ' for this report.', 'No Report Generated',MB_OK); lstQualifier.ItemIndex := -1; exit; end; lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart + ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop); DisplayHeading(lstQualifier.ItemID + MoreID); SetPiece(uRemoteType,'^',5,lstQualifier.ItemID); end else begin lstQualifier.ItemIndex := -1; InfoBox('Invalid Date Range entered. Please try again','Invalid Date/time entry',MB_OK); if (Execute) and (Length(TextOfStart) > 0) and (Length(TextOfStop) > 0) then begin lstQualifier.ItemIndex := lstQualifier.Items.Add(RelativeStart + ';' + RelativeStop + U + TextOfStart + ' to ' + TextOfStop); DisplayHeading(lstQualifier.ItemID + MoreID); SetPiece(uRemoteType,'^',5,lstQualifier.ItemID); end else begin lstQualifier.ItemIndex := -1; InfoBox('No Report Generated!','Invalid Date/time entry',MB_OK); exit; end; end; end; if (CharAt(lstQualifier.ItemID,1) = 'd') and (Length(piece(uRemoteType,'^',6)) > 0) and (StrToInt(piece(uRemoteType,'^',6)) > 0) then if ExtractInteger(lstQualifier.ItemID) > (StrToInt(piece(uRemoteType,'^',6))) then begin InfoBox('The Date Range selected is greater than the' + CRLF + 'Maximum Days Allowed of ' + piece(uRemoteType,'^',6) + ' for this report.', 'No Report Generated',MB_OK); lstQualifier.ItemIndex := -1; exit; end; Screen.Cursor := crHourGlass; uReportInstruction := #13#10 + 'Retrieving data...'; memLab.Lines.Add(uReportInstruction); {if WebBrowser1.Visible = true then **Browser Remove** begin uHTMLDoc := HTML_PRE + uReportInstruction + HTML_POST; WebBrowser1.Navigate('about:blank'); end; } case uQualifierType of QT_HSCOMPONENT: begin // = 5 lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; memLab.Lines.Clear; LabRowObjects.Clear; if ((aRemote = '1') or (aRemote = '2')) then GoRemote(uRemoteReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE); if not(piece(uRemoteType, '^', 9) = '1') then if (length(piece(uHState,';',2)) > 0) then begin if not(aRemote = '2') then LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); LoadListView(uLocalReportData); end else begin if ((aRemote = '1') or (aRemote = '2')) then ShowTabControl; LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); if uLocalReportData.Count < 1 then begin uReportInstruction := ''; memLab.Lines.Add(uReportInstruction); end else begin QuickCopy(uLocalReportData,memLab); TabControl1.OnChange(nil); end; end; end; QT_HSWPCOMPONENT: begin // = 6 lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; LabRowObjects.Clear; memLab.Lines.Clear; if ((aRemote = '1') or (aRemote = '2')) then begin Screen.Cursor := crDefault; GoRemote(uRemoteReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE); end; if not(piece(uRemoteType, '^', 9) = '1') then if (length(piece(uHState,';',2)) > 0) then begin if not(aRemote = '2') then LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); LoadListView(uLocalReportData); end else begin {if ((aRemote = '1') or (aRemote = '2')) then ShowTabControl;} if not (aRemote = '2') then begin LoadReportText(uLocalReportData, 'L:' + uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); if uLocalReportData.Count < 1 then begin uReportInstruction := ''; memLab.Lines.Add(uReportInstruction); end else QuickCopy(uLocalReportData,memLab); end; end; end else begin Screen.Cursor := crDefault; //GoRemote(uRemoteReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState, aHDR, aFHIE); //************************************************************************** case StrToInt(Piece(uRptID,':',1)) of 21: begin // Cumulative lstHeaders.Clear; memLab.Clear; uLabLocalReportData.Clear; uLabRemoteReportData.Clear; StatusText('Retrieving data for cumulative report...'); GoRemoteOld(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...'); GoRemoteOld(uLabRemoteReportData,0,3,'',uReportRPC,'','','',date1,date2); TabControl1.OnChange(nil); Interim(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then uLabLocalReportData.Add(''); 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...'); FastAssign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items), uLabLocalReportData); if uLabLocalReportData.Count > 0 then QuickCopy(uLabLocalReportData,memLab) else memLab.Lines.Add(''); 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...'); FastAssign(Worksheet(Patient.DFN, date1, date2, Piece(lblSpecimen.Caption, '^', 1), lstTests.Items), tmpGrid); 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...'); FastAssign(GetChart(Patient.DFN, date1, date2, Piece(lblSpecimen.Caption, '^', 1), Piece(lblSingleTest.Caption, '^', 1)), tmpList); 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(''); 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 := ' ' + 'Results may be available, but cannot be graphed. Please try an alternate view.' else pnlChart.Caption := ' ' + '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...'); GoRemoteOld(uLabRemoteReportData,0,4,'',uReportRPC,'','','',date1,date2); TabControl1.OnChange(nil); Micro(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then uLabLocalReportData.Add(''); 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...'); GoRemoteOld(uLabRemoteReportData,9,1,'',uReportRPC,'',IntToStr(daysback),'',date1,date2); TabControl1.OnChange(nil); Reports(uLabLocalReportData,Patient.DFN, 'L:' + '9', '', IntToStr(daysback),'', date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then uLabLocalReportData.Add(''); 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...'); GoRemoteOld(uLabRemoteReportData, 1, 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2); //GoRemoteOld(uLabRemoteReportData, StrToInt(Piece(uRptID,'^',1)), 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2); TabControl1.OnChange(nil); Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(uRptID,'^',1), '', IntToStr(daysback), '', date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then uLabLocalReportData.Add(''); if TabControl1.TabIndex < 1 then QuickCopy(uLabLocalReportData,memLab); memLab.Lines.Insert(0,' '); memLab.Lines.Delete(0); memLab.SelStart := 0; end; end; //************************************************************************** {LoadReportText(uLocalReportData, uRptID, lstQualifier.ItemID + MoreID, uReportRPC, uHState); if TabControl1.TabIndex < 1 then QuickCopy(uLocalReportData,memLab); } end; end; Screen.Cursor := crDefault; StatusText(''); memLab.Lines.Insert(0,' '); memLab.Lines.Delete(0); {if WebBrowser1.Visible = true then **Browser Remove** begin if uReportType = 'R' then uHTMLDoc := HTML_PRE + uLocalReportData.Text + HTML_POST else uHTMLDoc := uHTMLPatient + uLocalReportData.Text; WebBrowser1.Navigate('about:blank'); end; } end; procedure TfrmLabs.lblDateEnter(Sender: TObject); begin inherited; amgrMain.AccessText[lblDate] := 'Date Collected '+lblDate.Caption; end; procedure TfrmLabs.lstDatesClick(Sender: TObject); var tmpList: TStringList; daysback: integer; date1, date2: TFMDateTime; today: TDateTime; i: integer; x,x1,x2,aID: 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'); **Browser Remove** aID := piece(uRptID,':',1); if aID = '21' then begin // Cumulative lstHeaders.Clear; memLab.Clear; uLabLocalReportData.Clear; uLabRemoteReportData.Clear; StatusText('Retrieving data for cumulative report...'); GoRemoteOld(uLabRemoteReportData,21,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 else if aID = '3' then begin // Interim memLab.Clear; uLabLocalReportData.Clear; uLabRemoteReportData.Clear; StatusText('Retrieving data for interim report...'); GoRemoteOld(uLabRemoteReportData,3,3,'',uReportRPC,'','','',date1,date2); TabControl1.OnChange(nil); Interim(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then uLabLocalReportData.Add(''); if TabControl1.TabIndex < 1 then QuickCopy(uLabLocalReportData,memLab); memLab.Lines.Insert(0,' '); memLab.Lines.Delete(0); memLab.SelStart := 0; end else if aID = '4' then begin // Interim for Selected Tests memLab.Clear; uLabLocalReportData.Clear; uLabRemoteReportData.Clear; try StatusText('Retrieving data for selected tests...'); FastAssign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items), uLabLocalReportData); if uLabLocalReportData.Count > 0 then QuickCopy(uLabLocalReportData,memLab) else memLab.Lines.Add(''); memLab.SelStart := 0; finally //tmpList.Free; end; end else if aID = '5' then 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...'); FastAssign(Worksheet(Patient.DFN, date1, date2, Piece(lblSpecimen.Caption, '^', 1), lstTests.Items), tmpGrid); if ragHorV.ItemIndex = 0 then HGrid(tmpGrid) else VGrid(tmpGrid); GraphList(tmpGrid); GridComments(tmpGrid); ragCorGClick(self); end else if aID = '6' then 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...'); FastAssign(GetChart(Patient.DFN, date1, date2, Piece(lblSpecimen.Caption, '^', 1), Piece(lblSingleTest.Caption, '^', 1)), tmpList); 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(''); 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 := ' ' + 'Results may be available, but cannot be graphed. Please try an alternate view.' else pnlChart.Caption := ' ' + 'Results may be available, but cannot be graphed. Please try an alternate view.'; chtChart.Visible := false; end; finally tmpList.Free; end; end; end else if aID = '9' then begin // Micro memLab.Clear; uLabLocalReportData.Clear; uLabRemoteReportData.Clear; StatusText('Retrieving microbiology data...'); GoRemoteOld(uLabRemoteReportData,4,4,'',uReportRPC,'','','',date1,date2); TabControl1.OnChange(nil); Micro(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then uLabLocalReportData.Add(''); if TabControl1.TabIndex < 1 then QuickCopy(uLabLocalReportData,memLab); memLab.Lines.Insert(0,' '); memLab.Lines.Delete(0); memLab.SelStart := 0; end else if aID = '10' then begin // Lab Status memLab.Clear; uLabLocalReportData.Clear; uLabRemoteReportData.Clear; StatusText('Retrieving lab status data...'); GoRemoteOld(uLabRemoteReportData,10,1,'',uReportRPC,'',IntToStr(daysback),'',date1,date2); TabControl1.OnChange(nil); Reports(uLabLocalReportData,Patient.DFN, 'L:10', '', IntToStr(daysback),'', date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then uLabLocalReportData.Add(''); 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...'); //GoRemoteOld(uLabRemoteReportData, StrToInt(Piece(uRptID,'^',1)), 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2); GoRemoteOld(uLabRemoteReportData, 1, 1, '', uReportRPC, '', IntToStr(daysback), '', date1, date2); TabControl1.OnChange(nil); Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(uRptID,'^',1), '', IntToStr(daysback), '', date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then uLabLocalReportData.Add(''); if TabControl1.TabIndex < 1 then QuickCopy(uLabLocalReportData,memLab); memLab.Lines.Insert(0,' '); memLab.Lines.Delete(0); memLab.SelStart := 0; end; if uReportType = 'R' then uHTMLDoc := HTML_PRE + uLabLocalReportData.Text + HTML_POST else uHTMLDoc := uHTMLPatient + uLabLocalReportData.Text; Screen.Cursor := crDefault; x := lstDates.DisplayText[lstDates.ItemIndex]; x1 := piece(x,' ',1); x2 := piece(x,' ',2); if not(uRptID = '1:MOST RECENT') and (Uppercase(Copy(x1,1,1)) = 'T') and (Uppercase(Copy(x2,1,1)) = 'T') then DisplayHeading(piece(x,' ',1) + ';' + piece(x,' ',2)) else DisplayHeading('d' + lstDates.ItemID); StatusText(''); end; procedure TfrmLabs.cmdOtherTestsClick(Sender: TObject); begin inherited; tvReportsClick(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.grdLabTopLeftChanged(Sender: TObject); var i: integer; begin inherited; if piece(uRptID,':',1) ='1' then begin for i := 2 to grdLab.RowCount do grdLab.Cells[0,i] := ''; if not(grdLab.TopRow = 1) then grdLab.Cells[0,grdLab.TopRow] := lblDate.Caption; end; end; procedure TfrmLabs.HGrid(griddata: TStrings); var testcnt, datecnt, datacnt, linecnt, offset, x, y, i: integer; DisplayDateTime: string; 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 //------------------------------------------------------------------------------------------ //v27.2 - RV - PSI-05-118 / Remedy HD0000000123277 - don't show "00:00" if no time present if LabPatchInstalled then // Requires lab patch in const "PSI_05_118" begin DisplayDateTime := Piece(griddata[i + offset], '^', 2); if length(DisplayDateTime) > 7 then Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(DisplayDateTime)) else if length(DisplayDateTime) > 0 then Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy',MakeFMDateTime(DisplayDateTime)) else Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2))); end else // If no lab patch in const "PSI_05_118", continue as is begin Cells[0, i - testcnt] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2))); end; //------------------------------------------------------------------------------------------ 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; DisplayDateTime: string; 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 //------------------------------------------------------------------------------------------ if LabPatchInstalled then // Requires lab patch in const "PSI_05_118" begin DisplayDateTime := Piece(griddata[i + offset], '^', 2); if length(DisplayDateTime) > 7 then Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(DisplayDateTime)) else if length(DisplayDateTime) > 0 then Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy',MakeFMDateTime(DisplayDateTime)) else Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2))); end else // If no lab patch in const "PSI_05_118", continue as is begin Cells[i - testcnt, 0] := FormatFMDateTime('mm/dd/yy hh:nn',MakeFMDateTime(Piece(griddata[i + offset], '^', 2))); end; //------------------------------------------------------------------------------------------ Cells[i - testcnt, 1] := MixedCase(Piece(griddata[i + offset], '^', 4)) + ' ' + Piece(griddata[i + offset], '^', 5); 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(''); memLab.SelStart := 0; end; procedure TfrmLabs.FormDestroy(Sender: TObject); var i: integer; aColChange: string; begin inherited; if length(uColChange) > 0 then begin aColChange := ''; for i := 0 to lvReports.Columns.Count - 1 do aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ','; if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange); uColChange := ''; end; RemoteQueryAbortAll; tmpGrid.free; uLabLocalReportData.Free; uLabRemoteReportData.Free; uTreeStrings.Free; uEmptyImageList.Free; uColumns.Free; uLocalReportData.Free; uRemoteReportData.Free; LabRowObjects.Free; 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 := 6; DefaultColWidth := agrid.Width div ColCount - 2; ColWidths[0] := 120; //agrid.Width div 6; ColWidths[1] := agrid.Width div 4; //5 ColWidths[5] := agrid.Width div 7; //5 ColWidths[3] := agrid.Width div 14;//12 ColWidths[4] := agrid.Width div 12;//9 ColWidths[2] := agrid.Width div 5; //agrid.Width - ColWidths[0] - ColWidths[1] - 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] := 'Collection Date/Time'; Cells[1, 0] := 'Test'; Cells[2, 0] := 'Result / Status'; Cells[3, 0] := 'Flag'; Cells[4, 0] := 'Units'; Cells[5, 0] := 'Ref Range'; for i := 1 to testcnt do begin if i = 1 then Cells[0, i] := lblDate.Caption else Cells[0, i] := ''; Cells[1, i] := Piece(aitems[i], '^', 2); Cells[2, i] := Piece(aitems[i], '^', 3); Cells[3, i] := Piece(aitems[i], '^', 4); Cells[4, i] := Piece(aitems[i], '^', 5); Cells[5, 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, DisplayDate, aCollection, aSpecimen, aX: string; i,ix: integer; begin tmpList := TStringList.Create; GetNewestOldest(Patient.DFN, newest, oldest); //****** PATCH prevon := true; aCollection := ''; aSpecimen := ''; aX := ''; lblSample.Caption := ''; lblSample.Color := clBtnFace; try FastAssign(InterimGrid(Patient.DFN, adatetime, direction, uFormat), tmpList); if tmpList.Count > 0 then begin lblDateFloat.Caption := Piece(tmpList[0], '^', 3); uFormat := strtointdef(Piece(tmpList[0], '^', 9), 1); //------------------------------------------------------------------------------------------ //v27.1 - RV - PSI-05-118 / Remedy HD0000000123277 - don't show "00:00" if no time present if LabPatchInstalled then // Requires lab patch in const "PSI_05_118" begin DisplayDate := Piece(tmpList[0], '^', 3); if length(DisplayDate) > 7 then lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(DisplayDate)) else if length(DisplayDate) > 0 then lblDate.Caption := FormatFMDateTime('MMM DD, YYYY', strtofloat(DisplayDate)) else if length(lblDateFloat.Caption) > 0 then lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(lblDateFloat.Caption)); end else // If no lab patch in const "PSI_05_118", continue as is begin if length(lblDateFloat.Caption) > 0 then lblDate.Caption := FormatFMDateTime('MMM DD, YYYY hh:nn', strtofloat(lblDateFloat.Caption)); end; //------------------------------------------------------------------------------------------ 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; if Piece(tmpList[0], '^', 2) = 'CH' then begin lblSample.Caption := 'Specimen: ' + Piece(tmpList[0], '^', 5); lblSample.Color := clWindow; end; if Piece(tmpList[0], '^', 2) = 'MI' then begin for i := 0 to tmpList.Count - 1 do begin if i > 5 then break; if ansiContainsStr(tmpList[i],'Collection sample:') then begin ix := 0; if length(piece(tmpList[i], ':',2)) > 0 then begin ix := Length(piece(tmpList[i], ':',2)); if ix > 15 then ix := ix - 15; end; aCollection := ' Sample: ' + LeftStr(piece(tmpList[i], ':',2),ix); end; end; for i := 0 to tmpList.Count - 1 do begin if i > 5 then break; if ansiContainsStr(tmpList[i],'Site/Specimen:') then begin aSpecimen := 'Specimen: ' + piece(tmpList[i], ':', 2); end; end; aX := aSpecimen + aCollection; if Length(aX) > 0 then begin lblSample.Caption := aX; lblSample.Color := clWindow; end; end; end else begin lblDateFloat.Caption := ''; lblDate.Caption := ''; nexton := false; prevon := false; end; cmdNext.Enabled := nexton; cmdRecent.Enabled := nexton; cmdPrev.Enabled := prevon; cmdOld.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 Data' else if cmdOld.Enabled then lblMostRecent.Caption := 'Most Recent Lab Data' else lblMostRecent.Caption := 'Oldest Lab Data'; end; if tmpList.Count > 0 then begin if Piece(tmpList[0], '^', 2) = 'CH' then begin FillGrid(grdLab, tmpList); FillComments(memLab, tmpList); pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 5); sptHorzRight.Top := pnlRightTop.Height; uScreenSplitLoc := sptHorzRight.Top; pnlRightBottom.Height := pnlLeft.Height div 5; memLab.Height := pnlLeft.Height div 5; memLab.Lines.Insert(0,' '); memLab.Lines.Delete(0); memLab.SelStart := 0; 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.Align := alClient; memLab.Repaint; end; if Piece(tmpList[0], '^', 2) = 'MI' then begin tmpList.Delete(0); QuickCopy(tmpList, memLab); memLab.SelStart := 0; grdLab.Visible := false; pnlFooter.Visible := false; sptHorzRight.Visible := true; TabControl1.Visible := false; pnlRightTop.Height := pnlHeader.Height; memLab.Height := pnlRight.Height - (lblHeading.Height + lblTitle.Height + pnlHeader.Height); pnlRightTop.Visible := true; memLab.Align := alClient; memLab.Repaint; 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 tvReports.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 tvReports.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 := ' ' else pnlChart.Caption := ''; 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); //var //aID: integer; begin inherited; AlignList; lblHeaders.Height := lblReports.Height; lblDates.Height := lblReports.Height; lblHeading.Height := lblReports.Height; pnlFooter.Height := lblReports.Height + 5; lblFooter.Height := lblReports.Height; {aID := 0; if CharAt(uRPTID,2) =':' then aID := StrToInt(piece(uRptID,':',1)); if (aID = 0) and (CharAt(uRPTID,3) =':') then aID := StrToInt(piece(uRptID,':',1)); } {case lstReports.ItemIEN of } {case aID 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; pnlRightTop.Height := pnlLeft.Height - (pnlLeft.Height div 5); //*pnlRightTop.Visible := true; //*pnlButtons.Visible := true; //*pnlWorksheet.Visible := false; //*pnlGraph.Visible := false; //memLab.Align := alBottom; sptHorzRight.Visible := true; pnlRightBottom.Height := pnlLeft.Height div 5; //memLab.Height := pnlLeft.Height div 5; //grdLab.Align := alClient; end; 21: 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; 20: begin // Anatomic Path memLab.Repaint; end; 2: 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; pnlRightTop.Align := alTop; pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 6); pnlRightBottom.Visible := true; pnlRightBottom.Align := alClient; memLab.Align := alClient; 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; pnlRightBottom.Visible := false; pnlRightTop.Align := alClient; 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.Print1Click(Sender: TObject); begin inherited; RequestPrint; end; procedure TfrmLabs.Copy1Click(Sender: TObject); var i,j: integer; line: string; ListItem: TListItem; aText: String; begin inherited; ClipBoard; aText := ''; for i := 0 to lvReports.Items.Count - 1 do if lvReports.Items[i].Selected then begin ListItem := lvReports.Items[i]; line := ''; for j := 1 to lvReports.Columns.Count - 1 do begin if (lvReports.Column[j].Width <> 0) and (j < (ListItem.SubItems.Count + 1)) then line := line + ' ' + ListItem.SubItems[j-1]; end; if (length(line) > 0) and (lvReports.Column[0].Width <> 0) then line := ListItem.Caption + ' ' + line; if length(aText) > 0 then aText := aText + CRLF + line else aText := line; end; ClipBoard.Clear; ClipBoard.AsText := aText; end; procedure TfrmLabs.Copy2Click(Sender: TObject); begin inherited; memLab.CopyToClipboard; end; procedure TfrmLabs.Print2Click(Sender: TObject); begin inherited; RequestPrint; end; procedure TfrmLabs.lvReportsColumnClick(Sender: TObject; Column: TListColumn); var ClickedColumn: Integer; a1, a2: integer; s,s1,s2: string; begin inherited; a1 := StrToIntDef(piece(uSortOrder,':',1),0) - 1; a2 := StrToIntDef(piece(uSortOrder,':',2),0) - 1; ClickedColumn := Column.Index; ColumnToSort := Column.Index; SortIdx1 := StrToIntDef(piece(uColumns[ColumnToSort],'^',9),0); SortIdx2 := 0; SortIdx3 := 0; if a1 > -1 then SortIdx2 := StrToIntDef(piece(uColumns[a1],'^',9),0); if a2 > -1 then SortIdx3 := StrToIntDef(piece(uColumns[a2],'^',9),0); if a1 = ColumnToSort then begin SortIdx2 := SortIdx3; SortIdx3 := 0; end; if a2 = ColumnToSort then SortIdx3 := 0; if ClickedColumn = ColumnToSort then ColumnSortForward := not ColumnSortForward else ColumnSortForward := true; ColumnToSort := ClickedColumn; uFirstSort := ColumnToSort; uSecondSort := a1; uThirdSort := a2; lvReports.Hint := ''; if ColumnSortForward = true then s := 'Sorted forward' else s := 'Sorted reverse'; s1 := piece(uColumns[uFirstSort],'^',1); s2 := ''; if length(piece(s1,' ',2)) > 0 then s2 := pieces(s1,' ',2,99); if length(s2) > 0 then s2 := StripSpace(s2); s := s + ' by ' + piece(s1,' ',1) + ' ' + s2; if (a1 <> uFirstSort) and (a1 > -1) then begin s1 := piece(uColumns[a1], '^', 1); s2 := ''; if length(piece(s1,' ',2)) > 0 then s2 := pieces(s1,' ',2,99); if length(s2) > 0 then s2 := StripSpace(s2); s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2; end; if (a2 <> uFirstSort) and (a2 > -1) then begin s1 := piece(uColumns[a2], '^', 1); s2 := ''; if length(piece(s1,' ',2)) > 0 then s2 := pieces(s1,' ',2,99); if length(s2) > 0 then s2 := StripSpace(s2); s := s + ' then by ' + piece(s1,' ',1) + ' ' + s2; end; lvReports.Hint := s; lvReports.CustomSort(nil, 0); end; procedure TfrmLabs.lvReportsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); function CompareValues(Col: Integer): integer; var ix: Integer; s1, s2: string; v1, v2: extended; d1, d2: TFMDateTime; begin inherited; if ColumnToSort = 0 then Result := CompareText(Item1.Caption,Item2.Caption) else begin ix := ColumnToSort - 1; case Col of 0: //strings begin if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then s1 := Item1.SubItems[ix] else s1 := '0'; if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then s2 := Item2.SubItems[ix] else s2 := '0'; Result := CompareText(s1,s2); end; 1: //integers begin if(Item1.SubItems.Count > 0) and (ix < Item1.SubItems.Count) then s1 := Item1.SubItems[ix] else s1 := '0'; if(Item2.SubItems.Count > 0) and (ix < Item2.SubItems.Count) then s2 := Item2.SubItems[ix] else s2 := '0'; IsValidNumber(s1, v1); IsValidNumber(s2, v2); if v1 > v2 then Result := 1 else if v1 < v2 then Result := -1 else Result := 0; end; 2: //date/times begin if(Item1.SubItems.Count > 1) and (ix < Item1.SubItems.Count) then s1 := Item1.SubItems[ix] else s1 := '1/1/1700'; if(Item2.SubItems.Count > 1) and (ix < Item2.SubItems.Count) then s2 := Item2.SubItems[ix] else s2 := '1/1/1700'; d1 := StringToFMDateTime(s1); d2 := StringToFMDateTime(s2); if d1 > d2 then Result := 1 else if d1 < d2 then Result := -1 else Result := 0; end; else Result := 0; // to make the compiler happy end; end; end; begin ColumnToSort := uFirstSort; Compare := CompareValues(SortIdx1); if Compare = 0 then begin if (uSecondSort > -1) and (uFirstSort <> uSecondSort) then begin ColumnToSort := uSecondSort; Compare := CompareValues(SortIdx2); end; if Compare = 0 then if (uThirdSort > -1) and (uFirstSort <> uThirdSort) and (uSecondSort <> uThirdSort) then begin ColumnToSort := uThirdSort; Compare := CompareValues(SortIdx3); end; end; if not ColumnSortForward then Compare := -Compare; end; procedure TfrmLabs.lvReportsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if (Key = 67) and (ssCtrl in Shift) then Copy1Click(Self); if (Key = 65) and (ssCtrl in Shift) then SelectAll1Click(Self); end; procedure TfrmLabs.lvReportsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); var aID, aSID: string; i,j,k: integer; aBasket: TStringList; aWPFlag: Boolean; x, HasImages: string; begin inherited; if not selected then Exit; aBasket := TStringList.Create; uLocalReportData.Clear; aWPFlag := false; with lvReports do begin aID := Item.SubItems[0]; case uQualifierType of QT_OTHER: begin // = 0 end; QT_DATERANGE: begin // = 2 end; QT_IMAGING: begin // = 3 end; QT_NUTR: begin // = 4 end; QT_HSWPCOMPONENT: begin // = 6 if lvReports.SelCount < 3 then begin memLab.Lines.Clear; ulvSelectOn := false; end; aBasket.Clear; if (SelCount = 2) and (ulvSelectOn = false) then begin ulvSelectOn := true; for i := 0 to Items.Count - 1 do if (Items[i].Selected) and (aID <> Items[i].SubItems[0]) then begin aSID := Items[i].SubItems[0]; for j := 0 to LabRowObjects.ColumnList.Count - 1 do if piece(aSID,':',1) = piece(TCellObject(LabRowObjects.ColumnList[j]).Handle,':',1) then if Item.Caption = (piece(TCellObject(LabRowObjects.ColumnList[j]).Site,';',1)) then if (TCellObject(LabRowObjects.ColumnList[j]).Data.Count > 0) and (TCellObject(LabRowObjects.ColumnList[j]).Include = '1') then begin aWPFlag := true; MemLab.Lines.Add(TCellObject(LabRowObjects.ColumnList[j]).Name); FastAssign(TCellObject(LabRowObjects.ColumnList[j]).Data, aBasket); for k := 0 to aBasket.Count - 1 do MemLab.Lines.Add(' ' + aBasket[k]); end; if aWPFlag = true then begin memLab.Lines.Add('Facility: ' + Item.Caption); memLab.Lines.Add('==============================================================================='); end; end; end; aBasket.Clear; aWPFlag := false; for i := 0 to LabRowObjects.ColumnList.Count - 1 do if piece(aID,':',1) = piece(TCellObject(LabRowObjects.ColumnList[i]).Handle,':',1) then if Item.Caption = (piece(TCellObject(LabRowObjects.ColumnList[i]).Site,';',1)) then if (TCellObject(LabRowObjects.ColumnList[i]).Data.Count > 0) and (TCellObject(LabRowObjects.ColumnList[i]).Include = '1') then begin aWPFlag := true; MemLab.Lines.Add(TCellObject(LabRowObjects.ColumnList[i]).Name); FastAssign(TCellObject(LabRowObjects.ColumnList[i]).Data, aBasket); for j := 0 to aBasket.Count - 1 do MemLab.Lines.Add(' ' + aBasket[j]); end; if aWPFlag = true then begin memLab.Lines.Add('Facility: ' + Item.Caption); memLab.Lines.Add('==============================================================================='); end; if uRptID = 'OR_R18:IMAGING' then begin if (Item.SubItems.Count > 8) then //has id, may have case (?) begin x := 'RA^' + Item.SubItems[8] + U + Item.SubItems[4] + U + Item.Caption; SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]); NotifyOtherApps(NAE_REPORT, x); end else if (Item.SubItems.Count > 4) then begin x := 'RA^' + U + U + Item.SubItems[4] + U + Item.Caption; SetPiece(x, U, 10, BOOLCHAR[Item.SubItemImages[1] = IMG_1_IMAGE]); NotifyOtherApps(NAE_REPORT, x); end else if Item.SubItemImages[1] = IMG_1_IMAGE then begin memLab.Lines.Insert(0,''); memLab.Lines.Insert(1,' '); end; end; if uRptID = 'OR_PN:PROGRESS NOTES' then if (Item.SubItems.Count > 7) then begin if StrToIntDef(Item.SubItems[7], 0) > 0 then HasImages := '1' else HasImages := '0'; x := 'PN^' + Item.SubItems[7] + U + Item.SubItems[1] + U + Item.Caption; SetPiece(x, U, 10, HasImages); NotifyOtherApps(NAE_REPORT, x); end; end; QT_PROCEDURES: begin // = 19 end; QT_SURGERY: begin // = 28 end; end; memLab.Lines.Insert(0,' '); memLab.Lines.Delete(0); end; aBasket.Free; end; procedure TfrmLabs.SelectAll1Click(Sender: TObject); var i: integer; begin inherited; for i := 0 to lvReports.Items.Count - 1 do lvReports.Items[i].Selected := true; end; procedure TfrmLabs.SelectAll2Click(Sender: TObject); begin inherited; memLab.SelectAll; 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.chkMaxFreqClick(Sender: TObject); begin inherited; if chkMaxFreq.Checked = true then begin uMaxOcc := piece(uQualifier, ';', 3); SetPiece(uQualifier, ';', 3, ''); end else begin SetPiece(uQualifier, ';', 3, uMaxOcc); end; tvReportsClick(self); end; procedure TfrmLabs.GotoTop1Click(Sender: TObject); begin inherited; SendMessage(memLab.Handle, WM_VSCROLL, SB_TOP, 0); {GoToTop1.Enabled := false; GoToBottom1.Enabled := true; } end; procedure TfrmLabs.GotoBottom1Click(Sender: TObject); begin Inherited; SendMessage(memLab.Handle, WM_VSCROLL, SB_BOTTOM, 0); {GoToTop1.Enabled := true; GoToBottom1.Enabled := false; } 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.PopupMenu3Popup(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 //the following if condition & clause resolves CQ 16405 & 17076 - a mixture of two different patient's lab results in one display (TC). if (AnsiContainsStr(tvReports.Selected.Text, 'Microbiology')) or (AnsiContainsStr(tvReports.Selected.Text, 'Anatomic Pathology')) or (AnsiContainsStr(tvReports.Selected.Text, 'Cytology')) or (AnsiContainsStr(tvReports.Selected.Text, 'Electron Microscopy')) or (AnsiContainsStr(tvReports.Selected.Text, 'Surgical Pathology')) and (lvReports.Visible = TRUE) then begin lvReports.Visible := FALSE; end; tvReports.Selected := tvReports.TopItem; //moved here to fix the conflicting lab results caption header that is displayed with the alert message text. DisplayHeading(''); //fixes part B of CQ #17548 - CPRS v28.1 (TC) lstDates.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; **Browser Remove** //WebBrowser1.SendToBack; **Browser Remove** memLab.Visible := true; memLab.BringToFront; pnlFooter.Visible := true; memLab.Clear; uLabLocalReportData.Clear; uLabRemoteReportData.Clear; pnlRightTop.Height := 5; memLab.Align := alClient; FormResize(self); QuickCopy(ResultOrder(OrderIFN), memLab); memLab.SelStart := 0; memLab.Repaint; lblHeading.Caption := Notifications.Text; end else begin if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4; tvReports.Selected := tvReports.Items.GetFirstNode; tvReportsClick(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,fail: integer; r0: String; begin inherited; with RemoteSites.SiteList do begin for i := 0 to Count - 1 do if TRemoteSite(Items[i]).Selected then begin 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 UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, piece(r0,'^',2)); if piece(r0,'^',1) = '1' then begin GetRemoteData(TRemoteSite(Items[i]).LabData, TRemoteSite(Items[i]).LabRemoteHandle,Items[i]); RemoteReports.Add(TRemoteSite(Items[i]).CurrentLabQuery, TRemoteSite(Items[i]).LabRemoteHandle); TRemoteSite(Items[i]).LabRemoteHandle := ''; TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then begin uRemoteReportData.Clear; QuickCopy(TRemoteSite(Items[i]).LabData,uRemoteReportData); fail := 0; if uRemoteReportData.Count > 0 then begin if uRemoteReportData[0] = 'Report not available at this time.' then begin fail := 1; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Report not available'); end; if piece(uRemoteReportData[0],'^',1) = '-1' then begin fail := 1; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication failure'); end; if fail = 0 then LoadListView(uRemoteReportData); end; end; end else begin uRemoteCount := uRemoteCount + 1; if uRemoteCount > 90 then //~7 minute limit begin TRemoteSite(Items[i]).LabRemoteHandle := ''; 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 := 10000; end; end; if Timer1.Enabled = True then begin j := 0; for i := 0 to Count -1 do begin if Length(TRemoteSite(Items[i]).LabRemoteHandle) > 0 then begin j := 1; break; end; end; 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 begin j := 1; break; end; 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.tvReportsClick(Sender: TObject); var i: integer; aHeading, aReportType, aRPC, aQualifier, aStartTime, aStopTime, aMax, aRptCode, aRemote, aCategory, aSortOrder, aDaysBack, x, x1, x2: string; aIFN, aOldID: integer; aID, aHSTag, aColChange, aDirect, aHDR, aFHIE, aFHIEONLY, aQualifierID: string; CurrentNode: TTreeNode; begin inherited; if (Length(lblHeading.Caption) > 0) and (Length(frmFrame.stsArea.Panels.Items[1].Text) > 0) then begin //ProcessNotfications post-cleanup and clearing of notification message text lblHeading.Caption := ''; //in the header and status bar display when clicking to view lab results. frmFrame.stsArea.Panels.Items[1].Text := ''; end; lvReports.Hint := 'To sort, click on column headers|'; tvReports.TopItem := tvReports.Selected; uRemoteCount := 0; uReportInstruction := ''; aHeading := PReportTreeObject(tvReports.Selected.Data)^.Heading; aRemote := PReportTreeObject(tvReports.Selected.Data)^.Remote; aReportType := PReportTreeObject(tvReports.Selected.Data)^.RptType; aQualifier := PReportTreeObject(tvReports.Selected.Data)^.Qualifier; aID := PReportTreeObject(tvReports.Selected.Data)^.ID; aRPC := PReportTreeObject(tvReports.Selected.Data)^.RPCName; aHSTag := PReportTreeObject(tvReports.Selected.Data)^.HSTag; aCategory := PReportTreeObject(tvReports.Selected.Data)^.Category; aSortOrder := PReportTreeObject(tvReports.Selected.Data)^.SortOrder; aDaysBack := PReportTreeObject(tvReports.Selected.Data)^.MaxDaysBack; aIFN := StrToIntDef(PReportTreeObject(tvReports.Selected.Data)^.IFN,0); aDirect := PReportTreeObject(tvReports.Selected.Data)^.Direct; aHDR := PReportTreeObject(tvReports.Selected.Data)^.HDR; aFHIE := PReportTreeObject(tvReports.Selected.Data)^.FHIE; aFHIEONLY := PReportTreeObject(tvReports.Selected.Data)^.FHIEONLY; aStartTime := Piece(aQualifier,';',1); aStopTime := Piece(aQualifier,';',2); aMax := Piece(aQualifier,';',3); aRptCode := Piece(aQualifier,';',4); aQualifierID:= ''; lstQualifier.ItemIndex := -1; if length(uColChange) > 0 then begin aColChange := ''; for i := 0 to lvReports.Columns.Count - 1 do aColChange := aColChange + IntToStr(lvReports.Column[i].width) + ','; if (Length(aColChange) > 0) and (aColChange <> piece(uColchange,'^',2)) then SaveColumnSizes(piece(uColChange,'^',1) + '^' + aColChange); uColChange := ''; end; if (aReportType <> 'M') and (aRPC = '') and (CharAt(aID,1) = 'H') then begin aReportType := 'R'; aRptCode := LowerCase(CharAt(aID,1)) + Copy(aID, 2, Length(aID)); aID := '1'; aRPC := 'ORWRP REPORT TEXT'; aHSTag := ''; end; uLabLocalReportData.Clear; uLabRemoteReportData.Clear; if aReportType = '' then aReportType := 'R'; uReportRPC := aRPC; uRptID := aID; uLabRepID := aID; uDirect := aDirect; uReportType := aReportType; uQualifier := aQualifier; uSortOrder := aSortOrder; uRemoteType := aRemote + '^' + aReportType + '^' + IntToStr(aIFN) + '^' + aHeading + '^' + aRptCode + '^' + aDaysBack + '^' + aHDR + '^' + aFHIE + '^' + aFHIEONLY; pnlRightTop.Height := lblTitle.Height; // see below RedrawSuspend(tvReports.Handle); RedrawSuspend(memLab.Handle); uHState := aHSTag; Timer1.Enabled := False; HideTabControl; sptHorzRight.Visible := true; lvReports.Visible := false; if (aRemote = '1') or (aRemote = '2') then if not(uReportType = 'V') then ShowTabControl; StatusText(''); uHTMLDoc := ''; //WebBrowser1.Navigate('about:blank'); **Browser Remove** memLab.Lines.Clear; memLab.Parent := pnlRightBottom; memLab.Align := alClient; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; lvReports.Columns.Clear; DisplayHeading(''); if uReportType = 'H' then begin lvReports.Visible := false; pnlRightBottom.Visible := true; {WebBrowser1.Visible := true; **Browser Remove** WebBrowser1.TabStop := true; WebBrowser1.Navigate('about:blank'); WebBrowser1.BringToFront; } memLab.Visible := false; memLab.TabStop := false; end else if uReportType = 'V' then begin with lvReports do begin RedrawSuspend(lvReports.Handle); Columns.BeginUpdate; ViewStyle := vsReport; ColumnHeaders(uColumns, IntToStr(aIFN)); for i := 0 to uColumns.Count -1 do begin uNewColumn := Columns.Add; uNewColumn.Caption := piece(uColumns.Strings[i],'^',1); if length(uColChange) < 1 then uColChange := IntToStr(aIFN) + '^'; if piece(uColumns.Strings[i],'^',2) = '1' then begin uNewColumn.Width := 0; uColChange := uColChange + '0,'; end else if length(piece(uColumns.Strings[i],'^',10)) > 0 then begin uColChange := uColChange + piece(uColumns.Strings[i],'^',10) + ','; uNewColumn.Width := StrToInt(piece(uColumns.Strings[i],'^',10)) end else uNewColumn.Width := ColumnHeaderWidth; //ColumnTextWidth for width of text if (i = 0) and (((aRemote <> '2') and (aRemote <> '1')) or ((TabControl1.Tabs.Count < 2) and (not (aHDR = '1')))) then uNewColumn.Width := 0; end; Columns.EndUpdate; RedrawActivate(lvReports.Handle); end; lvReports.Visible := true; sptHorzRight.Visible := true; //WebBrowser1.Visible := false; **Browser Remove** //WebBrowser1.TabStop := false; **Browser Remove** pnlRightBottom.Visible := true; memLab.Visible := true; memLab.TabStop := true; memLab.BringToFront; RedrawActivate(memLab.Handle); end else begin lvReports.Visible := true; sptHorzRight.Visible := false; //WebBrowser1.Visible := false; **Browser Remove** //WebBrowser1.TabStop := false; **Browser Remove** pnlRightBottom.Visible := True; memLab.Visible := true; memLab.TabStop := true; memLab.BringToFront; RedrawActivate(memLab.Handle); end; uLocalReportData.Clear; LabRowObjects.Clear; uRemoteReportData.Clear; lstHeaders.Visible := false; lstHeaders.TabStop := false; lblHeaders.Visible := false; lstHeaders.Clear; for i := 0 to RemoteSites.SiteList.Count - 1 do TRemoteSite(RemoteSites.SiteList.Items[i]).LabClear; if uFrozen = True then begin memo1.visible := False; memo1.TabStop := False; end; Screen.Cursor := crHourGlass; if aReportType = 'M' then begin pnlLeftBottom.Visible := false; splitter1.Visible := false; CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false); memLab.Clear; chkBrowser; pnlHeader.Visible := false; sptHorzRight.Visible := true; lvReports.Visible := false; pnlRighttop.Height := lblHeading.Height; memLab.Height := pnlRight.Height - (lblHeading.Height + lblTitle.Height); pnlRightTop.Visible := true; memLab.Align := alClient; FormResize(self); end else begin uQualifierType := StrToIntDef(aRptCode,0); case uQualifierType of QT_OTHER: begin // = 0 memLab.Lines.Clear; If aID = '1:MOST RECENT' then begin CommonComponentVisible(false,false,false,false,false,true,true,false,true,false,false,false); pnlRightTop.Height := pnlLeft.Height - (pnlLeft.Height div 5); pnlRightTop.Visible := true; pnlButtons.Visible := true; pnlWorksheet.Visible := false; pnlGraph.Visible := false; memLab.Align := alBottom; pnlRightTop.Align := alTop; pnlRightBottom.Align := alclient; sptHorzRight.Visible := true; pnlRightBottom.Visible := true; pnlRightBottom.Height := pnlLeft.Height div 5; memLab.Height := pnlLeft.Height div 5; grdLab.Align := alTop; memLab.Clear; {if uReportType = 'H' then **Browser Remove** 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); uPrevReportNode := tvReports.Selected; end else if aID = '4:SELECTED TESTS BY DATE' then begin // Interim for Selected Tests if uPrevReportNode <> tvReports.Selected then begin lstTests.Clear; lblSpecimen.Caption := ''; end; SelectTests(Font.Size); if lstTests.Items.Count > 0 then begin CommonComponentVisible(false,false,true,true,true,false,false,false,true,false,false,false); pnlRighttop.Height := lblHeading.Height + lblTitle.Height; pnlRightTop.Visible := false; memLab.Clear; chkBrowser; FormResize(self); RedrawActivate(memLab.Handle); lstDatesClick(self); //lstQualifierClick(self); cmdOtherTests.SetFocus; cmdOtherTests.Default := true; uPrevReportNode := tvReports.Selected; end else begin uPrevReportNode := tvReports.Items.GetFirstNode; tvReports.Selected := uPrevReportNode; tvReportsClick(self); end; end else if aID = '5:WORKSHEET' then begin // Worksheet if uPrevReportNode <> tvReports.Selected then begin lstTests.Clear; lblSpecimen.Caption := ''; end; SelectTestGroups(Font.Size); if lstTests.Items.Count > 0 then begin CommonComponentVisible(false,false,true,true,true,true,true,false,false,false,false,false); pnlRighttop.Height := pnlRight.Height - (pnlRight.Height div 4); pnlRightTop.Visible := true; pnlHeader.Align := alTop; pnlChart.Align := alTop; sptHorzRight.Visible := true; 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); //lstQualifierClick(self); cmdOtherTests.SetFocus; cmdOtherTests.Default := true; uPrevReportNode := tvReports.Selected; if lstDates.ItemIndex = -1 then if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4; //for i := 1 to lstDates.Count - 1 do //Sets default date range to next item > 1 Month (which should be 6 months) //if strToInt(piece(lstDates.Items[i],'^',1)) > 31 then //begin //lstDates.ItemIndex := i; //break; //end; lstDatesClick(self); if ScreenReaderSystemActive then grdLab.SetFocus; end else begin uPrevReportNode := tvReports.Items.GetFirstNode; tvReports.Selected := uPrevReportNode; tvReportsClick(self); end; end else if aID = '6:GRAPH' then 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,false,false,false); pnlRightTop.Visible := 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 ?? //tvReports.Selected := uPrevReportNode; end else // otherwise, do lab graph begin if uPrevReportNode <> tvReports.Selected then begin lblSingleTest.Caption := ''; lblSpecimen.Caption := ''; end; 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,false,false,false); 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 **Browser Remove** 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); //lstQualifierClick(self); cmdOtherTests.SetFocus; cmdOtherTests.Default := true; uPrevReportNode := tvReports.Selected; end else tvReports.Selected := uPrevReportNode; end; end else if (aID = '9:MICROBIOLOGY') or (aID = '20:ANATOMIC PATHOLOGY') or (aID = '2:BLOOD BANK') or (aID = '10:LAB STATUS') or (aID = '3:ALL TESTS BY DATE') or (aID = '21:CUMULATIVE') or (aID = '27:AUTOPSY') then begin //added to deal with other reports from file 101.24 memLab.Clear; chkBrowser; pnlHeader.Visible := false; pnlRightTop.Visible := false; pnlRightBottom.Visible := false; sptHorzRight.Visible := false; pnlRightTop.Height := lblHeading.Height; if ((aRemote = '1') or (aRemote = '2')) then ShowTabControl; pnlRightTopHeader.Align := alTop; pnlRightTop.Align := alTop; TabControl1.Align := alTop; pnlRightBottom.Align := alclient; sptHorzRight.Visible := true; pnlRightBottom.Visible := true; lvReports.Visible := false; memLab.Align := alClient; if lstDates.ItemIndex = -1 then if Patient.Inpatient then lstDates.ItemIndex := 2 else lstDates.ItemIndex := 4; {for i := 1 to lstDates.Count - 1 do //Sets default date range to next item > 1 Month (which should be 6 months) if strToInt(piece(lstDates.Items[i],'^',1)) > 31 then begin lstDates.ItemIndex := i; break; end; } FormResize(self); aOldID := 1; if aID = '9:MICROBIOLOGY' then aOldID := 4; //if aID = '20:ANATOMIC PATHOLOGY' then AOldID := 8; if aID = '2:BLOOD BANK' then AOldID := 9; if aID = '10:LAB STATUS' then AOldID := 10; if aID = '3:ALL TESTS BY DATE' then AOldID := 3; if aID = '21:CUMULATIVE' then AOldID := 2; case StrToInt(aCategory) 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,false,false,false); StatusText('Retrieving data...'); GoRemoteOld(uLabRemoteReportData,StrToInt(Piece(aID,':',1)),aOldID,'',uReportRPC,'0','9999','1',0,0); //GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE); TabControl1.OnChange(nil); Reports(uLabLocalReportData,Patient.DFN, 'L:' + Piece(aID,':',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'); **Browser Remove** end; 1: begin CommonComponentVisible(false,false,false,true,true,false,false,false,false,false,false,false); memLab.Repaint; lstDatesClick(self); //lstQualifierClick(self); end; 2: begin CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false); lstHeaders.Clear; StatusText('Retrieving data...'); GoRemoteOld(uLabRemoteReportData,StrToInt(Piece(aID,':',1)),aOldID,'',uReportRPC,'0','9999','1',0,0); //GoRemote(uRemoteReportData, aID, aRptCode, aRPC, uHState, aHDR, aFHIE); TabControl1.OnChange(nil); Reports(uLabLocalReportData,Patient.DFN, Piece(aID,':',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'); **Browser Remove** end; 3: begin CommonComponentVisible(true,true,false,true,true,false,false,false,true,false,false,false); lstDatesClick(self); //lstQualifierClick(self); memLab.Lines.Insert(0,' '); memLab.Lines.Delete(0); end; end; uPrevReportNode := tvReports.Selected; end //else if aID = '20:ANATOMIC PATHOLOGY' then //else if aID = '2:BLOOD BANK' then //else if aID = '10:LAB STATUS' then else begin pnlLeftBottom.Visible := false; splitter1.Visible := false; CommonComponentVisible(true,true,false,false,false,false,false,false,false,false,false,false); pnlRightTop.Visible := true; StatusText('Retrieving ' + tvReports.Selected.Text + '...'); GoRemote(uRemoteReportData, 'L:' + aID, aRptCode, aRPC, uHState, aHDR, aFHIE); uReportInstruction := #13#10 + 'Retrieving data...'; TabControl1.OnChange(nil); if not(piece(uRemoteType, '^', 9) = '1') then LoadReportText(uLocalReportData, 'L:' + aID, aRptCode, aRPC, uHState); QuickCopy(uLocalReportData, memLab); if uLocalReportData.Count > 0 then TabControl1.OnChange(nil); StatusText(''); uPrevReportNode := tvReports.Selected; end; end; QT_DATERANGE: begin // = 2 ListReportDateRanges(lstQualifier.Items); if lstQualifier.ItemID = '' then begin lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; lstQualifierClick(self); end else lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lblQualifier.Caption := 'Date Range'; pnlLeftBottom.Visible := true; splitter1.Visible := true; uPrevReportNode := tvReports.Selected; end; QT_HSCOMPONENT: begin // = 5 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 4); pnlLeftBottom.Visible := false; splitter1.Visible := false; StatusText('Retrieving ' + tvReports.Selected.Text + '...'); uReportInstruction := #13#10 + 'Retrieving data...'; CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,true,true); pnlRightTop.Visible := true; lvReports.Visible := true; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; LabRowObjects.Clear; memLab.Lines.Clear; if (length(piece(aHSTag,';',2)) > 0) then begin if aCategory <> '0' then begin ListReportDateRanges(lstQualifier.Items); aQualifierID := lstQualifier.ItemID; if aQualifierID = '' then begin if aHDR = '1' then lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000') else if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end else begin GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE); if aHDR = '1' then lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000') else if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end; lblQualifier.Caption := 'Date Range'; pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin if not (aRemote = '2' ) then GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE); if not(piece(uRemoteType, '^', 9) = '1') then begin LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState); LoadListView(uLocalReportData); end; end; end else begin if (aRemote = '1') or (aRemote = '2') then if TabControl1.Tabs.Count > 1 then ShowTabControl; GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE); if not(piece(uRemoteType, '^', 9) = '1') then LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState); if uLocalReportData.Count < 1 then uReportInstruction := '' else begin if TabControl1.TabIndex < 1 then QuickCopy(uLocalReportData,memLab); end; TabControl1.OnChange(nil); if aCategory <> '0' then begin ListReportDateRanges(lstQualifier.Items); if lstQualifier.ItemID = '' then begin lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end else lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lblQualifier.Caption := 'Date Range'; pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin if uLocalReportData.Count < 1 then begin uReportInstruction := ''; memLab.Lines.Add(uReportInstruction); end else begin QuickCopy(uLocalReportData,memLab); TabControl1.OnChange(nil); end; end; end; StatusText(''); uPrevReportNode := tvReports.Selected; end; QT_HSWPCOMPONENT: begin // = 6 pnlRightTop.Height := pnlRight.Height - (pnlRight.Height div 2); sptHorzRight.top := pnlRightTop.Height; uScreenSplitLoc := sptHorzRight.Top; pnlLeftBottom.Visible := false; splitter1.Visible := false; StatusText('Retrieving ' + tvReports.Selected.Text + '...'); uReportInstruction := #13#10 + 'Retrieving data...'; CommonComponentVisible(false,false,false,false,false,false,false,false,false,false,false,false); pnlRightTop.Visible := true; lvReports.Visible := true; sptHorzRight.Visible := true; memLab.Visible := true; TabControl1.OnChange(nil); LabRowObjects.Clear; memLab.Lines.Clear; lvReports.SmallImages := uEmptyImageList; lvReports.Items.Clear; memLab.Repaint; if (length(piece(aHSTag,';',2)) > 0) then begin if aCategory <> '0' then begin ListReportDateRanges(lstQualifier.Items); aQualifierID := lstQualifier.ItemID; if aQualifierID = '' then begin if aHDR = '1' then lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000') else if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end else begin GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE); if aHDR = '1' then lstQualifier.ItemIndex := lstQualifier.Items.Add('T-50000' + ';' + 'T+50000' + '^' + 'T-50000' + ' to ' + 'T+50000') else if length(aStartTime) > 0 then lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end; lblQualifier.Caption := 'Date Range'; CommonComponentVisible(false,false,false,false,false,false,false,false,false,true,true,true); pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE); if not (aRemote = '2' ) and (not(piece(uRemoteType, '^', 9) = '1')) then begin LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState); LoadListView(uLocalReportData); end; end; end else begin if (aRemote = '1') or (aRemote = '2') then ShowTabControl; GoRemote(uRemoteReportData, 'L:' + aID, aQualifier, aRPC, uHState, aHDR, aFHIE); if not(piece(uRemoteType, '^', 9) = '1') then LoadReportText(uLocalReportData, 'L:' + aID, aQualifier, aRPC, uHState); if uLocalReportData.Count < 1 then uReportInstruction := '' else begin if TabControl1.TabIndex < 1 then QuickCopy(uLocalReportData,memLab); end; TabControl1.OnChange(nil); if aCategory <> '0' then begin ListReportDateRanges(lstQualifier.Items); if lstQualifier.ItemID = '' then begin lstQualifier.ItemIndex := lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lstQualifierClick(self); end else lstQualifier.Items.Add(aStartTime + ';' + aStopTime + '^' + aStartTime + ' to ' + aStopTime); lblQualifier.Caption := 'Date Range'; pnlLeftBottom.Visible := true; splitter1.Visible := true; end else begin LoadListView(uLocalReportData); end; end; StatusText(''); uPrevReportNode := tvReports.Selected; end; else begin // = ? uQualifierType := QT_OTHER; pnlLeftBottom.Visible := false; splitter1.Visible := false; StatusText('Retrieving ' + tvReports.Selected.Text + '...'); GoRemote(uRemoteReportData, 'L:' + aID, aRptCode, aRPC, uHState, aHDR, aFHIE); uReportInstruction := #13#10 + 'Retrieving data...'; TabControl1.OnChange(nil); //LoadReportText(uLocalReportData, 'L:' + aID, aRptCode, aRPC, uHState); if not(piece(uRemoteType, '^', 9) = '1') then LoadReportText(uLocalReportData, 'L:' + aID, '', aRPC, uHState); if uLocalReportData.Count < 1 then uReportInstruction := '' else begin if TabControl1.TabIndex < 1 then QuickCopy(uLocalReportData,memLab); end; TabControl1.OnChange(nil); StatusText(''); uPrevReportNode := tvReports.Selected; end; lstQualifier.Caption := lblQualifier.Caption; end; end; if lstQualifier.ItemIndex > -1 then begin if not (aHDR = '1') then if aCategory <> '0' then DisplayHeading(uQualifier) else DisplayHeading(''); end else begin if not (aHDR = '1') then if aCategory <> '0' then begin //lstDatesClick(self); x := lstDates.DisplayText[lstDates.ItemIndex]; x1 := piece(x,' ',1); x2 := piece(x,' ',2); if (Uppercase(Copy(x1,1,1)) = 'T') and (Uppercase(Copy(x2,1,1)) = 'T') then DisplayHeading(piece(x,' ',1) + ';' + piece(x,' ',2)) else DisplayHeading('d' + lstDates.ItemID); end else DisplayHeading(''); end; SendMessage(tvReports.Handle, WM_HSCROLL, SB_THUMBTRACK, 0); RedrawActivate(tvReports.Handle); memLab.Visible := true; memLab.TabStop := true; memLab.BringToFront; RedrawActivate(memLab.Handle); {if WebBrowser1.Visible = true then **Browser Remove** begin WebBrowser1.Navigate('about:blank'); WebBrowser1.BringToFront; end } {else if not GraphFormActive then begin memLab.Visible := true; memLab.TabStop := true; memLab.BringToFront; RedrawActivate(memLab.Handle); end} //else **Browser Remove** //begin **Browser Remove** {GraphPanel(true); with GraphForm do begin lstDateRange.Items := cboDateRange.Items; lstDateRange.ItemIndex := cboDateRange.ItemIndex; ViewSelections; BringToFront; end; } //end; **Browser Remove** lvReports.Columns.BeginUpdate; lvReports.Columns.EndUpdate; Screen.Cursor := crDefault; end; procedure TfrmLabs.tvReportsCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); begin inherited; tvReports.Selected := Node; end; procedure TfrmLabs.tvReportsExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); begin inherited; tvReports.Selected := Node; end; procedure TfrmLabs.tvReportsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; case Key of VK_LBUTTON, VK_RETURN, VK_SPACE: begin tvReportsClick(Sender); Key := 0; end; end; end; procedure TfrmLabs.GoRemote(Dest: TStringList; AItem: string; AQualifier, ARpc: string; AHSTag: string; AHDR: string; aFHIE: string); var i, j: integer; LocalHandle, Query, Report, Seq: string; HSType, DaysBack, ExamID, MaxOcc: string; Alpha, Omega, Trans: double; begin HSType := ''; DaysBack := ''; ExamID := ''; Alpha := 0; Omega := 0; Seq := ''; if AHDR = '1' then begin if HDRActive = '0' then begin InfoBox('The HDR is currently inactive.' + CRLF + 'Unable to retrieve HDR data at this time.', 'HDR Error', MB_OK); Exit; end; InfoBox('You must use VistaWeb to view this report.', 'Use VistaWeb for HDR data', MB_OK); if (Piece(AItem, ':', 1) = 'OR_VWAL') or (Piece(AItem, ':', 1) = 'OR_VWRX') then AQualifier := 'T-50000;T+50000;99999'; if (Piece(AItem, ':', 1) = 'OR_VWVS') and (CharAt(AQualifier, 1) = ';') then AQualifier := 'T-50000;T+50000;99999'; end; if CharAt(AQualifier, 1) = 'd' then begin DaysBack := Copy(AQualifier, 2, Length(AQualifier)); AQualifier := ('T-' + Piece(DaysBack,';',1) + ';T;' + Pieces(AQualifier,';',2,3)); DaysBack := ''; end; if CharAt(AQualifier, 1) = 'T' then begin if Piece(AQualifier,';',1) = 'T-0' then SetPiece(AQualifier,';',1,'T'); if (Piece(Aqualifier,';',1) = 'T') and (Piece(Aqualifier,';',2) = 'T') then SetPiece(AQualifier,';',2,'T+1'); Alpha := StrToFMDateTime(Piece(AQualifier,';',1)); Omega := StrToFMDateTime(Piece(AQualifier,';',2)); if Alpha > Omega then begin Trans := Omega; Omega := Alpha; Alpha := Trans; end; MaxOcc := Piece(AQualifier,';',3); SetPiece(AHSTag,';',4,MaxOcc); end; if CharAt(AQualifier, 1) = 'h' then HSType := Copy(AQualifier, 2, Length(AQualifier)); if CharAt(AQualifier, 1) = 'i' then ExamID := Copy(AQualifier, 2, Length(AQualifier)); with RemoteSites.SiteList do for i := 0 to Count - 1 do begin if (AHDR='1') and (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then begin TRemoteSite(Items[i]).Selected := true; frmFrame.lstCIRNLocations.Checked[i+1] := true; end; if TRemoteSite(Items[i]).Selected then begin TRemoteSite(Items[i]).ReportClear; if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') and not(AHDR = '1') then begin TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED'); TRemoteSite(Items[i]).LabRemoteHandle := ''; TRemoteSite(Items[i]).LabQueryStatus := '1^Done'; if uQualifierType = 6 then seq := '1^'; TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName); if uQualifierType = 6 then seq := '2^'; TRemoteSite(Items[i]).Data.Add(seq + ' - Use "HDR Reports" menu for HDR Data.'); TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then LoadListView(TRemoteSite(Items[i]).Data); continue; end; if (AHDR = '1') and not(LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200HD') then begin TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED'); TRemoteSite(Items[i]).LabRemoteHandle := ''; TRemoteSite(Items[i]).LabQueryStatus := '1^Done'; if uQualifierType = 6 then seq := '1^'; TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName); if uQualifierType = 6 then seq := '2^'; TRemoteSite(Items[i]).Data.Add(seq + ' This site is not a source for HDR Data.'); TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then LoadListView(TRemoteSite(Items[i]).Data); continue; end; if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') and not(aFHIE = '1') then begin TRemoteSite(Items[i]).LabQueryStatus := '1^Not Included'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'NOT INCLUDED'); TRemoteSite(Items[i]).LabRemoteHandle := ''; TRemoteSite(Items[i]).LabQueryStatus := '1^Done'; if uQualifierType = 6 then seq := '1^'; TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName); if uQualifierType = 6 then seq := '2^'; TRemoteSite(Items[i]).Data.Add(seq + ' - Use "Dept. of Defense Reports" Menu to retrieve data from DOD.'); TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then LoadListView(TRemoteSite(Items[i]).Data); continue; end; TRemoteSite(Items[i]).CurrentReportQuery := 'Report' + Patient.DFN + ';' + Patient.ICN + '^' + AItem + '^^^' + ARpc + '^' + HSType + '^' + DaysBack + '^' + ExamID + '^' + FloatToStr(Alpha) + '^' + FloatToStr(Omega) + '^' + TRemoteSite(Items[i]).SiteID + '^' + AHSTag + '^' + AHDR; LocalHandle := ''; Query := TRemoteSite(Items[i]).CurrentReportQuery; for j := 0 to RemoteReports.Count - 1 do begin 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]).Data,LocalHandle,Items[i]); TRemoteSite(Items[i]).LabRemoteHandle := ''; TRemoteSite(Items[i]).LabQueryStatus := '1^Done'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done'); TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then //and (chkText.Checked = false) then LoadListView(TRemoteSite(Items[i]).Data); end else begin if uDirect = '1' then begin StatusText('Retrieving reports from ' + TRemoteSite(Items[i]).SiteName + '...'); TRemoteSite(Items[i]).LabQueryStatus := '1^Direct Call'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Direct Call'); DirectQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag); if Copy(Dest[0],1,2) = '-1' then begin TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error'); if uQualifierType = 6 then seq := '1^'; TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName); if uQualifierType = 6 then seq := '2^'; TRemoteSite(Items[i]).Data.Add(seq + '- Unable to communicate with Remote site'); TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then LoadListView(TRemoteSite(Items[i]).Data); end else begin QuickCopy(Dest,TRemoteSite(Items[i]).Data); TRemoteSite(Items[i]).LabRemoteHandle := ''; TRemoteSite(Items[i]).LabQueryStatus := '1^Done'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID, 'Done'); TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then LoadListView(TRemoteSite(Items[i]).Data); end; StatusText(''); end else begin RemoteQuery(Dest, AItem, HSType, Daysback, ExamID, Alpha, Omega, TRemoteSite(Items[i]).SiteID, ARpc, AHSTag); if Dest[0] = '' then begin TRemoteSite(Items[i]).LabQueryStatus := '-1^Communication error'; UpdateRemoteStatus(TRemoteSite(Items[i]).SiteID,'Communication error'); if uQualifierType = 6 then seq := '1^'; TRemoteSite(Items[i]).Data.Add(seq + TRemoteSite(Items[i]).SiteName); if uQualifierType = 6 then seq := '2^'; TRemoteSite(Items[i]).Data.Add(seq + '- Unable to communicate with Remote site'); TabControl1.OnChange(nil); if (length(piece(uHState,';',2)) > 0) then LoadListView(TRemoteSite(Items[i]).Data); 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; end; end; procedure TfrmLabs.GoRemoteOld(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; if (LeftStr(TRemoteSite(Items[i]).SiteID, 5) = '200') 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 + '^' + 'L:' + 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, 'L:' + 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, 'L:' + 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; if (uQualifiertype <> 6) or (length(piece(uHState,';',2)) < 1) then memLab.Lines.Clear; lstHeaders.Items.Clear; if (length(piece(uHState,';',2)) = 0) then 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('Retrieving data... ' + Piece(aStatus,'^',2)); if Piece(aStatus,'^',1) = '' then memLab.Lines.Add(uReportInstruction); 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 if tvReports.Selected.Text = 'Imaging (local only)' then memLab.Lines.clear else QuickCopy(uLabLocalReportData,memLab); memLab.Lines.Insert(0,' '); memLab.Lines.Delete(0); end else memLab.Lines.Add(uReportInstruction); memLab.SelStart := 0; memLab.Lines.EndUpdate; end; end; procedure TfrmLabs.WebBrowser1DocumentComplete(Sender: TObject; //**Browser Remove** const pDisp: IDispatch; var URL: OleVariant); var //WebDoc: IHtmlDocument2; **Browser Remove** v: variant; begin inherited; if uHTMLDoc = '' then Exit; if not(uReportType = 'H') then Exit; //this can be removed if & when browser replaces memLab control //if not Assigned(WebBrowser1.Document) then Exit; **Browser Remove** //WebDoc := WebBrowser1.Document as IHtmlDocument2; **Browser Remove** v := VarArrayCreate([0, 0], varVariant); v[0] := uHTMLDoc; //WebDoc.write(PSafeArray(TVarData(v).VArray)); **Browser Remove** //WebDoc.close; **Browser Remove** //uHTMLDoc := ''; end; procedure TfrmLabs.ChkBrowser; // **Browser Remove** begin {if uReportType = 'H' then **Browser Remove** 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,A10,A11,A12: Boolean); begin //Clear the last date selection //if not A4 then lstDates.ItemIndex := -1; lstDates.Caption := lblDates.Caption; lstHeaders.Caption := lblHeaders.Caption; if A4 or A2 or A12 then begin pnlLefTop.Height := (frmLabs.Height div 2); pnlLeftBottom.Visible := true; Splitter1.Visible := true; end else begin pnlLefTop.Height := frmLabs.Height; pnlLeftBottom.Visible := false; Splitter1.Visible := false; end; lstDates.Visible := false; // turned off to realign correctly lblDates.Visible := false; lstQualifier.Visible := false; lblQualifier.Visible := false; pnlOtherTests.Visible := false; lstHeaders.Visible := false; lblHeaders.Visible := false; sptHorzRight.Visible := false; lblHeaders.Visible := A1; lstHeaders.Visible := A2; lblQualifier.Visible := A11; lstQualifier.Visible := A12; lblDates.Visible := A4; lstDates.Visible := A5; // reordered to realign pnlOtherTests.Visible := A3; pnlHeader.Visible := A6; grdLab.Visible := A7; pnlChart.Visible := A8; pnlFooter.Visible := A9; lvReports.Visible := A10; sptHorzRight.Visible := true; 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; frmLabs.Realign; end; procedure TfrmLabs.ShowTabControl; begin if TabControl1.Tabs.Count > 1 then begin TabControl1.Visible := true; TabControl1.TabStop := true; pnlRightTopHeader.Height := pnlRightTopHeaderTop.Height + TabControl1.Height; end; end; procedure TfrmLabs.HideTabControl; begin TabControl1.Visible := false; TabControl1.TabStop := false; pnlRightTopHeader.Height := pnlRightTopHeaderTop.Height; end; procedure TfrmLabs.Splitter1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 150 then Newsize := 150; end; procedure TfrmLabs.sptHorzRightCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin inherited; if NewSize < 5 then Newsize := 5; 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; { TGrdLab508Manager } constructor TGrdLab508Manager.Create; begin inherited Create([mtValue, mtItemChange]); end; function TGrdLab508Manager.GetItem(Component: TWinControl): TObject; var sg : TCaptionStringGrid; begin sg := TCaptionStringGrid(Component); Result := TObject(sg.Selection.Top + sg.Selection.Left); end; function TGrdLab508Manager.GetTextToSpeak(sg: TCaptionStringGrid): String; var textToSpeak : String; CurrRowStrings,HeaderStrings : TStrings; i : integer; begin textToSpeak := ''; HeaderStrings := sg.Rows[0]; CurrRowStrings := sg.Rows[sg.Selection.Top]; for i := 0 to CurrRowStrings.Count - 1 do begin textToSpeak := TextToSpeak + ', ' + HeaderStrings[i] + ', ' + ToBlankIfEmpty(CurrRowStrings[i]); end; Result := textToSpeak; end; function TGrdLab508Manager.GetValue(Component: TWinControl): string; var sg : TCaptionStringGrid; begin sg := TCaptionStringGrid(Component); Result := GetTextToSpeak(sg); end; function TGrdLab508Manager.ToBlankIfEmpty(aString: String): String; begin Result := aString; if aString = '' then Result := 'blank'; end; initialization SpecifyFormIsNotADialog(TfrmLabs); end.