Attribute VB_Name = "modUtils"
Option Explicit

' REPORTTYEPS
Public Const ReportType_Processed = "PROCESSED CLAIMS"
Public Const ReportType_Pending = "PENDING CLAIMS"
Public Const ReportType_Rth = "RETURNED TO HOSPITAL"

' PATIENTIS
Public Const PatientIs_M = "MEMBER"
Public Const PatientIs_S = "SPOUSE"
Public Const PatientIs_C = "CHILD"
Public Const PatientIs_P = "PARENT"

' GENDER
Public Const Gender_M = "MALE"
Public Const Gender_F = "FEMALE"

' PATIENTTYPES
Public Const PatientType_All = "ALL"
Public Const PatientType_In = "IN"
Public Const PatientType_Out = "OUT"

' USER CATEGORY
Public Const UCategory_Hospital = "HOSPITAL"
Public Const UCategory_TbDots = "TB DOTS"
Public Const UCategory_Hemo = "HEMO"
Public Const UCategory_Llc = "LLC TAGUDIN"

' USER LOGS
Public Const ULOGS_Request = "REQUEST"
Public Const ULOGS_Save = "SAVE/UPDATE"

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpszOp As String, _
     ByVal lpszFile As String, ByVal lpszParams As String, _
     ByVal LpszDir As String, ByVal FsShowCmd As Long) _
    As Long
    
Public Enum PhicServerType
    ECCSA
    PECWS
End Enum
    
Public Enum OrderByEnum
    enLastName
    enFirstName
    enAdmissionDate
    enDischargeDate
    enNONE
End Enum

Public Enum SortByEnum
    enAsc
    enDesc
End Enum

Private Type guId
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Declare Sub CoCreateGuid Lib "ole32.dll" (ByRef pGuId As guId)
Private Declare Function StringFromGUID2 Lib "ole32.dll" (ByVal rguid As Long, ByVal lpsz As Long, ByVal cchMax As Long) As Long

Public Function GetGUID() As String
    Dim MyGUID As guId
    Dim GUIDByte() As Byte
    Dim GuidLen As Long
    
    CoCreateGuid MyGUID
    
    ReDim GUIDByte(80)
    GuidLen = StringFromGUID2(VarPtr(MyGUID.Data1), VarPtr(GUIDByte(0)), UBound(GUIDByte))
    
    GetGUID = Left(GUIDByte, 38)
End Function
    
Public Function ProcessValueWithBlank(value As String) As String
    ProcessValueWithBlank = IIf(value = Empty, "", value)
End Function

Public Function GetGenderDescription(ByVal Code As String) As String
    Select Case UCase(Code)
        Case "M"
            GetGenderDescription = Gender_M
        Case "F"
            GetGenderDescription = Gender_F
        Case Else
            GetGenderDescription = ""
    End Select
End Function

Public Function GetGenderCode(ByVal Description As String) As String
    Select Case UCase(Description)
        Case Gender_M
            GetGenderCode = "M"
        Case Gender_F
            GetGenderCode = "F"
    End Select
End Function

Public Function GetPatientIsDescription(ByVal Code As String) As String
    Select Case UCase(Code)
        Case "M"
            GetPatientIsDescription = PatientIs_M
        Case "S"
            GetPatientIsDescription = PatientIs_S
        Case "C"
            GetPatientIsDescription = PatientIs_C
        Case "P"
            GetPatientIsDescription = PatientIs_P
        Case Else
            GetPatientIsDescription = ""
    End Select
End Function

Public Function GetPatientIsCode(ByVal Description As String) As String
    Select Case UCase(Description)
        Case PatientIs_M
            GetPatientIsCode = "M"
        Case PatientIs_S
            GetPatientIsCode = "S"
        Case PatientIs_C
            GetPatientIsCode = "C"
        Case PatientIs_P
            GetPatientIsCode = "P"
    End Select
End Function

Public Function GetFullDateName(dDate As String, Optional withTime As Boolean = False) As String
    Dim result As String
    result = UCase(MonthName(Month(dDate))) & " " & Day(dDate) & ", " & Year(dDate)
    If withTime Then
        result = result & Format(dDate, " hh:mm:ss AM/PM")
    End If
    
    GetFullDateName = result
End Function

Public Function ConstructFullName(ByVal FirstName As String, ByVal MiddleName As String, ByVal LastName As String, ByVal Suffix As String) As String
    Dim result As String
    result = result & LastName & ""
    result = result & IIf(Suffix <> Empty, " " & Suffix, Suffix) & ", "
    result = result & FirstName & " "
    result = result & MiddleName
    
    ConstructFullName = ReplaceApostrophe(result)
End Function
    
Public Function GetSuffix(ByRef Name As String, Optional ByVal isValidate As Boolean = True) As String
    ' If isValidate is True
    ' Do suffix validate
    If isValidate Then
        If IsPatientSuffix Then
            If ExtractPatientSuffix = False Then
                ' DO NOTHING
                Exit Function
            End If
        Else
            If ExtractMemberSuffix = False Then
                ' DO NOTHING
                Exit Function
            End If
        End If
    End If
    
    GetSuffix = ""
    Name = Trim(Name)
    Dim SufLoc As Integer
    
'    Dim suffixes: suffixes = GetINISetting("UTILITIES", "SUFFIXES", App.path & "\settings.ini")
    Dim suffixes: suffixes = ProgramUtilities.value("SUFFIXES")
    Dim suffArr() As String
    suffArr = Split(suffixes, ";")
    
    Dim counter As Integer
    For counter = 0 To UBound(suffArr)
        SufLoc = Len(Name) - Len(suffArr(counter))
        If Len(Name) > Len(suffArr(counter)) Then
            If Trim(Mid(Name, SufLoc)) = suffArr(counter) Then
                GetSuffix = suffArr(counter)
                Exit For
            End If
        End If
    Next counter
    
    If GetSuffix <> "" Then
        Name = Mid(Name, 1, SufLoc - 1)
    End If
         
End Function

Public Function RemoveSuffix(ByRef Name As String, Optional ByVal isValidate As Boolean = True) As String
    ' If isValidate is True
    ' Do suffix validate
    If isValidate Then
        If IsPatientSuffix Then
            If ExtractPatientSuffix = False Then
                RemoveSuffix = Name
                Exit Function
            End If
        Else
            If ExtractMemberSuffix = False Then
                RemoveSuffix = Name
                Exit Function
            End If
        End If
    End If
    
    RemoveSuffix = ""
    Name = Trim(Name)
    Dim SufLoc As Integer

'    Dim suffixes: suffixes = GetINISetting("UTILITIES", "SUFFIXES", App.path & "\settings.ini")
    Dim suffixes: suffixes = ProgramUtilities.value("SUFFIXES")
    Dim suffArr() As String
    suffArr = Split(suffixes, ";")
    
    Dim counter As Integer
    For counter = 0 To UBound(suffArr)
        SufLoc = Len(Name) - Len(suffArr(counter))
        If Len(Name) > Len(suffArr(counter)) Then
            If Trim(Mid(Name, SufLoc)) = suffArr(counter) Then
                ' RemoveSuffix = Replace(Name, " " & suffArr(counter), "")
                RemoveSuffix = Trim(Mid(Name, 1, SufLoc))
                Exit For
            End If
        End If
    Next counter
    
    If RemoveSuffix = "" Then
        RemoveSuffix = Name
    End If
         
End Function

' GetWord - pass a string containing a group of word separated by comma, returns the first word.
' The first word is removed from the group of words in the passed parameter w/c is returned to
' the calling procedure.
Public Function GetWord(WordGroup As String, Separator As String) As String

Dim SepPos As Integer

    SepPos = InStr(WordGroup, Separator)
    If SepPos > 0 Then
        GetWord = Mid(WordGroup, 1, SepPos - 1)
        WordGroup = Mid(WordGroup, SepPos + Len(Separator))
    Else
        GetWord = WordGroup
        WordGroup = ""
    End If
    
End Function

'Public Sub Addlog(STR As String)
'    frmLog.txtOutput.Text = STR & vbCrLf & frmLog.txtOutput.Text
'    If frmLog.Visible = False Then
'        frmLog.Visible = True
'    End If
'End Sub

Public Sub ReplaceString(SourceStr As String, ReplaceWhat As String, ReplaceWith As String)

    Dim SPos As Integer
    Do While InStr(1, UCase(SourceStr), UCase(ReplaceWhat)) > 0
        SPos = InStr(1, UCase(SourceStr), UCase(ReplaceWhat))
        SourceStr = Mid(SourceStr, 1, SPos - 1) & ReplaceWith & Mid(SourceStr, SPos + Len(ReplaceWhat))
    Loop
    
End Sub
            
'Public Function GetXMLValue(header As String, ByVal SourseStr As String, varName) As String
'
'    Dim EqualPos As Integer
'    Dim ReadVarName As String
'    Dim ReadVarValue As String
'    Dim ValueFound As Boolean
'
'    SourseStr = Mid(SourseStr, InStr(1, SourseStr, header) + Len(header))
'    ' Get the variable name and value
'    EqualPos = InStr(1, SourseStr, varName)
'    If EqualPos > 0 Then
'        SourseStr = Mid(SourseStr, EqualPos)
'        ReadVarName = Trim(Mid(SourseStr, 1, InStr(SourseStr, "=") - 1))
'        SourseStr = Mid(SourseStr, InStr(SourseStr, """") + 1)
'        ReadVarValue = Mid(SourseStr, 1, InStr(SourseStr, """") - 1)
'    Else
'    End If
'    GetXMLValue = ReadVarValue
'
'End Function

Public Function ReadXmlDocument(ByVal path As String) As String
    Dim doc As New MSXML2.DOMDocument
    Dim success As Boolean
    success = doc.Load(path)
    If success = False Then
        MsgBox "XML LOAD ERROR FROM " & path, vbOKOnly + vbCritical
    Else
        ReadXmlDocument = doc.xml
    End If
End Function

Public Function GetXMLValue(ByVal sourseStr As String, ByVal header As String, ByVal varName As String) As String
    GetXMLValue = ""
On Error GoTo ReturnEmpty
    Dim doc As New MSXML2.DOMDocument
    doc.loadXML sourseStr
    Dim nodeList As MSXML2.IXMLDOMNodeList
    
    Set nodeList = doc.selectNodes(header)
    If Not nodeList Is Nothing Then
        Dim node As MSXML2.IXMLDOMNode
        Dim value As String
        For Each node In nodeList
            If varName = Empty Then
                GetXMLValue = node.text
            Else
                GetXMLValue = node.Attributes.getNamedItem(varName).text
            End If
        Next node
    End If
    
    Exit Function
ReturnEmpty:
    GetXMLValue = ""
End Function
    
Public Function GetXMLArrayValue(ByVal sourseStr As String, ByVal header As String, ByVal varName As String) As String()
    Dim arrList() As String
    
On Error GoTo ReturnEmpty
    Dim doc As New MSXML2.DOMDocument
    doc.loadXML sourseStr
    Dim nodeList As MSXML2.IXMLDOMNodeList
    
    Set nodeList = doc.selectNodes(header)
    If Not nodeList Is Nothing Then
        Dim node As MSXML2.IXMLDOMNode
        Dim value As String
         
        Dim arrLength As Integer
        arrLength = nodeList.length
        ReDim arrList(arrLength)
        
        Dim counter As Integer
        counter = 0
        For Each node In nodeList
            If varName = Empty Then
                arrList(counter) = node.text
            Else
                arrList(counter) = node.Attributes.getNamedItem(varName).text
            End If
           counter = counter + 1
        Next node
    End If
    
    GetXMLArrayValue = arrList
    Exit Function
ReturnEmpty:
    GetXMLArrayValue = arrList
End Function

' Delete uploaded documents on c:\eClaimsWebService\Dump folder
Public Sub DeleteDumpDocuments(Id As String)
    Dim fileNames: fileNames = GetDocumentFileNames(Id)
    
    Dim hasElement As Boolean
    On Error Resume Next
    hasElement = IsNumeric(UBound(fileNames))
    
    If hasElement Then
        Dim oFso As Object
        Set oFso = CreateObject("Scripting.FileSystemObject")
        
        Dim counter As Integer
        For counter = 0 To UBound(fileNames)
'            Dim deleteFilePath: deleteFilePath = "c:\eClaimsWebService\Dump\" & fileNames(counter) & ".pdf"
            Dim deleteFilePath: deleteFilePath = App.path & "\Dump\" & fileNames(counter) & ".pdf"
            If oFso.FileExists(deleteFilePath) Then
                ' Remove Raw Data
                oFso.DeleteFile deleteFilePath
            Else
                ' check for XML
                deleteFilePath = App.path & "\Dump\" & fileNames(counter) & ".xml"
                If oFso.FileExists(deleteFilePath) Then
                    oFso.DeleteFile deleteFilePath
                End If
            End If
        Next counter
        
        Set oFso = Nothing
    End If
End Sub

' SET "N/A" IF ""(EMPTY STRING)
Public Function SetNAAsDefault(ByVal value As String)
    Dim ret: ret = value
    
    If value = Empty Then ret = "N/A"
    
    SetNAAsDefault = ret
End Function

' SET NULL INTO ""(EMPTY STRING)
Public Function ValidateNullValue(ByVal value As Variant, Optional isUCase As Boolean = True) As String
    If isUCase Then
        ValidateNullValue = Trim(IIf(IsNull(value), "", UCase(value)))
    Else
        ValidateNullValue = Trim(IIf(IsNull(value), "", value))
    End If
End Function

' REPLACE "_" CHARACTER WITH " "
Public Function ReplaceLowDashToSpace(ByVal value As String) As String
    ReplaceLowDashToSpace = Replace(value, "_", " ")
End Function

Public Function FormatClaimDate(ByVal value As String) As String
    FormatClaimDate = Format(value, "mm-dd-yyyy")
End Function

Public Function ReplaceApostrophe(ByVal value As String)
    ReplaceApostrophe = Replace(value, "'", "`")
End Function

Public Function ReplaceBackApostrophe(ByVal value As String)
    ReplaceBackApostrophe = Replace(value, "`", "'")
End Function

' Check URL if reachable
Public Function NetConnectStatusCode(ByVal pUrl As String) As String
    Dim request As Object
    Dim ff As Integer
    Dim rc As Variant
    
On Error GoTo EndNow
    Set request = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    With request
      .Open "GET", pUrl, False
      .send
      rc = .Status
    End With
    Set request = Nothing
    NetConnectStatusCode = rc
    
    Exit Function
EndNow:
    NetConnectStatusCode = Empty
End Function

Public Sub OfflineMessage()
    MsgBox "PECWS is offline at the moment, please try again later", vbOKOnly & vbInformation
End Sub

Public Sub ErrMessageFormHandler(ByVal pServerType As PhicServerType)
    Screen.MousePointer = vbArrow
    With frmErrMessage
        .ServerType = pServerType
        .message = Err.Description
        .Show vbModal
    End With
End Sub