Attribute VB_Name = "mod_RegOPDFunc"
Option Explicit



Public Function ConvertToDate(strYear As String, strMonth As String, strDay As String) As String
   Dim intTemp As Integer
   Dim strDate As String

   strDate = Trim(strYear)
   intTemp = Val(strMonth)
   If intTemp >= 1 And intTemp <= 12 Then
      strDate = strDate + "." + IIf(intTemp < 10, "0", "") + Trim(strMonth)
      intTemp = Val(strDay)
      If intTemp >= 1 And intTemp <= 31 Then
         strDate = strDate + "." + IIf(intTemp < 10, "0", "") + Trim(strDay)
      End If
   End If
   ConvertToDate = strDate
End Function


Public Function ChkSurname2(strName As String, Optional blnAllowBlank As Boolean = False, Optional blnLastName As Boolean = True) As Boolean
   If Len(Trim$(strName)) = 0 Then
      ChkSurname2 = blnAllowBlank
   Else
      strName = " " + strName + " "
      If InStr(1, strName, " JR ") > 0 Or InStr(1, strName, " SR ") > 0 Or InStr(1, strName, " II") > 0 Or InStr(1, strName, " IV") > 0 Then
         MsgBox "Please enter labels like Jr, Sr, II, VI or the like in the patient's firstname...", vbCritical
         ChkSurname2 = False
      Else
         Dim recTemp As New ADODB.Recordset
         Set recTemp = PatientSearch.patientclass.ExecuteCommand("Patient_Data..sp_Adm_ValidateLastName '" + Trim$(strName) + "'")
         With recTemp
            If .EOF And .BOF Then
               If MsgBox("The " + IIf(blnLastName, "last name", "middle name") + " '" + strName + "' may not be spelled correctly. Select the 'Yes' botton if correct or 'No' botton if not...", vbCritical + vbYesNo) = vbYes Then
                  ChkSurname2 = True
               Else
                  ChkSurname2 = False
               End If
            Else
               ChkSurname2 = True
            End If
         End With
         Set recTemp = Nothing
      End If
   End If
End Function

Public Sub ExtractName(ByVal strName As String, ByRef strLastName As String, ByRef strFirstName As String, ByRef strMiddleName As String)
   Dim intpos As Integer
   intpos = InStr(1, strName, ",", vbTextCompare)
   If intpos > 0 Then
      strLastName = Trim$(Mid$(strName, 1, intpos - 1))
      strName = Trim$(Mid$(strName, intpos + 1))
      intpos = InStr(1, strName, ",", vbTextCompare)
      If intpos > 0 Then
         strFirstName = Trim$(Mid$(strName, 1, intpos - 1))
         strMiddleName = Trim$(Mid$(strName, intpos + 1))
      Else
         strFirstName = strName
         strMiddleName = ""
      End If
   Else
      strLastName = Trim$(strName)
      strFirstName = ""
      strMiddleName = ""
   End If
End Sub

Public Function CheckHMOAccount(strAccountNum As String) As Boolean
        '<EhHeader>
        On Error GoTo CheckHMOAccount_Err
        '</EhHeader>
       Dim Rec As New ADODB.Recordset
       Dim SQL As String
   
100    CheckHMOAccount = False
   
102    SQL = "Patient_Data..SP_AOPD_CheckCompanyAccount '" & strAccountNum & "'"
   
104    With Rec
106         If .State > 0 Then .Close
108         .CursorLocation = adUseClient
110         .Open SQL, PCLSUser.SQLConnection, adOpenDynamic, adLockReadOnly
        
112         If .RecordCount > 0 Then
114             CheckHMOAccount = True
            End If
116         .Close
       End With
118    Set Rec = Nothing
        '<EhFooter>
        Exit Function

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

Public Function CheckCompanyAccount(strAccountNum As String) As Boolean
        '<EhHeader>
        On Error GoTo CheckCompanyAccount_Err
        '</EhHeader>
       Dim Rec As New ADODB.Recordset
       Dim SQL As String
       
100    CheckCompanyAccount = False
102    SQL = "Patient_Data..SP_AOPD_CheckCompanyAccount_RateH '" & strAccountNum & "'"
   
104    With Rec
106         If .State > 0 Then .Close
108         .CursorLocation = adUseClient
110         .Open SQL, PCLSUser.SQLConnection, adOpenDynamic, adLockReadOnly
        
112         If .RecordCount > 0 Then
114             CheckCompanyAccount = True
            End If
116         .Close
       End With
118    Set Rec = Nothing
        '<EhFooter>
        Exit Function

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


Public Function CheckDepartment(strDept As String) As Boolean
    Dim intCode As Integer


    Dim recOpdActive As New ADODB.Recordset

    With recOpdActive
        If .State > 0 Then .Close
        .CursorLocation = adUseClient
        .Open "Select * from Build_File..tbcoRevenuecode where OPDActive = 'Y' and RevenueID   = '" & Trim$(strDept) & "'", PCLSUser.SQLConnection, adOpenDynamic, adLockOptimistic
        If .RecordCount > 0 Then
            CheckDepartment = True

        Else
            CheckDepartment = False
        End If
    End With



    '  For intCode = 0 To 10
    '   If Mid$(Me.lblDepartment(intCode).Caption, 1, 2) = strDept Then
    '    CheckDepartment = True
    '    Exit For
    '   Else
    '    CheckDepartment = False
    '   End If
    '  Next
End Function