Attribute VB_Name = "modMain"
   

Option Explicit
Public Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
 
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 clsAssess As New clsAssessInfo


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 LSearch As Object
Global fosScript As Object
Global LabUser As Object
Global Discount As New clsComputeDiscount
'Global LabDLL As New prjLabCharging.clsAllInfo
Global SearchRequests As New clsSearchRequests
Global gblControlNum As String
Global gblFormType As String
'Global ADODBResult As New ADODB.Recordset
Global ColumnHeaderRecord As ColumnValues
Global DBENtry As New ADODB.Recordset
Global conLaboratory As New ADODB.Connection
Global getDateSetting As New clsDateSettings

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 blnWithFreeHemoLab As Boolean
Global blnWithSurcharge As Boolean
Global blnMyLabSearched As Boolean
Global MyLabSearch As Variant

Global lngSelectedResultNum As Long
Global strPrevExamFormType As String
Global strCurrSectionID As String
Global strCurrSectionName As String

Global StrStartDate As String
Global StrEndDate As String
Global strYear As String
Global strDivisionCode As String
Global strDivision As String
Global strSemester As String
Global sHospitalName As String
Global strClientName As String 'Gonzalo, 04212010
Global sAllowWalkInEntry As String 'Gonzalo, 04212010
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
Global OutPatient As New clsOutpatientSearch
Global ExamInfo As New clsLoadExam
Global GetServerSetting As New clsGetSettings
Global mRefnum As New ClassRefNum
Global GetPatientInfo As New clsGetPatientInfo
Global GetPatientRequestInfo As New clsGetPXRequestInfo
Public ReturnVal As String
Global strHostName As String
Public clsLoadExam As New clsLoadExam

Global dblTime As Double

'REAGENT VARIABLES
'LR182006 /BSL
Global gblReagentsRevID As String
Global gblLocationId As String
Global gblEmployeeCode As String
Global ListDrugs As Object
Global DrugInfo As Object

Global iBonzi As String


'User Rights
Global gblDivisionId As String
Global gblSectionId As String
Global gblClerk As Boolean
Global gblClearRevenueCode As String
Global gblCanVerifyResults As Boolean

Public Report As CRAXDRT.Report

Public chk_Codes As Lab_codes
Public chk_ADD As Detect_ADD

Global blnInquire As Boolean 'differentiate results for inquiry or editing, refer frmEditResult

Global strReportSectionID As String 'variable for storing laboratory section id alloted for reports.... gonzalo

'for markup, gonzalo, 09012010
Global blnHoliday As Boolean
Global blnTime As Boolean

Dim rRec As New ADODB.Recordset

Global CommType As Integer

'MarkUp Options, Gonzalo, 06142011
Global iExStat As String
Global iExBeyond As String
Global iExER As String
Global iExHoliday As String
Global blnAllowWalkIn As Boolean
Global blnShowAgent As Boolean
Global blnNotifyCashCom As Boolean
Global blnNotifyRequest As Boolean
Global blnAutoLock As Boolean
Global gblAutoLockTime As String
Global gblStatOnSurcharge As Boolean
Global gblEnableIPDRequest As Boolean
Global gblEnableOPDRequest As Boolean
Global gblEnableCashAssess As Boolean

Public Enum Lab_codes
    Browse_Ova = 1
    Browse_Antibiotic = 2
    Browse_Amoeba = 3
    Browse_Specimen = 4
    Browse_Section = 5
End Enum

Public Enum Detect_ADD
    Add_Ok = 1
    Save_Ok = 2
End Enum

Public Enum SearchType
    O1_LabExam = 1
    O2_Specimen = 2
    O3_Company = 3
    O4_LabNValues = 4
    O5_LabExamSpecimen = 5
    O6_LabDoctor = 6
    O7_LabFormFormats = 7
    O8_LabReagents = 8
    O10_LabAgeValues = 10
    O11_LabExamReagents = 11
    O27_LabMachines = 27
End Enum

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  Line(Flags As Integer, X1 As Single, Y1 As Single, X2 As Single, Y2 As Single, Color As Long)

        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
Public Function HolidayGreeting() As String
On Error GoTo Error_Trap:
    Dim recS As New ADODB.Recordset
    Dim strGreeting As String
    recS.Open "Build_File..global_HolidayTagging", CurrentUser.SQLConnection, adOpenDynamic, adLockOptimistic
    If recS.RecordCount <= 0 Then

        blnHoliday = False
    Else
        blnHoliday = True

        strGreeting = recS!HolidayGreeting & ""
        If Len(strGreeting) = 0 Then
            strGreeting = "Today is " & recS!HolidayName & "."
        End If
    End If
    recS.Close
    Set recS = Nothing
            
    If Not blnHoliday Then
        If IsSunday Then
            strGreeting = "Today is Sunday."
        Else
            strGreeting = ""
        End If
    End If
            
    HolidayGreeting = strGreeting
    
Exit Function
Error_Trap:
    blnHoliday = False
    HolidayGreeting = ""
End Function

Public Function IsSunday() As Boolean
    Dim recS As New ADODB.Recordset
    Dim intWeekDay As Integer
            
    recS.Open "select datepart(weekday, GETDATE()) as wd", CurrentUser.SQLConnection, adOpenDynamic, adLockOptimistic
    intWeekDay = recS!WD
    recS.Close
    Set recS = Nothing
            
    If intWeekDay = 1 Then
        IsSunday = True
    Else
        IsSunday = False
    End If
End Function

Function MarkedUpPrice(LabExamID As String, Amount As Double, PatientType As String) As Double
     If getDateSetting.WithSurcharge(LabExamID, PatientType) = True Then
        clsLoadExam.LoadExam LabExamID
        MarkedUpPrice = (CDbl(Amount) * (CDbl(clsLoadExam.MarkupPercentage) / 100)) + CDbl(Amount)
        blnWithSurcharge = True
     Else
         MarkedUpPrice = Format(Amount, "0.00")
         blnWithSurcharge = False
'     clsLoadExam.LoadExam LabExamID
'        MarkedUpPrice = (CInt(Amount) * (CInt(clsLoadExam.MarkupPercentage) / 100)) + CInt(Amount)
'        blnWithSurcharge = False
     End If
'    MarkedUpPrice = Format(Amount, "0.00")
'    blnWithSurcharge = False
End Function

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 GetFormCode(ValueType As String, FormType As String) As String
            
    GetFormCode = ""
    If rRec.State > 0 Then rRec.Close
    rRec.CursorLocation = adUseClient
        rRec.Open "Select Laboratory.dbo.fn_LabGetFormatCode ('" & ValueType & "','" & FormType & "') as Code", conLaboratory, adOpenDynamic, adLockReadOnly
        If rRec.RecordCount > 0 Then
            GetFormCode = IIf(rRec!Code = 0, "", rRec!Code)
        End If
    If rRec.State > 0 Then rRec.Close
    Set rRec = Nothing
End Function

Public Function FreeLab(HospNum As String, ItemCode As String) As String
            
    FreeLab = False
'    If rRec.State > 0 Then rRec.Close
'    rRec.CursorLocation = adUseClient
'        rRec.Open "Select Laboratory.dbo.fn_LabIsFreeLab ('" & HospNum & "','" & ItemCode & "') as FreeLab", conLaboratory, adOpenDynamic, adLockReadOnly
'        If rRec.RecordCount > 0 Then
'            FreeLab = rRec!FreeLab
'        End If
'    If rRec.State > 0 Then rRec.Close
'    Set rRec = Nothing
End Function

Public Function CalcAge(DateOfBirth As String) As String
    Dim rRec As New ADODB.Recordset
    Dim sAge As String
            
    sAge = 0
    DateOfBirth = IIf(Len(DateOfBirth) = 0, Date, DateOfBirth)
    If rRec.State > 0 Then rRec.Close
    rRec.CursorLocation = adUseClient
        rRec.Open "Select Laboratory.dbo.fn_LabComputeAge ('" & CDate(DateOfBirth) & "','" & GetServerDate & "') as Age", conLaboratory, adOpenDynamic, adLockReadOnly
        If rRec.RecordCount > 0 Then
            sAge = rRec!Age & ""
        End If
    If rRec.State > 0 Then rRec.Close
    Set rRec = Nothing
    CalcAge = sAge
End Function

'Public Function CalcAge1(datEmpDateofBirth As String) As Integer
'If Len(datEmpDateofBirth) > 0 Then
'    If Not IsNull(datEmpDateofBirth) Then
'        CalcAge1 = Int(DateDiff("y", IIf(datEmpDateofBirth = "__/__/____", Date, datEmpDateofBirth), Date) \ 365.25)
'    End If
'Else
'    CalcAge1 = "0"
'End If
'End Function


Function CheckExams(intRow As Integer, strCode As String, strFormName As Form) As Boolean
    Dim intR As Integer
    Dim blnResult As Boolean
    Dim intPrevRow As Integer
    Dim strItemCode As String
            
    blnResult = False
    intPrevRow = intRow
    With strFormName.grdInput
        For intR = 1 To .Rows - 1
                    '.Row = intR: .Col = 1
            If intR <> intRow Then
                If strCode = .Get_CellText(intR, 1) Then
                    blnResult = True
                    Exit For
                End If
            End If
        Next intR
    .Row = intPrevRow
    End With
            
    CheckExams = blnResult
End Function



Function CheckExamsNew(intRow As Integer, strCode As String, strFormName As Form) As Boolean
    Dim intR As Integer
    Dim blnResult As Boolean
    Dim intPrevRow As Integer
    Dim strItemCode As String
            
    blnResult = False
    intPrevRow = intRow
    With strFormName.grdNewInput
        For intR = 1 To .Rows - 1
                    '.Row = intR: .Col = 1
            If intR <> intRow Then
                If strCode = .Get_CellText(intR, 1) Then
                    blnResult = True
                    Exit For
                End If
            End If
        Next intR
    .Row = intPrevRow
    End With
            
    CheckExamsNew = blnResult
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())
On Error GoTo Error_Trap:
   Dim crxParameterField As CRAXDRT.ParameterFieldDefinition
   Dim intCtr As Integer
   Dim intTotalParam As Integer
   Dim crxTable As CRAXDRT.DatabaseTable
   Dim crxApplication As New CRAXDRT.Application
   Dim fso As New FileSystemObject
   Dim strFileLocation As String
   Dim vFilename As Variant
   
   strFileLocation = strReportFileName
   vFilename = Split(strFileLocation, "\")
   strReportFileName = App.Path & "\Reports\" & vFilename(UBound(vFilename))
   
   If fso.FileExists(strReportFileName) = True Then
        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, CurrentUser.UserId, CurrentUser.serverpassword
                           
        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
    Else
        MsgBox """" + strReportFileName + """ is missing or has been deleted.", vbExclamation
        Exit Sub
    End If
    
    Call SaveAuditTrail(CurrentUser.Employeecode, "OPENED REPORT " & vFilename(UBound(vFilename)))
Set fso = Nothing

Exit Sub

Error_Trap:
    MsgBox Err.Description, vbExclamation
End Sub

Public Sub OpenSubReport(ByVal strSubReport 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 crxSubreport As CRAXDRT.Report
                   
   intTotalParam = UBound(strParameters)
   Set crxSubreport = Report.OpenSubReport(strSubReport)
   crxSubreport.ReportTitle = sHospitalName
   For Each crxTable In crxSubreport.Database.Tables
      crxTable.Location = strDatabaseName + Mid(crxTable.Location, InStr(1, crxTable.Location, "."))
      crxTable.SetLogOnInfo CurrentUser.servername, strDatabaseName, CurrentUser.UserId, CurrentUser.serverpassword
   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)
On Error GoTo Error_Trap:

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
          .crViewer1.Zoom 1
          .Show vbModal
       End With
        
End If

Exit Sub

Error_Trap:
    Unload frmReportViewer
End Sub

Public Sub HighLight()
    With Screen.ActiveForm
        If (TypeOf .ActiveControl Is TextBox) Then
            .ActiveControl.SelStart = 0
            .ActiveControl.SelLength = Len(.ActiveControl)
        End If
    End With
End Sub

Public Sub EmbossText(myForm As Form)
    Dim ctr As Integer
    For ctr = 1 To 4
        Load myForm.lblHeader(ctr)
        myForm.lblHeader(ctr).Visible = True
    Next
    myForm.lblHeader(1).Left = myForm.lblHeader(0).Left - 10
    myForm.lblHeader(1).Top = myForm.lblHeader(0).Top - 10
    myForm.lblHeader(1).ForeColor = &H80000005
    myForm.lblHeader(2).Left = myForm.lblHeader(0).Left + 10
    myForm.lblHeader(2).Top = myForm.lblHeader(0).Top + 10
    myForm.lblHeader(2).ForeColor = &HC0C0C0
    myForm.lblHeader(3).Left = myForm.lblHeader(0).Left + 20
    myForm.lblHeader(3).Top = myForm.lblHeader(0).Top + 20
    myForm.lblHeader(3).ForeColor = &H80000012
End Sub

Public Sub CheckForUpdate()
    If GetSetting("Laboratory", "DllUpdater", "LabResultEntry.DLL") = "" Then
        SaveSetting "Laboratory", "DllUpdater", "LabResultEntry.DLL", "1.0.0.0"
        SaveSetting "Laboratory", "DllUpdater", "LabResultViewer.DLL", "1.0.0.0"
        SaveSetting "Laboratory", "DllUpdater", "LabSearchCodes.DLL", "1.0.0.0"
        SaveSetting "Laboratory", "DllUpdater", "HistopathRequest.DLL", "1.0.0.0"
    Else
        If fosScript.FileExists(App.Path & "\LabResultEntry.dll") Then DllUpdate fosScript.GetFileVersion(App.Path & "\LabResultEntry.dll"), GetSetting("Laboratory", "DllUpdater", "LabResultEntry.DLL"), "LabResultEntry.DLL"
        If fosScript.FileExists(App.Path & "\LabResultViewer.dll") Then DllUpdate fosScript.GetFileVersion(App.Path & "\LabResultViewer.dll"), GetSetting("Laboratory", "DllUpdater", "LabResultViewer.DLL"), "LabResultViewer.DLL"
        If fosScript.FileExists(App.Path & "\LabSearchCodes.dll") Then DllUpdate fosScript.GetFileVersion(App.Path & "\LabSearchCodes.dll"), GetSetting("Laboratory", "DllUpdater", "LabSearchCodes.DLL"), "LabSearchCodes.DLL"
        If fosScript.FileExists(App.Path & "\HistopathRequest.dll") Then DllUpdate fosScript.GetFileVersion(App.Path & "\HistopathRequest.dll"), GetSetting("Laboratory", "DllUpdater", "HistopathRequest.DLL"), "HistopathRequest.DLL"
    End If
End Sub

Public Sub DllUpdate(fileVer As String, RegVer As String, dllFileName As String)
    Dim mFileVer As Variant
    Dim mRegVer As Variant
    Dim ctr As Integer
    Dim temp As String
    Dim canUpdate  As Boolean
    canUpdate = False
    mFileVer = Split(fileVer, ".")
    mRegVer = Split(RegVer, ".")
    For ctr = 0 To 3
        If Val(mFileVer(ctr)) > Val(mRegVer(ctr)) Then
            canUpdate = True
            ctr = 3
        End If
    Next ctr
    If canUpdate Then
        Shell "regsvr32 " & Chr(34) & App.Path & "\" & dllFileName & Chr(34) & " /s", vbHide
        SaveSetting "Laboratory", "DllUpdater", dllFileName, fileVer
    End If
End Sub

Public Function HGridFormat(Grid As MSHFlexGrid, Columns As Integer, HeadingsString As String)
Dim intI As Integer
Dim intJ As Integer
Dim intPointer As Integer
Dim strHeading As String
        
Grid.RowPosition(0) = 0
Grid.Cols = Columns
        
intPointer = 0
For intI = 1 To Columns - 1
    Grid.Col = intI
    strHeading = ""
    intPointer = intPointer + 1
    For intJ = intPointer To Len(HeadingsString)
        intPointer = intJ
        If Mid$(HeadingsString, intPointer, 1) = "?" Then
            Grid.TextMatrix(0, Grid.Col) = strHeading
            Exit For
        Else
            strHeading = strHeading + Mid$(HeadingsString, intPointer, 1)
        End If
    Next intJ
Next intI
        
End Function

Public Sub MyFormatStringH(Grid1 As MSHFlexGrid, FormatString As String)
Dim intI As Integer
Dim intJ As Integer
            
intJ = -1
        
For intI = 1 To Len(FormatString)
            Select Case Mid$(FormatString, intI, 1)
                Case ">", "<", "^"
            intJ = intJ + 1
            If intJ <= Grid1.Cols - 1 Then
                        Select Case Mid$(FormatString, intI, 1)
                            Case "<"
                        Grid1.ColAlignment(intJ) = 1
                    Case ">"
                        Grid1.ColAlignment(intJ) = 7
                    Case "^"
                        Grid1.ColAlignment(intJ) = 4
                End Select
            End If
    End Select
Next intI
        
End Sub

Public Function Check_Clearance(IdNum As String) As Boolean
Dim recClear As New ADODB.Recordset
    Check_Clearance = False
    If recClear.State > 0 Then recClear.Close
    recClear.CursorLocation = adUseClient
    recClear.Open "Laboratory..Lab_CheckClearance '" & IdNum & "', '" & gblClearRevenueCode & "'", conLaboratory, adOpenDynamic, adLockReadOnly
    If recClear.RecordCount > 0 Then
        Check_Clearance = True
    End If
    If recClear.State > 0 Then recClear.Close
End Function

Public Function Search(SearchType As SearchType, SearchCriteria As String, Optional SearchCriteria2 As String = "") As Variant
    Dim mySearch As Variant
    Dim strType As String
            
    blnMyLabSearched = True
    mySearch = LSearch.showSearchForm(SearchType, SearchCriteria, SearchCriteria2)
    Select Case SearchType
        Case 1: strType = mySearch.LabExam
        Case 2: strType = mySearch.Specimen
        Case 3: strType = mySearch.Company
        Case 5: strType = mySearch.ExamSpecimen
        Case 7: strType = mySearch.Description
        Case 8: strType = mySearch.reagent
        Case 10: strType = mySearch.Age
        Case 27: strType = mySearch.Code
    End Select

    If Len(strType) <> 0 Then
        Search = mySearch
    Else
        blnMyLabSearched = False
    End If
'    Set mySearch = Nothing
End Function

Public Function CheckPending(IdNum As String) As Boolean
    Dim recPending As New ADODB.Recordset
    CheckPending = False
    If recPending.State > 0 Then recPending.Close
    recPending.CursorLocation = adUseClient
    recPending.Open "LABORATORY..Lab_CheckWithPending '" & Trim$(IdNum) & "','LB'", conLaboratory, adOpenDynamic, adLockReadOnly
        If recPending.RecordCount > 0 Then
            If recPending!Total > 0 Then CheckPending = True
        End If
    If recPending.State > 0 Then recPending.Close
    Set recPending = Nothing
End Function

Function PatientWithVerifiedResult(IdNum As String, CanView As Integer) As Boolean
    Dim recAccess As New ADODB.Recordset
    PatientWithVerifiedResult = False
    With recAccess
        If .State > 0 Then .Close
            .CursorLocation = adUseClient
            .Open "Select Laboratory.dbo.fn_LabPatientWithVerifiedResult('" & IdNum & "', '" & CanView & "') as WithVerified", conLaboratory, adOpenDynamic, adLockReadOnly
            If .RecordCount > 0 Then
                PatientWithVerifiedResult = !WithVerified
            End If
        If .State > 0 Then .Close
    End With
    Set recAccess = Nothing
End Function

Function CSWithVerifiedResult(CSNum As String, CanView As Integer) As Boolean
    Dim recAccess As New ADODB.Recordset
    CSWithVerifiedResult = False
    With recAccess
        If .State > 0 Then .Close
            .CursorLocation = adUseClient
            .Open "Select Laboratory.dbo.fn_LabWithVerifiedResultCS('" & CSNum & "', '" & CanView & "') as WithVerified", conLaboratory, adOpenDynamic, adLockReadOnly
            If .RecordCount > 0 Then
                CSWithVerifiedResult = !WithVerified
            End If
        If .State > 0 Then .Close
    End With
    Set recAccess = Nothing
End Function

Function ComputeStatFee(Amount As Double, strLabExamId As String) As Double
    Dim MarkupPercentage As Double
    ExamInfo.LoadExam strLabExamId
    MarkupPercentage = ExamInfo.MarkupPercentage
    
    ComputeStatFee = CDbl(Amount) + ((CDbl(MarkupPercentage) / 100)) * CDbl(Amount) '((CDbl(Amount) + StatFeeMarkUp))
    
    
    'updated by jetty
    
   ' ComputeStatFee = (CInt(Amount) + CInt(MarkupPercentage))
End Function

Public Sub UpCase(KeyAsc As Integer)
    With Screen.ActiveForm
        If (TypeOf .ActiveControl Is TextBox Or TypeOf .ActiveControl Is ComboBox) Then
            KeyAsc = Asc(UCase$(Chr$(KeyAsc)))
        End If
    End With
End Sub

Public Function Get_OPDRateType(strIDN As String) As String

Dim recIDN As New ADODB.Recordset

Get_OPDRateType = ""

If recIDN.State > 0 Then recIDN.Close

recIDN.Open "PATIENT_DATA..sp_Get_OPD_Classification '" & Trim$(strIDN) & "'", conLaboratory, adOpenForwardOnly, adLockReadOnly
If Not (recIDN.EOF Or recIDN.BOF) Then
    Get_OPDRateType = recIDN!RateType & ""
Else
    If Left(Trim(strIDN), 1) = "T" Then
        Get_OPDRateType = "A"
    End If
End If
If recIDN.State > 0 Then recIDN.Close
Set recIDN = Nothing

End Function


Public Function Check_IfSpecialHMO(strRIDNum As String) As String
    Dim recOpen As New ADODB.Recordset
    Dim strSQL As String
    Dim strHMO As String
    
    strSQL = "select Radiology.dbo.fn_Radio_CheckIfSpecialHMO ('" & Trim$(strRIDNum) & "') as HMO"
    
    If IsIdNumNumeric(strRIDNum) = True Then Exit Function
    
    With recOpen
        If .State > 0 Then .Close
        .CursorLocation = adUseClient
        .Open strSQL, conLaboratory, adOpenDynamic, adLockOptimistic
        If .RecordCount > 0 Then
            Check_IfSpecialHMO = !HMO & ""
        End If
    End With
    
'    If strRate = "G" Then
'        If strGrevenueid = "XR" Then
'            Check_IfSpecialHMO = strRate
'        ElseIf strGrevenueid = "US" Then
'            Check_IfSpecialHMO = strRate
'        Else
'            Check_IfSpecialHMO = ""
'        End If
'    ElseIf strRate = "F" Then
'        If strGrevenueid = "XR" Then
'            Check_IfSpecialHMO = strRate
'        Else
'            Check_IfSpecialHMO = ""
'        End If
'    Else
'        Check_IfSpecialHMO = ""
'    End If
    
End Function

Public Function GetRates(ItemID As String, Rate As String) As Double
    Dim recOpen As New ADODB.Recordset
    Dim strSQL As String
    Dim strRate As Double
    
    strSQL = "Radiology..Radio_SpecialHMORates '" & ItemID & "','LB','" & Rate & "'"
    
    With recOpen
        If .State > 0 Then .Close
        .CursorLocation = adUseClient
        .Open strSQL, conLaboratory, adOpenDynamic, adLockOptimistic
        If .RecordCount > 0 Then
            strRate = !Rate & ""
        End If
    End With
    GetRates = strRate
    
End Function

Public Sub AppendStockCard(strHospNum As String, _
                           strIdNum As String, _
                           strItemId As String, _
                           strTransDate As String, _
                           strRefNum As String, _
                           dblQuantity As Double, _
                           dblQuantityRec As Double, _
                           dblAmount As Double, _
                           strUserID As String, _
                           strDosageID As String, _
                           strRequestByID As String, _
                           strLocationID As String, _
                           strTargetLocationID As String, _
                           strRoomId As String, intShift As Integer, _
                           Optional strRevenueID As Variant = "PH", _
                           Optional strSummaryCode As String = "PH", _
                           Optional strClinicID As String = "", _
                           Optional strItemType As String = "D", _
                           Optional strRemark As String = "", _
                           Optional strRequestNumber As String = "", _
                           Optional strInOut As String = "I", _
                           Optional intCommunication As Integer = 0, _
                           Optional intPostOrReturn As Integer = 1, _
                           Optional strCreditMemoNum As String = "", _
                           Optional intDispenserCode As Integer = 0, Optional strCashName As String = "", Optional strSequence As String = "", Optional datReportDate As String, Optional intSenior As Integer = 0, Optional strAcctNum As String = "", Optional strCashAddress As String = "", Optional strCashDoctor As String = "")
   Dim recAppendStockCard As New ADODB.Recordset
   
'   On Error GoTo AppendStockCardErr
   
   With recAppendStockCard
      .Open "Inventory.dbo.Drug_AddStockCard '" & strSummaryCode & "','" & _
                                       strHospNum & "','" & _
                                       strIdNum & "','" & _
                                       strItemId & "','" & _
                                       strTransDate & "','" & _
                                       strRevenueID & "','" & _
                                       strRefNum & "','" & _
                                       dblQuantity & "','" & _
                                       dblQuantityRec & "','" & _
                                       dblAmount & "','" & _
                                       strUserID & "','" & _
                                       strDosageID & "','" & _
                                       strClinicID & "','" & _
                                       strItemType & "','" & _
                                       strRequestByID & "','" & _
                                       strLocationID & "','" & _
                                       strTargetLocationID & "','" & strRoomId & "','" & _
                                       strRemark & "','" & _
                                       strRequestNumber & "','" & _
                                       strInOut & "','" & _
                                       intCommunication & "','" & _
                                       intPostOrReturn & "','" & _
                                       strCreditMemoNum & "','" & intDispenserCode & "','" & strCashName & "','" & strSequence & "','" & datReportDate & "','" & intShift & "','" & intSenior & "','" & strAcctNum & "','" & strCashAddress & "','" & strCashDoctor & "'", _
             conLaboratory, adOpenDynamic, adLockOptimistic
      If .State > 0 Then .Close
   End With
   
   Set recAppendStockCard = Nothing
   
   Exit Sub

AppendStockCardErr:
'   Call RaiseError(MyUnhandledError, "Drug: AppendStockCard Method")
End Sub

Public Function Search_ChargeSlip(strChargeSlip As String) As Boolean
Dim recCh  As New ADODB.Recordset

Search_ChargeSlip = False

If recCh.State > 0 Then recCh.Close

recCh.Open "Verifiy_Chargeslip '" & Trim$(strChargeSlip) & "'", conLaboratory, adOpenDynamic, adLockOptimistic
If Not recCh.EOF Then
    Search_ChargeSlip = True
End If
If recCh.State > 0 Then recCh.Close
Set recCh = Nothing

End Function

Function GetServerDate() As Date
    Dim a As New ADODB.Recordset
    
    a.Open "SELECT getdate() as serverdate", _
                conLaboratory, adOpenDynamic, adLockReadOnly
        GetServerDate = a!serverdate
    a.Close
    Set a = Nothing
End Function

Function StatFeeMarkUp() As Double
Dim recX As New ADODB.Recordset

With recX
    If .State > 0 Then .Close
    .CursorLocation = adUseClient
    .Open "select top 1 isnull(statmarkup,0) as statmarkup from laboratory..tblabsetup", conLaboratory, adOpenDynamic, adLockOptimistic
    If .RecordCount > 0 Then
        StatFeeMarkUp = Val(!StatMarkUp)
    Else
        StatFeeMarkUp = 0
    End If
    
    If .State > 0 Then .Close
End With

Set recX = Nothing
End Function

Public Function ChangeAsc(KeyAscii As Integer) As Integer
    If KeyAscii = Asc("'") Then
        ChangeAsc = Asc("`")
    Else
        ChangeAsc = KeyAscii
    End If
End Function


Public Function ClientName() As String
On Error GoTo Trapper
    Dim recX As New ADODB.Recordset
    With recX
        If .State > 0 Then .Close
        .CursorLocation = adUseClient
        .Open "select top 1 clientName from patient_data..tbhospitalinfo", conLaboratory, adOpenDynamic, adLockOptimistic
        If .RecordCount > 0 Then
            ClientName = !ClientName & ""
        Else
            ClientName = ""
        End If
        If .State > 0 Then .Close
    End With
    Exit Function
Trapper:
    ClientName = ""
End Function

'============================================================
' Get Server Date and Time
'============================================================
Public Function getDateTime(Optional strDate As String) As String
On Error GoTo Error_Trap
    getDateTime = Format(strDate, "MM/DD/YYYY")
    Exit Function
Error_Trap:
    MsgBox "Error: [" + Err.Description + "]", vbCritical, "modMain (Function GetSAC)"
    End
End Function
        
Public Sub CheckVerifyRights(EmployeeID As String)
    Dim recRights As New ADODB.Recordset
    
    recRights.Open "Select 1 From Laboratory..tbLabPasswordMain Where EmployeeID = '" & _
        EmployeeID & "' and RightCode = 11", conLaboratory, adOpenDynamic, adLockReadOnly
    If Not recRights.EOF Then
        gblCanVerifyResults = True
    Else
        gblCanVerifyResults = False
    End If
    recRights.Close
End Sub

Public Function SurchargeExemptedForHemoPtx(strItemId As String) As Boolean
'***This function will check if a procedure is tagged as exempted for surcharge ***'
'***Exemption is exclusive for SCH Hemodialysis Outpatients                     ***'
'***If tagged, the price will be based on RateB                                 ***'
'***    else the usual price and markup will be applied                         ***'

On Error GoTo Error_Trap:
Dim recHemo As New ADODB.Recordset
Dim strSQL As String

strSQL = ""
strSQL = "SELECT isnull(hemosurchargeexempted,0) as SurchargeExempted FROM Build_file..tbcolabexam "
strSQL = strSQL + "WHERE LabexamId = '" & strItemId & "'"

With recHemo
    If .State > 0 Then .Close
    .CursorLocation = adUseClient
    .Open strSQL, conLaboratory, adOpenStatic, adLockReadOnly
    
    If .RecordCount > 0 Then
        If !SurchargeExempted = True Then
            SurchargeExemptedForHemoPtx = True
        Else
            SurchargeExemptedForHemoPtx = False
        End If
    Else
        SurchargeExemptedForHemoPtx = False
    End If
    
    If .State > 0 Then .Close
End With


Set recHemo = Nothing

Exit Function

Error_Trap:
    SurchargeExemptedForHemoPtx = False
End Function

Public Function StatOnSurcharge() As Boolean
'*** This function will set requests on STAT if there is surcharge. ***'
On Error GoTo Error_Trap:
Dim recStat As New ADODB.Recordset
Dim strSQL As String

strSQL = "select StatonSurcharge from Laboratory..tblabsetup"

With recStat
    If .State > 0 Then .Close
    .CursorLocation = adUseClient
    .Open strSQL, conLaboratory, adOpenStatic, adLockReadOnly
    If .RecordCount > 0 Then
        If !StatOnSurcharge = True Then
            StatOnSurcharge = True
        Else
            StatOnSurcharge = False
        End If
    Else
        StatOnSurcharge = True
    End If
    
    If .State > 0 Then .Close
End With
Set recStat = Nothing
Exit Function
Error_Trap:
    StatOnSurcharge = True
End Function
Public Sub SaveAuditTrail(UserId As String, Remarks As String)
On Error Resume Next
    conLaboratory.Execute "BUILD_FILE..spBuild_LogUserUpdate '" & UserId & "','" & "LB" & "','" & _
        Remarks & "'"
End Sub

Public Function IsIdNumNumeric(strIdNum As String) As Boolean
    If IsNumeric(Right(Trim$(strIdNum), 2)) = True Then
        IsIdNumNumeric = True
    Else
        IsIdNumNumeric = False
    End If
End Function

Public Function SaveAssessment(strPatientName As String, _
                strItemId As Variant, _
                dblAmount As Double, _
                strUserID As String, _
                strDate As String, _
                intSequence As Integer, _
                dblQuantity As Double, _
                strDoctorid As String, _
                strSpecimenId As String, _
                strRush As String, _
                strTransplant As String, _
                strDialysis As String, _
                strHospNum As String, _
                strChargeSlip As String, _
                strIdNum As String, _
                strDoctorName As String, _
                strProfId As String, _
                dblProfFee As Double, _
                intService As Integer, _
                strBarcode As String, _
                strRemarks As String) As String
                
 SaveAssessment = "Laboratory..LAB_AssessmentEntry '" & strPatientName _
              & "','" & Trim$(strItemId) & "','" & CStr(dblAmount) & "','" _
              & strUserID & "','" & CDate(strDate) & "','" & CStr(intSequence) & "','" _
              & CStr(dblQuantity) & "','" & Trim$(strDoctorid) & "','','','" _
              & strSpecimenId & "','" & strRush & "','" & strTransplant & "','" _
              & strDialysis & "','" & Trim$(strHospNum) & "','" & strChargeSlip _
              & "','" & Trim$(strIdNum) & "','LB','" & strDoctorName _
              & "','" & Trim$(strProfId) & "','" & CStr(dblProfFee) & "','" _
              & CStr(intService) & "','" & strBarcode & "','" & strRemarks & "'"
              
End Function