Attribute VB_Name = "Module1" Option Explicit Public Type ColumnValues NormalMinValue As String NormalMaxValue As String DescriptiveNormalMinValue As String DescriptiveNormalMaxValue As String DescriptiveNormalValue As String siUnit As String cuUnit As String ConversionFactor As String Remarks As String PromptData As String NormalMinConventional As String NormalMaxConventional As String End Type Type GridRow coExamType As ExamFormTypes strRowData() As String blnEnabled As Boolean End Type Global Const coCapitalize = 1 Global Const coNumericOnly = 2 Global Const coPositiveNumericOnly = 3 'Global ExamRow() As GridRow Global OutPatientSearcher As Object 'New RadioSearch.clsRadioSearch Global CurrentUser As Object 'As MEDSYS_User.clsCurrentUser Global VerifyExam As Object 'As New VerifyDll.clsDataEntry Global ExamEntry As Object 'As New ResultEntry.clsDataEntry Global Searcher As Object Global KeyPress As Object Global Patient As Object 'Global ADODBResult As New ADODB.Recordset Global ColumnHeaderRecord As ColumnValues Global DBENtry As New ADODB.Recordset Global conLaboratory As New ADODB.Connection Global blnCancelMode As Boolean Global blnProcPosted As Boolean Global booSelected As Boolean Global blnCashMode As Boolean Global blnExamWithReagent As Boolean Global booAllowSearch As Boolean Global booAllowHLT As Boolean Global lngSelectedResultNum As Long Global strPrevExamFormType As String Global strCurrSectionID As String Global strStartDate As String Global strEndDate As String Global sHospitalName As String Global sHospitalAddr As String Global sCompanyName As String Global sMtsServer As String Global sTinNum As String Global sPhoneNum As String Global strReportType As String Global strMode As String Public Report As CRAXDRT.Report Function GetDateToday() As String Dim recGetDate As New ADODB.Recordset Dim pdCurDate As String If recGetDate.State > 0 Then recGetDate.Close recGetDate.Open "Select convert(varchar(10),getdate(),101) as DateToday", CurrentUser.SQLConnection, adOpenDynamic, adLockReadOnly pdCurDate = recGetDate!DateToday If recGetDate.State > 0 Then recGetDate.Close GetDateToday = pdCurDate End Function Sub FadeForm(frm As Form, Red%, Green%, Blue%) Dim SaveScale%, SaveStyle%, SaveRedraw% Dim i&, j&, X&, Y&, pixels% 'Save current settings. SaveScale = frm.ScaleMode SaveStyle = frm.DrawStyle SaveRedraw = frm.AutoRedraw 'Paint screen. frm.ScaleMode = 3 pixels = Screen.Height / Screen.TwipsPerPixelY X = pixels / 64# + 0.5 frm.DrawStyle = 5 frm.AutoRedraw = True For j = 0 To pixels Step X Y = 240 - 245 * j \ pixels 'can tweak this to preference. If Y < 0 Then Y = 0 'just in case frm.Line (-2, j - 2)-(Screen.Width + 2, j + _ X + 3), RGB(-Red * Y, -Green * Y, -Blue * Y), BF Next j 'Reset to previous settings. frm.ScaleMode = SaveScale frm.DrawStyle = SaveStyle frm.AutoRedraw = SaveRedraw End Sub Function Same_Heading(strFormType As String) As Boolean Same_Heading = False Select Case strFormType Case "0", "6", "8", "9", "11" Select Case strPrevExamFormType Case "0", "6", "8", "9", "11" Same_Heading = True End Select Case "14", "15" Select Case strPrevExamFormType Case "14", "15" Same_Heading = True End Select Case "1", "2" Select Case strPrevExamFormType Case "1", "2" Same_Heading = True End Select End Select End Function Function GetFormType(strFormType As String) As String Dim intNum As Integer Select Case strFormType Case "1": intNum = 0 '*** normal value w/o conversion factor Case "2": intNum = 1 '*** short form Case "3": intNum = 2 '*** paragraph form w/ specimen Case "4": intNum = 3 '*** specific format Case "5": intNum = 4 '*** with cut off value Case "6": intNum = 5 '*** paragraph form w/ partial entry Case "7": intNum = 6 '*** normal range value Case "8": intNum = 7 '*** normal value w/ conversion factor Case "0": intNum = 8 '*** normal value accdg to age Case "A": intNum = 9 '*** normal value w/ open range Case "B": intNum = 10 '*** nv range w/ conversion factor Case "C": intNum = 11 '*** short form w/ nv but w/o conversion factor Case "K": intNum = 12 '*** combination of numeric & character Case "F": intNum = 13 '*** abused drug assay 'Case "H": intNum = 14 '*** dati ay X Case "Z": intNum = 15 '*** non-gynelogic cytology form Case "X": intNum = 14 '*** histopath form Case "N": intNum = 20 '*** NV Range w/ Convertion Factor End Select If strFormType = "P" Then GetFormType = "P" '*** profile ElseIf strFormType = "H" Or Len(strFormType) = 0 Then GetFormType = "H" ElseIf strFormType = "J" Then GetFormType = "J" '*** C&S Exam Else GetFormType = Trim(Str(intNum)) End If End Function Function Get_ResultTable(strExamType As String, strLDES As String) As String Get_ResultTable = "" Select Case strExamType Case "0": Get_ResultTable = "tbLAB1" Case "1": Get_ResultTable = "tbLAB2" Case "2": Get_ResultTable = "tbLAB7" Case "3": Get_ResultTable = "tbLAB18" Case "4": Get_ResultTable = "tbLAB16" Case "5": Get_ResultTable = "tbLAB15" Case "6": Get_ResultTable = "tbLAB21" Case "7": Get_ResultTable = "tbLAB1" Case "8": Get_ResultTable = "tbLAB16" Case "9": Get_ResultTable = "tbLAB1" Case "10": Get_ResultTable = "tbLAB1" Case "11": Get_ResultTable = "tbLAB1" Case "12": Get_ResultTable = "tbLAB1" Case "13": Get_ResultTable = "tbLAB18" Case "14": Get_ResultTable = "tbLAB12" Case "15": Get_ResultTable = "tbLAB13" Case "P" Select Case strLDES Case "LDES0": Get_ResultTable = "tbLAB14" Case "LDES9": Get_ResultTable = "tbLAB11" Case "LDES7": Get_ResultTable = "tbLAB12" End Select 'Case "H" End Select End Function Function Result_Database(strFormType As String, strRequestNum As String, strLABDesc As String) As ADODB.Recordset ' Set Result_Database = ADODBResult ' Result_Database.CursorLocation = adUseClient ' MsgBox "FORMTYPE=" & GetFormType(strFormType) & " Select * from " & Get_ResultTable(GetFormType(strFormType), strLABDesc) & " Where " & strRequestNum & "=RequestNum" ' Result_Database.Open "Select * from " & Get_ResultTable(GetFormType(strFormType), strLABDesc) & " Where " & strRequestNum & "=RequestNum", conLaboratory, adOpenForwardOnly, adLockReadOnly End Function Function Get_ColumnValue(strExamID As String, strPatientSex As String, strMethod As String) As ColumnValues Dim DBCol As New ADODB.Recordset DBCol.CursorLocation = adUseClient If blnExamWithReagent Then DBCol.Open "laboratory..LAB_Get_ReagentExamValues '" & strExamID & "','" & strMethod & "'", _ conLaboratory, adOpenForwardOnly, adLockReadOnly Else DBCol.Open "laboratory..LAB_Get_ExamValues '" & strExamID & "'", conLaboratory, adOpenForwardOnly, adLockReadOnly End If If Not (DBCol.EOF And DBCol.BOF) Then Get_ColumnValue.cuUnit = DBCol!ConversionUnit & "" Get_ColumnValue.siUnit = DBCol!Unit & "" Get_ColumnValue.ConversionFactor = DBCol!ConversionFactor & "" If Not blnExamWithReagent Then If strPatientSex = "M" Then Get_ColumnValue.DescriptiveNormalValue = DBCol!DescriptiveMinValue & "" Else Get_ColumnValue.DescriptiveNormalValue = DBCol!DescriptiveMaxValue & "" End If Get_ColumnValue.Remarks = DBCol!Remarks & "" Get_ColumnValue.PromptData = DBCol!PromptData & "" Get_ColumnValue.DescriptiveNormalMinValue = DBCol!DescriptiveMinValue & "" '01/27/2002 Get_ColumnValue.DescriptiveNormalMaxValue = DBCol!DescriptiveMaxValue & "" End If If strPatientSex = "M" Then Get_ColumnValue.NormalMaxValue = DBCol!MaleMaxValue & "" Get_ColumnValue.NormalMinValue = DBCol!MaleMinValue & "" If Not IsNull(DBCol!ConversionFactor) And Not DBCol!ConversionFactor = 0 Then Get_ColumnValue.NormalMinConventional = Format(DBCol!MaleMinValue / DBCol!ConversionFactor, "0.000") Get_ColumnValue.NormalMaxConventional = Format(DBCol!MaleMaxValue / DBCol!ConversionFactor, "0.000") End If Else Get_ColumnValue.NormalMaxValue = DBCol!FeMaleMaxValue & "" Get_ColumnValue.NormalMinValue = DBCol!FeMaleMinValue & "" If Not IsNull(DBCol!ConversionFactor) And DBCol!ConversionFactor <> 0 Then Get_ColumnValue.NormalMinConventional = Format(DBCol!FeMaleMinValue / DBCol!ConversionFactor, "0.000") Get_ColumnValue.NormalMaxConventional = Format(DBCol!FeMaleMaxValue / DBCol!ConversionFactor, "0.000") End If End If End If DBCol.Close End Function Function Get_ColumnValueByAge(strExamID As String, intAge As Integer, strMethod As String) As ColumnValues Dim DBCol As New ADODB.Recordset DBCol.CursorLocation = adUseClient If blnExamWithReagent Then DBCol.Open "laboratory..LAB_Get_ReagentExamValues '" & strExamID & "','" & strMethod & "'", conLaboratory, adOpenForwardOnly, adLockReadOnly Else DBCol.Open "laboratory..LAB_Get_ExamValues '" & strExamID & "'", conLaboratory, adOpenForwardOnly, adLockReadOnly End If If Not (DBCol.EOF And DBCol.BOF) Then Get_ColumnValueByAge.cuUnit = DBCol!ConversionUnit & "" Get_ColumnValueByAge.siUnit = DBCol!Unit & "" Get_ColumnValueByAge.ConversionFactor = DBCol!ConversionFactor & "" If Not blnExamWithReagent Then ' If strPatientSex = "M" Then ' Get_ColumnValueByAge.DescriptiveNormalValue = DBCol!DescriptiveMinValue & "" ' Else ' Get_ColumnValueByAge.DescriptiveNormalValue = DBCol!DescriptiveMaxValue & "" ' End If Get_ColumnValueByAge.Remarks = DBCol!Remarks & "" End If ' Get_ColumnValue.PromptData = DBCol!PromptData & "" If intAge > 17 Then Get_ColumnValueByAge.NormalMaxValue = DBCol!MaleMaxValue & "" Get_ColumnValueByAge.NormalMinValue = DBCol!MaleMinValue & "" If Not IsNull(DBCol!ConversionFactor) And DBCol!ConversionFactor <> 0 Then Get_ColumnValueByAge.NormalMaxConventional = Format(DBCol!MaleMaxValue / DBCol!ConversionFactor, "#####.###") Get_ColumnValueByAge.NormalMinConventional = Format(DBCol!MaleMinValue / DBCol!ConversionFactor, "#####.###") End If Else Get_ColumnValueByAge.NormalMaxValue = DBCol!FeMaleMaxValue & "" Get_ColumnValueByAge.NormalMinValue = DBCol!FeMaleMinValue & "" If Not IsNull(DBCol!ConversionFactor) And DBCol!ConversionFactor <> 0 Then Get_ColumnValueByAge.NormalMaxConventional = Format(DBCol!FeMaleMaxValue / DBCol!ConversionFactor, "#####.###") Get_ColumnValueByAge.NormalMinConventional = Format(DBCol!FeMaleMinValue / DBCol!ConversionFactor, "#####.###") End If End If End If DBCol.Close End Function Function Save_Exam(strFormType As String, strLDES As String, vardata As Variant) As Boolean Dim strTable As String Dim strSQLQuery As String Dim strFields As String Dim intI As Integer Dim DBExamSave As New ADODB.Recordset Save_Exam = True strTable = Get_ResultTable(strFormType, strLDES) strSQLQuery = "Insert Into " & strTable & " " Select Case strFormType Case "0", "9", "10", "11", "12" strFields = "(RequestNum,Result1,Result2,Result3,Result4,Result5,Result6,NormalRangeValue,NormalRangeCValue,Remarks,FormType) " Case "1": strFields = "(RequestNum,Result,FormType) " Case "2": strFields = "(RequestNum, DEF, RES, ISOTOPE, DOSE, Volume) " Case "3", "13" strFields = "(RequestNum, RES1, RVALUE, Rema) " Case "4": strFields = "(RequestNum, Result1, Result2, Result3, Result4, Remarks) " Case "5": strFields = "(RequestNum, Res, Res1, FormType, Speciment) " Case "6": strFields = "(RequestNum, Result1, Remarks, FormType) " Case "8": strFields = "(RequestNum, Result1, Result2, Result3, Result4, Remarks, FormType) " Case "14": strFields = "(RequestNum, Result1, Result2, Result3, Result4, Result5, Result6, Result7, Result8, Result9," strFields = strFields + "Result10, Result11, Result12, Result13, Result14, Result15, Result16, Remarks, TmpRemarks, FormType) " Case "15" strFields = "(RequestNum, Tissue1, Tissue2, Tissue3, Res1, Final1, Final2, Final3, Final4, Final5, Final6, Final7, Final8, Final9) " Case "P" Select Case strLDES Case "LDES0" Case "LDES9" Case "LDES7" End Select End Select strFields = strFields + "Values (" For intI = 0 To UBound(vardata) strFields = strFields & "'" & Trim(vardata(intI)) & "'" If intI < UBound(vardata) Then strFields = strFields & "," Else strFields = strFields & ")" End If Next intI strSQLQuery = strSQLQuery & strFields MsgBox "QUERY: [" & strSQLQuery & "]" DBExamSave.Open strSQLQuery, conLaboratory, adOpenForwardOnly, adLockReadOnly End Function Sub Write_PredefinedValues(grdResult As UserControl1, coExamType As ExamFormTypes) Dim intI As Integer With grdResult Select Case coExamType Case ABUSED_DRUG_ASSAY Case Histopath_Form Case Non_Gynecologic_Cytology_Form Case NORMAL_RANGE_VALUE Case NORMAL_VALUE_ACCORDING_TO_AGE Case NORMAL_VALUE_WITH_CONVERSION_FACTOR Case NORMAL_VALUE_WITH_OPEN_RANGE '***** 9 Case NORMAL_VALUE_WO_CONVERSION_FACTOR Case NV_RANGE_WITH_CONVERSION_FACTOR Case Paragraph_Form_With_Partial_Entry Case PARAGRAPH_FORM_WITH_SPECIMEN Case SHORT_FORM Case SHORTFORM_WNV_BUT_WOCFACTOR Case Specific_Format Case With_Cut_Off_Value End Select End With End Sub Function Get_ReagentColumnValue(strExamID As String, strPatientSex As String, strMethod As String) As ColumnValues Dim DBCol As New ADODB.Recordset DBCol.CursorLocation = adUseClient DBCol.Open "laboratory..LAB_Get_ReagentExamValues '" & strExamID & "','" & strMethod & "'", _ conLaboratory, adOpenForwardOnly, adLockReadOnly If Not (DBCol.EOF And DBCol.BOF) Then Get_ReagentColumnValue.cuUnit = DBCol!ConversionUnit Get_ReagentColumnValue.siUnit = DBCol!Unit & "" Get_ReagentColumnValue.Remarks = DBCol!Remarks & "" Get_ReagentColumnValue.PromptData = DBCol!PromptData & "" Get_ReagentColumnValue.ConversionFactor = DBCol!ConversionFactor & "" If strPatientSex = "M" Then Get_ReagentColumnValue.NormalMaxValue = DBCol!MaleMaxValue & "" Get_ReagentColumnValue.NormalMinValue = DBCol!MaleMinValue & "" If Not IsNull(DBCol!ConversionFactor) And Not DBCol!ConversionFactor = 0 Then Get_ReagentColumnValue.NormalMinConventional = Format(DBCol!MaleMinValue / DBCol!ConversionFactor, "#####.###") Get_ReagentColumnValue.NormalMaxConventional = Format(DBCol!MaleMaxValue / DBCol!ConversionFactor, "#####.###") End If Else Get_ReagentColumnValue.NormalMaxValue = DBCol!FeMaleMaxValue & "" Get_ReagentColumnValue.NormalMinValue = DBCol!FeMaleMinValue & "" If Not IsNull(DBCol!ConversionFactor) And DBCol!ConversionFactor <> 0 Then Get_ReagentColumnValue.NormalMinConventional = Format(DBCol!FeMaleMinValue / DBCol!ConversionFactor, "#####.###") Get_ReagentColumnValue.NormalMaxConventional = Format(DBCol!FeMaleMaxValue / DBCol!ConversionFactor, "#####.###") End If End If End If DBCol.Close End Function Function Get_ReagentColumnValueByAge(strExamID As String, intAge As Integer, strMethod As String) As ColumnValues Dim DBCol As New ADODB.Recordset DBCol.CursorLocation = adUseClient DBCol.Open "laboratory..LAB_Get_ReagentExamValues '" & strExamID & "','" & strMethod & "'", _ conLaboratory, adOpenForwardOnly, adLockReadOnly If Not (DBCol.EOF And DBCol.BOF) Then Get_ReagentColumnValueByAge.cuUnit = DBCol!ConversionUnit & "" Get_ReagentColumnValueByAge.siUnit = DBCol!Unit & "" Get_ReagentColumnValueByAge.ConversionFactor = DBCol!ConversionFactor If intAge > 17 Then Get_ReagentColumnValueByAge.NormalMaxValue = DBCol!MaleMaxValue & "" Get_ReagentColumnValueByAge.NormalMinValue = DBCol!MaleMinValue & "" If Not IsNull(DBCol!ConversionFactor) And DBCol!ConversionFactor <> 0 Then Get_ReagentColumnValueByAge.NormalMaxConventional = Format(DBCol!MaleMaxValue / DBCol!ConversionFactor, "#####.###") Get_ReagentColumnValueByAge.NormalMinConventional = Format(DBCol!MaleMinValue / DBCol!ConversionFactor, "#####.###") End If Else Get_ReagentColumnValueByAge.NormalMaxValue = DBCol!FeMaleMaxValue & "" Get_ReagentColumnValueByAge.NormalMinValue = DBCol!FeMaleMinValue & "" If Not IsNull(DBCol!ConversionFactor) And DBCol!ConversionFactor <> 0 Then Get_ReagentColumnValueByAge.NormalMinConventional = Format(DBCol!FeMaleMinValue / DBCol!ConversionFactor, "#####.###") Get_ReagentColumnValueByAge.NormalMaxConventional = Format(DBCol!FeMaleMaxValue / DBCol!ConversionFactor, "#####.###") End If End If End If DBCol.Close End Function Function InitDisplayWindow(intWhoCall As Integer, intStartColumn As Long, _ intNumCols As Long, intNumRows As Long, _ intNumFixCols As Long, intNumFixRows As Long, _ strFormat As String, strHelpTip As String, _ strColWidths As String, strRowHeights As String, _ strFormCaption As String) As Boolean Dim intILoop As Integer Dim intOLoop As Integer Dim strGrdOpt As String Dim intWhatRowCol As Integer Dim intI As Integer Dim strNum As String 'btDispCaller = intWhoCall 'btStartCol = intStartColumn With frmDisplayOutPatient '.Mode = intWhoCall .Caption = strFormCaption .lblTitle = strFormCaption & " " .lblSTitle = strFormCaption & " " .grdDispWindow.Cols = intNumCols .grdDispWindow.Rows = intNumRows .grdDispWindow.FixedCols = intNumFixCols .grdDispWindow.FixedRows = intNumFixRows .grdDispWindow.FormatString = strFormat .lblHelpTip.Caption = strHelpTip For intOLoop = 1 To 2 If intOLoop = 1 Then strGrdOpt = strColWidths Else strGrdOpt = strRowHeights End If intWhatRowCol = 0: intI = 1 For intILoop = 1 To Len(strGrdOpt) If Mid(strGrdOpt, intILoop, 1) = "," Then strNum = Mid(strGrdOpt, intI, intILoop - intI) If strNum <> "," Then If intOLoop = 1 Then .grdDispWindow.ColWidth(intWhatRowCol) = Val(strNum) Else .grdDispWindow.RowHeight(intWhatRowCol) = Val(strNum) End If End If intWhatRowCol = intWhatRowCol + 1 intI = intILoop + 1 intILoop = intI End If Next intILoop Next intOLoop End With End Function Public Function CalcAge(datEmpDateofBirth As String) As Integer If Len(datEmpDateofBirth) > 0 Then If Not IsNull(datEmpDateofBirth) Then CalcAge = Int(DateDiff("y", IIf(datEmpDateofBirth = "__/__/____", Date, datEmpDateofBirth), Date) \ 365.25) End If Else CalcAge = "0" End If End Function Function spGetCSlip() As String Dim rec As New ADODB.Recordset Dim strRefNum As String conLaboratory.Execute "UPDATE Laboratory..tbLabSlip SET chargeslip = chargeslip + 1" rec.Open "Laboratory..Lab_Get_Chargeslip", _ conLaboratory, adOpenDynamic, adLockReadOnly If Not rec.EOF Then strRefNum = "C" + Trim(Str(rec!chargeslip)) + "L" End If rec.Close spGetCSlip = strRefNum End Function Function spGetMedTech() As String Dim recEmp As New ADODB.Recordset Dim strFName As String Dim strMName As String Dim strLName As String Dim strTitle As String Dim strPosition As String If recEmp.State > 0 Then recEmp.Close recEmp.CursorLocation = adUseClient recEmp.Open "Laboratory..Lab_GetMedTech '" & CurrentUser.EmployeeCode & "'", _ conLaboratory, adOpenDynamic, adLockReadOnly If recEmp.RecordCount > 0 Then spGetMedTech = IIf(IsNull(recEmp!Medtech), "", recEmp!Medtech) Else spGetMedTech = "" End If If recEmp.State > 0 Then recEmp.Close End Function Public Sub OpenMainReport(ByVal strReportFileName As String, strDatabaseName As String, ParamArray strParameters()) Dim crxParameterField As CRAXDRT.ParameterFieldDefinition Dim intCtr As Integer Dim intTotalParam As Integer Dim crxTable As CRAXDRT.DatabaseTable Dim crxApplication As New CRAXDRT.Application intTotalParam = UBound(strParameters) If Not Report Is Nothing Then Set Report = Nothing Set Report = crxApplication.OpenReport(strReportFileName, 1) Report.ReportTitle = sHospitalName For Each crxTable In Report.Database.Tables crxTable.Location = strDatabaseName + Mid(crxTable.Location, InStr(1, crxTable.Location, ".")) crxTable.SetLogOnInfo CurrentUser.ServerName, strDatabaseName, "sa", "" Next If intTotalParam >= 0 Then For Each crxParameterField In Report.ParameterFields If intTotalParam >= intCtr Then crxParameterField.AddCurrentValue strParameters(intCtr) Else Exit For End If intCtr = intCtr + 1 Next End If Set crxParameterField = Nothing Set crxTable = Nothing Set crxApplication = Nothing End Sub Public Sub OpenSubReport(ByVal strSubReport As String, ParamArray strParameters()) Dim crxParameterField As CRAXDRT.ParameterFieldDefinition Dim intCtr As Integer Dim intTotalParam As Integer Dim crxTable As CRAXDRT.DatabaseTable Dim crxSubreport As CRAXDRT.Report intTotalParam = UBound(strParameters) Set crxSubreport = Report.OpenSubReport(strSubReport) For Each crxTable In crxSubreport.Database.Tables crxTable.Location = "Billing" + Mid(crxTable.Location, InStr(1, crxTable.Location, ".")) crxTable.SetLogOnInfo CurrentUser.ServerName, "Laboratory", "sa", "" Next If intTotalParam >= 0 Then For Each crxParameterField In crxSubreport.ParameterFields If intTotalParam >= intCtr Then crxParameterField.AddCurrentValue strParameters(intCtr) Else Exit For End If intCtr = intCtr + 1 Next End If Set crxParameterField = Nothing Set crxTable = Nothing Set crxSubreport = Nothing End Sub Public Sub ShowReportViewer(Optional blnShowGroupTree As Boolean = False, Optional strCaption As String = "", Optional blnDirectToPrinter As Boolean = False) If blnDirectToPrinter Then Report.DisplayProgressDialog = False Report.PrintOut False Set Report = Nothing Else Dim frmRView As New frmReportViewer With frmRView .ShowGroupTree = blnShowGroupTree .Caption = strCaption .DirectPrint = blnDirectToPrinter .Show vbModal End With End If End Sub