Attribute VB_Name = "modFunctions"
Option Explicit

Public Sub AppendMessage(ByRef rstrLine As String, _
                              ByVal pstrMessage As String)
    If Trim$(rstrLine) = vbNullString Then
        rstrLine = pstrMessage
    Else
        rstrLine = rstrLine & vbCrLf & pstrMessage
    End If
End Sub


Public Function Get_InventoryType(strLocID As String) As String
Dim recIType As New ADODB.Recordset

Get_InventoryType = ""
If recIType.State > 0 Then recIType.Close
recIType.Open "Select Isnull(InventoryType,'') As InventoryType From INVENTORY..tbInvLocation Where LocationID ='" & Trim$(strLocID) & "'", PCLSUser.sqlconnection, adOpenForwardOnly, adLockReadOnly
If Not recIType.EOF Then
    Get_InventoryType = recIType!InventoryType
End If
If recIType.State > 0 Then recIType.Close
Set recIType = Nothing

End Function


Public Function CheckFixRate(RevenueID As String, ItemID As String) As Boolean
    Dim Rec As New ADODB.Recordset
    Dim SQL As String
    
    CheckFixRate = False
    If RevenueID <> "PH" Or RevenueID <> "CS" Then
        SQL = "Select FixRate from Billing..tbBillExamListing where RevenueID = '" & RevenueID & "' and ItemID = '" & ItemID & "'"
        
        With Rec
            If .State > 0 Then .Close
            .CursorLocation = adUseClient
            .Open SQL, PCLSUser.sqlconnection, adOpenDynamic, adLockReadOnly
            
            If Not .EOF Then
                If !Fixrate = "N" Then
                    CheckFixRate = True
                End If
            End If
            .Close
        End With
        Set Rec = Nothing
    End If
End Function

Public Function CheckIfAlreadyBilled(IdNum As String) As Boolean
    Dim Rec As New ADODB.Recordset
    Dim SQL As String
    
    CheckIfAlreadyBilled = False
        SQL = "Select BillingDate from Patient_Data..tbOutPatient where IDNum = '" & IdNum & "'"
        
        With Rec
            If .State > 0 Then .Close
            .CursorLocation = adUseClient
            .Open SQL, PCLSUser.sqlconnection, adOpenDynamic, adLockReadOnly
            
            If Not .EOF Then
                If IsNull(!BillingDate) = False Then
                    CheckIfAlreadyBilled = True
                End If
            End If
            .Close
        End With
        Set Rec = Nothing
    
End Function

Public Function GetIDNum() As String
    Dim Rec As New ADODB.Recordset
    Dim SQL As String
    
        SQL = "Select IDNum from Patient_Data..tbOutPatient where Hospnum = '" & pubStrHospNum & "' and dcrDate is null and OPDStatus <> 'R' and convert(varchar(10), admdate,  101) >= convert(varchar(10), getdate(), 101) order by admdate desc"
        
        With Rec
            If .State > 0 Then .Close
            .CursorLocation = adUseClient
            .Open SQL, PCLSUser.sqlconnection, adOpenDynamic, adLockReadOnly
            
            If Not .EOF Then
               Do While .EOF = False
                    'If CheckAccount(!IdNum) Then
                        GetIDNum = !IdNum
                        Exit Do
                    'End If
               .MoveNext
                Loop
            End If
            .Close
        End With
        Set Rec = Nothing
    
End Function

Public Function CheckAccount(IdNum As String) As Boolean
    Dim Rec As New ADODB.Recordset
    Dim SQL As String
    
    CheckAccount = False
        SQL = "Select * from Billing..tbBillOPdailyOut where IDNum = '" & IdNum & "'"
        
        With Rec
            If .State > 0 Then .Close
            .CursorLocation = adUseClient
            .Open SQL, PCLSUser.sqlconnection, adOpenDynamic, adLockReadOnly
            
            If Not .EOF Then
                CheckAccount = True
            End If
            .Close
        End With
        Set Rec = Nothing
    
End Function
Public Function File_Exists(FileName As String) As Boolean
    Dim fs As Object
    Dim blnResult As Boolean
On Error GoTo errHandle
    Set fs = CreateObject("Scripting.FileSystemObject")
    blnResult = fs.FileExists(FileName)
    Set fs = Nothing
    
    File_Exists = blnResult
    Exit Function
errHandle:
    File_Exists = True
End Function

' Moved to billingclass
'Public Function pclsuser.medsysclasses.validatecompany(strCompanyCode As String) As Boolean
'Dim recx As New ADODB.Recordset
'Dim myQuery As String
'
'    myQuery = "Build_File..spBuild_CanAddItems '" & strCompanyCode & "'"
'    pclsuser.medsysclasses.validatecompany = False
'  With recx
'    If .State > 0 Then .Close
'        .CursorLocation = adUseClient
'        .Open myQuery, pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic
'        If .RecordCount > 0 Then
'            pclsuser.medsysclasses.validatecompany = True
'        Else
'            pclsuser.medsysclasses.validatecompany = False
'        End If
'  End With
'
'  Set recx = Nothing
'
'End Function

' Moved to billingclass
'Public Function GetSpecializedRate(strCompanyCode As String, strRevenueId As String, strItemId As String) As Double
'Dim Rec As New ADODB.Recordset
'Dim SQL As String
'
'    SQL = "Build_File..spBuild_GetItemRate '" & strCompanyCode & "', '" & strRevenueId & "', '" & strItemId & "'"
'    With Rec
'        If .State > 0 Then .Close
'           .CursorLocation = adUseClient
'           .Open SQL, pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic
'           If .RecordCount > 0 Then
'              GetSpecializedRate = !RateA
'           End If
'    End With
'    Set Rec = Nothing
'
'End Function

Public Function GetCompanyCode(strIDNum As String) As String
Dim Rec As New ADODB.Recordset
Dim SQL As String

    SQL = "Select accountnum from patient_data..tboutpatient where idnum = '" & strIDNum & "'"
    With Rec
        If .State > 0 Then .Close
           .CursorLocation = adUseClient
           .Open SQL, PCLSUser.sqlconnection, adOpenDynamic, adLockOptimistic
           If .RecordCount > 0 Then
              GetCompanyCode = !AccountNum
           End If
    End With
    Set Rec = Nothing
End Function

Public Function get_FirstRate(strRevenueId As String, strItemId As String) As Double
    Dim recClass As New ADODB.Recordset
    Dim strSQL As String
    Dim FirstRate As Double
    Dim strType As String
      
    If IsAllowOPDAssessmentRateG Then
        strType = "2"
    Else
        strType = "1"
    End If
        
    If recClass.State > 0 Then recClass.Close
    recClass.CursorLocation = adUseClient

            strSQL = "Patient_data..OPD_GetFirstRate '" & strRevenueId & "', '" & strItemId & "', '" & strType & "'"
            
            recClass.Open strSQL, PCLSUser.sqlconnection, adOpenDynamic, adLockReadOnly
        
            If recClass.RecordCount > 0 Then
                FirstRate = recClass!NewRate
            End If
        
        get_FirstRate = FirstRate
    
    Set recClass = Nothing
End Function

' Moved to clsbilling
'Public Function CheckIfPatientCardItem(strRevenueId As String, strItemId As String) As Boolean
'    Dim recInfo As New ADODB.Recordset
'
'    CheckIfPatientCardItem = False
'
'    If recInfo.State > 0 Then recInfo.Close
'    recInfo.CursorLocation = adUseClient
'    recInfo.Open "Select IsNull(IsPatientCard,0) IsPatientCard From Billing..tbBillExamListing Where RevenueID = '" & strRevenueId & "' And ItemID = '" & strItemId & "'", pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic
'
'    If recInfo.EOF = False Then
'        If recInfo!IsPatientCard = 1 Then
'            CheckIfPatientCardItem = True
'        End If
'    End If
'    recInfo.Close
'    Set recInfo = Nothing
'End Function
'Public Function CheckOpenLateCharges(strIDNum As String) As Boolean
'    Dim strSQL As String
'    Dim Rec As New ADODB.Recordset
'
'        On Error GoTo CheckOpenLateChargesErr
'
'    strSQL = ""
'    strSQL = strSQL & " Select LateCharges from Patient_Data..tbOutPatient "
'    strSQL = strSQL & " Where IDNum ='" & strIDNum & "'"
'    With Rec
'        .Open strSQL, PCLSUser.sqlconnection, adOpenDynamic, adLockReadOnly
'            If !latecharges = True Then
'                CheckOpenLateCharges = True
'            Else
'                CheckOpenLateCharges = False
'                MsgBox "Patient's Account has already been closed, If you have charges to adjust, pls. notify the billing for further instructions.", vbExclamation, "Message"
'
'            End If
'
'        .Close
'    End With
'
'    Exit Function
'
'CheckOpenLateChargesErr:
'    MsgBox Err.Description
'End Function

Function ValidateNumberNull(intNum As Variant) As Double
 ValidateNumberNull = 0
 If Not IsNull(intNum) Then ValidateNumberNull = intNum
End Function

Public Function GetOBCode(strID As String) As String
        '<EhHeader>
        On Error GoTo GetOBCode_Err
        '</EhHeader>

        Dim recOB As New ADODB.Recordset
        Dim strSQL As String

100     GetOBCode = ""

102     If GetPxType(strID) = "O" Then
104         strSQL = "SELECT ObstetCode FROM Patient_Data..tbOutPatientHistory WHERE IDNum = '" & strID & "'"
        Else
106         strSQL = "SELECT ObstetCode FROM Patient_data..tbPatientHistory WHERE IDNum = '" & strID & "'"
        End If

108     With recOB
110         If .State > 0 Then .Close
112         .Open strSQL, PCLSUser.sqlconnection, adOpenDynamic, adLockOptimistic
114         If Not .EOF Then
116             GetOBCode = !ObstetCode & ""
            End If
118         .Close
        End With
120     Set recOB = Nothing

        '<EhFooter>
        Exit Function

GetOBCode_Err:
        MsgBox Err.Description & vbCrLf & _
               "in prjOPDRegistration.modFunctions.GetOBCode " & _
               "at line " & Erl, _
               vbExclamation + vbOKOnly, "Application Error"
        Resume Next
        '</EhFooter>
End Function
Public Function GetPxType(strID As String) As String
    If Right$(strID, 1) = "B" Then
        GetPxType = "O"
    Else
        GetPxType = "I"
    End If
End Function

Public Function GetLMP(strID As String) As String
        '<EhHeader>
        On Error GoTo GetLMP_Err
        '</EhHeader>
        Dim recLMP As New ADODB.Recordset
        Dim strSQL As String

100     GetLMP = ""

    '    If GetPxType(strID) = "O" Then
    '        strSQL = "SELECT LMP FROM Patient_Data..tbOutNurseProfile WHERE IDNum = '" & strID & "'"
    '    Else
102         strSQL = "SELECT LMP FROM Station..tbNurseProfile WHERE IDNum = '" & strID & "'"
    '    End If

104     With recLMP
106         If .State > 0 Then .Close
108         .Open strSQL, PCLSUser.sqlconnection, adOpenDynamic, adLockOptimistic
110         If Not .EOF Then
112             GetLMP = !LMP & ""
            End If
114         .Close
        End With
116     Set recLMP = Nothing

118     If GetLMP <> "" Then
120         If IsDate(GetLMP) Then
122             GetLMP = Format(GetLMP, "mm/dd/yyyy")
            End If
        End If


        '<EhFooter>
        Exit Function

GetLMP_Err:
        MsgBox Err.Description & vbCrLf & _
               "in prjOPDRegistration.modFunctions.GetLMP " & _
               "at line " & Erl, _
               vbExclamation + vbOKOnly, "Application Error"
        Resume Next
        '</EhFooter>
End Function