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