//kt -- Modified with SourceScanner on 8/17/2007 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, DKLang; 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.'; <-- original line. //kt 8/17/2007 //TX_NOREPORT_CAP = 'No Report Selected'; <-- original line. //kt 8/17/2007 ZOOM_PERCENT = 99; // padding for inflating margins HTML_PRE = '
';
  HTML_POST = CRLF + '
'; {$R *.DFM} var TX_NOREPORT : string; //kt TX_NOREPORT_CAP : string; //kt procedure SetupVars; //kt Added entire function to replace constant declarations 8/17/2007 begin TX_NOREPORT := DKLangConstW('fLabs_No_report_is_currently_selectedx'); TX_NOREPORT_CAP := DKLangConstW('fLabs_No_Report_Selected'); end; var uFrozen: Boolean; uGraphingActivated: Boolean; uRemoteCount: Integer; uHTMLDoc: string; uReportType: string; uReportRPC: string; uHTMLPatient: ANSIstring; procedure TfrmLabs.RequestPrint; begin SetupVars; //kt added 8/17/2007 to replace constants with vars. 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); <-- original line. //kt 8/17/2007 InfoBox(DKLangConstW('fLabs_Unable_to_print_xxMost_Recentxx_reportx'), DKLangConstW('fLabs_No_Print_Available'), MB_OK); //kt added 8/17/2007 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); <-- original line. //kt 8/17/2007 InfoBox(DKLangConstW('fLabs_Unable_to_print_xxWorksheetxx_reportx'), DKLangConstW('fLabs_No_Print_Available'), MB_OK); //kt added 8/17/2007 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.'; <-- original line. //kt 8/17/2007 WhyNot := DKLangConstW('fLabs_A_remote_data_query_in_progress_will_be_abortedx'); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 TRemoteSite(Items[i]).LabQueryStatus := '-1^'+DKLangConstW('fLabs_Aborted'); //kt added 8/17/2007 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]; <-- original line. //kt 8/17/2007 Caption := DKLangConstW('fLabs_Laboratory_Results_x') + lstReports.DisplayText[lstReports.ItemIndex]; //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 lblFooter.Caption := DKLangConstW('fLabs_KEYx_xLx_x_Abnormal_Lowx_xHx_x_Abnormal_Highx_xxx_x_Critical_Valuex_xxxx_x_Comments_on_Specimen'); //kt added 8/17/2007 //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'); <-- original line. //kt 8/17/2007 memLab.Lines.Insert(1, DKLangConstW('fLabs_Graphing_activated')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_dataxxx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_dataxxx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_data_for_cumulative_reportxxx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_data_for_interim_reportxxx')); //kt added 8/17/2007 GoRemote(uLabRemoteReportData,0,3,'',uReportRPC,'','','',date1,date2); TabControl1.OnChange(nil); Interim(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then // uLabLocalReportData.Add(''); <-- original line. //kt 8/17/2007 uLabLocalReportData.Add(DKLangConstW('fLabs_xNo_results_for_this_date_rangexx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_data_for_selected_testsxxx')); //kt added 8/17/2007 uLabLocalReportData.Assign(InterimSelect(Patient.DFN, date1, date2, lstTests.Items)); if uLabLocalReportData.Count > 0 then QuickCopy(uLabLocalReportData,memLab) else // memLab.Lines.Add(''); <-- original line. //kt 8/17/2007 memLab.Lines.Add(DKLangConstW('fLabs_xNo_results_for_selected_tests_in_this_date_rangexx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_data_for_worksheetxxx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_data_for_graphxxx')); //kt added 8/17/2007 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(''); <-- original line. //kt 8/17/2007 memLab.Lines.Add(DKLangConstW('fLabs_xNo_comments_on_specimensxx')); //kt added 8/17/2007 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 := ' ' <-- original line. //kt 8/17/2007 Piece(lblSingleTest.Caption, '^', 2) + DKLangConstW('fLabs_in_this_date_rangexx') //kt added 8/17/2007 // + 'Results may be available, but cannot be graphed. Please try an alternate view.' <-- original line. //kt 8/17/2007 + DKLangConstW('fLabs_Results_may_be_availablex_but_cannot_be_graphedx_Please_try_an_alternate_viewx') //kt added 8/17/2007 else // pnlChart.Caption := ' ' <-- original line. //kt 8/17/2007 DKLangConstW('fLabs_x_in_this_date_rangexx') //kt added 8/17/2007 // + 'Results may be available, but cannot be graphed. Please try an alternate view.'; <-- original line. //kt 8/17/2007 + DKLangConstW('fLabs_Results_may_be_availablex_but_cannot_be_graphedx_Please_try_an_alternate_viewx'); //kt added 8/17/2007 chtChart.Visible := false; end; finally tmpList.Free; end; end; end; 9: begin // Micro memLab.Clear; uLabLocalReportData.Clear; uLabRemoteReportData.Clear; // StatusText('Retrieving microbiology data...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_microbiology_dataxxx')); //kt added 8/17/2007 GoRemote(uLabRemoteReportData,0,4,'',uReportRPC,'','','',date1,date2); TabControl1.OnChange(nil); Micro(uLabLocalReportData, Patient.DFN, date1, date2, uReportRPC); if uLabLocalReportData.Count < 1 then // uLabLocalReportData.Add(''); <-- original line. //kt 8/17/2007 uLabLocalReportData.Add(DKLangConstW('fLabs_xNo_microbiology_results_for_this_date_rangexx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_lab_status_dataxxx')); //kt added 8/17/2007 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(''); <-- original line. //kt 8/17/2007 uLabLocalReportData.Add(DKLangConstW('fLabs_xNo_laboratory_orders_for_this_date_rangexx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_lab_dataxxx')); //kt added 8/17/2007 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(''); <-- original line. //kt 8/17/2007 uLabLocalReportData.Add(DKLangConstW('fLabs_xNo_data_for_this_date_rangexx')); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 Cells[0, 0] := DKLangConstW('fLabs_DatexTime'); //kt added 8/17/2007 // Cells[1, 0] := 'Specimen'; <-- original line. //kt 8/17/2007 Cells[1, 0] := DKLangConstW('fLabs_Specimen'); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 Cells[0, 1] := DKLangConstW('fLabs_no_results'); //kt added 8/17/2007 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))); <-- original line. //kt 8/17/2007 Cells[0, i - testcnt] := FormatFMDateTime(DKLangConstW('fLabs_mmxddxyy_hhxnn'),MakeFMDateTime(Piece(griddata[i + offset], '^', 2))); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 Cells[0, 0] := DKLangConstW('fLabs_DatexTime'); //kt added 8/17/2007 // Cells[0, 1] := 'Specimen'; <-- original line. //kt 8/17/2007 Cells[0, 1] := DKLangConstW('fLabs_Specimen'); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 Cells[1, 0] := DKLangConstW('fLabs_no_results'); //kt added 8/17/2007 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))); <-- original line. //kt 8/17/2007 Cells[i - testcnt, 0] := FormatFMDateTime(DKLangConstW('fLabs_mmxddxyy_hhxnn'),MakeFMDateTime(Piece(griddata[i + offset], '^', 2))); //kt added 8/17/2007 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(''); <-- original line. //kt 8/17/2007 memLab.Lines.Add(DKLangConstW('fLabs_xNo_comments_on_specimensxx')); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 Cells[0, 0] := DKLangConstW('fLabs_Test'); //kt added 8/17/2007 // Cells[1, 0] := 'Result'; <-- original line. //kt 8/17/2007 Cells[1, 0] := DKLangConstW('fLabs_Result'); //kt added 8/17/2007 // Cells[2, 0] := 'Flag'; <-- original line. //kt 8/17/2007 Cells[2, 0] := DKLangConstW('fLabs_Flag'); //kt added 8/17/2007 // Cells[3, 0] := 'Units'; <-- original line. //kt 8/17/2007 Cells[3, 0] := DKLangConstW('fLabs_Units'); //kt added 8/17/2007 // Cells[4, 0] := 'Ref Range'; <-- original line. //kt 8/17/2007 Cells[4, 0] := DKLangConstW('fLabs_Ref_Range'); //kt added 8/17/2007 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); <-- original line. //kt 8/17/2007 amemo.Lines.Add(DKLangConstW('fLabs_Specimenx') + specimen + DKLangConstW('fLabs_x____Accessionx') + accession + DKLangConstW('fLabs_x____Providerx') + provider); //kt added 8/17/2007 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' <-- original line. //kt 8/17/2007 lblMostRecent.Caption := DKLangConstW('fLabs_No_Lab_Results') //kt added 8/17/2007 else if cmdOld.Enabled then // lblMostRecent.Caption := 'Most Recent Lab Result' <-- original line. //kt 8/17/2007 lblMostRecent.Caption := DKLangConstW('fLabs_Most_Recent_Lab_Result') //kt added 8/17/2007 else // lblMostRecent.Caption := 'Oldest Lab Result'; <-- original line. //kt 8/17/2007 lblMostRecent.Caption := DKLangConstW('fLabs_Oldest_Lab_Result'); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 lblFooter.Caption := DKLangConstW('fLabs_KEYx_xLx_x_Abnormal_Lowx_xHx_x_Abnormal_Highx_xxx_x_Critical_Value'); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_next_lab_dataxxx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_previous_lab_dataxxx')); //kt added 8/17/2007 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; <-- original line. //kt 8/17/2007 serHigh.Title := DKLangConstW('fLabs_Ref_High') + high; //kt added 8/17/2007 //serLow.Title := 'Ref Low ' + low; <-- original line. //kt 8/17/2007 serLow.Title := DKLangConstW('fLabs_Ref_Low') + low; //kt added 8/17/2007 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 := ' ' <-- original line. //kt 8/17/2007 pnlChart.Caption := DKLangConstW('fLabs_xNo_results_can_be_graphed_for') + serTest.Title + DKLangConstW('fLabs_in_this_date_rangexx') //kt added 8/17/2007 else // pnlChart.Caption := ''; <-- original line. //kt 8/17/2007 pnlChart.Caption := DKLangConstW('fLabs_xNo_results_can_be_graphed_for') + Piece(test, '^', 2) + DKLangConstW('fLabs_in_this_date_rangexx'); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_most_recent_lab_dataxxx')); //kt added 8/17/2007 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...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_oldest_lab_dataxxx')); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 lblFooter.Caption := DKLangConstW('fLabs_KEYx_xLx_x_Abnormal_Lowx_xHx_x_Abnormal_Highx_xxx_x_Critical_Value'); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 lblFooter.Caption := DKLangConstW('fLabs_KEYx_xLx_x_Abnormal_Lowx_xHx_x_Abnormal_Highx_xxx_x_Critical_Value'); //kt added 8/17/2007 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; <-- original line. //kt 8/17/2007 serHigh.Title := DKLangConstW('fLabs_Ref_High') + high; //kt added 8/17/2007 // serLow.Title := 'Ref Low ' + low; <-- original line. //kt 8/17/2007 serLow.Title := DKLangConstW('fLabs_Ref_Low') + low; //kt added 8/17/2007 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.'; <-- original line. //kt 8/17/2007 lblGraphInfo.Caption := DKLangConstW('fLabs_To_Zoomx_hold_down_the_mouse_button_while_dragging_an_area_to_be_enlargedx'); //kt added 8/17/2007 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.'; <-- original line. //kt 8/17/2007 + DKLangConstW('fLabs_To_Zoom_Back_drag_to_the_upper_leftx_You_can_also_use_the_actions_on_the_right_mouse_buttonx'); //kt added 8/17/2007 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'; <-- original line. //kt 8/17/2007 popDetails.Caption := DKLangConstW('fLabs_Details'); //kt added 8/17/2007 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]) + '...'; <-- original line. //kt 8/17/2007 chtChart.Hint := DKLangConstW('fLabs_Details_x_Lab_results_for') + FormatDateTime(DKLangConstW('fLabs_ddddx_mmmm_dx_yyyy'), Series.XValue[ValueIndex]) + DKLangConstW('fLabs_xxx'); //kt added 8/17/2007 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) + '...'; <-- original line. //kt 8/17/2007 chtChart.Hint := DKLangConstW('fLabs_Details_x_for') + Piece(serTest.Title, '(', 1) + DKLangConstW('fLabs_xxx'); //kt added 8/17/2007 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 + '...'); <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_data_for') + serTest.Title + DKLangConstW('fLabs_xxx')); //kt added 8/17/2007 // ReportBox(InterimSelect(Patient.DFN, date1, date2, tmpList), Piece(serTest.Title, '(', 1) + 'results on ' + Patient.Name, True); <-- original line. //kt 8/17/2007 ReportBox(InterimSelect(Patient.DFN, date1, date2, tmpList), Piece(serTest.Title, '(', 1) + DKLangConstW('fLabs_results_on') + Patient.Name, True); //kt added 8/17/2007 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 ' <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_Lab_data_from') //kt added 8/17/2007 + 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 ' <-- original line. //kt 8/17/2007 StatusText(DKLangConstW('fLabs_Retrieving_reports_from') //kt added 8/17/2007 + 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 <-- original line. //kt 8/17/2007 if aStatus = '1^'+DKLangConstW('fLabs_Done') then //kt added 8/17/2007 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)); <-- original line. //kt 8/17/2007 memLab.Lines.Add(DKLangConstW('fLabs_Remote_data_transmission_errorx') + Piece(aStatus,'^',2)); //kt added 8/17/2007 if Piece(aStatus,'^',1) = '0' then // memLab.Lines.Add('Transmission in progress: ' + Piece(aStatus,'^',2)); <-- original line. //kt 8/17/2007 memLab.Lines.Add(DKLangConstW('fLabs_Transmission_in_progressx') + Piece(aStatus,'^',2)); //kt added 8/17/2007 if Piece(aStatus,'^',1) = '' then // memLab.Lines.Add('Select a report...'); <-- original line. //kt 8/17/2007 memLab.Lines.Add(DKLangConstW('fLabs_Select_a_reportxxx')); //kt added 8/17/2007 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 <-- original line. //kt 8/17/2007 lblDates.Caption := DKLangConstW('fLabs_Headings'); // swithes captions if not aligned //kt added 8/17/2007 // lblHeaders.Caption := 'Date Range'; <-- original line. //kt 8/17/2007 lblHeaders.Caption := DKLangConstW('fLabs_Date_Range'); //kt added 8/17/2007 end else begin // lblDates.Caption := 'Date Range'; <-- original line. //kt 8/17/2007 lblDates.Caption := DKLangConstW('fLabs_Date_Range'); //kt added 8/17/2007 // lblHeaders.Caption := 'Headings'; <-- original line. //kt 8/17/2007 lblHeaders.Caption := DKLangConstW('fLabs_Headings'); //kt added 8/17/2007 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.